Line data Source code
1 : module micro_pumas_diags
2 :
3 : !----------------------------------------
4 : ! PUMAS diagnostics support package
5 : !----------------------------------------
6 :
7 : use shr_kind_mod, only: r8=>shr_kind_r8
8 :
9 : type, public :: proc_rates_type
10 :
11 : real(r8), allocatable :: prodsnow(:,:) ! production of snow (1/s)
12 : real(r8), allocatable :: evapsnow(:,:) ! sublimation rate of snow (1/s)
13 : real(r8), allocatable :: qcsevap(:,:) ! cloud water evaporation due to sedimentation (1/s)
14 : real(r8), allocatable :: qisevap(:,:) ! cloud ice sublimation due to sublimation (1/s)
15 : real(r8), allocatable :: qvres(:,:) ! residual condensation term to ensure RH < 100% (1/s)
16 : real(r8), allocatable :: cmeitot(:,:) ! grid-mean cloud ice sub/dep (1/s)
17 : real(r8), allocatable :: vtrmc(:,:) ! mass-weighted cloud water fallspeed (m/s)
18 : real(r8), allocatable :: vtrmi(:,:) ! mass-weighted cloud ice fallspeed (m/s)
19 : real(r8), allocatable :: umr(:,:) ! mass weighted rain fallspeed (m/s)
20 : real(r8), allocatable :: ums(:,:) ! mass weighted snow fallspeed (m/s)
21 : real(r8), allocatable :: umg(:,:) ! mass weighted graupel/hail fallspeed (m/s)
22 : real(r8), allocatable :: qgsedten(:,:) ! qg sedimentation tendency (1/s)
23 : real(r8), allocatable :: qcsedten(:,:) ! qc sedimentation tendency (1/s)
24 : real(r8), allocatable :: qisedten(:,:) ! qi sedimentation tendency (1/s)
25 : real(r8), allocatable :: qrsedten(:,:) ! qr sedimentation tendency (1/s)
26 : real(r8), allocatable :: qssedten(:,:) ! qs sedimentation tendency (1/s)
27 :
28 : real(r8), allocatable :: pratot(:,:)
29 : real(r8), allocatable :: prctot(:,:)
30 : real(r8), allocatable :: mnuccctot(:,:)
31 : real(r8), allocatable :: mnuccttot(:,:)
32 : real(r8), allocatable :: msacwitot(:,:)
33 : real(r8), allocatable :: psacwstot(:,:)
34 : real(r8), allocatable :: bergstot(:,:)
35 : real(r8), allocatable :: vapdepstot(:,:)
36 : real(r8), allocatable :: bergtot(:,:)
37 : real(r8), allocatable :: melttot(:,:)
38 : real(r8), allocatable :: meltstot(:,:)
39 : real(r8), allocatable :: meltgtot(:,:)
40 : real(r8), allocatable :: homotot(:,:)
41 : real(r8), allocatable :: qcrestot(:,:)
42 : real(r8), allocatable :: prcitot(:,:)
43 : real(r8), allocatable :: praitot(:,:)
44 : real(r8), allocatable :: qirestot(:,:)
45 : real(r8), allocatable :: mnuccrtot(:,:)
46 : real(r8), allocatable :: mnudeptot(:,:)
47 : real(r8), allocatable :: mnuccritot(:,:)
48 : real(r8), allocatable :: pracstot(:,:)
49 : real(r8), allocatable :: meltsdttot(:,:)
50 : real(r8), allocatable :: frzrdttot(:,:)
51 : real(r8), allocatable :: mnuccdtot(:,:)
52 : real(r8), allocatable :: pracgtot(:,:)
53 : real(r8), allocatable :: psacwgtot(:,:)
54 : real(r8), allocatable :: pgsacwtot(:,:)
55 : real(r8), allocatable :: pgracstot(:,:)
56 : real(r8), allocatable :: prdgtot(:,:)
57 : real(r8), allocatable :: qmultgtot(:,:)
58 : real(r8), allocatable :: qmultrgtot(:,:)
59 : real(r8), allocatable :: psacrtot(:,:)
60 : real(r8), allocatable :: npracgtot(:,:)
61 : real(r8), allocatable :: nscngtot(:,:)
62 : real(r8), allocatable :: ngracstot(:,:)
63 : real(r8), allocatable :: nmultgtot(:,:)
64 : real(r8), allocatable :: nmultrgtot(:,:)
65 : real(r8), allocatable :: npsacwgtot(:,:)
66 :
67 : real(r8), allocatable :: nnuccctot(:,:) ! change n due to Immersion freezing of cloud water
68 : real(r8), allocatable :: nnuccttot(:,:) ! change n due to Contact freezing of cloud water
69 : real(r8), allocatable :: nnuccdtot(:,:) ! change n due to Ice nucleation
70 : real(r8), allocatable :: nnudeptot(:,:) ! change n due to Deposition Nucleation
71 : real(r8), allocatable :: nhomotot(:,:) ! change n due to Homogeneous freezing of cloud water
72 : real(r8), allocatable :: nnuccrtot(:,:) ! change n due to heterogeneous freezing of rain to snow (1/s)
73 : real(r8), allocatable :: nnuccritot(:,:) ! change n due to Heterogeneous freezing of rain to ice
74 : real(r8), allocatable :: nsacwitot(:,:) ! change n due to Conversion of cloud water [to cloud ice]
75 : ! from rime-splintering
76 : real(r8), allocatable :: npratot(:,:) ! change n due to Accretion of cloud water by rain
77 : real(r8), allocatable :: npsacwstot(:,:) ! change n due to Accretion of cloud water by snow
78 : real(r8), allocatable :: npraitot(:,:) ! change n due to Accretion of cloud ice to snow
79 : real(r8), allocatable :: npracstot(:,:) ! change n due to Accretion of rain by snow
80 : real(r8), allocatable :: nprctot(:,:) ! change nr due to Autoconversion of cloud water [to rain]
81 : real(r8), allocatable :: nprcitot(:,:) ! change n due to Autoconversion of cloud ice to snow
82 : real(r8), allocatable :: ncsedten(:,:) ! change n due to cloud liquid sedimentation
83 : real(r8), allocatable :: nisedten(:,:) ! change n due to cloud ice sedimentation
84 : real(r8), allocatable :: nrsedten(:,:) ! change n due to rain sedimentation
85 : real(r8), allocatable :: nssedten(:,:) ! change n due to snow sedimentation
86 : real(r8), allocatable :: ngsedten(:,:) ! change n due to graupel sedimentation
87 : real(r8), allocatable :: nmelttot(:,:) ! change n due to Melting of cloud ice
88 : real(r8), allocatable :: nmeltstot(:,:) ! change n due to Melting of snow
89 : real(r8), allocatable :: nmeltgtot(:,:) ! change n due to Melting of graupel
90 :
91 : ! TAU diagnostic variables
92 : real(r8), allocatable :: nraggtot(:,:) ! change nr due to self collection of rain
93 :
94 :
95 : real(r8), allocatable :: pgam_out(:,:) ! Liquid Size distribution parameter Mu for output
96 : real(r8), allocatable :: lamc_out(:,:) ! Liquid Size distribution parameter Lambda for output
97 : real(r8), allocatable :: lamr_out(:,:) ! Rain Size distribution parameter Lambda for output
98 : real(r8), allocatable :: n0r_out(:,:) ! Size distribution parameter n0 for output
99 : real(r8), allocatable :: scale_qc(:,:) !TAU scaling factor for liquid mass to ensure conservation
100 : real(r8), allocatable :: scale_nc(:,:) !TAU scaling factor for liquid number to ensure conservation
101 : real(r8), allocatable :: scale_qr(:,:) !TAU scaling factor for rain mass to ensure conservation
102 : real(r8), allocatable :: scale_nr(:,:) !TAU scaling factor for rain_number to ensure conservation
103 : real(r8), allocatable :: amk_c(:,:,:) !TAU cloud liquid mass from bins
104 : real(r8), allocatable :: ank_c(:,:,:) !TAU cloud liquid number from bins
105 : real(r8), allocatable :: amk_r(:,:,:) !TAU cloud rain mass from bins
106 : real(r8), allocatable :: ank_r(:,:,:) !TAU cloud rain number from bins
107 : real(r8), allocatable :: amk(:,:,:) !TAU all liquid mass from bins
108 : real(r8), allocatable :: ank(:,:,:) !TAU all liquid number from bins
109 : real(r8), allocatable :: amk_out(:,:,:) !TAU all liquid number from bins output
110 : real(r8), allocatable :: ank_out(:,:,:) !TAU all liquid mass from bins output
111 : real(r8), allocatable :: qc_out_TAU(:,:) !TAU: output total cloud liquid mass
112 : real(r8), allocatable :: nc_out_TAU(:,:) !TAU: output total cloud liquid number
113 : real(r8), allocatable :: qr_out_TAU(:,:) !TAU: output total rain mass
114 : real(r8), allocatable :: nr_out_TAU(:,:) !TAU: output total cloud rain number
115 : real(r8), allocatable :: qc_in_TAU(:,:) !TAU: input total cloud liquid mass
116 : real(r8), allocatable :: nc_in_TAU(:,:) !TAU: input total cloud liquid number
117 : real(r8), allocatable :: qr_in_TAU(:,:) !TAU: input total rain mass
118 : real(r8), allocatable :: nr_in_TAU(:,:) !TAU: input total cloud rain number
119 : real(r8), allocatable :: qctend_KK2000(:,:) !cloud liquid mass tendency due to autoconversion & accretion from KK2000
120 : real(r8), allocatable :: nctend_KK2000(:,:) !cloud liquid number tendency due to autoconversion & accretion from KK2000
121 : real(r8), allocatable :: qrtend_KK2000(:,:) !rain mass tendency due to autoconversion & accretion from KK2000
122 : real(r8), allocatable :: nrtend_KK2000(:,:) !rain number tendency due to autoconversion & accretion from KK2000
123 : real(r8), allocatable :: qctend_SB2001(:,:) !cloud liquid mass tendency due to autoconversion & accretion from SB2001
124 : real(r8), allocatable :: nctend_SB2001(:,:) !cloud liquid number tendency due to autoconversion & accretion from SB2001
125 : real(r8), allocatable :: qrtend_SB2001(:,:) !rain mass tendency due to autoconversion & accretion from SB2001
126 : real(r8), allocatable :: nrtend_SB2001(:,:) !rain number tendency due to autoconversion & accretion from SB2001
127 : real(r8), allocatable :: qctend_TAU(:,:) !cloud liquid mass tendency due to autoconversion & accretion from TAU or Emulator code
128 : real(r8), allocatable :: nctend_TAU(:,:) !cloud liquid number tendency due to autoconversion & accretion from TAU or Emulator code
129 : real(r8), allocatable :: qrtend_TAU(:,:) !rain mass tendency due to autoconversion & accretion from TAU or Emulator code
130 : real(r8), allocatable :: nrtend_TAU(:,:) !rain number tendency due to autoconversion & accretion from TAU or Emulatorcode
131 : real(r8), allocatable :: gmnnn_lmnnn_TAU(:,:) ! TAU sum of mass gain and loss from bin code
132 : real(r8), allocatable :: ML_fixer(:,:) !Emulated: frequency of ML fixer is activated
133 : real(r8), allocatable :: QC_fixer(:,:) !Emulated: change in cloud liquid mass due to ML fixer
134 : real(r8), allocatable :: NC_fixer(:,:) !Emulated: change in cloud number number due to ML fixer
135 : real(r8), allocatable :: QR_fixer(:,:) !Emulated: change in rain mass due to ML fixer
136 : real(r8), allocatable :: NR_fixer(:,:) !Emulated: change in rain number due to ML fixer
137 :
138 : contains
139 : procedure :: allocate => proc_rates_allocate
140 : procedure :: deallocate => proc_rates_deallocate
141 : end type proc_rates_type
142 :
143 : contains
144 :
145 176472 : subroutine proc_rates_allocate(this, psetcols, nlev, ncd, warm_rain, errstring)
146 : !--------------------------------------------------------------
147 : ! Routine to allocate the elements of the proc_rates DDT
148 : !--------------------------------------------------------------
149 :
150 : use cam_abortutils, only: endrun
151 :
152 : implicit none
153 :
154 : class(proc_rates_type) :: this
155 :
156 : integer, intent(in) :: psetcols, nlev
157 : integer, intent(in) :: ncd
158 : character(len=16), intent(in) :: warm_rain ! 'tau','emulated','sb2001' or 'kk2000'
159 : character(128), intent(out) :: errstring
160 :
161 : integer :: ierr
162 :
163 176472 : errstring=' '
164 :
165 705888 : allocate(this%prodsnow(psetcols,nlev), stat=ierr)
166 176472 : if (ierr /= 0) then
167 0 : errstring='Error allocating this%prodsnow'
168 : end if
169 529416 : allocate(this%evapsnow(psetcols,nlev), stat=ierr)
170 176472 : if (ierr /= 0) then
171 0 : errstring='Error allocating this%evapsnow'
172 : end if
173 529416 : allocate(this%qcsevap(psetcols,nlev), stat=ierr)
174 176472 : if (ierr /= 0) then
175 0 : errstring='Error allocating this%qcsevap'
176 : end if
177 529416 : allocate(this%qisevap(psetcols,nlev), stat=ierr)
178 176472 : if (ierr /= 0) then
179 0 : errstring='Error allocating this%qisevap'
180 : end if
181 529416 : allocate(this%qvres(psetcols,nlev), stat=ierr)
182 176472 : if (ierr /= 0) then
183 0 : errstring='Error allocating this%qvres'
184 : end if
185 529416 : allocate(this%cmeitot(psetcols,nlev), stat=ierr)
186 176472 : if (ierr /= 0) then
187 0 : errstring='Error allocating this%cmeitot'
188 : end if
189 529416 : allocate(this%vtrmc(psetcols,nlev), stat=ierr)
190 176472 : if (ierr /= 0) then
191 0 : errstring='Error allocating this%vtrmc'
192 : end if
193 529416 : allocate(this%vtrmi(psetcols,nlev), stat=ierr)
194 176472 : if (ierr /= 0) then
195 0 : errstring='Error allocating this%vtrmi'
196 : end if
197 529416 : allocate(this%umr(psetcols,nlev), stat=ierr)
198 176472 : if (ierr /= 0) then
199 0 : errstring='Error allocating this%umr'
200 : end if
201 529416 : allocate(this%ums(psetcols,nlev), stat=ierr)
202 176472 : if (ierr /= 0) then
203 0 : errstring='Error allocating this%ums'
204 : end if
205 529416 : allocate(this%umg(psetcols,nlev), stat=ierr)
206 176472 : if (ierr /= 0) then
207 0 : errstring='Error allocating this%umg'
208 : end if
209 529416 : allocate(this%qgsedten(psetcols,nlev), stat=ierr)
210 176472 : if (ierr /= 0) then
211 0 : errstring='Error allocating this%qgsedten'
212 : end if
213 529416 : allocate(this%qcsedten(psetcols,nlev), stat=ierr)
214 176472 : if (ierr /= 0) then
215 0 : errstring='Error allocating this%qcsedten'
216 : end if
217 529416 : allocate(this%qisedten(psetcols,nlev), stat=ierr)
218 176472 : if (ierr /= 0) then
219 0 : errstring='Error allocating this%qisedten'
220 : end if
221 529416 : allocate(this%qrsedten(psetcols,nlev), stat=ierr)
222 176472 : if (ierr /= 0) then
223 0 : errstring='Error allocating this%qrsedten'
224 : end if
225 529416 : allocate(this%qssedten(psetcols,nlev), stat=ierr)
226 176472 : if (ierr /= 0) then
227 0 : errstring='Error allocating this%qssedten'
228 : end if
229 529416 : allocate(this%pratot(psetcols,nlev), stat=ierr)
230 176472 : if (ierr /= 0) then
231 0 : errstring='Error allocating this%pratot'
232 : end if
233 529416 : allocate(this%prctot(psetcols,nlev), stat=ierr)
234 176472 : if (ierr /= 0) then
235 0 : errstring='Error allocating this%prctot'
236 : end if
237 529416 : allocate(this%mnuccctot(psetcols,nlev), stat=ierr)
238 176472 : if (ierr /= 0) then
239 0 : errstring='Error allocating this%mnuccctot'
240 : end if
241 529416 : allocate(this%mnuccttot(psetcols,nlev), stat=ierr)
242 176472 : if (ierr /= 0) then
243 0 : errstring='Error allocating this%mnuccttot'
244 : end if
245 529416 : allocate(this%msacwitot(psetcols,nlev), stat=ierr)
246 176472 : if (ierr /= 0) then
247 0 : errstring='Error allocating this%msacwitot'
248 : end if
249 529416 : allocate(this%psacwstot(psetcols,nlev), stat=ierr)
250 176472 : if (ierr /= 0) then
251 0 : errstring='Error allocating this%psacwstot'
252 : end if
253 529416 : allocate(this%bergstot(psetcols,nlev), stat=ierr)
254 176472 : if (ierr /= 0) then
255 0 : errstring='Error allocating this%bergstot'
256 : end if
257 529416 : allocate(this%vapdepstot(psetcols,nlev), stat=ierr)
258 176472 : if (ierr /= 0) then
259 0 : errstring='Error allocating this%vapdepstot'
260 : end if
261 529416 : allocate(this%bergtot(psetcols,nlev), stat=ierr)
262 176472 : if (ierr /= 0) then
263 0 : errstring='Error allocating this%bergtot'
264 : end if
265 529416 : allocate(this%melttot(psetcols,nlev), stat=ierr)
266 176472 : if (ierr /= 0) then
267 0 : errstring='Error allocating this%melttot'
268 : end if
269 529416 : allocate(this%meltstot(psetcols,nlev), stat=ierr)
270 176472 : if (ierr /= 0) then
271 0 : errstring='Error allocating this%meltstot'
272 : end if
273 529416 : allocate(this%meltgtot(psetcols,nlev), stat=ierr)
274 176472 : if (ierr /= 0) then
275 0 : errstring='Error allocating this%meltgtot'
276 : end if
277 529416 : allocate(this%homotot(psetcols,nlev), stat=ierr)
278 176472 : if (ierr /= 0) then
279 0 : errstring='Error allocating this%homotot'
280 : end if
281 529416 : allocate(this%qcrestot(psetcols,nlev), stat=ierr)
282 176472 : if (ierr /= 0) then
283 0 : errstring='Error allocating this%qcrestot'
284 : end if
285 529416 : allocate(this%prcitot(psetcols,nlev), stat=ierr)
286 176472 : if (ierr /= 0) then
287 0 : errstring='Error allocating this%prcitot'
288 : end if
289 529416 : allocate(this%praitot(psetcols,nlev), stat=ierr)
290 176472 : if (ierr /= 0) then
291 0 : errstring='Error allocating this%praitot'
292 : end if
293 529416 : allocate(this%qirestot(psetcols,nlev), stat=ierr)
294 176472 : if (ierr /= 0) then
295 0 : errstring='Error allocating this%qirestot'
296 : end if
297 529416 : allocate(this%mnuccrtot(psetcols,nlev), stat=ierr)
298 176472 : if (ierr /= 0) then
299 0 : errstring='Error allocating this%mnuccrtot'
300 : end if
301 529416 : allocate(this%mnudeptot(psetcols,nlev), stat=ierr)
302 176472 : if (ierr /= 0) then
303 0 : errstring='Error allocating this%mnudeptot'
304 : end if
305 529416 : allocate(this%mnuccritot(psetcols,nlev), stat=ierr)
306 176472 : if (ierr /= 0) then
307 0 : errstring='Error allocating this%mnuccritot'
308 : end if
309 529416 : allocate(this%pracstot(psetcols,nlev), stat=ierr)
310 176472 : if (ierr /= 0) then
311 0 : errstring='Error allocating this%pracstot'
312 : end if
313 529416 : allocate(this%meltsdttot(psetcols,nlev), stat=ierr)
314 176472 : if (ierr /= 0) then
315 0 : errstring='Error allocating this%meltsdttot'
316 : end if
317 529416 : allocate(this%frzrdttot(psetcols,nlev), stat=ierr)
318 176472 : if (ierr /= 0) then
319 0 : errstring='Error allocating this%frzrdttot'
320 : end if
321 529416 : allocate(this%mnuccdtot(psetcols,nlev), stat=ierr)
322 176472 : if (ierr /= 0) then
323 0 : errstring='Error allocating this%mnuccdtot'
324 : end if
325 529416 : allocate(this%pracgtot(psetcols,nlev), stat=ierr)
326 176472 : if (ierr /= 0) then
327 0 : errstring='Error allocating this%pracgtot'
328 : end if
329 529416 : allocate(this%psacwgtot(psetcols,nlev), stat=ierr)
330 176472 : if (ierr /= 0) then
331 0 : errstring='Error allocating this%psacwgtot'
332 : end if
333 529416 : allocate(this%pgsacwtot(psetcols,nlev), stat=ierr)
334 176472 : if (ierr /= 0) then
335 0 : errstring='Error allocating this%pgsacwtot'
336 : end if
337 529416 : allocate(this%pgracstot(psetcols,nlev), stat=ierr)
338 176472 : if (ierr /= 0) then
339 0 : errstring='Error allocating this%pgracstot'
340 : end if
341 529416 : allocate(this%prdgtot(psetcols,nlev), stat=ierr)
342 176472 : if (ierr /= 0) then
343 0 : errstring='Error allocating this%prdgtot'
344 : end if
345 529416 : allocate(this%qmultgtot(psetcols,nlev), stat=ierr)
346 176472 : if (ierr /= 0) then
347 0 : errstring='Error allocating this%qmultgtot'
348 : end if
349 529416 : allocate(this%qmultrgtot(psetcols,nlev), stat=ierr)
350 176472 : if (ierr /= 0) then
351 0 : errstring='Error allocating this%qmultrgtot'
352 : end if
353 529416 : allocate(this%psacrtot(psetcols,nlev), stat=ierr)
354 176472 : if (ierr /= 0) then
355 0 : errstring='Error allocating this%psacrtot'
356 : end if
357 529416 : allocate(this%npracgtot(psetcols,nlev), stat=ierr)
358 176472 : if (ierr /= 0) then
359 0 : errstring='Error allocating this%npracgtot'
360 : end if
361 529416 : allocate(this%nscngtot(psetcols,nlev), stat=ierr)
362 176472 : if (ierr /= 0) then
363 0 : errstring='Error allocating this%nscngtot'
364 : end if
365 529416 : allocate(this%ngracstot(psetcols,nlev), stat=ierr)
366 176472 : if (ierr /= 0) then
367 0 : errstring='Error allocating this%ngracstot'
368 : end if
369 529416 : allocate(this%nmultgtot(psetcols,nlev), stat=ierr)
370 176472 : if (ierr /= 0) then
371 0 : errstring='Error allocating this%nmultgtot'
372 : end if
373 529416 : allocate(this%nmultrgtot(psetcols,nlev), stat=ierr)
374 176472 : if (ierr /= 0) then
375 0 : errstring='Error allocating this%nmultrgtot'
376 : end if
377 529416 : allocate(this%npsacwgtot(psetcols,nlev), stat=ierr)
378 176472 : if (ierr /= 0) then
379 0 : errstring='Error allocating this%npsacwgtot'
380 : end if
381 529416 : allocate(this%nnuccctot(psetcols,nlev), stat=ierr)
382 176472 : if (ierr /= 0) then
383 0 : errstring='Error allocating this%nnuccctot'
384 : end if
385 529416 : allocate(this%nnuccttot(psetcols,nlev), stat=ierr)
386 176472 : if (ierr /= 0) then
387 0 : errstring='Error allocating this%nnuccttot'
388 : end if
389 529416 : allocate(this%nnuccdtot(psetcols,nlev), stat=ierr)
390 176472 : if (ierr /= 0) then
391 0 : errstring='Error allocating this%nnuccdtot'
392 : end if
393 529416 : allocate(this%nnudeptot(psetcols,nlev), stat=ierr)
394 176472 : if (ierr /= 0) then
395 0 : errstring='Error allocating this%nnudeptot'
396 : end if
397 529416 : allocate(this%nhomotot(psetcols,nlev), stat=ierr)
398 176472 : if (ierr /= 0) then
399 0 : errstring='Error allocating this%nhomotot'
400 : end if
401 705888 : allocate(this%nnuccrtot(psetcols,nlev), stat=ierr)
402 176472 : if (ierr /= 0) then
403 0 : errstring='Error allocating this%nnuccrtot'
404 : end if
405 529416 : allocate(this%nnuccritot(psetcols,nlev), stat=ierr)
406 176472 : if (ierr /= 0) then
407 0 : errstring='Error allocating this%nnuccritot'
408 : end if
409 529416 : allocate(this%nsacwitot(psetcols,nlev), stat=ierr)
410 176472 : if (ierr /= 0) then
411 0 : errstring='Error allocating this%nsacwitot'
412 : end if
413 529416 : allocate(this%npratot(psetcols,nlev), stat=ierr)
414 176472 : if (ierr /= 0) then
415 0 : errstring='Error allocating this%npratot'
416 : end if
417 529416 : allocate(this%npsacwstot(psetcols,nlev), stat=ierr)
418 176472 : if (ierr /= 0) then
419 0 : errstring='Error allocating this%npsacwstot'
420 : end if
421 529416 : allocate(this%npraitot(psetcols,nlev), stat=ierr)
422 176472 : if (ierr /= 0) then
423 0 : errstring='Error allocating this%npraitot'
424 : end if
425 529416 : allocate(this%npracstot(psetcols,nlev), stat=ierr)
426 176472 : if (ierr /= 0) then
427 0 : errstring='Error allocating this%npracstot'
428 : end if
429 529416 : allocate(this%nprctot(psetcols,nlev), stat=ierr)
430 176472 : if (ierr /= 0) then
431 0 : errstring='Error allocating this%nprctot'
432 : end if
433 529416 : allocate(this%nraggtot(psetcols,nlev), stat=ierr)
434 176472 : if (ierr /= 0) then
435 0 : errstring='Error allocating this%nraggtot'
436 : end if
437 529416 : allocate(this%nprcitot(psetcols,nlev), stat=ierr)
438 176472 : if (ierr /= 0) then
439 0 : errstring='Error allocating this%nprcitot'
440 : end if
441 529416 : allocate(this%ncsedten(psetcols,nlev), stat=ierr)
442 176472 : if (ierr /= 0) then
443 0 : errstring='Error allocating this%ncsedten'
444 : end if
445 529416 : allocate(this%nisedten(psetcols,nlev), stat=ierr)
446 176472 : if (ierr /= 0) then
447 0 : errstring='Error allocating this%nisedten'
448 : end if
449 529416 : allocate(this%nrsedten(psetcols,nlev), stat=ierr)
450 176472 : if (ierr /= 0) then
451 0 : errstring='Error allocating this%nrsedten'
452 : end if
453 529416 : allocate(this%nssedten(psetcols,nlev), stat=ierr)
454 176472 : if (ierr /= 0) then
455 0 : errstring='Error allocating this%nssedten'
456 : end if
457 529416 : allocate(this%ngsedten(psetcols,nlev), stat=ierr)
458 176472 : if (ierr /= 0) then
459 0 : errstring='Error allocating this%ngsedten'
460 : end if
461 529416 : allocate(this%nmelttot(psetcols,nlev), stat=ierr)
462 176472 : if (ierr /= 0) then
463 0 : errstring='Error allocating this%nmelttot'
464 : end if
465 529416 : allocate(this%nmeltstot(psetcols,nlev), stat=ierr)
466 176472 : if (ierr /= 0) then
467 0 : errstring='Error allocating this%nmeltstot'
468 : end if
469 529416 : allocate(this%nmeltgtot(psetcols,nlev), stat=ierr)
470 176472 : if (ierr /= 0) then
471 0 : errstring='Error allocating this%nmeltgtot'
472 : end if
473 529416 : allocate(this%lamc_out(psetcols,nlev), stat=ierr)
474 176472 : if (ierr /= 0) then
475 0 : errstring='Error allocating this%lamc_out'
476 : end if
477 529416 : allocate(this%lamr_out(psetcols,nlev), stat=ierr)
478 176472 : if (ierr /= 0) then
479 0 : errstring='Error allocating this%lamr_out'
480 : end if
481 529416 : allocate(this%pgam_out(psetcols,nlev), stat=ierr)
482 176472 : if (ierr /= 0) then
483 0 : errstring='Error allocating this%pgam_out'
484 : end if
485 529416 : allocate(this%n0r_out(psetcols,nlev), stat=ierr)
486 176472 : if (ierr /= 0) then
487 0 : errstring='Error allocating this%n0r_out'
488 : end if
489 :
490 : ! Only allocate these variables if machine learning turned on
491 :
492 176472 : if (trim(warm_rain) == 'tau' .or. trim(warm_rain) == 'emulated') then
493 0 : allocate(this%scale_qc(psetcols,nlev), stat=ierr)
494 0 : if (ierr /= 0) then
495 0 : errstring='Error allocating this%scale_qc'
496 : end if
497 0 : allocate(this%scale_nc(psetcols,nlev), stat=ierr)
498 0 : if (ierr /= 0) then
499 0 : errstring='Error allocating this%scale_nc'
500 : end if
501 0 : allocate(this%scale_qr(psetcols,nlev), stat=ierr)
502 0 : if (ierr /= 0) then
503 0 : errstring='Error allocating this%scale_qr'
504 : end if
505 0 : allocate(this%scale_nr(psetcols,nlev), stat=ierr)
506 0 : if (ierr /= 0) then
507 0 : errstring='Error allocating this%scale_nr'
508 : end if
509 0 : allocate(this%amk_c(psetcols,nlev,ncd), stat=ierr)
510 0 : if (ierr /= 0) then
511 0 : errstring='Error allocating this%amk_c'
512 : end if
513 0 : allocate(this%ank_c(psetcols,nlev,ncd), stat=ierr)
514 0 : if (ierr /= 0) then
515 0 : errstring='Error allocating this%ank_c'
516 : end if
517 0 : allocate(this%amk_r(psetcols,nlev,ncd), stat=ierr)
518 0 : if (ierr /= 0) then
519 0 : errstring='Error allocating this%amk_r'
520 : end if
521 0 : allocate(this%ank_r(psetcols,nlev,ncd), stat=ierr)
522 0 : if (ierr /= 0) then
523 0 : errstring='Error allocating this%ank_r'
524 : end if
525 0 : allocate(this%amk(psetcols,nlev,ncd), stat=ierr)
526 0 : if (ierr /= 0) then
527 0 : errstring='Error allocating this%amk'
528 : end if
529 0 : allocate(this%ank(psetcols,nlev,ncd), stat=ierr)
530 0 : if (ierr /= 0) then
531 0 : errstring='Error allocating this%ank'
532 : end if
533 0 : allocate(this%amk_out(psetcols,nlev,ncd), stat=ierr)
534 0 : if (ierr /= 0) then
535 0 : errstring='Error allocating this%amk_out'
536 : end if
537 0 : allocate(this%ank_out(psetcols,nlev,ncd), stat=ierr)
538 0 : if (ierr /= 0) then
539 0 : errstring='Error allocating this%ank_out'
540 : end if
541 0 : allocate(this%qc_out_TAU(psetcols,nlev), stat=ierr)
542 0 : if (ierr /= 0) then
543 0 : errstring='Error allocating this%qc_out_TAU'
544 : end if
545 0 : allocate(this%nc_out_TAU(psetcols,nlev), stat=ierr)
546 0 : if (ierr /= 0) then
547 0 : errstring='Error allocating this%nc_out_TAU'
548 : end if
549 0 : allocate(this%qr_out_TAU(psetcols,nlev), stat=ierr)
550 0 : if (ierr /= 0) then
551 0 : errstring='Error allocating this%qr_out_TAU'
552 : end if
553 0 : allocate(this%nr_out_TAU(psetcols,nlev), stat=ierr)
554 0 : if (ierr /= 0) then
555 0 : errstring='Error allocating this%nr_out_TAU'
556 : end if
557 0 : allocate(this%qc_in_TAU(psetcols,nlev), stat=ierr)
558 0 : if (ierr /= 0) then
559 0 : errstring='Error allocating this%qc_in_TAU'
560 : end if
561 0 : allocate(this%nc_in_TAU(psetcols,nlev), stat=ierr)
562 0 : if (ierr /= 0) then
563 0 : errstring='Error allocating this%nc_in_TAU'
564 : end if
565 0 : allocate(this%qr_in_TAU(psetcols,nlev), stat=ierr)
566 0 : if (ierr /= 0) then
567 0 : errstring='Error allocating this%qr_in_TAU'
568 : end if
569 0 : allocate(this%nr_in_TAU(psetcols,nlev), stat=ierr)
570 0 : if (ierr /= 0) then
571 0 : errstring='Error allocating this%nr_in_TAU'
572 : end if
573 0 : allocate(this%qctend_TAU(psetcols,nlev), stat=ierr)
574 0 : if (ierr /= 0) then
575 0 : errstring='Error allocating this%qctend_TAU'
576 : end if
577 0 : allocate(this%nctend_TAU(psetcols,nlev), stat=ierr)
578 0 : if (ierr /= 0) then
579 0 : errstring='Error allocating this%nctend_TAU'
580 : end if
581 0 : allocate(this%qrtend_TAU(psetcols,nlev), stat=ierr)
582 0 : if (ierr /= 0) then
583 0 : errstring='Error allocating this%qrtend_TAU'
584 : end if
585 0 : allocate(this%nrtend_TAU(psetcols,nlev), stat=ierr)
586 0 : if (ierr /= 0) then
587 0 : errstring='Error allocating this%nrtend_TAU'
588 : end if
589 0 : allocate(this%gmnnn_lmnnn_TAU(psetcols,nlev), stat=ierr)
590 0 : if (ierr /= 0) then
591 0 : errstring='Error allocating this%gmnnn_lmnnn_TAU'
592 : end if
593 0 : allocate(this%ML_fixer(psetcols,nlev), stat=ierr)
594 0 : if (ierr /= 0) then
595 0 : errstring='Error allocating this%ML_fixer'
596 : end if
597 0 : allocate(this%QC_fixer(psetcols,nlev), stat=ierr)
598 0 : if (ierr /= 0) then
599 0 : errstring='Error allocating this%QC_fixer'
600 : end if
601 0 : allocate(this%NC_fixer(psetcols,nlev), stat=ierr)
602 0 : if (ierr /= 0) then
603 0 : errstring='Error allocating this%NC_fixer'
604 : end if
605 0 : allocate(this%QR_fixer(psetcols,nlev), stat=ierr)
606 0 : if (ierr /= 0) then
607 0 : errstring='Error allocating this%QR_fixer'
608 : end if
609 0 : allocate(this%NR_fixer(psetcols,nlev), stat=ierr)
610 0 : if (ierr /= 0) then
611 0 : errstring='Error allocating this%NR_fixer'
612 : end if
613 176472 : else if (warm_rain == 'sb2001') then
614 : ! Classic default (non-ML) microphysics
615 0 : allocate(this%qctend_SB2001(psetcols,nlev), stat=ierr)
616 0 : if (ierr /= 0) then
617 0 : errstring='Error allocating this%qctend_SB2001'
618 : end if
619 0 : allocate(this%nctend_SB2001(psetcols,nlev), stat=ierr)
620 0 : if (ierr /= 0) then
621 0 : errstring='Error allocating this%nctend_SB2001'
622 : end if
623 0 : allocate(this%qrtend_SB2001(psetcols,nlev), stat=ierr)
624 0 : if (ierr /= 0) then
625 0 : errstring='Error allocating this%artend_SB2001'
626 : end if
627 0 : allocate(this%nrtend_SB2001(psetcols,nlev), stat=ierr)
628 0 : if (ierr /= 0) then
629 0 : errstring='Error allocating this%nrtend_SB2001'
630 : end if
631 : end if
632 :
633 : ! Variables which are needed by all code (Machine Learning and non-ML)
634 529416 : allocate(this%qctend_KK2000(psetcols,nlev), stat=ierr)
635 176472 : if (ierr /= 0) then
636 0 : errstring='Error allocating this%qctend_KK2000'
637 : end if
638 705888 : allocate(this%nctend_KK2000(psetcols,nlev), stat=ierr)
639 176472 : if (ierr /= 0) then
640 0 : errstring='Error allocating this%nctend_KK2000'
641 : end if
642 529416 : allocate(this%qrtend_KK2000(psetcols,nlev), stat=ierr)
643 176472 : if (ierr /= 0) then
644 0 : errstring='Error allocating this%artend_KK2000'
645 : end if
646 529416 : allocate(this%nrtend_KK2000(psetcols,nlev), stat=ierr)
647 176472 : if (ierr /= 0) then
648 0 : errstring='Error allocating this%nrtend_KK2000'
649 : end if
650 :
651 176472 : end subroutine proc_rates_allocate
652 :
653 176472 : subroutine proc_rates_deallocate(this, warm_rain)
654 : !--------------------------------------------------------------
655 : ! Routine to deallocate the elements of the proc_rates DDT
656 : !--------------------------------------------------------------
657 :
658 : class(proc_rates_type) :: this
659 : character(len=16), intent(in) :: warm_rain ! 'tau','emulated','sb2001' or 'kk2000'
660 :
661 176472 : deallocate(this%prodsnow)
662 176472 : deallocate(this%evapsnow)
663 176472 : deallocate(this%qcsevap)
664 176472 : deallocate(this%qisevap)
665 176472 : deallocate(this%qvres)
666 176472 : deallocate(this%cmeitot)
667 176472 : deallocate(this%vtrmc)
668 176472 : deallocate(this%vtrmi)
669 176472 : deallocate(this%umr)
670 176472 : deallocate(this%ums)
671 176472 : deallocate(this%umg)
672 176472 : deallocate(this%qgsedten)
673 176472 : deallocate(this%qcsedten)
674 176472 : deallocate(this%qisedten)
675 176472 : deallocate(this%qrsedten)
676 176472 : deallocate(this%qssedten)
677 176472 : deallocate(this%pratot)
678 176472 : deallocate(this%prctot)
679 176472 : deallocate(this%mnuccctot)
680 176472 : deallocate(this%mnuccttot)
681 176472 : deallocate(this%msacwitot)
682 176472 : deallocate(this%psacwstot)
683 176472 : deallocate(this%bergstot)
684 176472 : deallocate(this%vapdepstot)
685 176472 : deallocate(this%bergtot)
686 176472 : deallocate(this%melttot)
687 176472 : deallocate(this%meltstot)
688 176472 : deallocate(this%meltgtot)
689 176472 : deallocate(this%homotot)
690 176472 : deallocate(this%qcrestot)
691 176472 : deallocate(this%prcitot)
692 176472 : deallocate(this%praitot)
693 176472 : deallocate(this%qirestot)
694 176472 : deallocate(this%mnuccrtot)
695 176472 : deallocate(this%mnudeptot)
696 176472 : deallocate(this%mnuccritot)
697 176472 : deallocate(this%pracstot)
698 176472 : deallocate(this%meltsdttot)
699 176472 : deallocate(this%frzrdttot)
700 176472 : deallocate(this%mnuccdtot)
701 176472 : deallocate(this%pracgtot)
702 176472 : deallocate(this%psacwgtot)
703 176472 : deallocate(this%pgsacwtot)
704 176472 : deallocate(this%pgracstot)
705 176472 : deallocate(this%prdgtot)
706 176472 : deallocate(this%qmultgtot)
707 176472 : deallocate(this%qmultrgtot)
708 176472 : deallocate(this%psacrtot)
709 176472 : deallocate(this%npracgtot)
710 176472 : deallocate(this%nscngtot)
711 176472 : deallocate(this%ngracstot)
712 176472 : deallocate(this%nmultgtot)
713 176472 : deallocate(this%nmultrgtot)
714 176472 : deallocate(this%npsacwgtot)
715 176472 : deallocate(this%nnuccctot)
716 176472 : deallocate(this%nnuccttot)
717 176472 : deallocate(this%nnuccdtot)
718 176472 : deallocate(this%nnudeptot)
719 176472 : deallocate(this%nhomotot)
720 176472 : deallocate(this%nnuccrtot)
721 176472 : deallocate(this%nnuccritot)
722 176472 : deallocate(this%nsacwitot)
723 176472 : deallocate(this%npratot)
724 176472 : deallocate(this%npsacwstot)
725 176472 : deallocate(this%npraitot)
726 176472 : deallocate(this%npracstot)
727 176472 : deallocate(this%nprctot)
728 176472 : deallocate(this%nraggtot)
729 176472 : deallocate(this%nprcitot)
730 176472 : deallocate(this%ncsedten)
731 176472 : deallocate(this%nisedten)
732 176472 : deallocate(this%nrsedten)
733 176472 : deallocate(this%nssedten)
734 176472 : deallocate(this%ngsedten)
735 176472 : deallocate(this%nmelttot)
736 176472 : deallocate(this%nmeltstot)
737 176472 : deallocate(this%nmeltgtot)
738 :
739 176472 : deallocate(this%qctend_KK2000)
740 176472 : deallocate(this%nctend_KK2000)
741 176472 : deallocate(this%qrtend_KK2000)
742 176472 : deallocate(this%nrtend_KK2000)
743 :
744 176472 : deallocate(this%lamc_out)
745 176472 : deallocate(this%lamr_out)
746 176472 : deallocate(this%pgam_out)
747 176472 : deallocate(this%n0r_out)
748 :
749 176472 : if (trim(warm_rain) == 'tau' .or. trim(warm_rain) == 'emulated') then
750 0 : deallocate(this%scale_qc)
751 0 : deallocate(this%scale_nc)
752 0 : deallocate(this%scale_qr)
753 0 : deallocate(this%scale_nr)
754 0 : deallocate(this%amk_c)
755 0 : deallocate(this%ank_c)
756 0 : deallocate(this%amk_r)
757 0 : deallocate(this%ank_r)
758 0 : deallocate(this%amk)
759 0 : deallocate(this%ank)
760 0 : deallocate(this%amk_out)
761 0 : deallocate(this%ank_out)
762 0 : deallocate(this%qc_out_TAU)
763 0 : deallocate(this%nc_out_TAU)
764 0 : deallocate(this%qr_out_TAU)
765 0 : deallocate(this%nr_out_TAU)
766 0 : deallocate(this%qc_in_TAU)
767 0 : deallocate(this%nc_in_TAU)
768 0 : deallocate(this%qr_in_TAU)
769 0 : deallocate(this%nr_in_TAU)
770 0 : deallocate(this%qctend_TAU)
771 0 : deallocate(this%nctend_TAU)
772 0 : deallocate(this%qrtend_TAU)
773 0 : deallocate(this%nrtend_TAU)
774 0 : deallocate(this%gmnnn_lmnnn_TAU)
775 0 : deallocate(this%ML_fixer)
776 0 : deallocate(this%QC_fixer)
777 0 : deallocate(this%NC_fixer)
778 0 : deallocate(this%QR_fixer)
779 0 : deallocate(this%NR_fixer)
780 176472 : else if (trim(warm_rain) == 'sb2001') then
781 0 : deallocate(this%qctend_SB2001)
782 0 : deallocate(this%nctend_SB2001)
783 0 : deallocate(this%qrtend_SB2001)
784 0 : deallocate(this%nrtend_SB2001)
785 : end if
786 :
787 176472 : end subroutine proc_rates_deallocate
788 :
789 0 : end module micro_pumas_diags
|
