--- trunk/libf/dyn3d/dudv2.f 2011/04/08 12:43:31 43 +++ trunk/dyn3d/dudv2.f 2014/03/11 15:09:02 88 @@ -1,64 +1,52 @@ -! -! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/dudv2.F,v 1.1.1.1 2004/05/19 12:53:06 lmdzadmin Exp $ -! - SUBROUTINE dudv2 ( teta, pkf, bern, du, dv ) - - use dimens_m - use paramet_m - use comvert - IMPLICIT NONE -c -c======================================================================= -c -c Auteur: P. Le Van -c ------- -c -c Objet: -c ------ -c -c ***************************************************************** -c ..... calcul du terme de pression (gradient de p/densite ) et -c du terme de ( -gradient de la fonction de Bernouilli ) ... -c ***************************************************************** -c Ces termes sont ajoutes a d(ucov)/dt et a d(vcov)/dt .. -c -c -c teta , pkf, bern sont des arguments d'entree pour le s-pg .... -c du et dv sont des arguments de sortie pour le s-pg .... -c -c======================================================================= -c - - REAL, intent(in):: teta( ip1jmp1,llm ) - real pkf( ip1jmp1,llm ) ,bern( ip1jmp1,llm ), - * du( ip1jmp1,llm ), dv( ip1jm,llm ) - INTEGER l,ij -c -c - DO 5 l = 1,llm -c - DO 2 ij = iip2, ip1jm - 1 - du(ij,l) = du(ij,l) + 0.5* ( teta( ij,l ) + teta( ij+1,l ) ) * - * ( pkf( ij,l ) - pkf(ij+1,l) ) + bern(ij,l) - bern(ij+1,l) - 2 CONTINUE -c -c -c ..... correction pour du(iip1,j,l), j=2,jjm ...... -c ... du(iip1,j,l) = du(1,j,l) ... -c -CDIR$ IVDEP - DO 3 ij = iip1+ iip1, ip1jm, iip1 - du( ij,l ) = du( ij - iim,l ) - 3 CONTINUE -c -c - DO 4 ij = 1,ip1jm - dv( ij,l) = dv(ij,l) + 0.5 * ( teta(ij,l) + teta( ij+iip1,l ) ) * - * ( pkf(ij+iip1,l) - pkf( ij,l ) ) - * + bern( ij+iip1,l ) - bern( ij ,l ) - 4 CONTINUE -c - 5 CONTINUE -c - RETURN - END +module dudv2_m + + IMPLICIT NONE + +contains + + SUBROUTINE dudv2(teta, pkf, bern, du, dv) + + ! From LMDZ4/libf/dyn3d/dudv2.F, version 1.1.1.1, 2004/05/19 12:53:06 + + ! Author: P. Le Van + + ! Objet: calcul du terme de pression (gradient de p/densité) et du + ! terme de (- gradient de la fonction de Bernouilli). Ces termes + ! sont ajoutes a d(ucov)/dt et a d(vcov)/dt. + + USE dimens_m, ONLY: iim, llm + USE paramet_m, ONLY: iip1, iip2, ip1jm, ip1jmp1 + + REAL, INTENT(IN):: teta(ip1jmp1, llm) + REAL, INTENT(IN):: pkf(ip1jmp1, llm) + real bern(ip1jmp1, llm), du(ip1jmp1, llm), dv(ip1jm, llm) + ! teta , pkf, bern sont des arguments d'entree pour le s-pg + ! du et dv sont des arguments de sortie pour le s-pg + + ! Local: + INTEGER l, ij + + !----------------------------------------------------------------- + + DO l = 1, llm + DO ij = iip2, ip1jm - 1 + du(ij, l) = du(ij, l) + 0.5 * (teta(ij, l) + teta(ij + 1, l)) & + * (pkf(ij, l) - pkf(ij + 1, l)) + bern(ij, l) - bern(ij + 1, l) + END DO + + ! correction pour du(iip1, j, l), j=2, jjm + ! du(iip1, j, l) = du(1, j, l) + DO ij = iip1 + iip1, ip1jm, iip1 + du(ij, l) = du(ij - iim, l) + END DO + + DO ij = 1, ip1jm + dv(ij, l) = dv(ij, l) + 0.5 * (teta(ij, l) + teta(ij + iip1, l)) & + * (pkf(ij + iip1, l) - pkf(ij, l)) + bern(ij + iip1, l) & + - bern(ij, l) + END DO + END DO + + END SUBROUTINE dudv2 + +end module dudv2_m