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 4467528 : 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 4467528 : errstring=' '
164 :
165 17870112 : allocate(this%prodsnow(psetcols,nlev), stat=ierr)
166 4467528 : if (ierr /= 0) then
167 0 : errstring='Error allocating this%prodsnow'
168 : end if
169 13402584 : allocate(this%evapsnow(psetcols,nlev), stat=ierr)
170 4467528 : if (ierr /= 0) then
171 0 : errstring='Error allocating this%evapsnow'
172 : end if
173 13402584 : allocate(this%qcsevap(psetcols,nlev), stat=ierr)
174 4467528 : if (ierr /= 0) then
175 0 : errstring='Error allocating this%qcsevap'
176 : end if
177 13402584 : allocate(this%qisevap(psetcols,nlev), stat=ierr)
178 4467528 : if (ierr /= 0) then
179 0 : errstring='Error allocating this%qisevap'
180 : end if
181 13402584 : allocate(this%qvres(psetcols,nlev), stat=ierr)
182 4467528 : if (ierr /= 0) then
183 0 : errstring='Error allocating this%qvres'
184 : end if
185 13402584 : allocate(this%cmeitot(psetcols,nlev), stat=ierr)
186 4467528 : if (ierr /= 0) then
187 0 : errstring='Error allocating this%cmeitot'
188 : end if
189 13402584 : allocate(this%vtrmc(psetcols,nlev), stat=ierr)
190 4467528 : if (ierr /= 0) then
191 0 : errstring='Error allocating this%vtrmc'
192 : end if
193 13402584 : allocate(this%vtrmi(psetcols,nlev), stat=ierr)
194 4467528 : if (ierr /= 0) then
195 0 : errstring='Error allocating this%vtrmi'
196 : end if
197 13402584 : allocate(this%umr(psetcols,nlev), stat=ierr)
198 4467528 : if (ierr /= 0) then
199 0 : errstring='Error allocating this%umr'
200 : end if
201 13402584 : allocate(this%ums(psetcols,nlev), stat=ierr)
202 4467528 : if (ierr /= 0) then
203 0 : errstring='Error allocating this%ums'
204 : end if
205 13402584 : allocate(this%umg(psetcols,nlev), stat=ierr)
206 4467528 : if (ierr /= 0) then
207 0 : errstring='Error allocating this%umg'
208 : end if
209 13402584 : allocate(this%qgsedten(psetcols,nlev), stat=ierr)
210 4467528 : if (ierr /= 0) then
211 0 : errstring='Error allocating this%qgsedten'
212 : end if
213 13402584 : allocate(this%qcsedten(psetcols,nlev), stat=ierr)
214 4467528 : if (ierr /= 0) then
215 0 : errstring='Error allocating this%qcsedten'
216 : end if
217 13402584 : allocate(this%qisedten(psetcols,nlev), stat=ierr)
218 4467528 : if (ierr /= 0) then
219 0 : errstring='Error allocating this%qisedten'
220 : end if
221 13402584 : allocate(this%qrsedten(psetcols,nlev), stat=ierr)
222 4467528 : if (ierr /= 0) then
223 0 : errstring='Error allocating this%qrsedten'
224 : end if
225 13402584 : allocate(this%qssedten(psetcols,nlev), stat=ierr)
226 4467528 : if (ierr /= 0) then
227 0 : errstring='Error allocating this%qssedten'
228 : end if
229 13402584 : allocate(this%pratot(psetcols,nlev), stat=ierr)
230 4467528 : if (ierr /= 0) then
231 0 : errstring='Error allocating this%pratot'
232 : end if
233 13402584 : allocate(this%prctot(psetcols,nlev), stat=ierr)
234 4467528 : if (ierr /= 0) then
235 0 : errstring='Error allocating this%prctot'
236 : end if
237 13402584 : allocate(this%mnuccctot(psetcols,nlev), stat=ierr)
238 4467528 : if (ierr /= 0) then
239 0 : errstring='Error allocating this%mnuccctot'
240 : end if
241 13402584 : allocate(this%mnuccttot(psetcols,nlev), stat=ierr)
242 4467528 : if (ierr /= 0) then
243 0 : errstring='Error allocating this%mnuccttot'
244 : end if
245 13402584 : allocate(this%msacwitot(psetcols,nlev), stat=ierr)
246 4467528 : if (ierr /= 0) then
247 0 : errstring='Error allocating this%msacwitot'
248 : end if
249 13402584 : allocate(this%psacwstot(psetcols,nlev), stat=ierr)
250 4467528 : if (ierr /= 0) then
251 0 : errstring='Error allocating this%psacwstot'
252 : end if
253 13402584 : allocate(this%bergstot(psetcols,nlev), stat=ierr)
254 4467528 : if (ierr /= 0) then
255 0 : errstring='Error allocating this%bergstot'
256 : end if
257 13402584 : allocate(this%vapdepstot(psetcols,nlev), stat=ierr)
258 4467528 : if (ierr /= 0) then
259 0 : errstring='Error allocating this%vapdepstot'
260 : end if
261 13402584 : allocate(this%bergtot(psetcols,nlev), stat=ierr)
262 4467528 : if (ierr /= 0) then
263 0 : errstring='Error allocating this%bergtot'
264 : end if
265 13402584 : allocate(this%melttot(psetcols,nlev), stat=ierr)
266 4467528 : if (ierr /= 0) then
267 0 : errstring='Error allocating this%melttot'
268 : end if
269 13402584 : allocate(this%meltstot(psetcols,nlev), stat=ierr)
270 4467528 : if (ierr /= 0) then
271 0 : errstring='Error allocating this%meltstot'
272 : end if
273 13402584 : allocate(this%meltgtot(psetcols,nlev), stat=ierr)
274 4467528 : if (ierr /= 0) then
275 0 : errstring='Error allocating this%meltgtot'
276 : end if
277 13402584 : allocate(this%homotot(psetcols,nlev), stat=ierr)
278 4467528 : if (ierr /= 0) then
279 0 : errstring='Error allocating this%homotot'
280 : end if
281 13402584 : allocate(this%qcrestot(psetcols,nlev), stat=ierr)
282 4467528 : if (ierr /= 0) then
283 0 : errstring='Error allocating this%qcrestot'
284 : end if
285 13402584 : allocate(this%prcitot(psetcols,nlev), stat=ierr)
286 4467528 : if (ierr /= 0) then
287 0 : errstring='Error allocating this%prcitot'
288 : end if
289 13402584 : allocate(this%praitot(psetcols,nlev), stat=ierr)
290 4467528 : if (ierr /= 0) then
291 0 : errstring='Error allocating this%praitot'
292 : end if
293 13402584 : allocate(this%qirestot(psetcols,nlev), stat=ierr)
294 4467528 : if (ierr /= 0) then
295 0 : errstring='Error allocating this%qirestot'
296 : end if
297 13402584 : allocate(this%mnuccrtot(psetcols,nlev), stat=ierr)
298 4467528 : if (ierr /= 0) then
299 0 : errstring='Error allocating this%mnuccrtot'
300 : end if
301 13402584 : allocate(this%mnudeptot(psetcols,nlev), stat=ierr)
302 4467528 : if (ierr /= 0) then
303 0 : errstring='Error allocating this%mnudeptot'
304 : end if
305 13402584 : allocate(this%mnuccritot(psetcols,nlev), stat=ierr)
306 4467528 : if (ierr /= 0) then
307 0 : errstring='Error allocating this%mnuccritot'
308 : end if
309 13402584 : allocate(this%pracstot(psetcols,nlev), stat=ierr)
310 4467528 : if (ierr /= 0) then
311 0 : errstring='Error allocating this%pracstot'
312 : end if
313 13402584 : allocate(this%meltsdttot(psetcols,nlev), stat=ierr)
314 4467528 : if (ierr /= 0) then
315 0 : errstring='Error allocating this%meltsdttot'
316 : end if
317 13402584 : allocate(this%frzrdttot(psetcols,nlev), stat=ierr)
318 4467528 : if (ierr /= 0) then
319 0 : errstring='Error allocating this%frzrdttot'
320 : end if
321 13402584 : allocate(this%mnuccdtot(psetcols,nlev), stat=ierr)
322 4467528 : if (ierr /= 0) then
323 0 : errstring='Error allocating this%mnuccdtot'
324 : end if
325 13402584 : allocate(this%pracgtot(psetcols,nlev), stat=ierr)
326 4467528 : if (ierr /= 0) then
327 0 : errstring='Error allocating this%pracgtot'
328 : end if
329 13402584 : allocate(this%psacwgtot(psetcols,nlev), stat=ierr)
330 4467528 : if (ierr /= 0) then
331 0 : errstring='Error allocating this%psacwgtot'
332 : end if
333 13402584 : allocate(this%pgsacwtot(psetcols,nlev), stat=ierr)
334 4467528 : if (ierr /= 0) then
335 0 : errstring='Error allocating this%pgsacwtot'
336 : end if
337 13402584 : allocate(this%pgracstot(psetcols,nlev), stat=ierr)
338 4467528 : if (ierr /= 0) then
339 0 : errstring='Error allocating this%pgracstot'
340 : end if
341 13402584 : allocate(this%prdgtot(psetcols,nlev), stat=ierr)
342 4467528 : if (ierr /= 0) then
343 0 : errstring='Error allocating this%prdgtot'
344 : end if
345 13402584 : allocate(this%qmultgtot(psetcols,nlev), stat=ierr)
346 4467528 : if (ierr /= 0) then
347 0 : errstring='Error allocating this%qmultgtot'
348 : end if
349 13402584 : allocate(this%qmultrgtot(psetcols,nlev), stat=ierr)
350 4467528 : if (ierr /= 0) then
351 0 : errstring='Error allocating this%qmultrgtot'
352 : end if
353 13402584 : allocate(this%psacrtot(psetcols,nlev), stat=ierr)
354 4467528 : if (ierr /= 0) then
355 0 : errstring='Error allocating this%psacrtot'
356 : end if
357 13402584 : allocate(this%npracgtot(psetcols,nlev), stat=ierr)
358 4467528 : if (ierr /= 0) then
359 0 : errstring='Error allocating this%npracgtot'
360 : end if
361 13402584 : allocate(this%nscngtot(psetcols,nlev), stat=ierr)
362 4467528 : if (ierr /= 0) then
363 0 : errstring='Error allocating this%nscngtot'
364 : end if
365 13402584 : allocate(this%ngracstot(psetcols,nlev), stat=ierr)
366 4467528 : if (ierr /= 0) then
367 0 : errstring='Error allocating this%ngracstot'
368 : end if
369 13402584 : allocate(this%nmultgtot(psetcols,nlev), stat=ierr)
370 4467528 : if (ierr /= 0) then
371 0 : errstring='Error allocating this%nmultgtot'
372 : end if
373 13402584 : allocate(this%nmultrgtot(psetcols,nlev), stat=ierr)
374 4467528 : if (ierr /= 0) then
375 0 : errstring='Error allocating this%nmultrgtot'
376 : end if
377 13402584 : allocate(this%npsacwgtot(psetcols,nlev), stat=ierr)
378 4467528 : if (ierr /= 0) then
379 0 : errstring='Error allocating this%npsacwgtot'
380 : end if
381 13402584 : allocate(this%nnuccctot(psetcols,nlev), stat=ierr)
382 4467528 : if (ierr /= 0) then
383 0 : errstring='Error allocating this%nnuccctot'
384 : end if
385 13402584 : allocate(this%nnuccttot(psetcols,nlev), stat=ierr)
386 4467528 : if (ierr /= 0) then
387 0 : errstring='Error allocating this%nnuccttot'
388 : end if
389 13402584 : allocate(this%nnuccdtot(psetcols,nlev), stat=ierr)
390 4467528 : if (ierr /= 0) then
391 0 : errstring='Error allocating this%nnuccdtot'
392 : end if
393 13402584 : allocate(this%nnudeptot(psetcols,nlev), stat=ierr)
394 4467528 : if (ierr /= 0) then
395 0 : errstring='Error allocating this%nnudeptot'
396 : end if
397 13402584 : allocate(this%nhomotot(psetcols,nlev), stat=ierr)
398 4467528 : if (ierr /= 0) then
399 0 : errstring='Error allocating this%nhomotot'
400 : end if
401 17870112 : allocate(this%nnuccrtot(psetcols,nlev), stat=ierr)
402 4467528 : if (ierr /= 0) then
403 0 : errstring='Error allocating this%nnuccrtot'
404 : end if
405 13402584 : allocate(this%nnuccritot(psetcols,nlev), stat=ierr)
406 4467528 : if (ierr /= 0) then
407 0 : errstring='Error allocating this%nnuccritot'
408 : end if
409 13402584 : allocate(this%nsacwitot(psetcols,nlev), stat=ierr)
410 4467528 : if (ierr /= 0) then
411 0 : errstring='Error allocating this%nsacwitot'
412 : end if
413 13402584 : allocate(this%npratot(psetcols,nlev), stat=ierr)
414 4467528 : if (ierr /= 0) then
415 0 : errstring='Error allocating this%npratot'
416 : end if
417 13402584 : allocate(this%npsacwstot(psetcols,nlev), stat=ierr)
418 4467528 : if (ierr /= 0) then
419 0 : errstring='Error allocating this%npsacwstot'
420 : end if
421 13402584 : allocate(this%npraitot(psetcols,nlev), stat=ierr)
422 4467528 : if (ierr /= 0) then
423 0 : errstring='Error allocating this%npraitot'
424 : end if
425 13402584 : allocate(this%npracstot(psetcols,nlev), stat=ierr)
426 4467528 : if (ierr /= 0) then
427 0 : errstring='Error allocating this%npracstot'
428 : end if
429 13402584 : allocate(this%nprctot(psetcols,nlev), stat=ierr)
430 4467528 : if (ierr /= 0) then
431 0 : errstring='Error allocating this%nprctot'
432 : end if
433 13402584 : allocate(this%nraggtot(psetcols,nlev), stat=ierr)
434 4467528 : if (ierr /= 0) then
435 0 : errstring='Error allocating this%nraggtot'
436 : end if
437 13402584 : allocate(this%nprcitot(psetcols,nlev), stat=ierr)
438 4467528 : if (ierr /= 0) then
439 0 : errstring='Error allocating this%nprcitot'
440 : end if
441 13402584 : allocate(this%ncsedten(psetcols,nlev), stat=ierr)
442 4467528 : if (ierr /= 0) then
443 0 : errstring='Error allocating this%ncsedten'
444 : end if
445 13402584 : allocate(this%nisedten(psetcols,nlev), stat=ierr)
446 4467528 : if (ierr /= 0) then
447 0 : errstring='Error allocating this%nisedten'
448 : end if
449 13402584 : allocate(this%nrsedten(psetcols,nlev), stat=ierr)
450 4467528 : if (ierr /= 0) then
451 0 : errstring='Error allocating this%nrsedten'
452 : end if
453 13402584 : allocate(this%nssedten(psetcols,nlev), stat=ierr)
454 4467528 : if (ierr /= 0) then
455 0 : errstring='Error allocating this%nssedten'
456 : end if
457 13402584 : allocate(this%ngsedten(psetcols,nlev), stat=ierr)
458 4467528 : if (ierr /= 0) then
459 0 : errstring='Error allocating this%ngsedten'
460 : end if
461 13402584 : allocate(this%nmelttot(psetcols,nlev), stat=ierr)
462 4467528 : if (ierr /= 0) then
463 0 : errstring='Error allocating this%nmelttot'
464 : end if
465 13402584 : allocate(this%nmeltstot(psetcols,nlev), stat=ierr)
466 4467528 : if (ierr /= 0) then
467 0 : errstring='Error allocating this%nmeltstot'
468 : end if
469 13402584 : allocate(this%nmeltgtot(psetcols,nlev), stat=ierr)
470 4467528 : if (ierr /= 0) then
471 0 : errstring='Error allocating this%nmeltgtot'
472 : end if
473 13402584 : allocate(this%lamc_out(psetcols,nlev), stat=ierr)
474 4467528 : if (ierr /= 0) then
475 0 : errstring='Error allocating this%lamc_out'
476 : end if
477 13402584 : allocate(this%lamr_out(psetcols,nlev), stat=ierr)
478 4467528 : if (ierr /= 0) then
479 0 : errstring='Error allocating this%lamr_out'
480 : end if
481 13402584 : allocate(this%pgam_out(psetcols,nlev), stat=ierr)
482 4467528 : if (ierr /= 0) then
483 0 : errstring='Error allocating this%pgam_out'
484 : end if
485 13402584 : allocate(this%n0r_out(psetcols,nlev), stat=ierr)
486 4467528 : 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 4467528 : 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 4467528 : 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 13402584 : allocate(this%qctend_KK2000(psetcols,nlev), stat=ierr)
635 4467528 : if (ierr /= 0) then
636 0 : errstring='Error allocating this%qctend_KK2000'
637 : end if
638 17870112 : allocate(this%nctend_KK2000(psetcols,nlev), stat=ierr)
639 4467528 : if (ierr /= 0) then
640 0 : errstring='Error allocating this%nctend_KK2000'
641 : end if
642 13402584 : allocate(this%qrtend_KK2000(psetcols,nlev), stat=ierr)
643 4467528 : if (ierr /= 0) then
644 0 : errstring='Error allocating this%artend_KK2000'
645 : end if
646 13402584 : allocate(this%nrtend_KK2000(psetcols,nlev), stat=ierr)
647 4467528 : if (ierr /= 0) then
648 0 : errstring='Error allocating this%nrtend_KK2000'
649 : end if
650 :
651 4467528 : end subroutine proc_rates_allocate
652 :
653 4467528 : 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 4467528 : deallocate(this%prodsnow)
662 4467528 : deallocate(this%evapsnow)
663 4467528 : deallocate(this%qcsevap)
664 4467528 : deallocate(this%qisevap)
665 4467528 : deallocate(this%qvres)
666 4467528 : deallocate(this%cmeitot)
667 4467528 : deallocate(this%vtrmc)
668 4467528 : deallocate(this%vtrmi)
669 4467528 : deallocate(this%umr)
670 4467528 : deallocate(this%ums)
671 4467528 : deallocate(this%umg)
672 4467528 : deallocate(this%qgsedten)
673 4467528 : deallocate(this%qcsedten)
674 4467528 : deallocate(this%qisedten)
675 4467528 : deallocate(this%qrsedten)
676 4467528 : deallocate(this%qssedten)
677 4467528 : deallocate(this%pratot)
678 4467528 : deallocate(this%prctot)
679 4467528 : deallocate(this%mnuccctot)
680 4467528 : deallocate(this%mnuccttot)
681 4467528 : deallocate(this%msacwitot)
682 4467528 : deallocate(this%psacwstot)
683 4467528 : deallocate(this%bergstot)
684 4467528 : deallocate(this%vapdepstot)
685 4467528 : deallocate(this%bergtot)
686 4467528 : deallocate(this%melttot)
687 4467528 : deallocate(this%meltstot)
688 4467528 : deallocate(this%meltgtot)
689 4467528 : deallocate(this%homotot)
690 4467528 : deallocate(this%qcrestot)
691 4467528 : deallocate(this%prcitot)
692 4467528 : deallocate(this%praitot)
693 4467528 : deallocate(this%qirestot)
694 4467528 : deallocate(this%mnuccrtot)
695 4467528 : deallocate(this%mnudeptot)
696 4467528 : deallocate(this%mnuccritot)
697 4467528 : deallocate(this%pracstot)
698 4467528 : deallocate(this%meltsdttot)
699 4467528 : deallocate(this%frzrdttot)
700 4467528 : deallocate(this%mnuccdtot)
701 4467528 : deallocate(this%pracgtot)
702 4467528 : deallocate(this%psacwgtot)
703 4467528 : deallocate(this%pgsacwtot)
704 4467528 : deallocate(this%pgracstot)
705 4467528 : deallocate(this%prdgtot)
706 4467528 : deallocate(this%qmultgtot)
707 4467528 : deallocate(this%qmultrgtot)
708 4467528 : deallocate(this%psacrtot)
709 4467528 : deallocate(this%npracgtot)
710 4467528 : deallocate(this%nscngtot)
711 4467528 : deallocate(this%ngracstot)
712 4467528 : deallocate(this%nmultgtot)
713 4467528 : deallocate(this%nmultrgtot)
714 4467528 : deallocate(this%npsacwgtot)
715 4467528 : deallocate(this%nnuccctot)
716 4467528 : deallocate(this%nnuccttot)
717 4467528 : deallocate(this%nnuccdtot)
718 4467528 : deallocate(this%nnudeptot)
719 4467528 : deallocate(this%nhomotot)
720 4467528 : deallocate(this%nnuccrtot)
721 4467528 : deallocate(this%nnuccritot)
722 4467528 : deallocate(this%nsacwitot)
723 4467528 : deallocate(this%npratot)
724 4467528 : deallocate(this%npsacwstot)
725 4467528 : deallocate(this%npraitot)
726 4467528 : deallocate(this%npracstot)
727 4467528 : deallocate(this%nprctot)
728 4467528 : deallocate(this%nraggtot)
729 4467528 : deallocate(this%nprcitot)
730 4467528 : deallocate(this%ncsedten)
731 4467528 : deallocate(this%nisedten)
732 4467528 : deallocate(this%nrsedten)
733 4467528 : deallocate(this%nssedten)
734 4467528 : deallocate(this%ngsedten)
735 4467528 : deallocate(this%nmelttot)
736 4467528 : deallocate(this%nmeltstot)
737 4467528 : deallocate(this%nmeltgtot)
738 :
739 4467528 : deallocate(this%qctend_KK2000)
740 4467528 : deallocate(this%nctend_KK2000)
741 4467528 : deallocate(this%qrtend_KK2000)
742 4467528 : deallocate(this%nrtend_KK2000)
743 :
744 4467528 : deallocate(this%lamc_out)
745 4467528 : deallocate(this%lamr_out)
746 4467528 : deallocate(this%pgam_out)
747 4467528 : deallocate(this%n0r_out)
748 :
749 4467528 : 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 4467528 : 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 4467528 : end subroutine proc_rates_deallocate
788 :
789 0 : end module micro_pumas_diags
|
