← 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.F90
1
4
7module gfdl_cloud_microphys
8
9 use gfdl_cloud_microphys_mod, only: gfdl_cloud_microphys_mod_init, &
10 gfdl_cloud_microphys_mod_driver, &
11 gfdl_cloud_microphys_mod_end, &
12 cloud_diagnosis
13
14 implicit none
15
16 private
17
18 public gfdl_cloud_microphys_run, gfdl_cloud_microphys_init, gfdl_cloud_microphys_final
19
20 logical :: is_initialized = .false.
21
22contains
23
24! -----------------------------------------------------------------------
25! CCPP entry points for gfdl cloud microphysics
26! -----------------------------------------------------------------------
27
34 subroutine gfdl_cloud_microphys_init (me, master, nlunit, input_nml_file, logunit, fn_nml, &
35 imp_physics, imp_physics_gfdl, do_shoc, errmsg, errflg)
36
37 implicit none
38
39 integer, intent (in) :: me
40 integer, intent (in) :: master
41 integer, intent (in) :: nlunit
42 integer, intent (in) :: logunit
43 character(len=*), intent (in) :: fn_nml
44 character(len=*), intent (in) :: input_nml_file(:)
45 integer, intent( in) :: imp_physics
46 integer, intent( in) :: imp_physics_gfdl
47 logical, intent( in) :: do_shoc
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'
65 errflg = 1
66 return
67 endif
68
69 call gfdl_cloud_microphys_mod_init(me, master, nlunit, input_nml_file, logunit, fn_nml, errmsg, errflg)
70
71 is_initialized = .true.
72
73 end subroutine gfdl_cloud_microphys_init
74
75! =======================================================================
82 subroutine gfdl_cloud_microphys_final(errmsg, errflg)
83
84 implicit none
85
86 character(len=*), intent(out) :: errmsg
87 integer, intent(out) :: errflg
88
89 ! Initialize CCPP error handling variables
90 errmsg = ''
91 errflg = 0
92
93 if (.not.is_initialized) return
94
95 call gfdl_cloud_microphys_mod_end()
96
97 is_initialized = .false.
98
99 end subroutine gfdl_cloud_microphys_final
100
117 subroutine gfdl_cloud_microphys_run( &
118 levs, im, rainmin, con_g, con_fvirt, con_rd, con_eps, frland, garea, islmsk, &
119 gq0, gq0_ntcw, gq0_ntrw, gq0_ntiw, gq0_ntsw, gq0_ntgl, gq0_ntclamt, &
120 gt0, gu0, gv0, vvl, prsl, phii, del, &
121 rain0, ice0, snow0, graupel0, prcp0, sr, &
122 dtp, hydrostatic, phys_hydrostatic, lradar, refl_10cm, &
123 reset, effr_in, rew, rei, rer, res, reg, &
124 cplchm, pfi_lsan, pfl_lsan, ten_t, ten_u, ten_v, ten_qv, ten_ql, ten_qr, &
125 ten_qi, ten_qs, ten_qg, ten_cldfrc, ten_q, errmsg, errflg)
126
127 use machine, only: kind_phys
128
129 implicit none
130
131 ! DH* TODO: CLEANUP, all of these should be coming in through the argument list
132 ! parameters
133 real(kind=kind_phys), parameter :: one = 1.0d0
134 real(kind=kind_phys), parameter :: con_p001= 0.001d0
135 real(kind=kind_phys), parameter :: con_day = 86400.d0
136 !real(kind=kind_phys), parameter :: rainmin = 1.0d-13
137 ! *DH
138
139 ! interface variables
140 integer, intent(in ) :: levs, im
141 real(kind=kind_phys), intent(in ) :: con_g, con_fvirt, con_rd, con_eps, rainmin
142 real(kind=kind_phys), intent(in ), dimension(:) :: frland, garea
143 integer, intent(in ), dimension(:) :: islmsk
144 real(kind=kind_phys), intent(in ), dimension(:,:) :: gq0, gq0_ntcw, gq0_ntrw, gq0_ntiw, &
145 gq0_ntsw, gq0_ntgl, gq0_ntclamt
146 real(kind=kind_phys), intent(in ), dimension(:,:) :: gt0, gu0, gv0
147 real(kind=kind_phys), intent(in ), dimension(:,:) :: vvl, prsl, del
148 real(kind=kind_phys), intent(in ), dimension(:,:) :: phii
149
150 ! rain/snow/ice/graupel/precip amounts, fraction of frozen precip
151 real(kind_phys), intent(out ), dimension(:) :: rain0
152 real(kind_phys), intent(out ), dimension(:) :: snow0
153 real(kind_phys), intent(out ), dimension(:) :: ice0
154 real(kind_phys), intent(out ), dimension(:) :: graupel0
155 real(kind_phys), intent(out ), dimension(:) :: prcp0
156 real(kind_phys), intent(out ), dimension(:) :: sr
157
158 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
159 real(kind_phys), intent(out ), dimension(:,:,:) :: ten_q
160
161 real(kind_phys), intent(in) :: dtp ! physics time step
162 logical, intent (in) :: hydrostatic, phys_hydrostatic
163
164 logical, intent (in) :: lradar
165 real(kind=kind_phys), intent(inout), dimension(:,:) :: refl_10cm
166 logical, intent (in) :: reset, effr_in
167 real(kind=kind_phys), intent(inout), dimension(:,:), optional :: rew, rei, rer, res, reg
168 logical, intent (in) :: cplchm
169 ! ice and liquid water 3d precipitation fluxes - only allocated if cplchm is .true.
170 real(kind=kind_phys), intent(inout), dimension(:,:), optional :: pfi_lsan, pfl_lsan
171
172 character(len=*), intent(out) :: errmsg
173 integer, intent(out) :: errflg
174
175 ! local variables
176 integer :: iis, iie, jjs, jje, kks, kke, kbot, ktop
177 integer :: i, k, kk
178 real(kind=kind_phys), dimension(1:im,1:levs) :: delp, dz, uin, vin, pt, qv1, ql1, qr1, qg1, qa1, qn1, qi1, &
179 qs1, pt_dt, qa_dt, u_dt, v_dt, w, qv_dt, ql_dt, qr_dt, qi_dt, &
180 qs_dt, qg_dt, p123, refl, new_qv, new_ql, new_qi, new_qr, &
181 new_qs, new_qg, new_t
182 real(kind=kind_phys), dimension(1:im,1,1:levs) :: pfils, pflls
183 real(kind=kind_phys), dimension(:,:), allocatable :: den
184 real(kind=kind_phys) :: onebg
185 real(kind=kind_phys) :: tem
186
187 ! Initialize CCPP error handling variables
188 errmsg = ''
189 errflg = 0
190
191 ten_t = 0.0
192 ten_u = 0.0
193 ten_v = 0.0
194 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
195 ten_qv = 0.0
196 ten_ql = 0.0
197 ten_qr = 0.0
198 ten_qi = 0.0
199 ten_qs = 0.0
200 ten_qg = 0.0
201 ten_cldfrc = 0.0
202
203 iis = 1
204 iie = im
205 jjs = 1
206 jje = 1
207 kks = 1
208 kke = levs
209 ! flipping of vertical direction
210 ktop = 1
211 kbot = levs
212
213 onebg = one/con_g
214
215 do k = 1, levs
216 kk = levs-k+1
217 do i = 1, im
218 qv_dt(i,k) = 0.0
219 ql_dt(i,k) = 0.0
220 qr_dt(i,k) = 0.0
221 qi_dt(i,k) = 0.0
222 qs_dt(i,k) = 0.0
223 qg_dt(i,k) = 0.0
224 qa_dt(i,k) = 0.0
225 pt_dt(i,k) = 0.0
226 u_dt(i,k) = 0.0
227 v_dt(i,k) = 0.0
228 qn1(i,k) = 0.0
229 pfils(i,1,k) = 0.0
230 pflls(i,1,k) = 0.0
231 ! flip vertical (k) coordinate
232 qv1(i,k) = gq0(i,kk)
233 ql1(i,k) = gq0_ntcw(i,kk)
234 qr1(i,k) = gq0_ntrw(i,kk)
235 qi1(i,k) = gq0_ntiw(i,kk)
236 qs1(i,k) = gq0_ntsw(i,kk)
237 qg1(i,k) = gq0_ntgl(i,kk)
238 qa1(i,k) = gq0_ntclamt(i,kk)
239 pt(i,k) = gt0(i,kk)
240 w(i,k) = -vvl(i,kk) * (one+con_fvirt * gq0(i,kk)) &
241 * gt0(i,kk) / prsl(i,kk) * (con_rd*onebg)
242 uin(i,k) = gu0(i,kk)
243 vin(i,k) = gv0(i,kk)
244 delp(i,k) = del(i,kk)
245 dz(i,k) = (phii(i,kk)-phii(i,kk+1))*onebg
246 p123(i,k) = prsl(i,kk)
247 refl(i,k) = refl_10cm(i,kk)
248 enddo
249 enddo
250
251 ! reset precipitation amounts to zero
252 rain0 = 0
253 ice0 = 0
254 snow0 = 0
255 graupel0 = 0
256
257 call gfdl_cloud_microphys_mod_driver(iis, iie, jjs, jje, kks, kke, ktop, kbot, &
258 qv1, ql1, qr1, qi1, qs1, qg1, qa1, qn1, qv_dt, ql_dt, qr_dt, qi_dt, &
259 qs_dt, qg_dt, qa_dt, pt_dt, pt, w, uin, vin, u_dt, v_dt, dz, delp, &
260 garea, dtp, frland, rain0, snow0, ice0, graupel0, hydrostatic, &
261 phys_hydrostatic, p123, lradar, refl, reset, pfils, pflls)
262 tem = dtp*con_p001/con_day
263
264 ! fix negative values
265 do i = 1, im
266 !rain0(i) = max(con_d00, rain0(i))
267 !snow0(i) = max(con_d00, snow0(i))
268 !ice0(i) = max(con_d00, ice0(i))
269 !graupel0(i) = max(con_d00, graupel0(i))
270 if(rain0(i)*tem < rainmin) then
271 rain0(i) = 0.0
272 endif
273 if(ice0(i)*tem < rainmin) then
274 ice0(i) = 0.0
275 endif
276 if(snow0(i)*tem < rainmin) then
277 snow0(i) = 0.0
278 endif
279 if(graupel0(i)*tem < rainmin) then
280 graupel0(i) = 0.0
281 endif
282 enddo
283
284 ! calculate fraction of frozen precipitation using unscaled
285 ! values of rain0, ice0, snow0, graupel0 (for bit-for-bit)
286 do i=1,im
287 prcp0(i) = (rain0(i)+snow0(i)+ice0(i)+graupel0(i)) * tem
288 if ( prcp0(i) > rainmin ) then
289 sr(i) = (snow0(i) + ice0(i) + graupel0(i)) &
290 / (rain0(i) + snow0(i) + ice0(i) + graupel0(i))
291 else
292 sr(i) = 0.0
293 endif
294 enddo
295
296 ! convert rain0, ice0, snow0, graupel0 from mm per day to m per physics timestep
297 rain0 = rain0*tem
298 ice0 = ice0*tem
299 snow0 = snow0*tem
300 graupel0 = graupel0*tem
301
302 ! flip vertical coordinate back
303 do k=1,levs
304 kk = levs-k+1
305 do i=1,im
306 ten_qv(i,k) = qv_dt(i,kk)
307 ten_ql(i,k) = ql_dt(i,kk)
308 ten_qr(i,k) = qr_dt(i,kk)
309 ten_qi(i,k) = qi_dt(i,kk)
310 ten_qs(i,k) = qs_dt(i,kk)
311 ten_qg(i,k) = qg_dt(i,kk)
312 ten_cldfrc(i,k) = qa_dt(i,kk)
313
314 ten_t(i,k) = pt_dt(i,kk)
315 ten_u(i,k) = u_dt(i,kk)
316 ten_v(i,k) = v_dt(i,kk)
317
318 refl_10cm(i,k) = refl(i,kk)
319
320 !new values needed for cloud_diagnosis below
321 new_qv(i,k) = qv1(i,kk) + qv_dt(i,kk) * dtp
322 new_ql(i,k) = ql1(i,kk) + ql_dt(i,kk) * dtp
323 new_qr(i,k) = qr1(i,kk) + qr_dt(i,kk) * dtp
324 new_qi(i,k) = qi1(i,kk) + qi_dt(i,kk) * dtp
325 new_qs(i,k) = qs1(i,kk) + qs_dt(i,kk) * dtp
326 new_qg(i,k) = qg1(i,kk) + qg_dt(i,kk) * dtp
327 new_t(i,k) = gt0(i,k) + pt_dt(i,kk) * dtp
328 enddo
329 enddo
330
331 ! output ice and liquid water 3d precipitation fluxes if requested
332 if (cplchm) then
333 do k=1,levs
334 kk = levs-k+1
335 do i=1,im
336 pfi_lsan(i,k) = pfils(i,1,kk)
337 pfl_lsan(i,k) = pflls(i,1,kk)
338 enddo
339 enddo
340 endif
341
342 if(effr_in) then
343 allocate(den(1:im,1:levs))
344 do k=1,levs
345 do i=1,im
346 den(i,k)=con_eps*prsl(i,k)/(con_rd*new_t(i,k)*(new_qv(i,k)+con_eps))
347 enddo
348 enddo
349 call cloud_diagnosis (1, im, 1, levs, den(1:im,1:levs), &
350 del(1:im,1:levs), islmsk(1:im), &
351 new_ql(1:im,1:levs), new_qi(1:im,1:levs), &
352 new_qr(1:im,1:levs), &
353 new_qs(1:im,1:levs) + new_qg(1:im,1:levs), &
354 new_qg(1:im,1:levs)*0.0, new_t(1:im,1:levs), &
355 rew(1:im,1:levs), rei(1:im,1:levs), rer(1:im,1:levs),&
356 res(1:im,1:levs), reg(1:im,1:levs))
357 deallocate(den)
358 endif
359
360 end subroutine gfdl_cloud_microphys_run
361
362end module gfdl_cloud_microphys
gfdl_cloud_microphys_mod::cloud_diagnosis
subroutine, public cloud_diagnosis(is, ie, ks, ke, den, delp, lsm, qmw, qmi, qmr, qms, qmg, t, rew, rei, rer, res, reg)
The subroutine 'cloud_diagnosis' diagnoses the radius of cloud species.
Definition gfdl_cloud_microphys_mod.F90:4597
gfdl_cloud_microphys_mod::gfdl_cloud_microphys_mod_end
subroutine, public gfdl_cloud_microphys_mod_end()
The subroutine 'gfdl_cloud_microphys_init' terminates the GFDL cloud microphysics.
Definition gfdl_cloud_microphys_mod.F90:3541
gfdl_cloud_microphys_mod::gfdl_cloud_microphys_mod_driver
subroutine, public gfdl_cloud_microphys_mod_driver(iis, iie, jjs, jje, kks, kke, ktop, kbot, qv, ql, qr, qi, qs, qg, qa, qn, qv_dt, ql_dt, qr_dt, qi_dt, qs_dt, qg_dt, qa_dt, pt_dt, pt, w, uin, vin, udt, vdt, dz, delp, area, dt_in, land, rain, snow, ice, graupel, hydrostatic, phys_hydrostatic, p, lradar, refl_10cm, reset, pfils, pflls)
This subroutine is the driver of the GFDL cloud microphysics.
Definition gfdl_cloud_microphys_mod.F90:205
gfdl_cloud_microphys_mod::gfdl_cloud_microphys_mod_init
subroutine, public gfdl_cloud_microphys_mod_init(me, master, nlunit, input_nml_file, logunit, fn_nml, errmsg, errflg)
The subroutine 'gfdl_cloud_microphys_init' initializes the GFDL cloud microphysics.
Definition gfdl_cloud_microphys_mod.F90:3407
gfdl_cloud_microphys_mod
This module contains the column GFDL Cloud microphysics scheme.
Definition gfdl_cloud_microphys_mod.F90:32
gfdl_cloud_microphys
This module contains the CCPP entry point for the column GFDL cloud microphysics ( Chen and Lin (2013...
Definition gfdl_cloud_microphys.F90:7