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

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

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

trunk/libf/phylmd/transp_lay.f revision 3 by guez, Wed Feb 27 13:16:39 2008 UTC trunk/Sources/phylmd/transp_lay.f revision 178 by guez, Fri Mar 11 18:47:26 2016 UTC
# Line 1  Line 1 
1        SUBROUTINE transp_lay (paprs,tsol,  module transp_lay_m
2       e                   t, q, u, v, geom,  
3       s                   vtran_e, vtran_q, utran_e, utran_q)    IMPLICIT NONE
4  c  
5        use dimens_m  contains
6        use dimphy  
7        use YOMCST    SUBROUTINE transp_lay(paprs, t, q, u, v, geom, vtran_e, vtran_q, &
8        IMPLICIT none         utran_e, utran_q)
9  c======================================================================  
10  c Auteur(s): Z.X.Li (LMD/CNRS)      USE dimens_m
11  c Date: le 25 avril 1994      USE dimphy
12  c Objet: Calculer le transport de l'energie et de la vapeur d'eau      USE suphec_m
13  c======================================================================      ! ======================================================================
14  c      ! Auteur(s): Z.X.Li (LMD/CNRS)
15  c      ! Date: le 25 avril 1994
16        REAL, intent(in):: paprs(klon,klev+1)      ! Objet: Calculer le transport de l'energie et de la vapeur d'eau
17        real tsol(klon)      ! ======================================================================
18        REAL t(klon,klev), q(klon,klev), u(klon,klev), v(klon,klev)  
19        REAL utran_e(klon,klev), utran_q(klon,klev)  
20        REAL vtran_e(klon,klev), vtran_q(klon,klev)      REAL, INTENT (IN):: paprs(klon, klev+1)
21  c      REAL, INTENT (IN):: t(klon, klev)
22        INTEGER i, l      REAL, INTENT (IN):: q(klon, klev), u(klon, klev), v(klon, klev)
23  c     ------------------------------------------------------------------      REAL utran_e(klon, klev), utran_q(klon, klev)
24        REAL geom(klon,klev), esh      REAL vtran_e(klon, klev), vtran_q(klon, klev)
25  c     ------------------------------------------------------------------  
26        DO l = 1, klev      INTEGER i, l
27        DO i = 1, klon      ! ------------------------------------------------------------------
28           utran_e(i,l) = 0.0      REAL geom(klon, klev), esh
29           utran_q(i,l) = 0.0      ! ------------------------------------------------------------------
30           vtran_e(i,l) = 0.0      DO l = 1, klev
31           vtran_q(i,l) = 0.0         DO i = 1, klon
32        ENDDO            utran_e(i, l) = 0.0
33        ENDDO            utran_q(i, l) = 0.0
34  c            vtran_e(i, l) = 0.0
35        DO l = 1, klev            vtran_q(i, l) = 0.0
36        DO i = 1, klon         END DO
37           esh = RCPD*t(i,l) + RLVTT*q(i,l) + geom(i,l)      END DO
38           utran_e(i,l)=utran_e(i,l)+ u(i,l)*esh*  
39       .                (paprs(i,l)-paprs(i,l+1))/RG      DO l = 1, klev
40           utran_q(i,l)=utran_q(i,l)+ u(i,l)*q(i,l)         DO i = 1, klon
41       .                *(paprs(i,l)-paprs(i,l+1))/RG            esh = rcpd*t(i, l) + rlvtt*q(i, l) + geom(i, l)
42           vtran_e(i,l)=vtran_e(i,l)+ v(i,l)*esh*            utran_e(i, l) = utran_e(i, l) + u(i, l)*esh*(paprs(i,l)-paprs(i,l+1))/ &
43       .                (paprs(i,l)-paprs(i,l+1))/RG                 rg
44           vtran_q(i,l)=vtran_q(i,l)+ v(i,l)*q(i,l)            utran_q(i, l) = utran_q(i, l) + u(i, l)*q(i, l)*(paprs(i,l)-paprs(i,l+1 &
45       .                *(paprs(i,l)-paprs(i,l+1))/RG                 ))/rg
46        ENDDO            vtran_e(i, l) = vtran_e(i, l) + v(i, l)*esh*(paprs(i,l)-paprs(i,l+1))/ &
47        ENDDO                 rg
48  c            vtran_q(i, l) = vtran_q(i, l) + v(i, l)*q(i, l)*(paprs(i,l)-paprs(i,l+1 &
49        RETURN                 ))/rg
50        END         END DO
51        END DO
52    
53      END SUBROUTINE transp_lay
54    
55    end module transp_lay_m
Legend:
Removed from v.3  
changed lines
  Added in v.178
  ViewVC Help
Powered by ViewVC 1.1.21