--- trunk/Sources/dyn3d/enercin.f 2015/04/29 15:47:56 134 +++ trunk/Sources/dyn3d/enercin.f 2016/09/01 10:30:53 207 @@ -1,97 +1,103 @@ +module enercin_m -! $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 - ! ======================================================================= +contains - ! Auteur: P. Le Van - ! ------- + SUBROUTINE enercin(vcov, ucov, vcont, ucont, ecin) - ! Objet: - ! ------ + ! From LMDZ4/libf/dyn3d/enercin.F, version 1.1.1.1 2004/05/19 12:53:06 - ! ********************************************************************* - ! .. 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 + USE dimens_m + USE paramet_m + USE comgeom - ! ======================================================================= + ! ======================================================================= + ! Auteur: P. Le Van + ! ------- - REAL, INTENT (IN) :: vcov(ip1jm, llm), ucov(ip1jmp1, llm) - REAL vcont(ip1jm, llm), ucont(ip1jmp1, llm), ecin(ip1jmp1, llm) + ! Objet: + ! ------ - REAL ecinni(iip1), ecinsi(iip1) + ! ********************************************************************* + ! .. 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 - REAL ecinpn, ecinps - INTEGER l, ij, i + ! ======================================================================= - REAL ssum + REAL, INTENT (IN) :: vcov(ip1jm, llm), ucov(ip1jmp1, llm) + REAL vcont(ip1jm, llm), ucont(ip1jmp1, llm), ecin(ip1jmp1, llm) + REAL ecinni(iip1), ecinsi(iip1) - ! . V - ! i,j-1 + REAL ecinpn, ecinps + INTEGER l, ij, i - ! alpha4 . . alpha1 + REAL ssum - ! U . . P . U - ! i-1,j i,j i,j - ! alpha3 . . alpha2 + ! . V + ! i,j-1 + ! alpha4 . . alpha1 - ! . V - ! i,j + ! U . . P . U + ! i-1,j i,j i,j - ! 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 ) + ! alpha3 . . alpha2 - DO l = 1, llm + ! . V + ! i,j - 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 - ! ... correction pour ecin(1,j,l) .... - ! ... ecin(1,j,l)= ecin(iip1,j,l) ... + ! 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 ) - ! DIR$ IVDEP - DO ij = iip2, ip1jm, iip1 - ecin(ij, l) = ecin(ij+iim, l) - END DO - ! calcul aux poles ....... + DO l = 1, llm + 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 - 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 + ! ... 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 - ecinpn = 0.5*ssum(iim, ecinni, 1)/apoln - ecinps = 0.5*ssum(iim, ecinsi, 1)/apols + ! 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 - DO ij = 1, iip1 - ecin(ij, l) = ecinpn - ecin(ij+ip1jm, l) = ecinps END DO - END DO - RETURN -END SUBROUTINE enercin + END SUBROUTINE enercin + +end module enercin_m