My Project
 All Classes Files Functions Variables Macros
nxgrad_gam_loc.F
Go to the documentation of this file.
1  SUBROUTINE nxgrad_gam_loc( 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 
13  IMPLICIT NONE
14 c
15 #include "dimensions.h"
16 #include "paramet.h"
17 #include "comgeom.h"
18  INTEGER klevel
19  REAL rot( ijb_v:ije_v,klevel )
20  REAL x( ijb_u:ije_u,klevel ),y(ijb_v:ije_v,klevel )
21  INTEGER l,ij
22  integer ismin,ismax
23  external ismin,ismax
24  INTEGER :: ijb,ije
25 c
26 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
27  DO 10 l = 1,klevel
28 c
29  ijb=ij_begin
30  ije=ij_end
31  if(pole_sud) ije=ij_end-iip1
32 
33  DO 1 ij = ijb+1, ije
34  y( ij,l ) = (rot( ij,l ) - rot( ij-1,l )) * cvscuvgam( ij )
35  1 CONTINUE
36 c
37 c ..... correction pour y ( 1,j,l ) ......
38 c
39 c .... y(1,j,l)= y(iip1,j,l) ....
40 CDIR$ IVDEP
41  DO 2 ij = ijb, ije, iip1
42  y( ij,l ) = y( ij +iim,l )
43  2 CONTINUE
44 c
45  ijb=ij_begin
46  ije=ij_end+iip1
47  if(pole_nord) ijb=ij_begin+iip1
48  if(pole_sud) ije=ij_end-iip1
49 
50  DO 4 ij = ijb,ije
51  x( ij,l ) = (rot( ij,l ) - rot( ij -iip1,l )) * cuscvugam( ij )
52  4 CONTINUE
53 
54  if (pole_nord) then
55  DO ij = 1,iip1
56  x( ij ,l ) = 0.
57  ENDDO
58  endif
59 
60  if (pole_sud) then
61  DO ij = 1,iip1
62  x( ij +ip1jm,l ) = 0.
63  ENDDO
64  endif
65 c
66  10 CONTINUE
67 c$OMP END DO NOWAIT
68  RETURN
69  END