73 subroutine rrtmgp_sw_cloud_optics_init( rrtmgp_root_dir, rrtmgp_sw_file_clouds, &
74 doGP_cldoptics_PADE, doGP_cldoptics_LUT, nrghice, mpicomm, mpirank, mpiroot, &
78 character(len=128),
intent(in) :: &
79 rrtmgp_root_dir, & !< RTE-RRTMGP root directory
81 logical,
intent(in) :: &
82 doGP_cldoptics_PADE,& !< Use RRTMGP cloud-optics: PADE approximation?
84 integer,
intent(inout) :: &
86 type(mpi_comm),
intent(in) :: &
88 integer,
intent(in) :: &
89 mpirank, & !< Current MPI rank
93 character(len=*),
intent(out) :: &
95 integer,
intent(out) :: &
99 integer :: status,ncid,dimid,varID,mpierr
100 character(len=264) :: sw_cloud_props_file
107 sw_cloud_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_sw_file_clouds)
116 if (mpirank .eq. mpiroot)
then
118 write (*,*)
'Reading RRTMGP shortwave cloud-optics metadata ... '
121 status = nf90_open(trim(sw_cloud_props_file), nf90_nowrite, ncid)
124 status = nf90_inq_dimid(ncid,
'nband', dimid)
125 status = nf90_inquire_dimension(ncid, dimid, len=nbandsw)
126 status = nf90_inq_dimid(ncid,
'nrghice', dimid)
127 status = nf90_inquire_dimension(ncid, dimid, len=nrghice_fromfilesw)
128 status = nf90_inq_dimid(ncid,
'nsize_liq', dimid)
129 status = nf90_inquire_dimension(ncid, dimid, len=nsize_liqsw)
130 status = nf90_inq_dimid(ncid,
'nsize_ice', dimid)
131 status = nf90_inquire_dimension(ncid, dimid, len=nsize_icesw)
132 status = nf90_inq_dimid(ncid,
'nsizereg', dimid)
133 status = nf90_inquire_dimension(ncid, dimid, len=nsizeregsw)
134 status = nf90_inq_dimid(ncid,
'ncoeff_ext', dimid)
135 status = nf90_inquire_dimension(ncid, dimid, len=ncoeff_extsw)
136 status = nf90_inq_dimid(ncid,
'ncoeff_ssa_g', dimid)
137 status = nf90_inquire_dimension(ncid, dimid, len=ncoeff_ssa_gsw)
138 status = nf90_inq_dimid(ncid,
'nbound', dimid)
139 status = nf90_inquire_dimension(ncid, dimid, len=nboundsw)
140 status = nf90_inq_dimid(ncid,
'pair', dimid)
141 status = nf90_inquire_dimension(ncid, dimid, len=npairssw)
146 call mpi_barrier(mpicomm, mpierr)
154 call mpi_bcast(nbandsw, 1, mpi_integer, mpiroot, mpicomm, mpierr)
155 call mpi_bcast(nsize_liqsw, 1, mpi_integer, mpiroot, mpicomm, mpierr)
156 call mpi_bcast(nsize_icesw, 1, mpi_integer, mpiroot, mpicomm, mpierr)
157 call mpi_bcast(nsizeregsw, 1, mpi_integer, mpiroot, mpicomm, mpierr)
158 call mpi_bcast(ncoeff_extsw, 1, mpi_integer, mpiroot, mpicomm, mpierr)
159 call mpi_bcast(ncoeff_ssa_gsw, 1, mpi_integer, mpiroot, mpicomm, mpierr)
160 call mpi_bcast(nboundsw, 1, mpi_integer, mpiroot, mpicomm, mpierr)
161 call mpi_bcast(npairssw, 1, mpi_integer, mpiroot, mpicomm, mpierr)
166 if (nrghice .ne. 0) nrghice_fromfilesw = nrghice
168 call mpi_bcast(nrghice_fromfilesw, 1, mpi_integer, mpiroot, mpicomm, mpierr)
177 if (dogp_cldoptics_lut)
then
178 allocate(lut_extliqsw(nsize_liqsw, nbandsw))
179 allocate(lut_ssaliqsw(nsize_liqsw, nbandsw))
180 allocate(lut_asyliqsw(nsize_liqsw, nbandsw))
181 allocate(lut_exticesw(nsize_icesw, nbandsw, nrghice_fromfilesw))
182 allocate(lut_ssaicesw(nsize_icesw, nbandsw, nrghice_fromfilesw))
183 allocate(lut_asyicesw(nsize_icesw, nbandsw, nrghice_fromfilesw))
185 if (dogp_cldoptics_pade)
then
186 allocate(pade_extliqsw(nbandsw, nsizeregsw, ncoeff_extsw ))
187 allocate(pade_ssaliqsw(nbandsw, nsizeregsw, ncoeff_ssa_gsw))
188 allocate(pade_asyliqsw(nbandsw, nsizeregsw, ncoeff_ssa_gsw))
189 allocate(pade_exticesw(nbandsw, nsizeregsw, ncoeff_extsw, nrghice_fromfilesw))
190 allocate(pade_ssaicesw(nbandsw, nsizeregsw, ncoeff_ssa_gsw, nrghice_fromfilesw))
191 allocate(pade_asyicesw(nbandsw, nsizeregsw, ncoeff_ssa_gsw, nrghice_fromfilesw))
192 allocate(pade_sizereg_extliqsw(nboundsw))
193 allocate(pade_sizereg_ssaliqsw(nboundsw))
194 allocate(pade_sizereg_asyliqsw(nboundsw))
195 allocate(pade_sizereg_exticesw(nboundsw))
196 allocate(pade_sizereg_ssaicesw(nboundsw))
197 allocate(pade_sizereg_asyicesw(nboundsw))
199 allocate(band_limscldsw(2,nbandsw))
208 if (mpirank .eq. mpiroot)
then
210 if (dogp_cldoptics_lut)
then
211 write (*,*)
'Reading RRTMGP shortwave cloud data (LUT) ... '
212 status = nf90_inq_varid(ncid,
'radliq_lwr',varid)
213 status = nf90_get_var(ncid,varid,radliq_lwrsw)
214 status = nf90_inq_varid(ncid,
'radliq_upr',varid)
215 status = nf90_get_var(ncid,varid,radliq_uprsw)
216 status = nf90_inq_varid(ncid,
'radliq_fac',varid)
217 status = nf90_get_var(ncid,varid,radliq_facsw)
218 status = nf90_inq_varid(ncid,
'radice_lwr',varid)
219 status = nf90_get_var(ncid,varid,radice_lwrsw)
220 status = nf90_inq_varid(ncid,
'radice_upr',varid)
221 status = nf90_get_var(ncid,varid,radice_uprsw)
222 status = nf90_inq_varid(ncid,
'radice_fac',varid)
223 status = nf90_get_var(ncid,varid,radice_facsw)
224 status = nf90_inq_varid(ncid,
'lut_extliq',varid)
225 status = nf90_get_var(ncid,varid,lut_extliqsw)
226 status = nf90_inq_varid(ncid,
'lut_ssaliq',varid)
227 status = nf90_get_var(ncid,varid,lut_ssaliqsw)
228 status = nf90_inq_varid(ncid,
'lut_asyliq',varid)
229 status = nf90_get_var(ncid,varid,lut_asyliqsw)
230 status = nf90_inq_varid(ncid,
'lut_extice',varid)
231 status = nf90_get_var(ncid,varid,lut_exticesw)
232 status = nf90_inq_varid(ncid,
'lut_ssaice',varid)
233 status = nf90_get_var(ncid,varid,lut_ssaicesw)
234 status = nf90_inq_varid(ncid,
'lut_asyice',varid)
235 status = nf90_get_var(ncid,varid,lut_asyicesw)
236 status = nf90_inq_varid(ncid,
'bnd_limits_wavenumber',varid)
237 status = nf90_get_var(ncid,varid,band_limscldsw)
239 if (dogp_cldoptics_pade)
then
240 write (*,*)
'Reading RRTMGP shortwave cloud data (PADE) ... '
241 status = nf90_inq_varid(ncid,
'radliq_lwr',varid)
242 status = nf90_get_var(ncid,varid,radliq_lwrsw)
243 status = nf90_inq_varid(ncid,
'radliq_upr',varid)
244 status = nf90_get_var(ncid,varid,radliq_uprsw)
245 status = nf90_inq_varid(ncid,
'radliq_fac',varid)
246 status = nf90_get_var(ncid,varid,radliq_facsw)
247 status = nf90_inq_varid(ncid,
'radice_lwr',varid)
248 status = nf90_get_var(ncid,varid,radice_lwrsw)
249 status = nf90_inq_varid(ncid,
'radice_upr',varid)
250 status = nf90_get_var(ncid,varid,radice_uprsw)
251 status = nf90_inq_varid(ncid,
'radice_fac',varid)
252 status = nf90_get_var(ncid,varid,radice_facsw)
253 status = nf90_inq_varid(ncid,
'pade_extliq',varid)
254 status = nf90_get_var(ncid,varid,pade_extliqsw)
255 status = nf90_inq_varid(ncid,
'pade_ssaliq',varid)
256 status = nf90_get_var(ncid,varid,pade_ssaliqsw)
257 status = nf90_inq_varid(ncid,
'pade_asyliq',varid)
258 status = nf90_get_var(ncid,varid,pade_asyliqsw)
259 status = nf90_inq_varid(ncid,
'pade_extice',varid)
260 status = nf90_get_var(ncid,varid,pade_exticesw)
261 status = nf90_inq_varid(ncid,
'pade_ssaice',varid)
262 status = nf90_get_var(ncid,varid,pade_ssaicesw)
263 status = nf90_inq_varid(ncid,
'pade_asyice',varid)
264 status = nf90_get_var(ncid,varid,pade_asyicesw)
265 status = nf90_inq_varid(ncid,
'pade_sizreg_extliq',varid)
266 status = nf90_get_var(ncid,varid,pade_sizereg_extliqsw)
267 status = nf90_inq_varid(ncid,
'pade_sizreg_ssaliq',varid)
268 status = nf90_get_var(ncid,varid,pade_sizereg_ssaliqsw)
269 status = nf90_inq_varid(ncid,
'pade_sizreg_asyliq',varid)
270 status = nf90_get_var(ncid,varid,pade_sizereg_asyliqsw)
271 status = nf90_inq_varid(ncid,
'pade_sizreg_extice',varid)
272 status = nf90_get_var(ncid,varid,pade_sizereg_exticesw)
273 status = nf90_inq_varid(ncid,
'pade_sizreg_ssaice',varid)
274 status = nf90_get_var(ncid,varid,pade_sizereg_ssaicesw)
275 status = nf90_inq_varid(ncid,
'pade_sizreg_asyice',varid)
276 status = nf90_get_var(ncid,varid,pade_sizereg_asyicesw)
277 status = nf90_inq_varid(ncid,
'bnd_limits_wavenumber',varid)
278 status = nf90_get_var(ncid,varid,band_limscldsw)
282 status = nf90_close(ncid)
288 call mpi_barrier(mpicomm, mpierr)
298 call mpi_bcast(radliq_facsw, 1, mpi_double_precision, mpiroot, mpicomm, mpierr)
299 call mpi_bcast(radice_facsw, 1, mpi_double_precision, mpiroot, mpicomm, mpierr)
300 call mpi_bcast(radliq_lwrsw, 1, mpi_double_precision, mpiroot, mpicomm, mpierr)
301 call mpi_bcast(radliq_uprsw, 1, mpi_double_precision, mpiroot, mpicomm, mpierr)
302 call mpi_bcast(radice_lwrsw, 1, mpi_double_precision, mpiroot, mpicomm, mpierr)
303 call mpi_bcast(radice_uprsw, 1, mpi_double_precision, mpiroot, mpicomm, mpierr)
306 call mpi_bcast(band_limscldsw,
size(band_limscldsw), &
307 mpi_double_precision, mpiroot, mpicomm, mpierr)
308 if (dogp_cldoptics_lut)
then
309 call mpi_bcast(lut_extliqsw,
size(lut_extliqsw), &
310 mpi_double_precision, mpiroot, mpicomm, mpierr)
311 call mpi_bcast(lut_ssaliqsw,
size(lut_ssaliqsw), &
312 mpi_double_precision, mpiroot, mpicomm, mpierr)
313 call mpi_bcast(lut_asyliqsw,
size(lut_asyliqsw), &
314 mpi_double_precision, mpiroot, mpicomm, mpierr)
315 call mpi_bcast(lut_exticesw,
size(lut_exticesw), &
316 mpi_double_precision, mpiroot, mpicomm, mpierr)
317 call mpi_bcast(lut_ssaicesw,
size(lut_ssaicesw), &
318 mpi_double_precision, mpiroot, mpicomm, mpierr)
319 call mpi_bcast(lut_asyicesw,
size(lut_asyicesw), &
320 mpi_double_precision, mpiroot, mpicomm, mpierr)
322 if (dogp_cldoptics_pade)
then
323 call mpi_bcast(pade_extliqsw,
size(pade_extliqsw), &
324 mpi_double_precision, mpiroot, mpicomm, mpierr)
325 call mpi_bcast(pade_ssaliqsw,
size(pade_ssaliqsw), &
326 mpi_double_precision, mpiroot, mpicomm, mpierr)
327 call mpi_bcast(pade_asyliqsw,
size(pade_asyliqsw), &
328 mpi_double_precision, mpiroot, mpicomm, mpierr)
329 call mpi_bcast(pade_exticesw,
size(pade_exticesw), &
330 mpi_double_precision, mpiroot, mpicomm, mpierr)
331 call mpi_bcast(pade_ssaicesw,
size(pade_ssaicesw), &
332 mpi_double_precision, mpiroot, mpicomm, mpierr)
333 call mpi_bcast(pade_asyicesw,
size(pade_asyicesw), &
334 mpi_double_precision, mpiroot, mpicomm, mpierr)
335 call mpi_bcast(pade_sizereg_extliqsw,
size(pade_sizereg_extliqsw), &
336 mpi_double_precision, mpiroot, mpicomm, mpierr)
337 call mpi_bcast(pade_sizereg_ssaliqsw,
size(pade_sizereg_ssaliqsw), &
338 mpi_double_precision, mpiroot, mpicomm, mpierr)
339 call mpi_bcast(pade_sizereg_asyliqsw,
size(pade_sizereg_asyliqsw), &
340 mpi_double_precision, mpiroot, mpicomm, mpierr)
341 call mpi_bcast(pade_sizereg_exticesw,
size(pade_sizereg_exticesw), &
342 mpi_double_precision, mpiroot, mpicomm, mpierr)
343 call mpi_bcast(pade_sizereg_ssaicesw,
size(pade_sizereg_ssaicesw), &
344 mpi_double_precision, mpiroot, mpicomm, mpierr)
345 call mpi_bcast(pade_sizereg_asyicesw,
size(pade_sizereg_asyicesw), &
346 mpi_double_precision, mpiroot, mpicomm, mpierr)
355 if (dogp_cldoptics_lut)
then
356 call check_error_msg(
'sw_cloud_optics_init',sw_cloud_props%load(band_limscldsw, &
357 radliq_lwrsw, radliq_uprsw, radliq_facsw, radice_lwrsw, radice_uprsw, &
358 radice_facsw, lut_extliqsw, lut_ssaliqsw, lut_asyliqsw, lut_exticesw, &
359 lut_ssaicesw, lut_asyicesw))
362 if (dogp_cldoptics_pade)
then
363 call check_error_msg(
'sw_cloud_optics_init', sw_cloud_props%load(band_limscldsw, &
364 pade_extliqsw, pade_ssaliqsw, pade_asyliqsw, pade_exticesw, pade_ssaicesw, &
365 pade_asyicesw, pade_sizereg_extliqsw, pade_sizereg_ssaliqsw, &
366 pade_sizereg_asyliqsw, pade_sizereg_exticesw, pade_sizereg_ssaicesw, &
367 pade_sizereg_asyicesw))
370 call check_error_msg(
'sw_cloud_optics_init',sw_cloud_props%set_ice_roughness(nrghice_fromfilesw))
373 allocate(b0r(sw_cloud_props%get_nband()),b0s(sw_cloud_props%get_nband()), &
374 b1s(sw_cloud_props%get_nband()),c0r(sw_cloud_props%get_nband()), &
375 c0s(sw_cloud_props%get_nband()))
376 b0r = (/0.496, 0.466, 0.437, 0.416, 0.391, 0.374, 0.352, &
377 0.183, 0.048, 0.012, 0.000, 0.000, 0.000, 0.000/)
378 b0s = (/0.460, 0.460, 0.460, 0.460, 0.460, 0.460, 0.460, &
379 0.460, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000/)
380 b1s = (/0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
381 0.000, 1.62e-5, 1.62e-5, 0.000, 0.000, 0.000, 0.000/)
382 c0r = (/0.980, 0.975, 0.965, 0.960, 0.955, 0.952, 0.950, &
383 0.944, 0.894, 0.884, 0.883, 0.883, 0.883, 0.883/)
384 c0s = (/0.970, 0.970, 0.970, 0.970, 0.970, 0.970, 0.970, &
385 0.970, 0.970, 0.970, 0.700, 0.700, 0.700, 0.700/)