My Project
 All Classes Files Functions Variables Macros
nxgrad_p.F
Go to the documentation of this file.
1  SUBROUTINE nxgrad_p (klevel, rot, x, y )
2 c
3 c P. Le Van
4 c
5 c ********************************************************************
6 c calcul du gradient tourne de pi/2 du rotationnel du vect.v
7 c ********************************************************************
8 c rot est un argument d'entree pour le s-prog
9 c x et y sont des arguments de sortie pour le s-prog
10 c
11  USE parallel
12  IMPLICIT NONE
13 c
14 #include "dimensions.h"
15 #include "paramet.h"
16 #include "comgeom.h"
17  INTEGER klevel
18  REAL rot( ip1jm,klevel ),x( ip1jmp1,klevel ),y(ip1jm,klevel )
19  INTEGER l,ij
20  INTEGER :: ijb,ije
21 c
22 c
23 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
24  DO 10 l = 1,klevel
25 c
26  ijb=ij_begin
27  ije=ij_end
28  if (pole_sud) ije=ij_end-iip1
29 
30  DO 1 ij = ijb+1, ije
31  y( ij,l ) = ( rot( ij,l ) - rot( ij-1,l ) ) * cvsurcuv( ij )
32  1 CONTINUE
33 c
34 c ..... correction pour y ( 1,j,l ) ......
35 c
36 c .... y(1,j,l)= y(iip1,j,l) ....
37 CDIR$ IVDEP
38  DO 2 ij = ijb, ije, iip1
39  y( ij,l ) = y( ij +iim,l )
40  2 CONTINUE
41 c
42  ijb=ij_begin
43  ije=ij_end+iip1
44 
45  if (pole_nord) ijb=ij_begin+iip1
46  if (pole_sud) ije=ij_end-iip1
47 
48  DO 4 ij = ijb,ije
49  x( ij,l ) = ( rot( ij,l ) - rot( ij -iip1,l ) ) * cusurcvu( ij )
50  4 CONTINUE
51 
52  if (pole_nord) then
53  DO ij = 1,iip1
54  x( ij ,l ) = 0.
55  ENDDO
56  endif
57 
58  if (pole_sud) then
59  DO ij = 1,iip1
60  x( ij +ip1jm,l ) = 0.
61  ENDDO
62  endif
63 c
64  10 CONTINUE
65 c$OMP END DO NOWAIT
66  RETURN
67  END