1 ! Generated by TAPENADE (INRIA, Tropics team)
2 ! Tapenade 3.7 (r4786) - 21 Feb 2013 15:53
4 ! Differentiation of cumulus_driver in reverse (adjoint) mode (with options r8):
5 ! gradient of useful results: th raincv p t rthcuten z pratec
6 ! qv_curr rqvcuten rho dz8w
7 ! with respect to varying inputs: th raincv p t rthcuten z pratec
8 ! qv_curr rqvcuten rho dz8w
9 ! RW status of diff variables: th:incr raincv:in-out p:incr t:incr
10 ! rthcuten:in-out z:incr pratec:in-out qv_curr:incr
11 ! rqvcuten:in-out rho:incr dz8w:incr
12 !WRF:MEDIATION_LAYER:PHYSICS
14 MODULE a_module_cumulus_driver
17 SUBROUTINE A_CUMULUS_DRIVER(grid, ids, ide, jds, jde, kds, kde, ims, ime&
18 & , jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe, i_start, i_end, &
19 & j_start, j_end, kts, kte, num_tiles, u, v, th, thb, t, tb, w, p, pb, &
20 & pi, rho, rhob, itimestep, dt, dx, cudt, curr_secs, adapt_step_flag, &
21 & cudtacttime, rainc, raincv, raincvb, pratec, pratecb, nca, z, zb, &
22 & z_at_w, dz8w, dz8wb, mavail, pblh, p8w, psfc, tsk, tke_pbl, ust, &
23 & forcet, forceq, w0avg, stepcu, gsw, cldefi, lowlyr, xland, cu_act_flag&
24 & , warm_rain, hfx, qfx, cldfra, cldfra_mp_all, tpert2d, htop, hbot, &
25 & kpbl, ht, ensdim, maxiens, maxens, maxens2, maxens3, periodic_x, &
26 & periodic_y, evapcdp3d, icwmrdp3d, rprddp3d, &
27 & cu_physics, bl_pbl_physics, sf_sfclay_physics, qv_curr, qv_currb, &
28 & qc_curr, qr_curr, qi_curr, qs_curr, qg_curr, qv_prev, qc_prev, qr_prev&
29 & , qi_prev, qs_prev, qg_prev, apr_gr, apr_w, apr_mc, apr_st, apr_as, &
30 & apr_capma, apr_capme, apr_capmi, edt_out, clos_choice, mass_flux, &
31 & xf_ens, pr_ens, cugd_avedx, imomentum, ishallow, cugd_tten, cugd_qvten&
32 & , cugd_qcten, cugd_ttens, cugd_qvtens, gd_cloud, gd_cloud2, cape, zmmu&
33 & , zmmd, zmdt, zmdq, dlf, rliq, pconvb, pconvt, evaptzm, fzsntzm, &
34 & evsntzm, evapqzm, zmflxprc, zmflxsnw, zmntprpd, zmntsnpd, zmeiheat, &
35 & cmfmc, cmfmcdzm, preccdzm, precz, zmmtu, zmmtv, zmupgu, zmupgd, zmvpgu&
36 & , zmvpgd, zmicuu, zmicud, zmicvu, zmicvd, zmdice, zmdliq, dp3d, du3d, &
37 & ed3d, eu3d, md3d, mu3d, dsubcld2d, ideep2d, jt2d, maxg2d, lengath2d, &
38 & k22_shallow, kbcon_shallow, ktop_shallow, xmb_shallow, ktop_deep, &
39 & pgcon, sas_mass_flux, shalconv, shal_pgcon, hpbl2d, evap2d, heat2d, &
40 & mp_physics, rqvcuten, rqvcutenb, rqccuten, rqrcuten, rqicuten, &
41 & rqscuten, rqgcuten, rqcncuten, rqincuten, rqvblten, rqvften, rucuten, &
42 & rvcuten, rthcuten, rthcutenb, rthraten, rthblten, rthften, mommix, &
43 & store_rand, znu, f_qv, f_qc, f_qr, f_qi, f_qs, f_qg, cfu1, cfd1, dfu1&
44 & , efu1, dfd1, efd1, f_flux, kfeta_trigger)
46 USE module_model_constants
47 USE module_state_description, ONLY: KFSCHEME,BMJSCHEME &
48 ,KFETASCHEME,GDSCHEME &
50 ,P_QC,P_QI,Param_FIRST_SCALAR &
51 ,CAMZMSCHEME, SASSCHEME &
53 ,NSASSCHEME, DUCUSCHEME &
57 ! *** add new modules of schemes here
60 USE module_dm , ONLY : ntasks_x,ntasks_y,local_communicator,mytask,ntasks
62 USE module_domain , ONLY: domain
63 USE a_module_cu_du , ONLY : DUCU_B
64 USE module_wrf_error , ONLY : wrf_err_message
67 !======================================================================
68 ! Grid structure in physics part of WRF
69 !----------------------------------------------------------------------
70 ! The horizontal velocities used in the physics are unstaggered
71 ! relative to temperature/moisture variables. All predicted
72 ! variables are carried at half levels except w, which is at full
73 ! levels. Some arrays with names (*8w) are at w (full) levels.
75 !----------------------------------------------------------------------
76 ! In WRF, kms (smallest number) is the bottom level and kme (largest
77 ! number) is the top level. In your scheme, if 1 is at the top level,
78 ! then you have to reverse the order in the k direction.
80 ! kme - half level (no data at this level)
81 ! kme ----- full level
83 ! kme-1 ----- full level
88 ! kms+2 ----- full level
90 ! kms+1 ----- full level
92 ! kms ----- full level
94 !======================================================================
97 ! Rho_d dry density (kg/m^3)
98 ! Theta_m moist potential temperature (K)
99 ! Qv water vapor mixing ratio (kg/kg)
100 ! Qc cloud water mixing ratio (kg/kg)
101 ! Qr rain water mixing ratio (kg/kg)
102 ! Qi cloud ice mixing ratio (kg/kg)
103 ! Qs snow mixing ratio (kg/kg)
104 !-----------------------------------------------------------------
105 !-- DT time step (second)
106 !-- CUDT cumulus time step (minute)
107 !-- curr_secs current forecast time (seconds)
108 !-- itimestep number of time step (integer)
109 !-- DX horizontal space interval (m)
110 !-- rr dry air density (kg/m^3)
112 !-- RUCUTEN Zonal wind tendency due to
113 ! cumulus scheme precipitation (m/s/s)
114 !-- RVCUTEN Meridional wind tendency due to
115 ! cumulus scheme precipitation (m/s/s)
116 !-- RTHCUTEN Theta tendency due to
117 ! cumulus scheme precipitation (K/s)
118 !-- RQVCUTEN Qv tendency due to
119 ! cumulus scheme precipitation (kg/kg/s)
120 !-- RQRCUTEN Qr tendency due to
121 ! cumulus scheme precipitation (kg/kg/s)
122 !-- RQCCUTEN Qc tendency due to
123 ! cumulus scheme precipitation (kg/kg/s)
124 !-- RQSCUTEN Qs tendency due to
125 ! cumulus scheme precipitation (kg/kg/s)
126 !-- RQICUTEN Qi tendency due to
127 ! cumulus scheme precipitation (kg/kg/s)
129 !-- RAINC accumulated total cumulus scheme precipitation (mm)
130 !-- RAINCV time-step cumulus scheme precipitation (mm)
131 !-- PRATEC precipitiation rate from cumulus scheme (mm/s)
132 !-- NCA counter of the cloud relaxation
133 ! time in KF cumulus scheme (integer)
134 !-- u_phy u-velocity interpolated to theta points (m/s)
135 !-- v_phy v-velocity interpolated to theta points (m/s)
136 !-- th_phy potential temperature (K)
137 !-- t_phy temperature (K)
138 !-- tsk skin temperature (K)
139 !-- tke_pbl turbulent kinetic energy from PBL scheme (m2/s2)
140 !-- ust u* in similarity theory (m/s)
141 !-- w vertical velocity (m/s)
142 !-- moist moisture array (4D - last index is species) (kg/kg)
143 !-- z height above sea level at middle of layers (m)
144 !-- z_at_w height above sea level at layer interfaces (m)
145 !-- dz8w dz between full levels (m)
146 !-- pblh planetary boundary layer height (m)
147 !-- mavail soil moisture availability
148 !-- p8w pressure at full levels (Pa)
149 !-- psfc surface pressure (Pa)
150 !-- p_phy pressure (Pa)
151 !-- pi_phy exner function (dimensionless)
152 ! points (dimensionless)
153 !-- hfx upward heat flux at surface (W/m2)
154 !-- qfx upward moisture flux at surface (kg/m2/s)
155 !-- RTHRATEN radiative temp forcing for Grell-Devenyi scheme
156 !-- RTHBLTEN PBL temp forcing for Grell-Devenyi scheme
157 !-- RQVBLTEN PBL moisture forcing for Grell-Devenyi scheme
164 !-- cldfra cloud fraction
165 !-- cldfra_mp_all cloud fraction
167 !-- W0AVG average vertical velocity, (for KF scheme) (m/s)
168 !-- kfeta_trigger namelist for KF trigger (=1, default; =2, moisture-advection-dependent trigger)
169 !-- rho density (kg/m^3)
170 !-- CLDEFI precipitation efficiency (for BMJ scheme) (dimensionless)
171 !-- STEPCU # of fundamental timesteps between convection calls
172 !-- XLAND land-sea mask (1.0 for land; 2.0 for water)
173 !-- LOWLYR index of lowest model layer above the ground
174 !-- XLV0 latent heat of vaporization constant
175 ! used in temperature dependent formula (J/kg)
176 !-- XLV1 latent heat of vaporization constant
177 ! used in temperature dependent formula (J/kg/K)
178 !-- XLS0 latent heat of sublimation constant
179 ! used in temperature dependent formula (J/kg)
180 !-- XLS1 latent heat of sublimation constant
181 ! used in temperature dependent formula (J/kg/K)
182 !-- R_d gas constant for dry air ( 287. J/kg/K)
183 !-- R_v gas constant for water vapor (461 J/k/kg)
184 !-- Cp specific heat at constant pressure (1004 J/k/kg)
185 !-- rvovrd R_v divided by R_d (dimensionless)
186 !-- G acceleration due to gravity (m/s^2)
187 !-- EP_1 constant for virtual temperature
188 ! (R_v/R_d - 1) (dimensionless)
189 !-- pi_phy the exner function, (p/p0)**(R/Cp) (none unit)
190 !-- evapcdp3d Evaporation of deep convective precipitation (kg/kg/s)
191 !-- icwmrdp3d Deep Convection in-cloud water mixing ratio (kg/m2)
192 !-- rprddp3d dq/dt due to deep convective rainout (kg/kg/s)
193 !-- ids start index for i in domain
194 !-- ide end index for i in domain
195 !-- jds start index for j in domain
196 !-- jde end index for j in domain
197 !-- kds start index for k in domain
198 !-- kde end index for k in domain
199 !-- ims start index for i in memory
200 !-- ime end index for i in memory
201 !-- jms start index for j in memory
202 !-- jme end index for j in memory
203 !-- kms start index for k in memory
204 !-- kme end index for k in memory
205 !-- i_start start indices for i in tile
206 !-- i_end end indices for i in tile
207 !-- j_start start indices for j in tile
208 !-- j_end end indices for j in tile
209 !-- kts start index for k in tile
210 !-- kte end index for k in tile
211 !-- num_tiles number of tiles
212 !-- HBOT index of lowest model layer with convection
213 !-- HTOP index of highest model layer with convection
214 !-- LBOT index of lowest model layer with convection
215 !-- LTOP index of highest model layer with convection
216 !-- KPBL layer index of the PBL
217 !-- periodic_x T/F this is using periodic lateral boundaries in the X direction
218 !-- periodic_y T/F this is using periodic lateral boundaries in the Y-direction
220 !======================================================================
221 INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
222 & jme, kms, kme, kts, kte, itimestep, num_tiles
223 LOGICAL :: periodic_x, periodic_y
224 TYPE(DOMAIN), INTENT(INOUT) :: grid
225 INTEGER, DIMENSION(num_tiles), INTENT(IN) :: i_start, i_end, j_start, &
227 INTEGER, INTENT(IN) :: ensdim, maxiens, maxens, maxens2, maxens3
228 INTEGER, OPTIONAL, INTENT(IN) :: cugd_avedx, clos_choice, &
229 & bl_pbl_physics, sf_sfclay_physics
230 INTEGER, INTENT(IN) :: cu_physics
231 INTEGER, INTENT(IN) :: stepcu
232 LOGICAL, INTENT(IN) :: warm_rain
233 !BSINGH:01/31/2013: Added for CAMZM
234 REAL, INTENT(IN), OPTIONAL :: pgcon, shal_pgcon, sas_mass_flux
235 INTEGER, INTENT(IN), OPTIONAL :: shalconv
236 INTEGER, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: lowlyr
237 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: z, dz8w, p8w&
238 & , p, pi, u, v, th, t, rho, w
239 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: zb, dz8wb, pb, thb, tb, &
241 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(OUT), OPTIONAL :: &
242 & evapcdp3d, icwmrdp3d, rprddp3d
243 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN), OPTIONAL :: &
244 & z_at_w, cldfra, cldfra_mp_all, tke_pbl
245 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: w0avg
246 REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: gsw, ht, xland
247 REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: rainc, raincv, nca&
248 & , htop, hbot, cldefi
249 REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: raincvb
250 REAL, DIMENSION(kms:kme), OPTIONAL, INTENT(IN) :: znu
251 REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT), OPTIONAL :: pratec, &
252 & mavail, pblh, psfc, tsk, tpert2d, ust, hfx, qfx
253 REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT), OPTIONAL :: pratecb
254 REAL, DIMENSION(ims:ime, jms:jme) :: tmppratec
255 REAL, DIMENSION(ims:ime, jms:jme) :: tmppratecb
256 INTEGER, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: kpbl
257 LOGICAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: cu_act_flag
258 INTEGER, INTENT(IN), OPTIONAL :: kfeta_trigger
259 REAL, INTENT(IN) :: dt, dx
260 INTEGER, INTENT(IN), OPTIONAL :: ips, ipe, jps, jpe, kps, kpe, &
261 & imomentum, ishallow
262 REAL, INTENT(IN), OPTIONAL :: cudt
263 REAL, INTENT(IN), OPTIONAL :: curr_secs
264 LOGICAL, INTENT(IN), OPTIONAL :: adapt_step_flag
265 REAL, INTENT(INOUT), OPTIONAL :: cudtacttime
266 REAL :: cudt_pass, curr_secs_pass, cudtacttime_pass
267 LOGICAL :: adapt_step_flag_pass
268 INTEGER, INTENT(IN), OPTIONAL :: mp_physics
269 REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(IN) :: store_rand
271 REAL, OPTIONAL, INTENT(INOUT) :: mommix
272 !Kwon for sas2010 shallow convection
273 REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: hpbl2d, &
276 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: rucuten, &
281 INTEGER, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
282 & k22_shallow, kbcon_shallow, ktop_shallow, ideep2d, jt2d, maxg2d, &
284 INTEGER, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(OUT) :: &
286 ! optional moisture tracers
287 ! 2 time levels; if only one then use CURR
288 ! optional moisture and other tendencies
289 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
290 & qv_curr, qc_curr, qr_curr, qi_curr, qs_curr, qg_curr, qv_prev, qc_prev&
291 & , qr_prev, qi_prev, qs_prev, qg_prev, rqvcuten, rqccuten, rqrcuten, &
292 & rqicuten, rqscuten, rqgcuten, rqcncuten, rqincuten, rqvblten, rqvften&
293 & , rthraten, rthblten, cugd_tten, cugd_qvten, cugd_qcten, cugd_ttens, &
294 & cugd_qvtens, forcet, forceq, rthften, rthcuten
295 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL :: qv_currb, &
296 & rqvcutenb, rthcutenb
297 REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: apr_gr, &
298 & apr_w, apr_mc, apr_st, apr_as, apr_capma, apr_capme, apr_capmi, &
299 & edt_out, xmb_shallow, mass_flux, cape, pconvb, pconvt, preccdzm, precz&
301 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
302 & gd_cloud, gd_cloud2, zmmd, zmmu, zmdt, zmdq, dlf, evaptzm, fzsntzm, &
303 & evsntzm, evapqzm, zmflxprc, zmflxsnw, zmntprpd, zmntsnpd, zmeiheat, &
304 & cmfmc, cmfmcdzm, zmmtu, zmmtv, zmupgu, zmupgd, zmvpgu, zmvpgd, zmicuu&
305 & , zmicud, zmicvu, zmicvd, zmdice, zmdliq, dp3d, du3d, ed3d, eu3d, md3d&
307 REAL, DIMENSION(ims:ime, jms:jme, ensdim), OPTIONAL, INTENT(INOUT) :: &
309 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
310 & cfu1, cfd1, dfu1, efu1, dfd1, efd1
312 ! Flags relating to the optional tendency arrays declared above
313 ! Models that carry the optional tendencies will provdide the
314 ! optional arguments at compile time; these flags all the model
315 ! to determine at run-time whether a particular tracer is in
318 LOGICAL, INTENT(IN), OPTIONAL :: f_qv, f_qc, f_qr, f_qi, f_qs, f_qg
319 LOGICAL, INTENT(IN), OPTIONAL :: f_flux
321 INTEGER :: i, j, k, its, ite, jts, jte, ij, trigger_kf
323 LOGICAL :: decided, run_param, doing_adapt_dt
325 EXTERNAL WRF_ERROR_FATAL
326 !-----------------------------------------------------------------
328 IF (.NOT.PRESENT(curr_secs)) THEN
331 curr_secs_pass = curr_secs
333 IF (.NOT.PRESENT(cudt)) THEN
335 cudtacttime_pass = -1
338 cudtacttime_pass = cudtacttime
340 IF (.NOT.PRESENT(adapt_step_flag)) THEN
341 adapt_step_flag_pass = .false.
343 adapt_step_flag_pass = adapt_step_flag
345 ! Initialize tmppratec to pratec
346 IF (PRESENT(pratec)) THEN
347 CALL PUSHCONTROL1B(0)
349 CALL PUSHCONTROL1B(1)
351 IF (cu_physics .EQ. 0) THEN
354 ! Initialization for adaptive time step.
355 IF (adapt_step_flag_pass) THEN
356 doing_adapt_dt = .true.
357 IF (cudtacttime_pass .EQ. 0.) cudtacttime_pass = curr_secs_pass + &
360 doing_adapt_dt = .false.
362 ! Do we run through this scheme or not?
363 ! Test 1: If this is the initial model time, then yes.
365 ! Test 2: If the user asked for the cumulus to be run every time step, then yes.
367 ! Test 3: If not adaptive dt, and this is on the requested cumulus frequency, then yes.
368 ! MOD(ITIMESTEP,STEPCU)=0
369 ! Test 4: If using adaptive dt and the current time is past the last requested activate cumulus time, then yes.
370 ! CURR_SECS >= CUDTACTTIME
371 ! If we do run through the scheme, we set the flag run_param to TRUE and we set the decided flag
372 ! to TRUE. The decided flag says that one of these tests was able to say "yes", run the scheme.
373 ! We only proceed to other tests if the previous tests all have left decided as FALSE.
374 ! If we set run_param to TRUE and this is adaptive time stepping, we set the time to the next
378 IF (.NOT.decided .AND. itimestep .EQ. 1) THEN
382 IF (.NOT.decided .AND. (cudt_pass .EQ. 0. .OR. stepcu .EQ. 1)) THEN
386 IF (.NOT.decided .AND. (.NOT.doing_adapt_dt) .AND. MOD(itimestep, &
387 & stepcu) .EQ. 0) THEN
391 IF (.NOT.decided .AND. doing_adapt_dt .AND. curr_secs_pass .GE. &
392 & cudtacttime_pass) run_param = .true.
394 ! DON'T JUDGE TIME STEP HERE, SINCE KF NEEDS ACCUMULATED W FIELD.
395 ! DO IT INSIDE THE INDIVIDUAL CUMULUS SCHEME
396 ! SET START AND END POINTS FOR TILES
398 !$OMP PRIVATE ( ij ,its,ite,jts,jte, i,j,k)
404 SELECT CASE (cu_physics)
406 CALL PUSHCONTROL1B(1)
408 CALL PUSHCONTROL1B(0)
411 !$OMP END PARALLEL DO
412 ! Copy pratec back to output array, if necessary.
413 IF (PRESENT(pratec)) THEN
415 tmppratecb(:, :) = pratecb(:, :)
421 CALL POPCONTROL1B(branch)
422 IF (branch .NE. 0) THEN
427 CALL DUCU_B(ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=&
428 & kde, ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=&
429 & kme, its=its, ite=ite, jts=jts, jte=jte, kts=kts, kte=&
430 & kte, dt=dt, ktau=itimestep, dx=dx, rho=rho, rhob=rhob, &
431 & raincv=raincv, raincvb=raincvb, nca=nca, pratec=&
432 & tmppratec, pratecb=tmppratecb, u=u, v=v, th=th, thb=thb&
433 & , t=t, tb=tb, w=w, dz8w=dz8w, dz8wb=dz8wb, z=z, zb=zb, &
434 & pcps=p, pcpsb=pb, pi=pi, w0avg=w0avg, cp=cp, rd=r_d, rv=&
435 & r_v, g=g, xlv=xlv0, ep2=ep_2, svp1=svp1, svp2=svp2, svp3&
436 & =svp3, svpt0=svpt0, stepcu=stepcu, cu_act_flag=&
437 & cu_act_flag, warm_rain=warm_rain, cutop=htop, cubot=hbot&
438 & , qv=qv_curr, qvb=qv_currb, rthcuten=rthcuten, rthcutenb&
439 & =rthcutenb, rqvcuten=rqvcuten, rqvcutenb=rqvcutenb)
446 CALL POPCONTROL1B(branch)
447 IF (branch .EQ. 0) pratecb = pratecb + tmppratecb
448 END SUBROUTINE A_CUMULUS_DRIVER
449 END MODULE a_module_cumulus_driver