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