My Project
 All Classes Files Functions Variables Macros
rotat_p.F
Go to the documentation of this file.
1  SUBROUTINE rotat_p (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  IMPLICIT NONE
14 c
15 #include "dimensions.h"
16 #include "paramet.h"
17 #include "comgeom.h"
18 c
19 c ..... variables en arguments ......
20 c
21  INTEGER klevel
22  REAL rot( ip1jm,klevel )
23  REAL x( ip1jmp1,klevel ), y( ip1jm,klevel )
24 c
25 c ... variables locales ...
26 c
27  INTEGER l, ij
28  INTEGER :: ijb,ije
29 c
30 c
31  ijb=ij_begin
32  ije=ij_end
33  if(pole_sud) ije=ij_end-iip1
34 
35 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
36  DO 10 l = 1,klevel
37 c
38  DO ij = ijb, ije - 1
39  rot( ij,l ) = y( ij+1 , l ) - y( ij,l ) +
40  * x(ij +iip1, l ) - x( ij,l )
41  ENDDO
42 c
43 c .... correction pour rot( iip1,j,l) ....
44 c .... rot(iip1,j,l)= rot(1,j,l) ...
45 CDIR$ IVDEP
46  DO ij = ijb+iip1-1, ije, iip1
47  rot( ij,l ) = rot( ij -iim,l )
48  ENDDO
49 c
50  10 CONTINUE
51 c$OMP END DO NOWAIT
52 ccc CALL filtreg( rot, jjm, klevel, 2, 2, .FALSE., 1 )
53 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
54  DO l = 1, klevel
55  DO ij = ijb, ije
56  rot(ij,l) = rot(ij,l) * unsairez(ij)
57  ENDDO
58  ENDDO
59 c$OMP END DO NOWAIT
60 c
61 c
62  RETURN
63  END