source: LMDZ6/trunk/libf/phylmd/transp_lay.f90 @ 5423

Last change on this file since 5423 was 5285, checked in by abarral, 2 months ago

As discussed internally, remove generic ONLY: ... for new _mod_h modules
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 1.5 KB
Line 
1
2! $Header$
3
4SUBROUTINE transp_lay(paprs, tsol, t, q, u, v, geom, vtran_e, vtran_q, &
5    utran_e, utran_q)
6
7  USE dimphy
8  USE yomcst_mod_h
9IMPLICIT NONE
10  ! ======================================================================
11  ! Auteur(s): Z.X.Li (LMD/CNRS)
12  ! Date: le 25 avril 1994
13  ! Objet: Calculer le transport de l'energie et de la vapeur d'eau
14  ! ======================================================================
15
16
17
18  REAL paprs(klon, klev+1), tsol(klon)
19  REAL t(klon, klev), q(klon, klev), u(klon, klev), v(klon, klev)
20  REAL utran_e(klon, klev), utran_q(klon, klev)
21  REAL vtran_e(klon, klev), vtran_q(klon, klev)
22
23  INTEGER i, l
24  ! ------------------------------------------------------------------
25  REAL geom(klon, klev), esh
26  ! ------------------------------------------------------------------
27  DO l = 1, klev
28    DO i = 1, klon
29      utran_e(i, l) = 0.0
30      utran_q(i, l) = 0.0
31      vtran_e(i, l) = 0.0
32      vtran_q(i, l) = 0.0
33    END DO
34  END DO
35
36  DO l = 1, klev
37    DO i = 1, klon
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*(paprs(i,l)-paprs(i,l+1))/ &
40        rg
41      utran_q(i, l) = utran_q(i, l) + u(i, l)*q(i, l)*(paprs(i,l)-paprs(i,l+1 &
42        ))/rg
43      vtran_e(i, l) = vtran_e(i, l) + v(i, l)*esh*(paprs(i,l)-paprs(i,l+1))/ &
44        rg
45      vtran_q(i, l) = vtran_q(i, l) + v(i, l)*q(i, l)*(paprs(i,l)-paprs(i,l+1 &
46        ))/rg
47    END DO
48  END DO
49
50  RETURN
51END SUBROUTINE transp_lay
Note: See TracBrowser for help on using the repository browser.