/[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 52 by guez, Fri Sep 23 12:28:01 2011 UTC trunk/Sources/phylmd/transp_lay.f revision 213 by guez, Mon Feb 27 15:44:55 2017 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 SUPHEC_M    SUBROUTINE transp_lay(paprs, t, q, u, v, geom, vtran_e, vtran_q, utran_e, &
8        IMPLICIT none         utran_q)
9  c======================================================================  
10  c Auteur(s): Z.X.Li (LMD/CNRS)      ! Author: Z. X. Li (LMD/CNRS)
11  c Date: le 25 avril 1994      ! Date: April, 25th 1994
12  c Objet: Calculer le transport de l'energie et de la vapeur d'eau      ! Objet : calculer le transport de l'\'energie et de la vapeur d'eau
13  c======================================================================  
14  c      USE dimphy, only: klon, klev
15  c      USE suphec_m, only: rcpd, rg, rlvtt
16        REAL, intent(in):: paprs(klon,klev+1)  
17        real tsol(klon)      REAL, INTENT(IN):: paprs(klon, klev+1)
18        REAL, INTENT (IN):: t(klon,klev)      REAL, INTENT(IN):: t(klon, klev)
19        real q(klon,klev), u(klon,klev), v(klon,klev)      REAL, INTENT(IN):: q(klon, klev), u(klon, klev), v(klon, klev)
20        REAL utran_e(klon,klev), utran_q(klon,klev)      REAL, INTENT(IN):: geom(klon, klev)
21        REAL vtran_e(klon,klev), vtran_q(klon,klev)      REAL, INTENT(out):: vtran_e(klon, klev), vtran_q(klon, klev)
22  c      REAL, INTENT(out):: utran_e(klon, klev), utran_q(klon, klev)
23        INTEGER i, l  
24  c     ------------------------------------------------------------------      ! Local:
25        REAL geom(klon,klev), esh      INTEGER i, l
26  c     ------------------------------------------------------------------      real esh
27        DO l = 1, klev      
28        DO i = 1, klon      !------------------------------------------------------------------
29           utran_e(i,l) = 0.0      
30           utran_q(i,l) = 0.0      DO l = 1, klev
31           vtran_e(i,l) = 0.0         DO i = 1, klon
32           vtran_q(i,l) = 0.0            utran_e(i, l) = 0.
33        ENDDO            utran_q(i, l) = 0.
34        ENDDO            vtran_e(i, l) = 0.
35  c            vtran_q(i, l) = 0.
36        DO l = 1, klev         END DO
37        DO i = 1, klon      END DO
38           esh = RCPD*t(i,l) + RLVTT*q(i,l) + geom(i,l)  
39           utran_e(i,l)=utran_e(i,l)+ u(i,l)*esh*      DO l = 1, klev
40       .                (paprs(i,l)-paprs(i,l+1))/RG         DO i = 1, klon
41           utran_q(i,l)=utran_q(i,l)+ u(i,l)*q(i,l)            esh = rcpd * t(i, l) + rlvtt * q(i, l) + geom(i, l)
42       .                *(paprs(i,l)-paprs(i,l+1))/RG            utran_e(i, l) = utran_e(i, l) + u(i, l) * esh &
43           vtran_e(i,l)=vtran_e(i,l)+ v(i,l)*esh*                 * (paprs(i, l) - paprs(i, l+1)) / rg
44       .                (paprs(i,l)-paprs(i,l+1))/RG            utran_q(i, l) = utran_q(i, l) + u(i, l) * q(i, l) &
45           vtran_q(i,l)=vtran_q(i,l)+ v(i,l)*q(i,l)                 * (paprs(i, l) - paprs(i, l+1)) / rg
46       .                *(paprs(i,l)-paprs(i,l+1))/RG            vtran_e(i, l) = vtran_e(i, l) + v(i, l) * esh &
47        ENDDO                 * (paprs(i, l) - paprs(i, l+1)) / rg
48        ENDDO            vtran_q(i, l) = vtran_q(i, l) + v(i, l) * q(i, l) &
49  c                 * (paprs(i, l) - paprs(i, l+1)) / rg
50        RETURN         END DO
51        END      END DO
52    
53      END SUBROUTINE transp_lay
54    
55    end module transp_lay_m
Legend:
Removed from v.52  
changed lines
  Added in v.213
  ViewVC Help
Powered by ViewVC 1.1.21