--- trunk/dyn3d/enercin.f 2014/03/05 12:22:46 80 +++ trunk/dyn3d/enercin.f90 2014/03/05 14:38:41 81 @@ -1,98 +1,97 @@ -! -! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/enercin.F,v 1.1.1.1 2004/05/19 12:53:06 lmdzadmin Exp $ -! - SUBROUTINE enercin ( vcov, ucov, vcont, ucont, ecin ) - use dimens_m - use paramet_m - use comgeom - IMPLICIT NONE -c======================================================================= -c -c Auteur: P. Le Van -c ------- -c -c Objet: -c ------ -c -c ********************************************************************* -c .. calcul de l'energie cinetique aux niveaux s ...... -c ********************************************************************* -c vcov, vcont, ucov et ucont sont des arguments d'entree pour le s-pg . -c ecin est un argument de sortie pour le s-pg -c -c======================================================================= +! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/enercin.F,v 1.1.1.1 2004/05/19 +! 12:53:06 lmdzadmin Exp $ +SUBROUTINE enercin(vcov, ucov, vcont, ucont, ecin) + USE dimens_m + USE paramet_m + USE comgeom + IMPLICIT NONE - REAL, intent(in):: vcov( ip1jm,llm ), ucov( ip1jmp1,llm ) - real vcont( ip1jm,llm ) ,ucont( ip1jmp1,llm ),ecin( ip1jmp1,llm ) + ! ======================================================================= - REAL ecinni( iip1 ),ecinsi( iip1 ) + ! Auteur: P. Le Van + ! ------- - REAL ecinpn, ecinps - INTEGER l,ij,i + ! Objet: + ! ------ - REAL SSUM + ! ********************************************************************* + ! .. calcul de l'energie cinetique aux niveaux s ...... + ! ********************************************************************* + ! vcov, vcont, ucov et ucont sont des arguments d'entree pour le s-pg . + ! ecin est un argument de sortie pour le s-pg + ! ======================================================================= -c . V -c i,j-1 + REAL, INTENT (IN) :: vcov(ip1jm, llm), ucov(ip1jmp1, llm) + REAL vcont(ip1jm, llm), ucont(ip1jmp1, llm), ecin(ip1jmp1, llm) -c alpha4 . . alpha1 + REAL ecinni(iip1), ecinsi(iip1) + REAL ecinpn, ecinps + INTEGER l, ij, i -c U . . P . U -c i-1,j i,j i,j + REAL ssum -c alpha3 . . alpha2 -c . V -c i,j + ! . V + ! i,j-1 -c -c L'energie cinetique au point scalaire P(i,j) ,autre que les poles, est : -c Ecin = 0.5 * U(i-1,j)**2 *( alpha3 + alpha4 ) + -c 0.5 * U(i ,j)**2 *( alpha1 + alpha2 ) + -c 0.5 * V(i,j-1)**2 *( alpha1 + alpha4 ) + -c 0.5 * V(i, j)**2 *( alpha2 + alpha3 ) + ! alpha4 . . alpha1 - DO 5 l = 1,llm + ! U . . P . U + ! i-1,j i,j i,j - DO 1 ij = iip2, ip1jm -1 - ecin( ij+1, l ) = 0.5 * - * ( ucov( ij ,l ) * ucont( ij ,l ) * alpha3p4( ij +1 ) + - * ucov( ij+1 ,l ) * ucont( ij+1 ,l ) * alpha1p2( ij +1 ) + - * vcov(ij-iim,l ) * vcont(ij-iim,l ) * alpha1p4( ij +1 ) + - * vcov( ij+ 1,l ) * vcont( ij+ 1,l ) * alpha2p3( ij +1 ) ) - 1 CONTINUE + ! alpha3 . . alpha2 -c ... correction pour ecin(1,j,l) .... -c ... ecin(1,j,l)= ecin(iip1,j,l) ... -CDIR$ IVDEP - DO 2 ij = iip2, ip1jm, iip1 - ecin( ij,l ) = ecin( ij + iim, l ) - 2 CONTINUE + ! . V + ! i,j -c calcul aux poles ....... + ! L'energie cinetique au point scalaire P(i,j) ,autre que les poles, est : + ! Ecin = 0.5 * U(i-1,j)**2 *( alpha3 + alpha4 ) + + ! 0.5 * U(i ,j)**2 *( alpha1 + alpha2 ) + + ! 0.5 * V(i,j-1)**2 *( alpha1 + alpha4 ) + + ! 0.5 * V(i, j)**2 *( alpha2 + alpha3 ) - DO 3 i = 1, iim - ecinni(i) = vcov( i , l) * vcont( i ,l) * aire( i ) - ecinsi(i) = vcov(i+ip1jmi1,l) * vcont(i+ip1jmi1,l) * aire(i+ip1jm) - 3 CONTINUE - ecinpn = 0.5 * SSUM( iim,ecinni,1 ) / apoln - ecinps = 0.5 * SSUM( iim,ecinsi,1 ) / apols + DO l = 1, llm - DO 4 ij = 1,iip1 - ecin( ij , l ) = ecinpn - ecin( ij+ ip1jm, l ) = ecinps - 4 CONTINUE + DO ij = iip2, ip1jm - 1 + ecin(ij+1, l) = 0.5*(ucov(ij,l)*ucont(ij,l)*alpha3p4(ij+1)+ucov(ij+1,l) & + *ucont(ij+1,l)*alpha1p2(ij+1)+vcov(ij-iim,l)*vcont(ij-iim,l)*alpha1p4 & + (ij+1)+vcov(ij+1,l)*vcont(ij+1,l)*alpha2p3(ij+1)) + END DO - 5 CONTINUE - RETURN - END + ! ... correction pour ecin(1,j,l) .... + ! ... ecin(1,j,l)= ecin(iip1,j,l) ... + + ! DIR$ IVDEP + DO ij = iip2, ip1jm, iip1 + ecin(ij, l) = ecin(ij+iim, l) + END DO + + ! calcul aux poles ....... + + + DO i = 1, iim + ecinni(i) = vcov(i, l)*vcont(i, l)*aire(i) + ecinsi(i) = vcov(i+ip1jmi1, l)*vcont(i+ip1jmi1, l)*aire(i+ip1jm) + END DO + + ecinpn = 0.5*ssum(iim, ecinni, 1)/apoln + ecinps = 0.5*ssum(iim, ecinsi, 1)/apols + + DO ij = 1, iip1 + ecin(ij, l) = ecinpn + ecin(ij+ip1jm, l) = ecinps + END DO + + END DO + RETURN +END SUBROUTINE enercin