- Timestamp:
- Jul 23, 2024, 7:14:34 PM (8 weeks ago)
- File:
-
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/nxgrad_gam_loc.f90
r5104 r5105 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_lmdz 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 l = 1,klevel 28 c 29 ijb=ij_begin 30 ije=ij_end 31 if(pole_sud) ije=ij_end-iip1 32 33 DO ij = ijb+1, ije 34 y( ij,l ) = (rot( ij,l ) - rot( ij-1,l )) * cvscuvgam( ij ) 35 END DO 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 ij = ijb, ije, iip1 42 y( ij,l ) = y( ij +iim,l ) 43 END DO 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 ij = ijb,ije 51 x( ij,l ) = (rot( ij,l ) - rot( ij -iip1,l )) * cuscvugam( ij ) 52 END DO 53 54 if (pole_nord) then 55 DO ij = 1,iip1 56 x( ij ,l ) = 0. 57 ENDDO 58 endif 1 SUBROUTINE nxgrad_gam_loc( klevel, rot, x, y ) 2 ! 3 ! P. Le Van 4 ! 5 ! ******************************************************************** 6 ! calcul du gradient tourne de pi/2 du rotationnel du vect.v 7 ! ******************************************************************** 8 ! rot est un argument d'entree pour le s-prog 9 ! x et y sont des arguments de sortie pour le s-prog 10 ! 11 USE parallel_lmdz 59 12 60 if (pole_sud) then 61 DO ij = 1,iip1 62 x( ij +ip1jm,l ) = 0. 63 ENDDO 64 endif 65 c 66 END DO 67 c$OMP END DO NOWAIT 68 RETURN 69 END 13 IMPLICIT NONE 14 ! 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 ! 26 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 27 DO l = 1,klevel 28 ! 29 ijb=ij_begin 30 ije=ij_end 31 if(pole_sud) ije=ij_end-iip1 32 33 DO ij = ijb+1, ije 34 y( ij,l ) = (rot( ij,l ) - rot( ij-1,l )) * cvscuvgam( ij ) 35 END DO 36 ! 37 ! ..... correction pour y ( 1,j,l ) ...... 38 ! 39 ! .... y(1,j,l)= y(iip1,j,l) .... 40 !DIR$ IVDEP 41 DO ij = ijb, ije, iip1 42 y( ij,l ) = y( ij +iim,l ) 43 END DO 44 ! 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 ij = ijb,ije 51 x( ij,l ) = (rot( ij,l ) - rot( ij -iip1,l )) * cuscvugam( ij ) 52 END DO 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 ! 66 END DO 67 !$OMP END DO NOWAIT 68 69 END SUBROUTINE nxgrad_gam_loc
Note: See TracChangeset
for help on using the changeset viewer.