/[lmdze]/trunk/Sources/phylmd/cv_driver.f
ViewVC logotype

Diff of /trunk/Sources/phylmd/cv_driver.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/libf/phylmd/cv_driver.f90 revision 52 by guez, Fri Sep 23 12:28:01 2011 UTC trunk/Sources/phylmd/cv_driver.f revision 145 by guez, Tue Jun 16 15:23:29 2015 UTC
# Line 4  module cv_driver_m Line 4  module cv_driver_m
4    
5  contains  contains
6    
7    SUBROUTINE cv_driver(len, nd, ndp1, ntra, iflag_con, t1, q1, qs1, u1, v1, &    SUBROUTINE cv_driver(t1, q1, qs1, u1, v1, p1, ph1, iflag1, ft1, &
8         tra1, p1, ph1, iflag1, ft1, fq1, fu1, fv1, ftra1, precip1, VPrecip1, &         fq1, fu1, fv1, precip1, VPrecip1, cbmf1, sig1, w01, icb1, inb1, delt, &
9         cbmf1, sig1, w01, icb1, inb1, delt, Ma1, upwd1, dnwd1, dnwd01, &         Ma1, upwd1, dnwd1, dnwd01, qcondc1, wd1, cape1, da1, phi1, mp1)
10         qcondc1, wd1, cape1, da1, phi1, mp1)  
11        ! From LMDZ4/libf/phylmd/cv_driver.F, version 1.3, 2005/04/15 12:36:17
12      ! From LMDZ4/libf/phylmd/cv_driver.F, version 1.3 2005/04/15 12:36:17      ! Main driver for convection
13        ! Author: S. Bony, March 2002
14      use dimens_m  
15      use dimphy      ! Several modules corresponding to different physical processes
16      !  
17      ! PARAMETERS:      ! Several versions of convect may be used:
18      !      Name            Type         Usage            Description      ! - iflag_con = 3: version lmd
19      !   ----------      ----------     -------  ----------------------------      ! - iflag_con = 4: version 4.3b
20      !  
21      !      len           Integer        Input        first (i) dimension      use clesphys2, only: iflag_con
22      !      nd            Integer        Input        vertical (k) dimension      use cv3_compress_m, only: cv3_compress
23      !      ndp1          Integer        Input        nd + 1      use cv3_feed_m, only: cv3_feed
24      !      ntra          Integer        Input        number of tracors      use cv3_mixing_m, only: cv3_mixing
25      !      iflag_con     Integer        Input        version of convect (3/4)      use cv3_param_m, only: cv3_param
26      !      t1            Real           Input        temperature      use cv3_prelim_m, only: cv3_prelim
27      !      q1            Real           Input        specific hum      use cv3_tracer_m, only: cv3_tracer
28      !      qs1           Real           Input        sat specific hum      use cv3_uncompress_m, only: cv3_uncompress
29      !      u1            Real           Input        u-wind      use cv3_unsat_m, only: cv3_unsat
30      !      v1            Real           Input        v-wind      use cv3_yield_m, only: cv3_yield
31      !      tra1          Real           Input        tracors      use cv_feed_m, only: cv_feed
32      !      p1            Real           Input        full level pressure      use cv_uncompress_m, only: cv_uncompress
33      !      ph1           Real           Input        half level pressure      USE dimphy, ONLY: klev, klon
34      !      iflag1        Integer        Output       flag for Emanuel conditions  
35      !      ft1           Real           Output       temp tend      real, intent(in):: t1(klon, klev) ! temperature
36      !      fq1           Real           Output       spec hum tend      real, intent(in):: q1(klon, klev) ! specific hum
37      !      fu1           Real           Output       u-wind tend      real, intent(in):: qs1(klon, klev) ! sat specific hum
38      !      fv1           Real           Output       v-wind tend      real, intent(in):: u1(klon, klev) ! u-wind
39      !      ftra1         Real           Output       tracor tend      real, intent(in):: v1(klon, klev) ! v-wind
40      !      precip1       Real           Output       precipitation      real, intent(in):: p1(klon, klev) ! full level pressure
41      !      VPrecip1      Real           Output       vertical profile of precipitations      real, intent(in):: ph1(klon, klev + 1) ! half level pressure
42      !      cbmf1         Real           Output       cloud base mass flux      integer, intent(out):: iflag1(klon) ! flag for Emanuel conditions
43      !      sig1          Real           In/Out       section adiabatic updraft      real, intent(out):: ft1(klon, klev) ! temp tend
44      !      w01           Real           In/Out       vertical velocity within adiab updraft      real, intent(out):: fq1(klon, klev) ! spec hum tend
45      !      delt          Real           Input        time step      real, intent(out):: fu1(klon, klev) ! u-wind tend
46      !      Ma1           Real           Output       mass flux adiabatic updraft      real, intent(out):: fv1(klon, klev) ! v-wind tend
47      !      upwd1         Real           Output       total upward mass flux (adiab+mixed)      real, intent(out):: precip1(klon) ! precipitation
48      !      dnwd1         Real           Output       saturated downward mass flux (mixed)  
49      !      dnwd01        Real           Output       unsaturated downward mass flux      real, intent(out):: VPrecip1(klon, klev+1)
50      !      qcondc1       Real           Output       in-cld mixing ratio of condensed water      ! vertical profile of precipitation
51      !      wd1           Real           Output       downdraft velocity scale for sfc fluxes  
52      !      cape1         Real           Output       CAPE      real, intent(inout):: cbmf1(klon) ! cloud base mass flux
53      !      real, intent(inout):: sig1(klon, klev) ! section adiabatic updraft
54      ! S. Bony, Mar 2002:  
55      !     * Several modules corresponding to different physical processes      real, intent(inout):: w01(klon, klev)
56      !     * Several versions of convect may be used:      ! vertical velocity within adiabatic updraft
57      !        - iflag_con=3: version lmd  (previously named convect3)  
58      !        - iflag_con=4: version 4.3b (vect. version, previously convect1/2)      integer, intent(out):: icb1(klon)
59      !   + tard:    - iflag_con=5: version lmd with ice (previously named convectg)      integer, intent(inout):: inb1(klon)
60      ! S. Bony, Oct 2002:      real, intent(in):: delt ! time step
61      !     * Vectorization of convect3 (ie version lmd)      real Ma1(klon, klev)
62      !      ! Ma1 Real Output mass flux adiabatic updraft
63      !..............................END PROLOGUE.............................      real, intent(out):: upwd1(klon, klev) ! total upward mass flux (adiab+mixed)
64      !      real, intent(out):: dnwd1(klon, klev) ! saturated downward mass flux (mixed)
65      !      real, intent(out):: dnwd01(klon, klev) ! unsaturated downward mass flux
66    
67      integer len      real qcondc1(klon, klev) ! cld
68      integer nd      ! qcondc1 Real Output in-cld mixing ratio of condensed water
69      integer ndp1      real wd1(klon) ! gust
70      integer noff      ! wd1 Real Output downdraft velocity scale for sfc fluxes
71      integer, intent(in):: iflag_con      real cape1(klon)
72      integer ntra      ! cape1 Real Output CAPE
     real, intent(in):: t1(len, nd)  
     real q1(len, nd)  
     real qs1(len, nd)  
     real u1(len, nd)  
     real v1(len, nd)  
     real p1(len, nd)  
     real ph1(len, ndp1)  
     integer iflag1(len)  
     real ft1(len, nd)  
     real fq1(len, nd)  
     real fu1(len, nd)  
     real fv1(len, nd)  
     real precip1(len)  
     real cbmf1(len)  
     real VPrecip1(len, nd+1)  
     real Ma1(len, nd)  
     real upwd1(len, nd)  
     real dnwd1(len, nd)  
     real dnwd01(len, nd)  
   
     real qcondc1(len, nd)     ! cld  
     real wd1(len)            ! gust  
     real cape1(len)  
   
     real da1(len, nd), phi1(len, nd, nd), mp1(len, nd)  
     real da(len, nd), phi(len, nd, nd), mp(len, nd)  
     real, intent(in):: tra1(len, nd, ntra)  
     real ftra1(len, nd, ntra)  
73    
74      real, intent(in):: delt      real, intent(inout):: da1(klon, klev), phi1(klon, klev, klev)
75        real, intent(inout):: mp1(klon, klev)
76    
     !-------------------------------------------------------------------  
77      ! --- ARGUMENTS      ! --- ARGUMENTS
78      !-------------------------------------------------------------------  
79      ! --- On input:      ! --- On input:
     !  
     !  t:   Array of absolute temperature (K) of dimension ND, with first  
     !       index corresponding to lowest model level. Note that this array  
     !       will be altered by the subroutine if dry convective adjustment  
     !       occurs and if IPBL is not equal to 0.  
     !  
     !  q:   Array of specific humidity (gm/gm) of dimension ND, with first  
     !       index corresponding to lowest model level. Must be defined  
     !       at same grid levels as T. Note that this array will be altered  
     !       if dry convective adjustment occurs and if IPBL is not equal to 0.  
     !  
     !  qs:  Array of saturation specific humidity of dimension ND, with first  
     !       index corresponding to lowest model level. Must be defined  
     !       at same grid levels as T. Note that this array will be altered  
     !       if dry convective adjustment occurs and if IPBL is not equal to 0.  
     !  
     !  u:   Array of zonal wind velocity (m/s) of dimension ND, witth first  
     !       index corresponding with the lowest model level. Defined at  
     !       same levels as T. Note that this array will be altered if  
     !       dry convective adjustment occurs and if IPBL is not equal to 0.  
     !  
     !  v:   Same as u but for meridional velocity.  
     !  
     !  tra: Array of passive tracer mixing ratio, of dimensions (ND, NTRA),  
     !       where NTRA is the number of different tracers. If no  
     !       convective tracer transport is needed, define a dummy  
     !       input array of dimension (ND, 1). Tracers are defined at  
     !       same vertical levels as T. Note that this array will be altered  
     !       if dry convective adjustment occurs and if IPBL is not equal to 0.  
     !  
     !  p:   Array of pressure (mb) of dimension ND, with first  
     !       index corresponding to lowest model level. Must be defined  
     !       at same grid levels as T.  
     !  
     !  ph:  Array of pressure (mb) of dimension ND+1, with first index  
     !       corresponding to lowest level. These pressures are defined at  
     !       levels intermediate between those of P, T, Q and QS. The first  
     !       value of PH should be greater than (i.e. at a lower level than)  
     !       the first value of the array P.  
     !  
     !  nl:  The maximum number of levels to which convection can penetrate, plus 1.  
     !       NL MUST be less than or equal to ND-1.  
     !  
     !  delt: The model time step (sec) between calls to CONVECT  
     !  
     !----------------------------------------------------------------------------  
     ! ---   On Output:  
     !  
     !  iflag: An output integer whose value denotes the following:  
     !       VALUE   INTERPRETATION  
     !       -----   --------------  
     !         0     Moist convection occurs.  
     !         1     Moist convection occurs, but a CFL condition  
     !               on the subsidence warming is violated. This  
     !               does not cause the scheme to terminate.  
     !         2     Moist convection, but no precip because ep(inb) lt 0.0001  
     !         3     No moist convection because new cbmf is 0 and old cbmf is 0.  
     !         4     No moist convection; atmosphere is not  
     !               unstable  
     !         6     No moist convection because ihmin le minorig.  
     !         7     No moist convection because unreasonable  
     !               parcel level temperature or specific humidity.  
     !         8     No moist convection: lifted condensation  
     !               level is above the 200 mb level.  
     !         9     No moist convection: cloud base is higher  
     !               then the level NL-1.  
     !  
     !  ft:   Array of temperature tendency (K/s) of dimension ND, defined at same  
     !        grid levels as T, Q, QS and P.  
     !  
     !  fq:   Array of specific humidity tendencies ((gm/gm)/s) of dimension ND,  
     !        defined at same grid levels as T, Q, QS and P.  
     !  
     !  fu:   Array of forcing of zonal velocity (m/s^2) of dimension ND,  
     !        defined at same grid levels as T.  
     !  
     !  fv:   Same as FU, but for forcing of meridional velocity.  
     !  
     !  ftra: Array of forcing of tracer content, in tracer mixing ratio per  
     !        second, defined at same levels as T. Dimensioned (ND, NTRA).  
     !  
     !  precip: Scalar convective precipitation rate (mm/day).  
     !  
     !  VPrecip: Vertical profile of convective precipitation (kg/m2/s).  
     !  
     !  wd:   A convective downdraft velocity scale. For use in surface  
     !        flux parameterizations. See convect.ps file for details.  
     !  
     !  tprime: A convective downdraft temperature perturbation scale (K).  
     !          For use in surface flux parameterizations. See convect.ps  
     !          file for details.  
     !  
     !  qprime: A convective downdraft specific humidity  
     !          perturbation scale (gm/gm).  
     !          For use in surface flux parameterizations. See convect.ps  
     !          file for details.  
     !  
     !  cbmf: The cloud base mass flux ((kg/m**2)/s). THIS SCALAR VALUE MUST  
     !        BE STORED BY THE CALLING PROGRAM AND RETURNED TO CONVECT AT  
     !        ITS NEXT CALL. That is, the value of CBMF must be "remembered"  
     !        by the calling program between calls to CONVECT.  
     !  
     !  det:   Array of detrainment mass flux of dimension ND.  
     !  
     !-------------------------------------------------------------------  
     !  
     !  Local arrays  
     !  
80    
81      integer i, k, n, il, j      ! t: Array of absolute temperature (K) of dimension KLEV, with first
82        ! index corresponding to lowest model level. Note that this array
83        ! will be altered by the subroutine if dry convective adjustment
84        ! occurs and if IPBL is not equal to 0.
85    
86        ! q: Array of specific humidity (gm/gm) of dimension KLEV, with first
87        ! index corresponding to lowest model level. Must be defined
88        ! at same grid levels as T. Note that this array will be altered
89        ! if dry convective adjustment occurs and if IPBL is not equal to 0.
90    
91        ! qs: Array of saturation specific humidity of dimension KLEV, with first
92        ! index corresponding to lowest model level. Must be defined
93        ! at same grid levels as T. Note that this array will be altered
94        ! if dry convective adjustment occurs and if IPBL is not equal to 0.
95    
96        ! u: Array of zonal wind velocity (m/s) of dimension KLEV, witth first
97        ! index corresponding with the lowest model level. Defined at
98        ! same levels as T. Note that this array will be altered if
99        ! dry convective adjustment occurs and if IPBL is not equal to 0.
100    
101        ! v: Same as u but for meridional velocity.
102    
103        ! p: Array of pressure (mb) of dimension KLEV, with first
104        ! index corresponding to lowest model level. Must be defined
105        ! at same grid levels as T.
106    
107        ! ph: Array of pressure (mb) of dimension KLEV+1, with first index
108        ! corresponding to lowest level. These pressures are defined at
109        ! levels intermediate between those of P, T, Q and QS. The first
110        ! value of PH should be greater than (i.e. at a lower level than)
111        ! the first value of the array P.
112    
113        ! nl: The maximum number of levels to which convection can penetrate, plus 1
114        ! NL MUST be less than or equal to KLEV-1.
115    
116        ! delt: The model time step (sec) between calls to CONVECT
117    
118        ! --- On Output:
119    
120        ! iflag: An output integer whose value denotes the following:
121        ! VALUE INTERPRETATION
122        ! ----- --------------
123        ! 0 Moist convection occurs.
124        ! 1 Moist convection occurs, but a CFL condition
125        ! on the subsidence warming is violated. This
126        ! does not cause the scheme to terminate.
127        ! 2 Moist convection, but no precip because ep(inb) lt 0.0001
128        ! 3 No moist convection because new cbmf is 0 and old cbmf is 0.
129        ! 4 No moist convection; atmosphere is not
130        ! unstable
131        ! 6 No moist convection because ihmin le minorig.
132        ! 7 No moist convection because unreasonable
133        ! parcel level temperature or specific humidity.
134        ! 8 No moist convection: lifted condensation
135        ! level is above the 200 mb level.
136        ! 9 No moist convection: cloud base is higher
137        ! then the level NL-1.
138    
139        ! ft: Array of temperature tendency (K/s) of dimension KLEV, defined at same
140        ! grid levels as T, Q, QS and P.
141    
142        ! fq: Array of specific humidity tendencies ((gm/gm)/s) of dimension KLEV,
143        ! defined at same grid levels as T, Q, QS and P.
144    
145        ! fu: Array of forcing of zonal velocity (m/s^2) of dimension KLEV,
146        ! defined at same grid levels as T.
147    
148        ! fv: Same as FU, but for forcing of meridional velocity.
149    
150        ! precip: Scalar convective precipitation rate (mm/day).
151    
152        ! VPrecip: Vertical profile of convective precipitation (kg/m2/s).
153    
154        ! wd: A convective downdraft velocity scale. For use in surface
155        ! flux parameterizations. See convect.ps file for details.
156    
157        ! tprime: A convective downdraft temperature perturbation scale (K).
158        ! For use in surface flux parameterizations. See convect.ps
159        ! file for details.
160    
161        ! qprime: A convective downdraft specific humidity
162        ! perturbation scale (gm/gm).
163        ! For use in surface flux parameterizations. See convect.ps
164        ! file for details.
165    
166        ! cbmf: The cloud base mass flux ((kg/m**2)/s). THIS SCALAR VALUE MUST
167        ! BE STORED BY THE CALLING PROGRAM AND RETURNED TO CONVECT AT
168        ! ITS NEXT CALL. That is, the value of CBMF must be "remembered"
169        ! by the calling program between calls to CONVECT.
170    
171        ! det: Array of detrainment mass flux of dimension KLEV.
172    
173        ! Local arrays
174    
175        real da(klon, klev), phi(klon, klev, klev), mp(klon, klev)
176    
177        integer i, k, il
178      integer icbmax      integer icbmax
179      integer nk1(klon)      integer nk1(klon)
     integer icb1(klon)  
     integer inb1(klon)  
180      integer icbs1(klon)      integer icbs1(klon)
181    
182      real plcl1(klon)      real plcl1(klon)
183      real tnk1(klon)      real tnk1(klon)
184      real qnk1(klon)      real qnk1(klon)
185      real gznk1(klon)      real gznk1(klon)
     real pnk1(klon)  
     real qsnk1(klon)  
186      real pbase1(klon)      real pbase1(klon)
187      real buoybase1(klon)      real buoybase1(klon)
188    
# Line 239  contains Line 195  contains
195      real tp1(klon, klev)      real tp1(klon, klev)
196      real tvp1(klon, klev)      real tvp1(klon, klev)
197      real clw1(klon, klev)      real clw1(klon, klev)
     real sig1(klon, klev)  
     real w01(klon, klev)  
198      real th1(klon, klev)      real th1(klon, klev)
199      !  
200      integer ncum      integer ncum
201      !  
202      ! (local) compressed fields:      ! (local) compressed fields:
203      !  
204      integer nloc      integer idcum(klon)
205      parameter (nloc=klon) ! pour l'instant      integer iflag(klon), nk(klon), icb(klon)
206        integer nent(klon, klev)
207      integer idcum(nloc)      integer icbs(klon)
208      integer iflag(nloc), nk(nloc), icb(nloc)      integer inb(klon), inbis(klon)
209      integer nent(nloc, klev)  
210      integer icbs(nloc)      real cbmf(klon), plcl(klon), tnk(klon), qnk(klon), gznk(klon)
211      integer inb(nloc), inbis(nloc)      real t(klon, klev), q(klon, klev), qs(klon, klev)
212        real u(klon, klev), v(klon, klev)
213      real cbmf(nloc), plcl(nloc), tnk(nloc), qnk(nloc), gznk(nloc)      real gz(klon, klev), h(klon, klev), lv(klon, klev), cpn(klon, klev)
214      real t(nloc, klev), q(nloc, klev), qs(nloc, klev)      real p(klon, klev), ph(klon, klev+1), tv(klon, klev), tp(klon, klev)
215      real u(nloc, klev), v(nloc, klev)      real clw(klon, klev)
216      real gz(nloc, klev), h(nloc, klev), lv(nloc, klev), cpn(nloc, klev)      real dph(klon, klev)
217      real p(nloc, klev), ph(nloc, klev+1), tv(nloc, klev), tp(nloc, klev)      real pbase(klon), buoybase(klon), th(klon, klev)
218      real clw(nloc, klev)      real tvp(klon, klev)
219      real dph(nloc, klev)      real sig(klon, klev), w0(klon, klev)
220      real pbase(nloc), buoybase(nloc), th(nloc, klev)      real hp(klon, klev), ep(klon, klev), sigp(klon, klev)
221      real tvp(nloc, klev)      real frac(klon), buoy(klon, klev)
222      real sig(nloc, klev), w0(nloc, klev)      real cape(klon)
223      real hp(nloc, klev), ep(nloc, klev), sigp(nloc, klev)      real m(klon, klev), ment(klon, klev, klev), qent(klon, klev, klev)
224      real frac(nloc), buoy(nloc, klev)      real uent(klon, klev, klev), vent(klon, klev, klev)
225      real cape(nloc)      real ments(klon, klev, klev), qents(klon, klev, klev)
226      real m(nloc, klev), ment(nloc, klev, klev), qent(nloc, klev, klev)      real sij(klon, klev, klev), elij(klon, klev, klev)
227      real uent(nloc, klev, klev), vent(nloc, klev, klev)      real qp(klon, klev), up(klon, klev), vp(klon, klev)
228      real ments(nloc, klev, klev), qents(nloc, klev, klev)      real wt(klon, klev), water(klon, klev), evap(klon, klev)
229      real sij(nloc, klev, klev), elij(nloc, klev, klev)      real b(klon, klev), ft(klon, klev), fq(klon, klev)
230      real qp(nloc, klev), up(nloc, klev), vp(nloc, klev)      real fu(klon, klev), fv(klon, klev)
231      real wt(nloc, klev), water(nloc, klev), evap(nloc, klev)      real upwd(klon, klev), dnwd(klon, klev), dnwd0(klon, klev)
232      real b(nloc, klev), ft(nloc, klev), fq(nloc, klev)      real Ma(klon, klev), mike(klon, klev), tls(klon, klev)
233      real fu(nloc, klev), fv(nloc, klev)      real tps(klon, klev), qprime(klon), tprime(klon)
234      real upwd(nloc, klev), dnwd(nloc, klev), dnwd0(nloc, klev)      real precip(klon)
235      real Ma(nloc, klev), mike(nloc, klev), tls(nloc, klev)      real VPrecip(klon, klev+1)
236      real tps(nloc, klev), qprime(nloc), tprime(nloc)      real qcondc(klon, klev) ! cld
237      real precip(nloc)      real wd(klon) ! gust
     real VPrecip(nloc, klev+1)  
     real tra(nloc, klev, ntra), trap(nloc, klev, ntra)  
     real ftra(nloc, klev, ntra), traent(nloc, klev, klev, ntra)  
     real qcondc(nloc, klev)  ! cld  
     real wd(nloc)           ! gust  
238    
239      !-------------------------------------------------------------------      !-------------------------------------------------------------------
240      ! --- SET CONSTANTS AND PARAMETERS      ! --- SET CONSTANTS AND PARAMETERS
     !-------------------------------------------------------------------  
241    
242      ! -- set simulation flags:      ! -- set simulation flags:
243      !   (common cvflag)      ! (common cvflag)
244    
245      CALL cv_flag      CALL cv_flag
246    
247      ! -- set thermodynamical constants:      ! -- set thermodynamical constants:
248      !     (common cvthermo)      ! (common cvthermo)
249    
250      CALL cv_thermo(iflag_con)      CALL cv_thermo
251    
252      ! -- set convect parameters      ! -- set convect parameters
     !  
     !     includes microphysical parameters and parameters that  
     !     control the rate of approach to quasi-equilibrium)  
     !     (common cvparam)  
253    
254      if (iflag_con.eq.3) then      ! includes microphysical parameters and parameters that
255         CALL cv3_param(nd, delt)      ! control the rate of approach to quasi-equilibrium)
256      endif      ! (common cvparam)
257    
258      if (iflag_con.eq.4) then      if (iflag_con == 3) CALL cv3_param(klev, delt)
        CALL cv_param(nd)  
     endif  
259    
     !---------------------------------------------------------------------  
260      ! --- INITIALIZE OUTPUT ARRAYS AND PARAMETERS      ! --- INITIALIZE OUTPUT ARRAYS AND PARAMETERS
     !---------------------------------------------------------------------  
261    
262      do k=1, nd      do k = 1, klev
263         do  i=1, len         do i = 1, klon
264            ft1(i, k)=0.0            ft1(i, k) = 0.0
265            fq1(i, k)=0.0            fq1(i, k) = 0.0
266            fu1(i, k)=0.0            fu1(i, k) = 0.0
267            fv1(i, k)=0.0            fv1(i, k) = 0.0
268            tvp1(i, k)=0.0            tvp1(i, k) = 0.0
269            tp1(i, k)=0.0            tp1(i, k) = 0.0
270            clw1(i, k)=0.0            clw1(i, k) = 0.0
271            !ym            !ym
272            clw(i, k)=0.0            clw(i, k) = 0.0
273            gz1(i, k) = 0.            gz1(i, k) = 0.
274            VPrecip1(i, k) = 0.            VPrecip1(i, k) = 0.
275            Ma1(i, k)=0.0            Ma1(i, k) = 0.0
276            upwd1(i, k)=0.0            upwd1(i, k) = 0.0
277            dnwd1(i, k)=0.0            dnwd1(i, k) = 0.0
278            dnwd01(i, k)=0.0            dnwd01(i, k) = 0.0
279            qcondc1(i, k)=0.0            qcondc1(i, k) = 0.0
        end do  
     end do  
   
     do  j=1, ntra  
        do  k=1, nd  
           do  i=1, len  
              ftra1(i, k, j)=0.0  
           end do  
280         end do         end do
281      end do      end do
282    
283      do  i=1, len      do i = 1, klon
284         precip1(i)=0.0         precip1(i) = 0.0
285         iflag1(i)=0         iflag1(i) = 0
286         wd1(i)=0.0         wd1(i) = 0.0
287         cape1(i)=0.0         cape1(i) = 0.0
288         VPrecip1(i, nd+1)=0.0         VPrecip1(i, klev+1) = 0.0
289      end do      end do
290    
291      if (iflag_con.eq.3) then      if (iflag_con == 3) then
292         do il=1, len         do il = 1, klon
293            sig1(il, nd)=sig1(il, nd)+1.            sig1(il, klev) = sig1(il, klev) + 1.
294            sig1(il, nd)=amin1(sig1(il, nd), 12.1)            sig1(il, klev) = min(sig1(il, klev), 12.1)
295         enddo         enddo
296      endif      endif
297    
     !--------------------------------------------------------------------  
298      ! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY      ! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
     !--------------------------------------------------------------------  
299    
300      if (iflag_con.eq.3) then      if (iflag_con == 3) then
301         CALL cv3_prelim(len, nd, ndp1, t1, q1, p1, ph1, lv1, cpn1, tv1, gz1, &         CALL cv3_prelim(klon, klev, klev + 1, t1, q1, p1, ph1, lv1, cpn1, tv1, &
302              h1, hm1, th1)! nd->na              gz1, h1, hm1, th1)
303        else
304           ! iflag_con == 4
305           CALL cv_prelim(klon, klev, klev + 1, t1, q1, p1, ph1, lv1, cpn1, tv1, &
306                gz1, h1, hm1)
307      endif      endif
308    
     if (iflag_con.eq.4) then  
        CALL cv_prelim(len, nd, ndp1, t1, q1, p1, ph1 &  
             , lv1, cpn1, tv1, gz1, h1, hm1)  
     endif  
   
     !--------------------------------------------------------------------  
309      ! --- CONVECTIVE FEED      ! --- CONVECTIVE FEED
     !--------------------------------------------------------------------  
310    
311      if (iflag_con.eq.3) then      if (iflag_con == 3) then
312         CALL cv3_feed(len, nd, t1, q1, qs1, p1, ph1, hm1, gz1            &         CALL cv3_feed(klon, klev, t1, q1, qs1, p1, ph1, gz1, nk1, icb1, &
313              , nk1, icb1, icbmax, iflag1, tnk1, qnk1, gznk1, plcl1) ! nd->na              icbmax, iflag1, tnk1, qnk1, gznk1, plcl1) ! klev->na
314        else
315           ! iflag_con == 4
316           CALL cv_feed(klon, klev, t1, q1, qs1, p1, hm1, gz1, nk1, icb1, icbmax, &
317                iflag1, tnk1, qnk1, gznk1, plcl1)
318      endif      endif
319    
     if (iflag_con.eq.4) then  
        CALL cv_feed(len, nd, t1, q1, qs1, p1, hm1, gz1 &  
             , nk1, icb1, icbmax, iflag1, tnk1, qnk1, gznk1, plcl1)  
     endif  
   
     !--------------------------------------------------------------------  
320      ! --- UNDILUTE (ADIABATIC) UPDRAFT / 1st part      ! --- UNDILUTE (ADIABATIC) UPDRAFT / 1st part
321      ! (up through ICB for convect4, up through ICB+1 for convect3)      ! (up through ICB for convect4, up through ICB+1 for convect3)
322      !     Calculates the lifted parcel virtual temperature at nk, the      ! Calculates the lifted parcel virtual temperature at nk, the
323      !     actual temperature, and the adiabatic liquid water content.      ! actual temperature, and the adiabatic liquid water content.
     !--------------------------------------------------------------------  
   
     if (iflag_con.eq.3) then  
        CALL cv3_undilute1(len, nd, t1, q1, qs1, gz1, plcl1, p1, nk1, icb1   &  
             , tp1, tvp1, clw1, icbs1) ! nd->na  
     endif  
324    
325      if (iflag_con.eq.4) then      if (iflag_con == 3) then
326         CALL cv_undilute1(len, nd, t1, q1, qs1, gz1, p1, nk1, icb1, icbmax &         CALL cv3_undilute1(klon, klev, t1, q1, qs1, gz1, plcl1, p1, nk1, icb1, &
327              , tp1, tvp1, clw1)              tp1, tvp1, clw1, icbs1) ! klev->na
328        else
329           ! iflag_con == 4
330           CALL cv_undilute1(klon, klev, t1, q1, qs1, gz1, p1, nk1, icb1, icbmax, &
331                tp1, tvp1, clw1)
332      endif      endif
333    
     !-------------------------------------------------------------------  
334      ! --- TRIGGERING      ! --- TRIGGERING
     !-------------------------------------------------------------------  
   
     if (iflag_con.eq.3) then  
        CALL cv3_trigger(len, nd, icb1, plcl1, p1, th1, tv1, tvp1       &  
             , pbase1, buoybase1, iflag1, sig1, w01) ! nd->na  
     endif  
335    
336      if (iflag_con.eq.4) then      if (iflag_con == 3) then
337         CALL cv_trigger(len, nd, icb1, cbmf1, tv1, tvp1, iflag1)         CALL cv3_trigger(klon, klev, icb1, plcl1, p1, th1, tv1, tvp1, pbase1, &
338      endif              buoybase1, iflag1, sig1, w01) ! klev->na
339        else
340           ! iflag_con == 4
341           CALL cv_trigger(klon, klev, icb1, cbmf1, tv1, tvp1, iflag1)
342        end if
343    
     !=====================================================================  
344      ! --- IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY      ! --- IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY
     !=====================================================================  
345    
346      ncum=0      ncum = 0
347      do  i=1, len      do i = 1, klon
348         if(iflag1(i).eq.0)then         if(iflag1(i) == 0)then
349            ncum=ncum+1            ncum = ncum+1
350            idcum(ncum)=i            idcum(ncum) = i
351         endif         endif
352      end do      end do
353    
354      !       print*, 'klon, ncum = ', len, ncum      IF (ncum > 0) THEN
   
     IF (ncum.gt.0) THEN  
   
        !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^  
355         ! --- COMPRESS THE FIELDS         ! --- COMPRESS THE FIELDS
356         !        (-> vectorization over convective gridpoints)         ! (-> vectorization over convective gridpoints)
        !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^  
   
        if (iflag_con.eq.3) then  
           CALL cv3_compress( len, nloc, ncum, nd, ntra &  
                , iflag1, nk1, icb1, icbs1 &  
                , plcl1, tnk1, qnk1, gznk1, pbase1, buoybase1 &  
                , t1, q1, qs1, u1, v1, gz1, th1 &  
                , tra1 &  
                , h1, lv1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1  &  
                , sig1, w01 &  
                , iflag, nk, icb, icbs &  
                , plcl, tnk, qnk, gznk, pbase, buoybase &  
                , t, q, qs, u, v, gz, th &  
                , tra &  
                , h, lv, cpn, p, ph, tv, tp, tvp, clw  &  
                , sig, w0  )  
        endif  
357    
358         if (iflag_con.eq.4) then         if (iflag_con == 3) then
359            CALL cv_compress( len, nloc, ncum, nd &            CALL cv3_compress(klon, klon, ncum, klev, iflag1, nk1, icb1, icbs1, &
360                 , iflag1, nk1, icb1 &                 plcl1, tnk1, qnk1, gznk1, pbase1, buoybase1, t1, q1, qs1, u1, &
361                 , cbmf1, plcl1, tnk1, qnk1, gznk1 &                 v1, gz1, th1, h1, lv1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
362                 , t1, q1, qs1, u1, v1, gz1 &                 sig1, w01, iflag, nk, icb, icbs, plcl, tnk, qnk, gznk, pbase, &
363                 , h1, lv1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1 &                 buoybase, t, q, qs, u, v, gz, th, h, lv, cpn, p, ph, tv, tp, &
364                 , iflag, nk, icb &                 tvp, clw, sig, w0)
365                 , cbmf, plcl, tnk, qnk, gznk &         else
366                 , t, q, qs, u, v, gz, h, lv, cpn, p, ph, tv, tp, tvp, clw  &            ! iflag_con == 4
367                 , dph )            CALL cv_compress(klon, klon, ncum, klev, iflag1, nk1, icb1, cbmf1, &
368                   plcl1, tnk1, qnk1, gznk1, t1, q1, qs1, u1, v1, gz1, h1, lv1, &
369                   cpn1, p1, ph1, tv1, tp1, tvp1, clw1, iflag, nk, icb, cbmf, &
370                   plcl, tnk, qnk, gznk, t, q, qs, u, v, gz, h, lv, cpn, p, ph, &
371                   tv, tp, tvp, clw, dph)
372         endif         endif
373    
        !-------------------------------------------------------------------  
374         ! --- UNDILUTE (ADIABATIC) UPDRAFT / second part :         ! --- UNDILUTE (ADIABATIC) UPDRAFT / second part :
375         ! ---   FIND THE REST OF THE LIFTED PARCEL TEMPERATURES         ! --- FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
376         ! ---   &         ! --- &
377         ! ---   COMPUTE THE PRECIPITATION EFFICIENCIES AND THE         ! --- COMPUTE THE PRECIPITATION EFFICIENCIES AND THE
378         ! ---   FRACTION OF PRECIPITATION FALLING OUTSIDE OF CLOUD         ! --- FRACTION OF PRECIPITATION FALLING OUTSIDE OF CLOUD
379         ! ---   &         ! --- &
380         ! ---   FIND THE LEVEL OF NEUTRAL BUOYANCY         ! --- FIND THE LEVEL OF NEUTRAL BUOYANCY
381         !-------------------------------------------------------------------  
382           if (iflag_con == 3) then
383         if (iflag_con.eq.3) then            CALL cv3_undilute2(klon, ncum, klev, icb, icbs, nk, tnk, qnk, gznk, &
384            CALL cv3_undilute2(nloc, ncum, nd, icb, icbs, nk         &                 t, q, qs, gz, p, h, tv, lv, pbase, buoybase, plcl, inb, tp, &
385                 , tnk, qnk, gznk, t, q, qs, gz &                 tvp, clw, hp, ep, sigp, buoy) !na->klev
386                 , p, h, tv, lv, pbase, buoybase, plcl &         else
387                 , inb, tp, tvp, clw, hp, ep, sigp, buoy) !na->nd            ! iflag_con == 4
388         endif            CALL cv_undilute2(klon, ncum, klev, icb, nk, tnk, qnk, gznk, t, q, &
389                   qs, gz, p, dph, h, tv, lv, inb, inbis, tp, tvp, clw, hp, ep, &
390         if (iflag_con.eq.4) then                 sigp, frac)
           CALL cv_undilute2(nloc, ncum, nd, icb, nk &  
                , tnk, qnk, gznk, t, q, qs, gz &  
                , p, dph, h, tv, lv &  
                , inb, inbis, tp, tvp, clw, hp, ep, sigp, frac)  
391         endif         endif
392    
        !-------------------------------------------------------------------  
393         ! --- CLOSURE         ! --- CLOSURE
        !-------------------------------------------------------------------  
394    
395         if (iflag_con.eq.3) then         if (iflag_con == 3) then
396            CALL cv3_closure(nloc, ncum, nd, icb, inb               &            CALL cv3_closure(klon, ncum, klev, icb, inb, pbase, p, ph, tv, &
397                 , pbase, p, ph, tv, buoy &                 buoy, sig, w0, cape, m) ! na->klev
398                 , sig, w0, cape, m) ! na->nd         else
399              ! iflag_con == 4
400              CALL cv_closure(klon, ncum, klev, nk, icb, tv, tvp, p, ph, dph, &
401                   plcl, cpn, iflag, cbmf)
402         endif         endif
403    
        if (iflag_con.eq.4) then  
           CALL cv_closure(nloc, ncum, nd, nk, icb &  
                , tv, tvp, p, ph, dph, plcl, cpn &  
                , iflag, cbmf)  
        endif  
   
        !-------------------------------------------------------------------  
404         ! --- MIXING         ! --- MIXING
        !-------------------------------------------------------------------  
405    
406         if (iflag_con.eq.3) then         if (iflag_con == 3) then
407            CALL cv3_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb     &            CALL cv3_mixing(klon, ncum, klev, klev, icb, nk, inb, t, q, qs, u, &
408                 , ph, t, q, qs, u, v, tra, h, lv, qnk &                 v, h, lv, hp, ep, clw, m, sig, ment, qent, uent, vent, nent, &
409                 , hp, tv, tvp, ep, clw, m, sig &                 sij, elij, ments, qents)
410                 , ment, qent, uent, vent, nent, sij, elij, ments, qents, traent)! na->nd         else
411              ! iflag_con == 4
412              CALL cv_mixing(klon, ncum, klev, icb, nk, inb, inbis, ph, t, q, qs, &
413                   u, v, h, lv, qnk, hp, tv, tvp, ep, clw, cbmf, m, ment, qent, &
414                   uent, vent, nent, sij, elij)
415         endif         endif
416    
        if (iflag_con.eq.4) then  
           CALL cv_mixing(nloc, ncum, nd, icb, nk, inb, inbis &  
                , ph, t, q, qs, u, v, h, lv, qnk &  
                , hp, tv, tvp, ep, clw, cbmf &  
                , m, ment, qent, uent, vent, nent, sij, elij)  
        endif  
   
        !-------------------------------------------------------------------  
417         ! --- UNSATURATED (PRECIPITATING) DOWNDRAFTS         ! --- UNSATURATED (PRECIPITATING) DOWNDRAFTS
        !-------------------------------------------------------------------  
   
        if (iflag_con.eq.3) then  
           CALL cv3_unsat(nloc, ncum, nd, nd, ntra, icb, inb     &  
                , t, q, qs, gz, u, v, tra, p, ph &  
                , th, tv, lv, cpn, ep, sigp, clw &  
                , m, ment, elij, delt, plcl &  
                , mp, qp, up, vp, trap, wt, water, evap, b)! na->nd  
        endif  
418    
419         if (iflag_con.eq.4) then         if (iflag_con == 3) then
420            CALL cv_unsat(nloc, ncum, nd, inb, t, q, qs, gz, u, v, p, ph &            CALL cv3_unsat(klon, ncum, klev, klev, icb, inb, t, q, qs, gz, u, &
421                 , h, lv, ep, sigp, clw, m, ment, elij &                 v, p, ph, th, tv, lv, cpn, ep, sigp, clw, m, ment, elij, delt, &
422                 , iflag, mp, qp, up, vp, wt, water, evap)                 plcl, mp, qp, up, vp, wt, water, evap, b)! na->klev
423           else
424              ! iflag_con == 4
425              CALL cv_unsat(klon, ncum, klev, inb, t, q, qs, gz, u, v, p, ph, h, &
426                   lv, ep, sigp, clw, m, ment, elij, iflag, mp, qp, up, vp, wt, &
427                   water, evap)
428         endif         endif
429    
        !-------------------------------------------------------------------  
430         ! --- YIELD         ! --- YIELD
431         !     (tendencies, precipitation, variables of interface with other         ! (tendencies, precipitation, variables of interface with other
432         !      processes, etc)         ! processes, etc)
        !-------------------------------------------------------------------  
   
        if (iflag_con.eq.3) then  
           CALL cv3_yield(nloc, ncum, nd, nd, ntra             &  
                , icb, inb, delt &  
                , t, q, u, v, tra, gz, p, ph, h, hp, lv, cpn, th &  
                , ep, clw, m, tp, mp, qp, up, vp, trap &  
                , wt, water, evap, b &  
                , ment, qent, uent, vent, nent, elij, traent, sig &  
                , tv, tvp &  
                , iflag, precip, VPrecip, ft, fq, fu, fv, ftra &  
                , upwd, dnwd, dnwd0, ma, mike, tls, tps, qcondc, wd)! na->nd  
        endif  
433    
434         if (iflag_con.eq.4) then         if (iflag_con == 3) then
435            CALL cv_yield(nloc, ncum, nd, nk, icb, inb, delt &            CALL cv3_yield(klon, ncum, klev, klev, icb, inb, delt, t, q, u, v, &
436                 , t, q, u, v, gz, p, ph, h, hp, lv, cpn &                 gz, p, ph, h, hp, lv, cpn, th, ep, clw, m, tp, mp, qp, up, vp, &
437                 , ep, clw, frac, m, mp, qp, up, vp &                 wt, water, evap, b, ment, qent, uent, vent, nent, elij, sig, &
438                 , wt, water, evap &                 tv, tvp, iflag, precip, VPrecip, ft, fq, fu, fv, upwd, dnwd, &
439                 , ment, qent, uent, vent, nent, elij &                 dnwd0, ma, mike, tls, tps, qcondc, wd)! na->klev
440                 , tv, tvp &         else
441                 , iflag, wd, qprime, tprime &            ! iflag_con == 4
442                 , precip, cbmf, ft, fq, fu, fv, Ma, qcondc)            CALL cv_yield(klon, ncum, klev, nk, icb, inb, delt, t, q, u, v, gz, &
443                   p, ph, h, hp, lv, cpn, ep, clw, frac, m, mp, qp, up, vp, wt, &
444                   water, evap, ment, qent, uent, vent, nent, elij, tv, tvp, &
445                   iflag, wd, qprime, tprime, precip, cbmf, ft, fq, fu, fv, Ma, &
446                   qcondc)
447         endif         endif
448    
        !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^  
449         ! --- passive tracers         ! --- passive tracers
        !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^  
450    
451         if (iflag_con.eq.3) then         if (iflag_con == 3) CALL cv3_tracer(klon, ncum, klev, ment, sij, da, phi)
           CALL cv3_tracer(nloc, len, ncum, nd, nd, &  
                ment, sij, da, phi)  
        endif  
452    
        !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^  
453         ! --- UNCOMPRESS THE FIELDS         ! --- UNCOMPRESS THE FIELDS
454         !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^  
455         ! set iflag1 =42 for non convective points         ! set iflag1 = 42 for non convective points
456         do  i=1, len         do i = 1, klon
457            iflag1(i)=42            iflag1(i) = 42
458         end do         end do
        !  
        if (iflag_con.eq.3) then  
           CALL cv3_uncompress(nloc, len, ncum, nd, ntra, idcum &  
                , iflag &  
                , precip, VPrecip, sig, w0 &  
                , ft, fq, fu, fv, ftra &  
                , inb  &  
                , Ma, upwd, dnwd, dnwd0, qcondc, wd, cape &  
                , da, phi, mp &  
                , iflag1 &  
                , precip1, VPrecip1, sig1, w01 &  
                , ft1, fq1, fu1, fv1, ftra1 &  
                , inb1 &  
                , Ma1, upwd1, dnwd1, dnwd01, qcondc1, wd1, cape1  &  
                , da1, phi1, mp1)  
        endif  
459    
460         if (iflag_con.eq.4) then         if (iflag_con == 3) then
461            CALL cv_uncompress(nloc, len, ncum, nd, idcum &            CALL cv3_uncompress(idcum(:ncum), iflag, precip, VPrecip, sig, w0, &
462                 , iflag &                 ft, fq, fu, fv, inb, Ma, upwd, dnwd, dnwd0, qcondc, wd, cape, &
463                 , precip, cbmf &                 da, phi, mp, iflag1, precip1, VPrecip1, sig1, w01, ft1, fq1, &
464                 , ft, fq, fu, fv &                 fu1, fv1, inb1, Ma1, upwd1, dnwd1, dnwd01, qcondc1, wd1, &
465                 , Ma, qcondc             &                 cape1, da1, phi1, mp1)
466                 , iflag1 &         else
467                 , precip1, cbmf1 &            ! iflag_con == 4
468                 , ft1, fq1, fu1, fv1 &            CALL cv_uncompress(idcum(:ncum), iflag, precip, cbmf, ft, fq, fu, &
469                 , Ma1, qcondc1 )                 fv, Ma, qcondc, iflag1, precip1, cbmf1, ft1, fq1, fu1, fv1, &
470                   Ma1, qcondc1)
471         endif         endif
472      ENDIF ! ncum>0      ENDIF ! ncum>0
473    

Legend:
Removed from v.52  
changed lines
  Added in v.145

  ViewVC Help
Powered by ViewVC 1.1.21