Sources/phylmd/transp_lay.f

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

  USE dimens_m
  USE dimphy
  USE suphec_m
  IMPLICIT NONE
  ! ======================================================================
  ! 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 q(klon, klev), u(klon, klev), v(klon, klev)
  REAL utran_e(klon, klev), utran_q(klon, klev)
  REAL vtran_e(klon, klev), vtran_q(klon, klev)

  INTEGER i, l
  ! ------------------------------------------------------------------
  REAL geom(klon, klev), esh
  ! ------------------------------------------------------------------
  DO l = 1, klev
    DO i = 1, klon
      utran_e(i, l) = 0.0
      utran_q(i, l) = 0.0
      vtran_e(i, l) = 0.0
      vtran_q(i, l) = 0.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

  RETURN
END SUBROUTINE transp_lay
1	guez	81	SUBROUTINE transp_lay(paprs, tsol, t, q, u, v, geom, vtran_e, vtran_q, &
2			utran_e, utran_q)
3
4			USE dimens_m
5			USE dimphy
6			USE suphec_m
7			IMPLICIT NONE
8			! ======================================================================
9			! Auteur(s): Z.X.Li (LMD/CNRS)
10			! Date: le 25 avril 1994
11			! Objet: Calculer le transport de l'energie et de la vapeur d'eau
12			! ======================================================================
13
14
15			REAL, INTENT (IN) :: paprs(klon, klev+1)
16			REAL tsol(klon)
17			REAL, INTENT (IN) :: t(klon, klev)
18			REAL 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)
21
22			INTEGER i, l
23			! ------------------------------------------------------------------
24			REAL geom(klon, klev), esh
25			! ------------------------------------------------------------------
26			DO l = 1, klev
27			DO i = 1, klon
28			utran_e(i, l) = 0.0
29			utran_q(i, l) = 0.0
30			vtran_e(i, l) = 0.0
31			vtran_q(i, l) = 0.0
32			END DO
33			END DO
34
35			DO l = 1, klev
36			DO i = 1, klon
37			esh = rcpdt(i, l) + rlvttq(i, l) + geom(i, l)
38			utran_e(i, l) = utran_e(i, l) + u(i, l)esh(paprs(i,l)-paprs(i,l+1))/ &
39			rg
40			utran_q(i, l) = utran_q(i, l) + u(i, l)q(i, l)(paprs(i,l)-paprs(i,l+1 &
41			))/rg
42			vtran_e(i, l) = vtran_e(i, l) + v(i, l)esh(paprs(i,l)-paprs(i,l+1))/ &
43			rg
44			vtran_q(i, l) = vtran_q(i, l) + v(i, l)q(i, l)(paprs(i,l)-paprs(i,l+1 &
45			))/rg
46			END DO
47			END DO
48
49			RETURN
50			END SUBROUTINE transp_lay