Changeset 5246 for LMDZ6/trunk/libf/dyn3dmem/rotat_p.f90
- Timestamp:
- Oct 21, 2024, 2:58:45 PM (23 hours ago)
- File:
-
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/dyn3dmem/rotat_p.f90
r5245 r5246 1 2 c 3 c Auteur : P.Le Van 4 c**************************************************************5 c. calcule le rotationnel6 ca tous les niveaux d'1 vecteur de comp. x et y ..7 cx et y etant des composantes covariantes ...8 c********************************************************************9 cklevel, x et y sont des arguments d'entree pour le s-prog10 crot est un argument de sortie pour le s-prog11 c 12 13 14 c 15 16 17 18 c 19 c..... variables en arguments ......20 c 21 INTEGERklevel22 REALrot( ip1jm,klevel )23 REALx( ip1jmp1,klevel ), y( ip1jm,klevel )24 c 25 c... variables locales ...26 c 27 INTEGERl, ij28 29 c 30 c 31 32 33 34 35 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 36 DO 10l = 1,klevel37 c 38 39 rot( ij,l ) = y( ij+1 , l ) - y( ij,l ) +40 * x(ij +iip1, l ) - x( ij,l )41 42 c 43 c.... correction pour rot( iip1,j,l) ....44 c.... rot(iip1,j,l)= rot(1,j,l) ...45 CDIR$ IVDEP46 47 48 49 c 50 10 CONTINUE51 c$OMP END DO NOWAIT52 ccc CALL filtreg( rot, jjm, klevel, 2, 2, .FALSE., 1 )53 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 54 55 56 57 58 59 c$OMP END DO NOWAIT60 c 61 c 62 63 END 1 SUBROUTINE rotat_p (klevel, x, y, rot ) 2 ! 3 ! Auteur : P.Le Van 4 !************************************************************** 5 !. calcule le rotationnel 6 ! a tous les niveaux d'1 vecteur de comp. x et y .. 7 ! x et y etant des composantes covariantes ... 8 !******************************************************************** 9 ! klevel, x et y sont des arguments d'entree pour le s-prog 10 ! rot est un argument de sortie pour le s-prog 11 ! 12 USE parallel_lmdz 13 IMPLICIT NONE 14 ! 15 INCLUDE "dimensions.h" 16 INCLUDE "paramet.h" 17 INCLUDE "comgeom.h" 18 ! 19 ! ..... variables en arguments ...... 20 ! 21 INTEGER :: klevel 22 REAL :: rot( ip1jm,klevel ) 23 REAL :: x( ip1jmp1,klevel ), y( ip1jm,klevel ) 24 ! 25 ! ... variables locales ... 26 ! 27 INTEGER :: l, ij 28 INTEGER :: ijb,ije 29 ! 30 ! 31 ijb=ij_begin 32 ije=ij_end 33 if(pole_sud) ije=ij_end-iip1 34 35 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 36 DO l = 1,klevel 37 ! 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 ! 43 ! .... correction pour rot( iip1,j,l) .... 44 ! .... rot(iip1,j,l)= rot(1,j,l) ... 45 !DIR$ IVDEP 46 DO ij = ijb+iip1-1, ije, iip1 47 rot( ij,l ) = rot( ij -iim,l ) 48 ENDDO 49 ! 50 END DO 51 !$OMP END DO NOWAIT 52 !cc CALL filtreg( rot, jjm, klevel, 2, 2, .FALSE., 1 ) 53 !$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 !$OMP END DO NOWAIT 60 ! 61 ! 62 RETURN 63 END SUBROUTINE rotat_p
Note: See TracChangeset
for help on using the changeset viewer.