My Project
 All Classes Files Functions Variables Macros
rotatf_loc.F
Go to the documentation of this file.
1  SUBROUTINE rotatf_loc (klevel, x, y, rot )
2 c
3 c Auteur : P.Le Van
4 c**************************************************************
5 c. calcule le rotationnel
6 c a tous les niveaux d'1 vecteur de comp. x et y ..
7 c x et y etant des composantes covariantes ...
8 c********************************************************************
9 c klevel, x et y sont des arguments d'entree pour le s-prog
10 c rot est un argument de sortie pour le s-prog
11 c
12  USE parallel
13  USE mod_filtreg_p
14  IMPLICIT NONE
15 c
16 #include "dimensions.h"
17 #include "paramet.h"
18 #include "comgeom.h"
19 c
20 c ..... variables en arguments ......
21 c
22  INTEGER klevel
23  REAL rot( ijb_v:ije_v,klevel )
24  REAL x( ijb_u:ije_u,klevel ), y( ijb_v:ije_v,klevel )
25 c
26 c ... variables locales ...
27 c
28  INTEGER l, ij
29  INTEGER :: ijb,ije,jjb,jje
30 c
31 c
32  ijb=ij_begin
33  ije=ij_end
34  if(pole_sud) ije=ij_end-iip1
35 
36 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
37  DO 10 l = 1,klevel
38 c
39  DO ij = ijb, ije - 1
40  rot( ij,l ) = y( ij+1 , l ) - y( ij,l ) +
41  * x(ij +iip1, l ) - x( ij,l )
42  ENDDO
43 c
44 c .... correction pour rot( iip1,j,l) ....
45 c .... rot(iip1,j,l)= rot(1,j,l) ...
46 CDIR$ IVDEP
47  DO ij = ijb+iip1-1, ije, iip1
48  rot( ij,l ) = rot( ij -iim,l )
49  ENDDO
50 c
51  10 CONTINUE
52 c$OMP END DO NOWAIT
53  jjb=jj_begin
54  jje=jj_end
55  if (pole_sud) jje=jj_end-1
56  CALL filtreg_p( rot, jjb_v, jje_v,jjb,jje,jjm,
57  & klevel, 2, 2, .false., 1 )
58 
59 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
60  DO l = 1, klevel
61  DO ij = ijb, ije
62  rot(ij,l) = rot(ij,l) * unsairez(ij)
63  ENDDO
64  ENDDO
65 c$OMP END DO NOWAIT
66 c
67 c
68  RETURN
69  END