/[lmdze]/trunk/Sources/phylmd/transp.f
ViewVC logotype

Diff of /trunk/Sources/phylmd/transp.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 134 by guez, Wed Apr 29 15:47:56 2015 UTC revision 171 by guez, Tue Sep 29 19:48:59 2015 UTC
# Line 1  Line 1 
1    module transp_m
2    
3  ! $Header: /home/cvsroot/LMDZ4/libf/phylmd/transp.F,v 1.1.1.1 2004/05/19    IMPLICIT NONE
 ! 12:53:09 lmdzadmin Exp $  
4    
5  SUBROUTINE transp(paprs, tsol, t, q, u, v, geom, vtran_e, vtran_q, utran_e, &  contains
     utran_q)  
6    
7    USE dimens_m    SUBROUTINE transp(paprs, t, q, u, v, geom, vtran_e, vtran_q, utran_e, utran_q)
8    USE dimphy  
9    USE suphec_m      ! From LMDZ4/libf/phylmd/transp.F,v 1.1.1.1 2004/05/19 12:53:09
   IMPLICIT NONE  
   ! ======================================================================  
   ! Auteur(s): Z.X.Li (LMD/CNRS)  
   ! Date: le 25 avril 1994  
   ! Objet: Calculer le transport de l'energie et de la vapeur d'eau  
   ! ======================================================================  
   
   
   REAL, INTENT (IN) :: paprs(klon, klev+1)  
   REAL tsol(klon)  
   REAL, INTENT (IN) :: t(klon, klev)  
   REAL, INTENT (IN) :: q(klon, klev), u(klon, klev), v(klon, klev)  
   REAL utran_e(klon), utran_q(klon), vtran_e(klon), vtran_q(klon)  
   
   INTEGER i, l  
   ! ------------------------------------------------------------------  
   REAL geom(klon, klev), e  
   ! ------------------------------------------------------------------  
   DO i = 1, klon  
     utran_e(i) = 0.0  
     utran_q(i) = 0.0  
     vtran_e(i) = 0.0  
     vtran_q(i) = 0.0  
   END DO  
10    
11    DO l = 1, klev      USE dimens_m
12        USE dimphy
13        USE suphec_m
14        ! ======================================================================
15        ! Auteur(s): Z.X.Li (LMD/CNRS)
16        ! Date: le 25 avril 1994
17        ! Objet: Calculer le transport total de l'energie et de la vapeur d'eau
18        ! ======================================================================
19    
20    
21        REAL, INTENT (IN) :: paprs(klon, klev+1)
22        REAL, INTENT (IN) :: t(klon, klev)
23        REAL, INTENT (IN) :: q(klon, klev), u(klon, klev), v(klon, klev)
24        REAL utran_e(klon), utran_q(klon), vtran_e(klon), vtran_q(klon)
25    
26        INTEGER i, l
27        ! ------------------------------------------------------------------
28        REAL geom(klon, klev), e
29        ! ------------------------------------------------------------------
30      DO i = 1, klon      DO i = 1, klon
31        e = rcpd*t(i, l) + rlvtt*q(i, l) + geom(i, l)         utran_e(i) = 0.0
32        utran_e(i) = utran_e(i) + u(i, l)*e*(paprs(i,l)-paprs(i,l+1))/rg         utran_q(i) = 0.0
33        utran_q(i) = utran_q(i) + u(i, l)*q(i, l)*(paprs(i,l)-paprs(i,l+1))/rg         vtran_e(i) = 0.0
34        vtran_e(i) = vtran_e(i) + v(i, l)*e*(paprs(i,l)-paprs(i,l+1))/rg         vtran_q(i) = 0.0
       vtran_q(i) = vtran_q(i) + v(i, l)*q(i, l)*(paprs(i,l)-paprs(i,l+1))/rg  
35      END DO      END DO
   END DO  
36    
37    RETURN      DO l = 1, klev
38  END SUBROUTINE transp         DO i = 1, klon
39              e = rcpd*t(i, l) + rlvtt*q(i, l) + geom(i, l)
40              utran_e(i) = utran_e(i) + u(i, l)*e*(paprs(i,l)-paprs(i,l+1))/rg
41              utran_q(i) = utran_q(i) + u(i, l)*q(i, l)*(paprs(i,l)-paprs(i,l+1))/rg
42              vtran_e(i) = vtran_e(i) + v(i, l)*e*(paprs(i,l)-paprs(i,l+1))/rg
43              vtran_q(i) = vtran_q(i) + v(i, l)*q(i, l)*(paprs(i,l)-paprs(i,l+1))/rg
44           END DO
45        END DO
46    
47      END SUBROUTINE transp
48    
49    end module transp_m
Legend:
Removed from v.134  
changed lines
  Added in v.171
  ViewVC Help
Powered by ViewVC 1.1.21