source: LMDZ5/branches/LMDZ5_SPLA/libf/phylmd/conemav.F90 @ 5425

Last change on this file since 5425 was 1992, checked in by lguez, 11 years ago

Converted to free source form files in libf/phylmd which were still in
fixed source form. The conversion was done using the polish mode of
the NAG Fortran Compiler.

In addition to converting to free source form, the processing of the
files also:

-- indented the code (including comments);

-- set Fortran keywords to uppercase, and set all other identifiers
to lower case;

-- added qualifiers to end statements (for example "end subroutine
conflx", instead of "end");

-- changed the terminating statements of all DO loops so that each
loop ends with an ENDDO statement (instead of a labeled continue).

-- replaced #include by include.

  • 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: 4.1 KB
Line 
1
2! $Header$
3
4SUBROUTINE conemav(dtime, paprs, pplay, t, q, u, v, tra, ntra, work1, work2, &
5    d_t, d_q, d_u, d_v, d_tra, rain, snow, kbas, ktop, upwd, dnwd, dnwdbis, &
6    ma, cape, tvp, iflag, pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr)
7
8
9  USE dimphy
10  USE infotrac, ONLY: nbtr
11  IMPLICIT NONE
12  ! ======================================================================
13  ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
14  ! Objet: schema de convection de Emanuel (1991) interface
15  ! ======================================================================
16  ! Arguments:
17  ! dtime--input-R-pas d'integration (s)
18  ! s-------input-R-la valeur "s" pour chaque couche
19  ! sigs----input-R-la valeur "sigma" de chaque couche
20  ! sig-----input-R-la valeur de "sigma" pour chaque niveau
21  ! psolpa--input-R-la pression au sol (en Pa)
22  ! pskapa--input-R-exponentiel kappa de psolpa
23  ! h-------input-R-enthalpie potentielle (Cp*T/P**kappa)
24  ! q-------input-R-vapeur d'eau (en kg/kg)
25
26  ! work*: input et output: deux variables de travail,
27  ! on peut les mettre a 0 au debut
28  ! ALE-----input-R-energie disponible pour soulevement
29
30  ! d_h-----output-R-increment de l'enthalpie potentielle (h)
31  ! d_q-----output-R-increment de la vapeur d'eau
32  ! rain----output-R-la pluie (mm/s)
33  ! snow----output-R-la neige (mm/s)
34  ! upwd----output-R-saturated updraft mass flux (kg/m**2/s)
35  ! dnwd----output-R-saturated downdraft mass flux (kg/m**2/s)
36  ! dnwd0---output-R-unsaturated downdraft mass flux (kg/m**2/s)
37  ! Cape----output-R-CAPE (J/kg)
38  ! Tvp-----output-R-Temperature virtuelle d'une parcelle soulevee
39  ! adiabatiquement a partir du niveau 1 (K)
40  ! deltapb-output-R-distance entre LCL et base de la colonne (<0 ; Pa)
41  ! Ice_flag-input-L-TRUE->prise en compte de la thermodynamique de la glace
42  ! ======================================================================
43
44  include "dimensions.h"
45
46
47  REAL dtime, paprs(klon, klev+1), pplay(klon, klev)
48  REAL t(klon, klev), q(klon, klev), u(klon, klev), v(klon, klev)
49  REAL tra(klon, klev, nbtr)
50  INTEGER ntra
51  REAL work1(klon, klev), work2(klon, klev)
52
53  REAL d_t(klon, klev), d_q(klon, klev), d_u(klon, klev), d_v(klon, klev)
54  REAL d_tra(klon, klev, nbtr)
55  REAL rain(klon), snow(klon)
56
57  INTEGER kbas(klon), ktop(klon)
58  REAL em_ph(klon, klev+1), em_p(klon, klev)
59  REAL upwd(klon, klev), dnwd(klon, klev), dnwdbis(klon, klev)
60  REAL ma(klon, klev), cape(klon), tvp(klon, klev)
61  INTEGER iflag(klon)
62  REAL rflag(klon)
63  REAL pbase(klon), bbase(klon)
64  REAL dtvpdt1(klon, klev), dtvpdq1(klon, klev)
65  REAL dplcldt(klon), dplcldr(klon)
66
67  REAL zx_t, zdelta, zx_qs, zcor
68
69  INTEGER noff, minorig
70  INTEGER i, k, itra
71  REAL qs(klon, klev)
72  REAL, ALLOCATABLE, SAVE :: cbmf(:)
73  !$OMP THREADPRIVATE(cbmf)
74  INTEGER ifrst
75  SAVE ifrst
76  DATA ifrst/0/
77  !$OMP THREADPRIVATE(ifrst)
78  include "YOMCST.h"
79  include "YOETHF.h"
80  include "FCTTRE.h"
81
82
83  IF (ifrst==0) THEN
84    ifrst = 1
85    ALLOCATE (cbmf(klon))
86    DO i = 1, klon
87      cbmf(i) = 0.
88    END DO
89  END IF
90
91  DO k = 1, klev + 1
92    DO i = 1, klon
93      em_ph(i, k) = paprs(i, k)/100.0
94    END DO
95  END DO
96
97  DO k = 1, klev
98    DO i = 1, klon
99      em_p(i, k) = pplay(i, k)/100.0
100    END DO
101  END DO
102
103
104  DO k = 1, klev
105    DO i = 1, klon
106      zx_t = t(i, k)
107      zdelta = max(0., sign(1.,rtt-zx_t))
108      zx_qs = min(0.5, r2es*foeew(zx_t,zdelta)/em_p(i,k)/100.0)
109      zcor = 1./(1.-retv*zx_qs)
110      qs(i, k) = zx_qs*zcor
111    END DO
112  END DO
113
114  noff = 2
115  minorig = 2
116  CALL convect1(klon, klev, klev+1, noff, minorig, t, q, qs, u, v, em_p, &
117    em_ph, iflag, d_t, d_q, d_u, d_v, rain, cbmf, dtime, ma)
118
119  DO i = 1, klon
120    rain(i) = rain(i)/86400.
121    rflag(i) = iflag(i)
122  END DO
123  ! call dump2d(iim,jjm-1,rflag(2:klon-1),'FLAG CONVECTION   ')
124  ! if (klon.eq.1) then
125  ! print*,'IFLAG ',iflag
126  ! else
127  ! write(*,'(96i1)') (iflag(i),i=2,klon-1)
128  ! endif
129  DO k = 1, klev
130    DO i = 1, klon
131      d_t(i, k) = dtime*d_t(i, k)
132      d_q(i, k) = dtime*d_q(i, k)
133      d_u(i, k) = dtime*d_u(i, k)
134      d_v(i, k) = dtime*d_v(i, k)
135    END DO
136    DO itra = 1, ntra
137      DO i = 1, klon
138        d_tra(i, k, itra) = 0.
139      END DO
140    END DO
141  END DO
142
143
144
145
146  RETURN
147END SUBROUTINE conemav
148
Note: See TracBrowser for help on using the repository browser.