← Back to Documentation Home
CCPP SciDoc v8.0.0  v8.0.0
Common Community Physics Package Developed at DTC
 
Loading...
Searching...
No Matches
gfdl_cloud_microphys_v3.F90
1
4module gfdl_cloud_microphys_v3
5
6 use gfdl_cloud_microphys_v3_mod, only: gfdl_cloud_microphys_v3_mod_init, &
7 gfdl_cloud_microphys_v3_mod_driver, &
8 gfdl_cloud_microphys_v3_mod_end, &
9 rad_ref, cld_eff_rad
10
11 implicit none
12
13 private
14
15 public gfdl_cloud_microphys_v3_run, gfdl_cloud_microphys_v3_init, gfdl_cloud_microphys_v3_final
16
17 logical :: is_initialized = .false.
18
19contains
20
21! -----------------------------------------------------------------------
22! CCPP entry points for gfdl cloud microphysics
23! -----------------------------------------------------------------------
24
31
32 subroutine gfdl_cloud_microphys_v3_init (me, master, nlunit, input_nml_file, logunit, &
33 fn_nml, imp_physics, imp_physics_gfdl, do_shoc, &
34 hydrostatic, errmsg, errflg)
35
36 implicit none
37
38 integer, intent (in) :: me
39 integer, intent (in) :: master
40 integer, intent (in) :: nlunit
41 integer, intent (in) :: logunit
42 character(len=*), intent (in) :: fn_nml
43 character(len=*), intent (in) :: input_nml_file(:)
44 integer, intent( in) :: imp_physics
45 integer, intent( in) :: imp_physics_gfdl
46 logical, intent( in) :: do_shoc
47 logical, intent( in) :: hydrostatic
48 character(len=*), intent(out) :: errmsg
49 integer, intent(out) :: errflg
50
51 ! Initialize CCPP error handling variables
52 errmsg = ''
53 errflg = 0
54
55 if (is_initialized) return
56
57 if (imp_physics/=imp_physics_gfdl) then
58 write(errmsg,'(*(a))') 'Namelist option for microphysics does not match choice in suite definition file'
59 errflg = 1
60 return
61 end if
62
63 if (do_shoc) then
64 write(errmsg,'(*(a))') 'SHOC is not currently compatible with GFDL MP v3'
65 errflg = 1
66 return
67 endif
68
69 call gfdl_cloud_microphys_v3_mod_init(me, master, nlunit, input_nml_file, logunit, fn_nml, hydrostatic, errmsg, errflg)
70
71 is_initialized = .true.
72
73 end subroutine gfdl_cloud_microphys_v3_init
74
75
76! =======================================================================
83 subroutine gfdl_cloud_microphys_v3_final(errmsg, errflg)
84
85 implicit none
86
87 character(len=*), intent(out) :: errmsg
88 integer, intent(out) :: errflg
89
90 ! Initialize CCPP error handling variables
91 errmsg = ''
92 errflg = 0
93
94 if (.not.is_initialized) return
95
96 call gfdl_cloud_microphys_v3_mod_end()
97
98 is_initialized = .false.
99
100 end subroutine gfdl_cloud_microphys_v3_final
101
118 subroutine gfdl_cloud_microphys_v3_run(fast_mp_consv, &
119 levs, im, rainmin, con_g, con_fvirt, con_rd, con_eps, garea, slmsk, snowd, &
120 gq0, gq0_ntcw, gq0_ntrw, gq0_ntiw, gq0_ntsw, gq0_ntgl, gq0_ntclamt, aerfld, &
121 gt0, gu0, gv0, vvl, prsl, phii, del, &
122 rain0, ice0, snow0, graupel0, prcp0, sr, oro, &
123 dtp, hydrostatic, lradar, refl_10cm, &
124 reset, effr_in, rew, rei, rer, res, reg, &
125 cplchm, pfi_lsan, pfl_lsan, con_one, con_p001, con_secinday, ten_t, ten_u, &
126 ten_v, ten_qv, ten_ql, ten_qr, ten_qi, ten_qs, ten_qg, ten_cldfrc, ten_q, &
127 errmsg, errflg)
128
129 use machine, only: kind_phys, kind_dyn, kind_dbl_prec
130
131 implicit none
132
133 ! interface variables
134 integer, intent(in ) :: levs, im
135 real(kind=kind_phys), intent(in ) :: con_g, con_fvirt, con_rd, con_eps, rainmin
136 real(kind=kind_phys), intent(in ) :: con_one, con_p001, con_secinday
137 real(kind=kind_phys), intent(in ), dimension(:) :: garea, slmsk, snowd, oro
138 real(kind=kind_phys), intent(in ), dimension(:,:) :: gq0, gq0_ntcw, gq0_ntrw, gq0_ntiw, &
139 gq0_ntsw, gq0_ntgl, gq0_ntclamt
140 real(kind_phys), intent(in ), dimension(:,:,:) :: aerfld
141 real(kind=kind_phys), intent(in ), dimension(:,:) :: gt0, gu0, gv0
142 real(kind=kind_phys), intent(in ), dimension(:,:) :: vvl, prsl, del
143 real(kind=kind_phys), intent(in ), dimension(:,:) :: phii
144
145 ! rain/snow/ice/graupel/precip amounts, fraction of frozen precip
146 !real(kind_phys), dimension(:) :: water0
147 real(kind_phys), intent(out ), dimension(:), optional :: rain0
148 real(kind_phys), intent(out ), dimension(:), optional :: snow0
149 real(kind_phys), intent(out ), dimension(:), optional :: ice0
150 real(kind_phys), intent(out ), dimension(:), optional :: graupel0
151 real(kind_phys), intent(out ), dimension(:) :: prcp0
152 real(kind_phys), intent(out ), dimension(:) :: sr
153
154 real(kind_phys), intent(out ), dimension(:,:) :: ten_t, ten_u, ten_v, ten_qv, ten_ql, ten_qr, ten_qi, ten_qs, ten_qg, ten_cldfrc
155 real(kind_phys), intent(out ), dimension(:,:,:) :: ten_q
156
157 real(kind_phys), intent(in) :: dtp ! physics time step
158 logical, intent (in) :: hydrostatic, fast_mp_consv
159
160 logical, intent (in) :: lradar
161 real(kind=kind_phys), intent(inout), dimension(:,:) :: refl_10cm
162 logical, intent (in) :: reset, effr_in
163 real(kind=kind_phys), intent(inout), dimension(:,:), optional :: rew, rei, rer, res, reg
164 logical, intent (in) :: cplchm
165 ! ice and liquid water 3d precipitation fluxes - only allocated if cplchm is .true.
166 real(kind=kind_phys), intent(inout), dimension(:,:), optional :: pfi_lsan, pfl_lsan
167
168 character(len=*), intent(out) :: errmsg
169 integer, intent(out) :: errflg
170
171 ! local variables
172 integer :: iis, iie, jjs, jje, kks, kke, kbot, ktop
173 integer :: i, k, kk
174 real(kind=kind_phys), dimension(1:im,1:levs) :: delp, dz, uin, vin, pt, qv1, ql1, qi1, qr1, qs1, qg1, &
175 qa1, qnl, qni, w, p123, refl
176 real(kind=kind_phys), dimension(1:im,1:levs) :: q_con, cappa !for inline MP option
177 real(kind=kind_phys), dimension(1:im,1,1:levs) :: pfils, pflls
178 real(kind=kind_phys), dimension(1:im,1,1:levs) :: adj_vmr, te
179 real(kind=kind_phys), dimension(1:im,1:levs) :: prefluxw, prefluxr, prefluxi, prefluxs, prefluxg
180 real(kind=kind_phys), dimension(1:im) :: hs, gsize
181 real(kind=kind_dbl_prec), dimension(1:im) :: dte
182 !real(kind=kind_phys), dimension(:,:), allocatable :: den
183 real(kind=kind_phys), dimension(1:im) :: water0
184 real(kind=kind_phys) :: onebg
185 real(kind=kind_phys) :: tem
186 logical last_step, do_inline_mp
187 real(kind=kind_phys), dimension(:,:), allocatable :: new_qv, new_ql, new_qi, new_qr, new_qs, new_qg, new_qa, new_t
188
189 ! Initialize CCPP error handling variables
190 errmsg = ''
191 errflg = 0
192
193 ten_t = 0.0
194 ten_u = 0.0
195 ten_v = 0.0
196 ten_q = 0.0 !set tendency of entire tracer array to zero to make sure that those tracers not affected by this scheme do not change when tendencies are applied
197 ten_qv = 0.0
198 ten_ql = 0.0
199 ten_qr = 0.0
200 ten_qi = 0.0
201 ten_qs = 0.0
202 ten_qg = 0.0
203 ten_cldfrc = 0.0
204
205 iis = 1
206 iie = im
207 jjs = 1
208 jje = 1
209 kks = 1
210 kke = levs
211 ! flipping of vertical direction
212 ktop = 1
213 kbot = levs
214
215 onebg = con_one/con_g
216
217 do k = 1, levs
218 kk = levs-k+1
219 do i = 1, im
220 qnl(i,k) = aerfld(i,kk,11) ! sulfate
221 prefluxw(i,k) =0.0
222 prefluxi(i,k) =0.0
223 prefluxr(i,k) =0.0
224 prefluxs(i,k) =0.0
225 prefluxg(i,k) =0.0
226
227 ! flip vertical (k) coordinate top =1
228 qv1(i,k) = gq0(i,kk)
229 ql1(i,k) = gq0_ntcw(i,kk)
230 qr1(i,k) = gq0_ntrw(i,kk)
231 qi1(i,k) = gq0_ntiw(i,kk)
232 qs1(i,k) = gq0_ntsw(i,kk)
233 qg1(i,k) = gq0_ntgl(i,kk)
234 qa1(i,k) = gq0_ntclamt(i,kk)
235 pt(i,k) = gt0(i,kk)
236 w(i,k) = -vvl(i,kk) * (con_one+con_fvirt * gq0(i,kk)) &
237 * gt0(i,kk) / prsl(i,kk) * (con_rd*onebg)
238 uin(i,k) = gu0(i,kk)
239 vin(i,k) = gv0(i,kk)
240 delp(i,k) = del(i,kk)
241 dz(i,k) = (phii(i,kk)-phii(i,kk+1))*onebg
242 p123(i,k) = prsl(i,kk)
243 qni(i,k) = 10.
244 q_con(i,k) = 0.0
245 cappa(i,k) = 0.0
246 enddo
247 enddo
248
249 ! reset precipitation amounts to zero
250 water0 = 0
251 rain0 = 0
252 ice0 = 0
253 snow0 = 0
254 graupel0 = 0
255
256 ! Call MP driver
257 last_step = .false.
258 do_inline_mp = .false.
259 hs = oro(:) * con_g
260 gsize = sqrt(garea(:))
261
262 call gfdl_cloud_microphys_v3_mod_driver( qv1, ql1, qr1, qi1, qs1, qg1, qa1, qnl, qni, pt, w,&
263 uin, vin, dz, delp, gsize, dtp, hs, water0, rain0, &
264 ice0, snow0, graupel0, hydrostatic, iis, iie, kks, kke, q_con, cappa, &
265 fast_mp_consv, adj_vmr, te, dte, prefluxw, prefluxr, prefluxi, prefluxs, &
266 prefluxg, last_step, do_inline_mp )
267 tem = dtp*con_p001/con_secinday
268
269 ! fix negative values
270 do i = 1, im
271 !rain0(i) = max(con_d00, rain0(i))
272 !snow0(i) = max(con_d00, snow0(i))
273 !ice0(i) = max(con_d00, ice0(i))
274 !graupel0(i) = max(con_d00, graupel0(i))
275 if(water0(i)*tem < rainmin) then
276 water0(i) = 0.0
277 endif
278 if(rain0(i)*tem < rainmin) then
279 rain0(i) = 0.0
280 endif
281 if(ice0(i)*tem < rainmin) then
282 ice0(i) = 0.0
283 endif
284 if(snow0(i)*tem < rainmin) then
285 snow0(i) = 0.0
286 endif
287 if(graupel0(i)*tem < rainmin) then
288 graupel0(i) = 0.0
289 endif
290 enddo
291
292 ! calculate fraction of frozen precipitation using unscaled
293 ! values of rain0, ice0, snow0, graupel0 (for bit-for-bit)
294 do i=1,im
295 prcp0(i) = (rain0(i)+snow0(i)+ice0(i)+graupel0(i)) * tem
296 if ( prcp0(i) > rainmin ) then
297 sr(i) = (snow0(i) + ice0(i) + graupel0(i)) &
298 / (rain0(i) + snow0(i) + ice0(i) + graupel0(i))
299 else
300 sr(i) = 0.0
301 endif
302 enddo
303
304 ! convert rain0, ice0, snow0, graupel0 from mm per day to m per physics timestep
305 water0 = water0*tem
306 rain0 = rain0*tem
307 ice0 = ice0*tem
308 snow0 = snow0*tem
309 graupel0 = graupel0*tem
310
311 ! flip vertical coordinate back
312 do k=1,levs
313 kk = levs-k+1
314 do i=1,im
315 ten_qv(i,k) = (qv1(i,kk) - gq0(i,k))/dtp
316 ten_ql(i,k) = (ql1(i,kk) - gq0_ntcw(i,k))/dtp
317 ten_qr(i,k) = (qr1(i,kk) - gq0_ntrw(i,k))/dtp
318 ten_qi(i,k) = (qi1(i,kk) - gq0_ntiw(i,k))/dtp
319 ten_qs(i,k) = (qs1(i,kk) - gq0_ntsw(i,k))/dtp
320 ten_qg(i,k) = (qg1(i,kk) - gq0_ntgl(i,k))/dtp
321 ten_cldfrc(i,k) = (qa1(i,kk) - gq0_ntclamt(i,k))/dtp
322 ten_t(i,k) = (pt(i,kk) - gt0(i,k))/dtp
323 ten_u(i,k) = (uin(i,kk) - gu0(i,k))/dtp
324 ten_v(i,k) = (vin(i,kk) - gv0(i,k))/dtp
325 refl_10cm(i,k) = refl(i,kk)
326 enddo
327 enddo
328
329 ! output ice and liquid water 3d precipitation fluxes if requested
330 if (cplchm) then
331 do k=1,levs
332 kk = levs-k+1
333 do i=1,im
334 pfi_lsan(i,k) = prefluxi(i,kk) + prefluxs(i,kk) + prefluxg(i,kk)
335 pfl_lsan(i,k) = prefluxr(i,kk)
336 enddo
337 enddo
338 endif
339
340 if(effr_in) then
341 allocate(new_qv(im,levs), new_ql(im,levs), new_qi(im,levs), new_qr(im,levs), new_qs(im,levs), new_qg(im,levs), new_qa(im,levs), new_t(im,levs))
342 do k=1,levs
343 kk = levs-k+1
344 do i=1,im
345 new_qv(i,k) = qv1(i,kk)
346 new_ql(i,k) = ql1(i,kk)
347 new_qr(i,k) = qr1(i,kk)
348 new_qi(i,k) = qi1(i,kk)
349 new_qs(i,k) = qs1(i,kk)
350 new_qg(i,k) = qg1(i,kk)
351 new_qa(i,k) = qa1(i,kk)
352 new_t(i,k) = pt(i,kk)
353 enddo
354 enddo
355
356 call cld_eff_rad (1, im, 1, levs, slmsk(1:im), &
357 prsl(1:im,1:levs), del(1:im,1:levs), &
358 new_t(1:im,1:levs), new_qv(1:im,1:levs), &
359 new_ql(1:im,1:levs), new_qi(1:im,1:levs), &
360 new_qr(1:im,1:levs), new_qs(1:im,1:levs), &
361 new_qg(1:im,1:levs), new_qa(1:im,1:levs), &
362 rew(1:im,1:levs), rei(1:im,1:levs), rer(1:im,1:levs),&
363 res(1:im,1:levs), reg(1:im,1:levs),snowd(1:im))
364 endif
365
366 if(lradar) then
367 call rad_ref (1, im, 1, 1, qv1(1:im,1:levs), qr1(1:im,1:levs), &
368 qs1(1:im,1:levs),qg1(1:im,1:levs),pt(1:im,1:levs), &
369 delp(1:im,1:levs), dz(1:im,1:levs), refl(1:im,1:levs), levs, hydrostatic, &
370 do_inline_mp, 1)
371
372 do k=1,levs
373 kk = levs-k+1
374 do i=1,im
375 refl_10cm(i,k) = max(-35.,refl(i,kk))
376 enddo
377 enddo
378 endif
379
380 if(effr_in) then
381 deallocate(new_qv, new_ql, new_qi, new_qr, new_qs, new_qg, new_qa, new_t)
382 end if
383
384 end subroutine gfdl_cloud_microphys_v3_run
385
386end module gfdl_cloud_microphys_v3