/[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/phylmd/transp_lay.f revision 91 by guez, Wed Mar 26 17:18:58 2014 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, t, q, u, v, geom, vtran_e, vtran_q, &  module transp_lay_m
     utran_e, utran_q)  
2    
   USE dimens_m  
   USE dimphy  
   USE suphec_m  
3    IMPLICIT NONE    IMPLICIT NONE
4    ! ======================================================================  
5    ! Auteur(s): Z.X.Li (LMD/CNRS)  contains
6    ! Date: le 25 avril 1994  
7    ! Objet: Calculer le transport de l'energie et de la vapeur d'eau    SUBROUTINE transp_lay(paprs, t, q, u, v, geom, vtran_e, vtran_q, utran_e, &
8    ! ======================================================================         utran_q)
9    
10        ! Author: Z. X. Li (LMD/CNRS)
11    REAL, INTENT (IN):: paprs(klon, klev+1)      ! Date: April, 25th 1994
12    REAL tsol(klon)      ! Objet : calculer le transport de l'\'energie et de la vapeur d'eau
13    REAL, INTENT (IN):: t(klon, klev)  
14    REAL, INTENT (IN):: q(klon, klev), u(klon, klev), v(klon, klev)      USE dimphy, only: klon, klev
15    REAL utran_e(klon, klev), utran_q(klon, klev)      USE suphec_m, only: rcpd, rg, rlvtt
16    REAL vtran_e(klon, klev), vtran_q(klon, klev)  
17        REAL, INTENT(IN):: paprs(klon, klev+1)
18    INTEGER i, l      REAL, INTENT(IN):: t(klon, klev)
19    ! ------------------------------------------------------------------      REAL, INTENT(IN):: q(klon, klev), u(klon, klev), v(klon, klev)
20    REAL geom(klon, klev), esh      REAL, INTENT(IN):: geom(klon, klev)
21    ! ------------------------------------------------------------------      REAL, INTENT(out):: vtran_e(klon, klev), vtran_q(klon, klev)
22    DO l = 1, klev      REAL, INTENT(out):: utran_e(klon, klev), utran_q(klon, klev)
23      DO i = 1, klon  
24        utran_e(i, l) = 0.0      ! Local:
25        utran_q(i, l) = 0.0      INTEGER i, l
26        vtran_e(i, l) = 0.0      real esh
27        vtran_q(i, l) = 0.0      
28        !------------------------------------------------------------------
29        
30        DO l = 1, klev
31           DO i = 1, klon
32              utran_e(i, l) = 0.
33              utran_q(i, l) = 0.
34              vtran_e(i, l) = 0.
35              vtran_q(i, l) = 0.
36           END DO
37      END DO      END DO
   END DO  
38    
39    DO l = 1, klev      DO l = 1, klev
40      DO i = 1, klon         DO i = 1, klon
41        esh = rcpd*t(i, l) + rlvtt*q(i, l) + geom(i, l)            esh = rcpd * t(i, l) + rlvtt * q(i, l) + geom(i, l)
42        utran_e(i, l) = utran_e(i, l) + u(i, l)*esh*(paprs(i,l)-paprs(i,l+1))/ &            utran_e(i, l) = utran_e(i, l) + u(i, l) * esh &
43          rg                 * (paprs(i, l) - paprs(i, l+1)) / rg
44        utran_q(i, l) = utran_q(i, l) + u(i, l)*q(i, l)*(paprs(i,l)-paprs(i,l+1 &            utran_q(i, l) = utran_q(i, l) + u(i, l) * q(i, l) &
45          ))/rg                 * (paprs(i, l) - paprs(i, l+1)) / rg
46        vtran_e(i, l) = vtran_e(i, l) + v(i, l)*esh*(paprs(i,l)-paprs(i,l+1))/ &            vtran_e(i, l) = vtran_e(i, l) + v(i, l) * esh &
47          rg                 * (paprs(i, l) - paprs(i, l+1)) / rg
48        vtran_q(i, l) = vtran_q(i, l) + v(i, l)*q(i, l)*(paprs(i,l)-paprs(i,l+1 &            vtran_q(i, l) = vtran_q(i, l) + v(i, l) * q(i, l) &
49          ))/rg                 * (paprs(i, l) - paprs(i, l+1)) / rg
50           END DO
51      END DO      END DO
   END DO  
52    
53    RETURN    END SUBROUTINE transp_lay
54  END SUBROUTINE transp_lay  
55    end module transp_lay_m

Legend:
Removed from v.91  
changed lines
  Added in v.213

  ViewVC Help
Powered by ViewVC 1.1.21