Sources/phylmd/transp_lay.f

module transp_lay_m

  IMPLICIT NONE

contains

  SUBROUTINE transp_lay(paprs, t, q, u, v, geom, vtran_e, vtran_q, utran_e, &
       utran_q)

    ! Author: Z. X. Li (LMD/CNRS)
    ! Date: April, 25th 1994
    ! Objet : calculer le transport de l'\'energie et de la vapeur d'eau

    USE dimphy, only: klon, klev
    USE suphec_m, only: rcpd, rg, rlvtt

    REAL, INTENT(IN):: paprs(klon, klev+1)
    REAL, INTENT(IN):: t(klon, klev)
    REAL, INTENT(IN):: q(klon, klev), u(klon, klev), v(klon, klev)
    REAL, INTENT(IN):: geom(klon, klev)
    REAL, INTENT(out):: vtran_e(klon, klev), vtran_q(klon, klev)
    REAL, INTENT(out):: utran_e(klon, klev), utran_q(klon, klev)

    ! Local:
    INTEGER i, l
    real esh
    
    !------------------------------------------------------------------
    
    DO l = 1, klev
       DO i = 1, klon
          utran_e(i, l) = 0.
          utran_q(i, l) = 0.
          vtran_e(i, l) = 0.
          vtran_q(i, l) = 0.
       END DO
    END DO

    DO l = 1, klev
       DO i = 1, klon
          esh = rcpd * t(i, l) + rlvtt * q(i, l) + geom(i, l)
          utran_e(i, l) = utran_e(i, l) + u(i, l) * esh &
               * (paprs(i, l) - paprs(i, l+1)) / rg
          utran_q(i, l) = utran_q(i, l) + u(i, l) * q(i, l) &
               * (paprs(i, l) - paprs(i, l+1)) / rg
          vtran_e(i, l) = vtran_e(i, l) + v(i, l) * esh &
               * (paprs(i, l) - paprs(i, l+1)) / rg
          vtran_q(i, l) = vtran_q(i, l) + v(i, l) * q(i, l) &
               * (paprs(i, l) - paprs(i, l+1)) / rg
       END DO
    END DO

  END SUBROUTINE transp_lay

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