Changeset 5246 for LMDZ6/trunk/libf/dyn3d/dudv2.f90
- Timestamp:
- Oct 21, 2024, 2:58:45 PM (23 hours ago)
- File:
-
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/dyn3d/dudv2.f90
r5245 r5246 2 2 ! $Header$ 3 3 ! 4 4 SUBROUTINE dudv2 ( teta, pkf, bern, du, dv ) 5 5 6 7 c 8 c=======================================================================9 c 10 cAuteur: P. Le Van11 c-------12 c 13 cObjet:14 c------15 c 16 c*****************************************************************17 c..... calcul du terme de pression (gradient de p/densite ) et18 cdu terme de ( -gradient de la fonction de Bernouilli ) ...19 c*****************************************************************20 cCes termes sont ajoutes a d(ucov)/dt et a d(vcov)/dt ..21 c 22 c 23 cteta , pkf, bern sont des arguments d'entree pour le s-pg ....24 cdu et dv sont des arguments de sortie pour le s-pg ....25 c 26 c=======================================================================27 c 28 29 6 IMPLICIT NONE 7 ! 8 !======================================================================= 9 ! 10 ! Auteur: P. Le Van 11 ! ------- 12 ! 13 ! Objet: 14 ! ------ 15 ! 16 ! ***************************************************************** 17 ! ..... calcul du terme de pression (gradient de p/densite ) et 18 ! du terme de ( -gradient de la fonction de Bernouilli ) ... 19 ! ***************************************************************** 20 ! Ces termes sont ajoutes a d(ucov)/dt et a d(vcov)/dt .. 21 ! 22 ! 23 ! teta , pkf, bern sont des arguments d'entree pour le s-pg .... 24 ! du et dv sont des arguments de sortie pour le s-pg .... 25 ! 26 !======================================================================= 27 ! 28 include "dimensions.h" 29 include "paramet.h" 30 30 31 REAL teta( ip1jmp1,llm ),pkf( ip1jmp1,llm ) ,bern( ip1jmp1,llm ),32 *du( ip1jmp1,llm ), dv( ip1jm,llm )33 INTEGERl,ij34 c 35 c 36 DO 5l = 1,llm37 c 38 DO 2ij = iip2, ip1jm - 139 du(ij,l) = du(ij,l) + 0.5* ( teta( ij,l ) + teta( ij+1,l ) ) *40 *( pkf( ij,l ) - pkf(ij+1,l) ) + bern(ij,l) - bern(ij+1,l)41 2 CONTINUE42 c 43 c 44 c..... correction pour du(iip1,j,l), j=2,jjm ......45 c... du(iip1,j,l) = du(1,j,l) ...46 c 47 CDIR$ IVDEP48 DO 3ij = iip1+ iip1, ip1jm, iip149 50 3 CONTINUE51 c 52 c 53 DO 4ij = 1,ip1jm54 dv( ij,l) = dv(ij,l) + 0.5 * ( teta(ij,l) + teta( ij+iip1,l ) ) *55 * ( pkf(ij+iip1,l) - pkf( ij,l ) )56 *+ bern( ij+iip1,l ) - bern( ij ,l )57 4 CONTINUE58 c 59 5 CONTINUE60 c 61 62 END 31 REAL :: teta( ip1jmp1,llm ),pkf( ip1jmp1,llm ) ,bern( ip1jmp1,llm ), & 32 du( ip1jmp1,llm ), dv( ip1jm,llm ) 33 INTEGER :: l,ij 34 ! 35 ! 36 DO l = 1,llm 37 ! 38 DO ij = iip2, ip1jm - 1 39 du(ij,l) = du(ij,l) + 0.5* ( teta( ij,l ) + teta( ij+1,l ) ) * & 40 ( pkf( ij,l ) - pkf(ij+1,l) ) + bern(ij,l) - bern(ij+1,l) 41 END DO 42 ! 43 ! 44 ! ..... correction pour du(iip1,j,l), j=2,jjm ...... 45 ! ... du(iip1,j,l) = du(1,j,l) ... 46 ! 47 !DIR$ IVDEP 48 DO ij = iip1+ iip1, ip1jm, iip1 49 du( ij,l ) = du( ij - iim,l ) 50 END DO 51 ! 52 ! 53 DO ij = 1,ip1jm 54 dv( ij,l) = dv(ij,l) + 0.5 * ( teta(ij,l) + teta( ij+iip1,l ) ) * & 55 ( pkf(ij+iip1,l) - pkf( ij,l ) ) & 56 + bern( ij+iip1,l ) - bern( ij ,l ) 57 END DO 58 ! 59 END DO 60 ! 61 RETURN 62 END SUBROUTINE dudv2
Note: See TracChangeset
for help on using the changeset viewer.