--- trunk/libf/dyn3d/dteta1.f 2011/04/08 12:43:31 43 +++ trunk/libf/dyn3d/dteta1.f90 2011/04/13 12:29:18 44 @@ -1,71 +1,46 @@ -! -! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/dteta1.F,v 1.1.1.1 2004/05/19 12:53:06 lmdzadmin Exp $ -! - SUBROUTINE dteta1 ( teta, pbaru, pbarv, dteta) - use dimens_m - use paramet_m - use logic - use filtreg_m, only: filtreg +SUBROUTINE dteta1(teta, pbaru, pbarv, dteta) - IMPLICIT NONE + ! From LMDZ4/libf/dyn3d/dteta1.F, version 1.1.1.1 2004/05/19 12:53:06 + ! Auteurs : P. Le Van, F. Forget -c======================================================================= -c -c Auteur: P. Le Van -c ------- -c Modif F.Forget 03/94 (on retire q et dq pour construire dteta1) -c -c ******************************************************************** -c ... calcul du terme de convergence horizontale du flux d'enthalpie -c potentielle ...... -c ******************************************************************** -c .. teta,pbaru et pbarv sont des arguments d'entree pour le s-pg .... -c dteta sont des arguments de sortie pour le s-pg .... -c -c======================================================================= + ! Calcul du terme de convergence horizontale du flux d'enthalpie + ! potentielle. + ! dteta est un argument de sortie pour le s-pg + use dimens_m + use paramet_m + use logic + use filtreg_m, only: filtreg - REAL, intent(in):: teta( ip1jmp1,llm ) - real pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm) - REAL dteta( ip1jmp1,llm ) - INTEGER l,ij + IMPLICIT NONE - REAL hbyv( ip1jm,llm ), hbxu( ip1jmp1,llm ) + REAL, intent(in):: teta(ip1jmp1, llm), pbaru(ip1jmp1, llm), pbarv(ip1jm, llm) + REAL dteta(ip1jmp1, llm) + INTEGER l, ij -c + REAL hbyv(ip1jm, llm), hbxu(ip1jmp1, llm) - DO 5 l = 1,llm + !---------------------------------------------------------------- - DO 1 ij = iip2, ip1jm - 1 - hbxu(ij,l) = pbaru(ij,l) * 0.5 * ( teta(ij,l) + teta(ij+1,l) ) - 1 CONTINUE + DO l = 1, llm + DO ij = iip2, ip1jm - 1 + hbxu(ij, l) = pbaru(ij, l) * 0.5 * (teta(ij, l) + teta(ij + 1, l)) + end DO -c .... correction pour hbxu(iip1,j,l) ..... -c .... hbxu(iip1,j,l)= hbxu(1,j,l) .... + DO ij = iip1+ iip1, ip1jm, iip1 + hbxu(ij, l) = hbxu(ij - iim, l) + end DO -CDIR$ IVDEP - DO 2 ij = iip1+ iip1, ip1jm, iip1 - hbxu( ij, l ) = hbxu( ij - iim, l ) - 2 CONTINUE + DO ij = 1, ip1jm + hbyv(ij, l)= pbarv(ij, l) * 0.5 * (teta(ij, l) + teta(ij + iip1, l)) + end DO + end DO + CALL convflu(hbxu, hbyv, llm, dteta) - DO 3 ij = 1,ip1jm - hbyv(ij,l)= pbarv(ij, l)* 0.5 * ( teta(ij, l)+ teta(ij +iip1,l) ) - 3 CONTINUE + ! stockage dans dh de la convergence horizont. filtree' du flux + ! d'enthalpie potentielle + CALL filtreg(dteta, jjp1, llm, 2, 2, .true., 1) - 5 CONTINUE - - - CALL convflu ( hbxu, hbyv, llm, dteta ) - - -c stockage dans dh de la convergence horizont. filtree' du flux -c .... ........... -c d'enthalpie potentielle . - - CALL filtreg( dteta, jjp1, llm, 2, 2, .true., 1) - -c - RETURN - END +END SUBROUTINE dteta1