Changeset 5246 for LMDZ6/trunk/libf/dyn3dmem/dudv2_loc.f90
- Timestamp:
- Oct 21, 2024, 2:58:45 PM (23 hours ago)
- File:
-
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/dyn3dmem/dudv2_loc.f90
r5245 r5246 1 2 3 4 c 5 c=======================================================================6 c 7 cAuteur: P. Le Van8 c-------9 c 10 cObjet:11 c------12 c 13 c*****************************************************************14 c..... calcul du terme de pression (gradient de p/densite ) et15 cdu terme de ( -gradient de la fonction de Bernouilli ) ...16 c*****************************************************************17 cCes termes sont ajoutes a d(ucov)/dt et a d(vcov)/dt ..18 c 19 c 20 cteta , pkf, bern sont des arguments d'entree pour le s-pg ....21 cdu et dv sont des arguments de sortie pour le s-pg ....22 c 23 c=======================================================================24 c 25 26 1 SUBROUTINE dudv2_loc ( teta, pkf, bern, du, dv ) 2 USE parallel_lmdz 3 IMPLICIT NONE 4 ! 5 !======================================================================= 6 ! 7 ! Auteur: P. Le Van 8 ! ------- 9 ! 10 ! Objet: 11 ! ------ 12 ! 13 ! ***************************************************************** 14 ! ..... calcul du terme de pression (gradient de p/densite ) et 15 ! du terme de ( -gradient de la fonction de Bernouilli ) ... 16 ! ***************************************************************** 17 ! Ces termes sont ajoutes a d(ucov)/dt et a d(vcov)/dt .. 18 ! 19 ! 20 ! teta , pkf, bern sont des arguments d'entree pour le s-pg .... 21 ! du et dv sont des arguments de sortie pour le s-pg .... 22 ! 23 !======================================================================= 24 ! 25 include "dimensions.h" 26 include "paramet.h" 27 27 28 REALteta( ijb_u:ije_u,llm ),pkf( ijb_u:ije_u,llm )29 REALbern( ijb_u:ije_u,llm )30 REALdu( ijb_u:ije_u,llm ), dv( ijb_v:ije_v,llm )31 INTEGERl,ij,ijb,ije32 c 33 c 34 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)35 DO 5l = 1,llm36 c 37 38 39 40 28 REAL :: teta( ijb_u:ije_u,llm ),pkf( ijb_u:ije_u,llm ) 29 REAL :: bern( ijb_u:ije_u,llm ) 30 REAL :: du( ijb_u:ije_u,llm ), dv( ijb_v:ije_v,llm ) 31 INTEGER :: l,ij,ijb,ije 32 ! 33 ! 34 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 35 DO l = 1,llm 36 ! 37 ijb=ij_begin 38 ije=ij_end 39 if (pole_nord) ijb=ijb+iip1 40 if (pole_sud) ije=ije-iip1 41 41 42 DO 2ij = ijb, ije - 143 du(ij,l) = du(ij,l) + 0.5* ( teta( ij,l ) + teta( ij+1,l ) ) *44 *( pkf( ij,l ) - pkf(ij+1,l) ) + bern(ij,l) - bern(ij+1,l)45 2 CONTINUE46 c 47 c 48 c..... correction pour du(iip1,j,l), j=2,jjm ......49 c... du(iip1,j,l) = du(1,j,l) ...50 c 51 CDIR$ IVDEP52 DO 3ij = ijb+iip1-1, ije, iip153 54 3 CONTINUE55 c 56 c 57 42 DO ij = ijb, ije - 1 43 du(ij,l) = du(ij,l) + 0.5* ( teta( ij,l ) + teta( ij+1,l ) ) * & 44 ( pkf( ij,l ) - pkf(ij+1,l) ) + bern(ij,l) - bern(ij+1,l) 45 END DO 46 ! 47 ! 48 ! ..... correction pour du(iip1,j,l), j=2,jjm ...... 49 ! ... du(iip1,j,l) = du(1,j,l) ... 50 ! 51 !DIR$ IVDEP 52 DO ij = ijb+iip1-1, ije, iip1 53 du( ij,l ) = du( ij - iim,l ) 54 END DO 55 ! 56 ! 57 if (pole_nord) ijb=ijb-iip1 58 58 59 DO 4ij = ijb,ije60 dv( ij,l) = dv(ij,l) + 0.5 * ( teta(ij,l) + teta( ij+iip1,l ) ) *61 * ( pkf(ij+iip1,l) - pkf( ij,l ) )62 *+ bern( ij+iip1,l ) - bern( ij ,l )63 4 CONTINUE64 c 65 5 CONTINUE66 c$OMP END DO NOWAIT 67 c 68 69 END 59 DO ij = ijb,ije 60 dv( ij,l) = dv(ij,l) + 0.5 * ( teta(ij,l) + teta( ij+iip1,l ) ) * & 61 ( pkf(ij+iip1,l) - pkf( ij,l ) ) & 62 + bern( ij+iip1,l ) - bern( ij ,l ) 63 END DO 64 ! 65 END DO 66 !$OMP END DO NOWAIT 67 ! 68 RETURN 69 END SUBROUTINE dudv2_loc
Note: See TracChangeset
for help on using the changeset viewer.