source: LMDZ6/branches/contrails/libf/phylmd/conemav.f90 @ 5440

Last change on this file since 5440 was 5285, checked in by abarral, 8 weeks 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: 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_phy, ONLY: nbtr
11  USE yomcst_mod_h
12  USE yoethf_mod_h
13  IMPLICIT NONE
14  ! ======================================================================
15  ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
16  ! Objet: schema de convection de Emanuel (1991) interface
17  ! ======================================================================
18  ! Arguments:
19  ! dtime--input-R-pas d'integration (s)
20  ! s-------input-R-la valeur "s" pour chaque couche
21  ! sigs----input-R-la valeur "sigma" de chaque couche
22  ! sig-----input-R-la valeur de "sigma" pour chaque niveau
23  ! psolpa--input-R-la pression au sol (en Pa)
24  ! pskapa--input-R-exponentiel kappa de psolpa
25  ! h-------input-R-enthalpie potentielle (Cp*T/P**kappa)
26  ! q-------input-R-vapeur d'eau (en kg/kg)
27
28  ! work*: input et output: deux variables de travail,
29  ! on peut les mettre a 0 au debut
30  ! ALE-----input-R-energie disponible pour soulevement
31
32  ! d_h-----output-R-increment de l'enthalpie potentielle (h)
33  ! d_q-----output-R-increment de la vapeur d'eau
34  ! rain----output-R-la pluie (mm/s)
35  ! snow----output-R-la neige (mm/s)
36  ! upwd----output-R-saturated updraft mass flux (kg/m**2/s)
37  ! dnwd----output-R-saturated downdraft mass flux (kg/m**2/s)
38  ! dnwd0---output-R-unsaturated downdraft mass flux (kg/m**2/s)
39  ! Cape----output-R-CAPE (J/kg)
40  ! Tvp-----output-R-Temperature virtuelle d'une parcelle soulevee
41  ! adiabatiquement a partir du niveau 1 (K)
42  ! deltapb-output-R-distance entre LCL et base de la colonne (<0 ; Pa)
43  ! Ice_flag-input-L-TRUE->prise en compte de la thermodynamique de la glace
44  ! ======================================================================
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 "FCTTRE.h"
79
80
81  IF (ifrst==0) THEN
82    ifrst = 1
83    ALLOCATE (cbmf(klon))
84    DO i = 1, klon
85      cbmf(i) = 0.
86    END DO
87  END IF
88
89  DO k = 1, klev + 1
90    DO i = 1, klon
91      em_ph(i, k) = paprs(i, k)/100.0
92    END DO
93  END DO
94
95  DO k = 1, klev
96    DO i = 1, klon
97      em_p(i, k) = pplay(i, k)/100.0
98    END DO
99  END DO
100
101
102  DO k = 1, klev
103    DO i = 1, klon
104      zx_t = t(i, k)
105      zdelta = max(0., sign(1.,rtt-zx_t))
106      zx_qs = min(0.5, r2es*foeew(zx_t,zdelta)/em_p(i,k)/100.0)
107      zcor = 1./(1.-retv*zx_qs)
108      qs(i, k) = zx_qs*zcor
109    END DO
110  END DO
111
112  noff = 2
113  minorig = 2
114  CALL convect1(klon, klev, klev+1, noff, minorig, t, q, qs, u, v, em_p, &
115    em_ph, iflag, d_t, d_q, d_u, d_v, rain, cbmf, dtime, ma)
116
117  DO i = 1, klon
118    rain(i) = rain(i)/86400.
119    rflag(i) = iflag(i)
120  END DO
121  ! call dump2d(iim,jjm-1,rflag(2:klon-1),'FLAG CONVECTION   ')
122  ! if (klon.eq.1) then
123  ! print*,'IFLAG ',iflag
124  ! else
125  ! write(*,'(96i1)') (iflag(i),i=2,klon-1)
126  ! endif
127  DO k = 1, klev
128    DO i = 1, klon
129      d_t(i, k) = dtime*d_t(i, k)
130      d_q(i, k) = dtime*d_q(i, k)
131      d_u(i, k) = dtime*d_u(i, k)
132      d_v(i, k) = dtime*d_v(i, k)
133    END DO
134    DO itra = 1, ntra
135      DO i = 1, klon
136        d_tra(i, k, itra) = 0.
137      END DO
138    END DO
139  END DO
140
141
142
143
144  RETURN
145END SUBROUTINE conemav
146
Note: See TracBrowser for help on using the repository browser.