← Back to Documentation Home
CCPP SciDoc v8.0.0  v8.0.0
Common Community Physics Package Developed at DTC
 
Loading...
Searching...
No Matches
rrtmgp_sw_gas_optics.F90
1
3
6module rrtmgp_sw_gas_optics
7 use mo_rte_kind, only: wl, wp
8 use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp
9 use mo_gas_concentrations, only: ty_gas_concs
10 use radiation_tools, only: check_error_msg
11 use netcdf
12 use mpi_f08
13
14 implicit none
15 real(wp),parameter :: &
16 tsi_default = 1360.85767381726, &
17 mg_default = 0.1567652, &
18 sb_default = 902.7126
19
20 ! RRTMGP k-distribution LUTs.
21 type(ty_gas_optics_rrtmgp) :: sw_gas_props
22 integer :: &
23 ntempsSW, npressSW, ngptsSW, nabsorbersSW, nextrabsorbersSW, nminorabsorbersSW, &
24 nmixingfracsSW, nlayersSW, nbndsSW, npairsSW, nminor_absorber_intervals_lowerSW,&
25 nminor_absorber_intervals_upperSW, ncontributors_lowerSW, ncontributors_upperSW
26 integer, dimension(:), allocatable :: &
27 kminor_start_lowersw, & !< Starting index in the [1, nContributors] vector for a contributor
28
29 kminor_start_uppersw
31 integer, dimension(:,:), allocatable :: &
32 band2gptsw, & !< Beginning and ending gpoint for each band
33 minor_limits_gpt_lowersw, & !< Beginning and ending gpoint for each minor interval in lower atmosphere
34 minor_limits_gpt_uppersw
35 integer, dimension(:,:,:), allocatable :: &
36 key_speciessw
37 real(wp) :: &
38 press_ref_tropsw, & !< Reference pressure separating the lower and upper atmosphere [Pa]
39 temp_ref_psw, & !< Standard spectroscopic reference pressure [Pa]
40 temp_ref_tsw, & !< Standard spectroscopic reference temperature [K]
41 tsi_defaultsw, & !<
42 mg_defaultsw, & !< Mean value of Mg2 index over the average solar cycle from the NRLSSI2 model of solar variability
43 sb_defaultsw
44 real(wp), dimension(:), allocatable :: &
45 press_refsw, & !< Pressures for reference atmosphere; press_ref(# reference layers) [Pa]
46 temp_refsw, & !< Temperatures for reference atmosphere; temp_ref(# reference layers) [K]
47 solar_quietsw, & !< Spectrally-dependent quiet sun irradiance from the NRLSSI2 model of solar variability
48 solar_facularsw, & !< Spectrally-dependent facular term from the NRLSSI2 model of solar variability
49 solar_sunspotsw
50 real(wp), dimension(:,:), allocatable :: &
51 band_limssw
52 real(wp), dimension(:,:,:), allocatable :: &
53 vmr_refsw, & !< Volume mixing ratios for reference atmosphere
54 kminor_lowersw, & !< (transformed from [nTemp x nEta x nGpt x nAbsorbers] array to
55
56 kminor_uppersw, &
58 rayl_lowersw, &
59 rayl_uppersw
60 real(wp), dimension(:,:,:,:), allocatable :: &
61 kmajorsw
62 character(len=32), dimension(:), allocatable :: &
63 gas_namessw, & !< Names of absorbing gases
64 gas_minorsw, & !< Name of absorbing minor gas
65 identifier_minorsw, & !< Unique string identifying minor gas
66 minor_gases_lowersw, & !< Names of minor absorbing gases in lower atmosphere
67 minor_gases_uppersw, & !< Names of minor absorbing gases in upper atmosphere
68 scaling_gas_lowersw, & !< Absorption also depends on the concentration of this gas
69 scaling_gas_uppersw
70 logical(wl), dimension(:), allocatable :: &
71 minor_scales_with_density_lowersw, & !< Density scaling is applied to minor absorption coefficients
72 minor_scales_with_density_uppersw, & !< Density scaling is applied to minor absorption coefficients
73 scale_by_complement_lowersw, & !< Absorption is scaled by concentration of scaling_gas (F) or its complement (T)
74 scale_by_complement_uppersw
75contains
76
85 subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, &
86 active_gases_array, mpicomm, mpirank, mpiroot, is_initialized, errmsg, errflg)
87
88 ! Inputs
89 character(len=128),intent(in) :: &
90 rrtmgp_root_dir, & !< RTE-RRTMGP root directory
91 rrtmgp_sw_file_gas
92 character(len=*), dimension(:), intent(in) :: &
93 active_gases_array
94 type(mpi_comm),intent(in) :: &
95 mpicomm
96 integer,intent(in) :: &
97 mpirank, & !< Current MPI rank
98 mpiroot
99
100 ! Outputs
101 logical, intent(inout) :: &
102 is_initialized
103 character(len=*), intent( out) :: &
104 errmsg
105 integer, intent( out) :: &
106 errflg
107
108 ! Local variables
109 integer :: status, ncid, dimid, varID, mpierr, iChar
110 integer,dimension(:),allocatable :: temp1, temp2, temp3, temp4
111 character(len=264) :: sw_gas_props_file
112 type(ty_gas_concs) :: gas_concs ! RRTMGP DDT containing active trace gases
113
114 ! Initialize
115 errmsg = ''
116 errflg = 0
117
118 if (is_initialized) return
119
120 ! Filenames are set in the gfphysics_nml
121 sw_gas_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_sw_file_gas)
122
123 ! #######################################################################################
124 !
125 ! Read dimensions for k-distribution fields...
126 ! (ONLY master processor(0), if MPI enabled)
127 !
128 ! #######################################################################################
129 if (mpirank .eq. mpiroot) then
130 write (*,*) 'Reading RRTMGP shortwave k-distribution metadata ... '
131
132 ! Open file
133 status = nf90_open(trim(sw_gas_props_file), nf90_nowrite, ncid)
134
135 ! Read dimensions for k-distribution fields
136 status = nf90_inq_dimid(ncid, 'temperature', dimid)
137 status = nf90_inquire_dimension(ncid, dimid, len=ntempssw)
138 status = nf90_inq_dimid(ncid, 'pressure', dimid)
139 status = nf90_inquire_dimension(ncid, dimid, len=npresssw)
140 status = nf90_inq_dimid(ncid, 'absorber', dimid)
141 status = nf90_inquire_dimension(ncid, dimid, len=nabsorberssw)
142 status = nf90_inq_dimid(ncid, 'minor_absorber',dimid)
143 status = nf90_inquire_dimension(ncid, dimid, len=nminorabsorberssw)
144 status = nf90_inq_dimid(ncid, 'absorber_ext', dimid)
145 status = nf90_inquire_dimension(ncid, dimid, len=nextrabsorberssw)
146 status = nf90_inq_dimid(ncid, 'mixing_fraction', dimid)
147 status = nf90_inquire_dimension(ncid, dimid, len=nmixingfracssw)
148 status = nf90_inq_dimid(ncid, 'atmos_layer', dimid)
149 status = nf90_inquire_dimension(ncid, dimid, len=nlayerssw)
150 status = nf90_inq_dimid(ncid, 'bnd', dimid)
151 status = nf90_inquire_dimension(ncid, dimid, len=nbndssw)
152 status = nf90_inq_dimid(ncid, 'gpt', dimid)
153 status = nf90_inquire_dimension(ncid, dimid, len=ngptssw)
154 status = nf90_inq_dimid(ncid, 'pair', dimid)
155 status = nf90_inquire_dimension(ncid, dimid, len=npairssw)
156 status = nf90_inq_dimid(ncid, 'contributors_lower',dimid)
157 status = nf90_inquire_dimension(ncid, dimid, len=ncontributors_lowersw)
158 status = nf90_inq_dimid(ncid, 'contributors_upper', dimid)
159 status = nf90_inquire_dimension(ncid, dimid, len=ncontributors_uppersw)
160 status = nf90_inq_dimid(ncid, 'minor_absorber_intervals_lower', dimid)
161 status = nf90_inquire_dimension(ncid, dimid, len=nminor_absorber_intervals_lowersw)
162 status = nf90_inq_dimid(ncid, 'minor_absorber_intervals_upper', dimid)
163 status = nf90_inquire_dimension(ncid, dimid, len=nminor_absorber_intervals_uppersw)
164
165 endif ! On master processor
166
167 ! Other processors waiting...
168 call mpi_barrier(mpicomm, mpierr)
169
170 ! #######################################################################################
171 !
172 ! Broadcast dimensions...
173 ! (ALL processors)
174 !
175 ! #######################################################################################
176 call mpi_bcast(nbndssw, 1, mpi_integer, mpiroot, mpicomm, mpierr)
177 call mpi_bcast(ngptssw, 1, mpi_integer, mpiroot, mpicomm, mpierr)
178 call mpi_bcast(nmixingfracssw, 1, mpi_integer, mpiroot, mpicomm, mpierr)
179 call mpi_bcast(ntempssw, 1, mpi_integer, mpiroot, mpicomm, mpierr)
180 call mpi_bcast(npresssw, 1, mpi_integer, mpiroot, mpicomm, mpierr)
181 call mpi_bcast(nabsorberssw, 1, mpi_integer, mpiroot, mpicomm, mpierr)
182 call mpi_bcast(nextrabsorberssw, 1, mpi_integer, mpiroot, mpicomm, mpierr)
183 call mpi_bcast(nminorabsorberssw, 1, mpi_integer, mpiroot, mpicomm, mpierr)
184 call mpi_bcast(nlayerssw, 1, mpi_integer, mpiroot, mpicomm, mpierr)
185 call mpi_bcast(npairssw, 1, mpi_integer, mpiroot, mpicomm, mpierr)
186 call mpi_bcast(ncontributors_uppersw, 1, mpi_integer, mpiroot, mpicomm, mpierr)
187 call mpi_bcast(ncontributors_lowersw, 1, mpi_integer, mpiroot, mpicomm, mpierr)
188 call mpi_bcast(nminor_absorber_intervals_uppersw, 1, mpi_integer, mpiroot, mpicomm, mpierr)
189 call mpi_bcast(nminor_absorber_intervals_lowersw, 1, mpi_integer, mpiroot, mpicomm, mpierr)
190
191 ! #######################################################################################
192 !
193 ! Allocate space for arrays...
194 ! (ALL processors)
195 !
196 ! #######################################################################################
197 if (.not. allocated(gas_namessw)) &
198 allocate(gas_namessw(nabsorberssw))
199 if (.not. allocated(scaling_gas_lowersw)) &
200 allocate(scaling_gas_lowersw(nminor_absorber_intervals_lowersw))
201 if (.not. allocated(scaling_gas_uppersw)) &
202 allocate(scaling_gas_uppersw(nminor_absorber_intervals_uppersw))
203 if (.not. allocated(gas_minorsw)) &
204 allocate(gas_minorsw(nminorabsorberssw))
205 if (.not. allocated(identifier_minorsw)) &
206 allocate(identifier_minorsw(nminorabsorberssw))
207 if (.not. allocated(minor_gases_lowersw)) &
208 allocate(minor_gases_lowersw(nminor_absorber_intervals_lowersw))
209 if (.not. allocated(minor_gases_uppersw)) &
210 allocate(minor_gases_uppersw(nminor_absorber_intervals_uppersw))
211 if (.not. allocated(minor_limits_gpt_lowersw)) &
212 allocate(minor_limits_gpt_lowersw(npairssw,nminor_absorber_intervals_lowersw))
213 if (.not. allocated(minor_limits_gpt_uppersw)) &
214 allocate(minor_limits_gpt_uppersw(npairssw,nminor_absorber_intervals_uppersw))
215 if (.not. allocated(band2gptsw)) &
216 allocate(band2gptsw(2,nbndssw))
217 if (.not. allocated(key_speciessw)) &
218 allocate(key_speciessw(2,nlayerssw,nbndssw))
219 if (.not. allocated(band_limssw)) &
220 allocate(band_limssw(2,nbndssw))
221 if (.not. allocated(press_refsw)) &
222 allocate(press_refsw(npresssw))
223 if (.not. allocated(temp_refsw)) &
224 allocate(temp_refsw(ntempssw))
225 if (.not. allocated(vmr_refsw)) &
226 allocate(vmr_refsw(nlayerssw, nextrabsorberssw, ntempssw))
227 if (.not. allocated(kminor_lowersw)) &
228 allocate(kminor_lowersw(ncontributors_lowersw, nmixingfracssw, ntempssw))
229 if (.not. allocated(kmajorsw)) &
230 allocate(kmajorsw(ngptssw, nmixingfracssw, npresssw+1, ntempssw))
231 if (.not. allocated(kminor_start_lowersw)) &
232 allocate(kminor_start_lowersw(nminor_absorber_intervals_lowersw))
233 if (.not. allocated(kminor_uppersw)) &
234 allocate(kminor_uppersw(ncontributors_uppersw, nmixingfracssw, ntempssw))
235 if (.not. allocated(kminor_start_uppersw)) &
236 allocate(kminor_start_uppersw(nminor_absorber_intervals_uppersw))
237 if (.not. allocated(minor_scales_with_density_lowersw)) &
238 allocate(minor_scales_with_density_lowersw(nminor_absorber_intervals_lowersw))
239 if (.not. allocated(minor_scales_with_density_uppersw)) &
240 allocate(minor_scales_with_density_uppersw(nminor_absorber_intervals_uppersw))
241 if (.not. allocated(scale_by_complement_lowersw)) &
242 allocate(scale_by_complement_lowersw(nminor_absorber_intervals_lowersw))
243 if (.not. allocated(scale_by_complement_uppersw)) &
244 allocate(scale_by_complement_uppersw(nminor_absorber_intervals_uppersw))
245 if (.not. allocated(rayl_uppersw)) &
246 allocate(rayl_uppersw(ngptssw, nmixingfracssw, ntempssw))
247 if (.not. allocated(rayl_lowersw)) &
248 allocate(rayl_lowersw(ngptssw, nmixingfracssw, ntempssw))
249 if (.not. allocated(solar_quietsw)) &
250 allocate(solar_quietsw(ngptssw))
251 if (.not. allocated(solar_facularsw)) &
252 allocate(solar_facularsw(ngptssw))
253 if (.not. allocated(solar_sunspotsw)) &
254 allocate(solar_sunspotsw(ngptssw))
255 if (.not. allocated(temp1)) &
256 allocate(temp1(nminor_absorber_intervals_lowersw))
257 if (.not. allocated(temp2)) &
258 allocate(temp2(nminor_absorber_intervals_uppersw))
259 if (.not. allocated(temp3)) &
260 allocate(temp3(nminor_absorber_intervals_lowersw))
261 if (.not. allocated(temp4)) &
262 allocate(temp4(nminor_absorber_intervals_uppersw))
263
264 ! #######################################################################################
265 !
266 ! Read in data ...
267 ! (ONLY master processor(0), if MPI enabled)
268 !
269 ! #######################################################################################
270 if (mpirank .eq. mpiroot) then
271 write (*,*) 'Reading RRTMGP shortwave k-distribution data ... '
272 status = nf90_inq_varid(ncid, 'gas_names', varid)
273 status = nf90_get_var( ncid, varid, gas_namessw)
274 status = nf90_inq_varid(ncid, 'scaling_gas_lower', varid)
275 status = nf90_get_var( ncid, varid, scaling_gas_lowersw)
276 status = nf90_inq_varid(ncid, 'scaling_gas_upper', varid)
277 status = nf90_get_var( ncid, varid, scaling_gas_uppersw)
278 status = nf90_inq_varid(ncid, 'gas_minor', varid)
279 status = nf90_get_var( ncid, varid, gas_minorsw)
280 status = nf90_inq_varid(ncid, 'identifier_minor', varid)
281 status = nf90_get_var( ncid, varid, identifier_minorsw)
282 status = nf90_inq_varid(ncid, 'minor_gases_lower', varid)
283 status = nf90_get_var( ncid, varid, minor_gases_lowersw)
284 status = nf90_inq_varid(ncid, 'minor_gases_upper', varid)
285 status = nf90_get_var( ncid, varid, minor_gases_uppersw)
286 status = nf90_inq_varid(ncid, 'minor_limits_gpt_lower', varid)
287 status = nf90_get_var( ncid, varid, minor_limits_gpt_lowersw)
288 status = nf90_inq_varid(ncid, 'minor_limits_gpt_upper', varid)
289 status = nf90_get_var( ncid, varid, minor_limits_gpt_uppersw)
290 status = nf90_inq_varid(ncid, 'bnd_limits_gpt', varid)
291 status = nf90_get_var( ncid, varid, band2gptsw)
292 status = nf90_inq_varid(ncid, 'key_species', varid)
293 status = nf90_get_var( ncid, varid, key_speciessw)
294 status = nf90_inq_varid(ncid,'bnd_limits_wavenumber', varid)
295 status = nf90_get_var( ncid, varid, band_limssw)
296 status = nf90_inq_varid(ncid, 'press_ref', varid)
297 status = nf90_get_var( ncid, varid, press_refsw)
298 status = nf90_inq_varid(ncid, 'temp_ref', varid)
299 status = nf90_get_var( ncid, varid, temp_refsw)
300 status = nf90_inq_varid(ncid, 'absorption_coefficient_ref_P', varid)
301 status = nf90_get_var( ncid, varid, temp_ref_psw)
302 status = nf90_inq_varid(ncid, 'absorption_coefficient_ref_T', varid)
303 status = nf90_get_var( ncid, varid, temp_ref_tsw)
304 status = nf90_inq_varid(ncid, 'tsi_default', varid)
305 if (status .eq. 0) then
306 status = nf90_get_var( ncid, varid, tsi_defaultsw)
307 else
308 tsi_defaultsw = tsi_default
309 endif
310 status = nf90_inq_varid(ncid, 'mg_default', varid)
311 if (status .eq. 0) then
312 status = nf90_get_var( ncid, varid, mg_defaultsw)
313 else
314 mg_defaultsw = mg_default
315 endif
316 status = nf90_inq_varid(ncid, 'sb_default', varid)
317 if (status .eq. 0) then
318 status = nf90_get_var( ncid, varid, sb_defaultsw)
319 else
320 sb_defaultsw = sb_default
321 endif
322 status = nf90_inq_varid(ncid, 'press_ref_trop', varid)
323 status = nf90_get_var( ncid, varid, press_ref_tropsw)
324 status = nf90_inq_varid(ncid, 'kminor_lower', varid)
325 status = nf90_get_var( ncid, varid, kminor_lowersw)
326 status = nf90_inq_varid(ncid, 'kminor_upper', varid)
327 status = nf90_get_var( ncid, varid, kminor_uppersw)
328 status = nf90_inq_varid(ncid, 'vmr_ref', varid)
329 status = nf90_get_var( ncid, varid, vmr_refsw)
330 status = nf90_inq_varid(ncid, 'kmajor', varid)
331 status = nf90_get_var( ncid, varid, kmajorsw)
332 status = nf90_inq_varid(ncid, 'kminor_start_lower', varid)
333 status = nf90_get_var( ncid, varid, kminor_start_lowersw)
334 status = nf90_inq_varid(ncid, 'kminor_start_upper', varid)
335 status = nf90_get_var( ncid, varid, kminor_start_uppersw)
336 status = nf90_inq_varid(ncid, 'solar_source_quiet', varid)
337 status = nf90_get_var( ncid, varid, solar_quietsw)
338 status = nf90_inq_varid(ncid, 'solar_source_facular', varid)
339 status = nf90_get_var( ncid, varid, solar_facularsw)
340 status = nf90_inq_varid(ncid, 'solar_source_sunspot', varid)
341 status = nf90_get_var( ncid, varid, solar_sunspotsw)
342 status = nf90_inq_varid(ncid, 'rayl_lower', varid)
343 status = nf90_get_var( ncid, varid, rayl_lowersw)
344 status = nf90_inq_varid(ncid, 'rayl_upper', varid)
345 status = nf90_get_var( ncid, varid, rayl_uppersw)
346
347 ! Logical fields are read in as integers and then converted to logicals.
348 status = nf90_inq_varid(ncid,'minor_scales_with_density_lower', varid)
349 status = nf90_get_var( ncid, varid,temp1)
350 minor_scales_with_density_lowersw(:) = .false.
351 where(temp1 .eq. 1) minor_scales_with_density_lowersw(:) = .true.
352 status = nf90_inq_varid(ncid,'minor_scales_with_density_upper', varid)
353 status = nf90_get_var( ncid, varid,temp2)
354 minor_scales_with_density_uppersw(:) = .false.
355 where(temp2 .eq. 1) minor_scales_with_density_uppersw(:) = .true.
356 status = nf90_inq_varid(ncid,'scale_by_complement_lower', varid)
357 status = nf90_get_var( ncid, varid,temp3)
358 scale_by_complement_lowersw(:) = .false.
359 where(temp3 .eq. 1) scale_by_complement_lowersw(:) = .true.
360 status = nf90_inq_varid(ncid,'scale_by_complement_upper', varid)
361 status = nf90_get_var( ncid, varid,temp4)
362 scale_by_complement_uppersw(:) = .false.
363 where(temp4 .eq. 1) scale_by_complement_uppersw(:) = .true.
364
365 ! Close
366 status = nf90_close(ncid)
367 endif ! Master process
368
369 ! Other processors waiting...
370 call mpi_barrier(mpicomm, mpierr)
371
372 ! #######################################################################################
373 !
374 ! Broadcast data...
375 ! (ALL processors)
376 !
377 ! #######################################################################################
378
379 ! Real scalars
380#ifdef RTE_USE_SP
381 call mpi_bcast(press_ref_tropsw, 1, mpi_real, mpiroot, mpicomm, mpierr)
382 call mpi_bcast(temp_ref_psw, 1, mpi_real, mpiroot, mpicomm, mpierr)
383 call mpi_bcast(temp_ref_tsw, 1, mpi_real, mpiroot, mpicomm, mpierr)
384 call mpi_bcast(tsi_defaultsw, 1, mpi_real, mpiroot, mpicomm, mpierr)
385 call mpi_bcast(mg_defaultsw, 1, mpi_real, mpiroot, mpicomm, mpierr)
386 call mpi_bcast(sb_defaultsw, 1, mpi_real, mpiroot, mpicomm, mpierr)
387#else
388 call mpi_bcast(press_ref_tropsw, 1, mpi_double_precision, mpiroot, mpicomm, mpierr)
389 call mpi_bcast(temp_ref_psw, 1, mpi_double_precision, mpiroot, mpicomm, mpierr)
390 call mpi_bcast(temp_ref_tsw, 1, mpi_double_precision, mpiroot, mpicomm, mpierr)
391 call mpi_bcast(tsi_defaultsw, 1, mpi_double_precision, mpiroot, mpicomm, mpierr)
392 call mpi_bcast(mg_defaultsw, 1, mpi_double_precision, mpiroot, mpicomm, mpierr)
393 call mpi_bcast(sb_defaultsw, 1, mpi_double_precision, mpiroot, mpicomm, mpierr)
394#endif
395
396 ! Integer arrays
397 call mpi_bcast(kminor_start_lowersw, &
398 size(kminor_start_lowersw), mpi_integer, mpiroot, mpicomm, mpierr)
399 call mpi_bcast(kminor_start_uppersw, &
400 size(kminor_start_uppersw), mpi_integer, mpiroot, mpicomm, mpierr)
401 call mpi_bcast(band2gptsw, &
402 size(band2gptsw), mpi_integer, mpiroot, mpicomm, mpierr)
403 call mpi_bcast(minor_limits_gpt_lowersw, &
404 size(minor_limits_gpt_lowersw), mpi_integer, mpiroot, mpicomm, mpierr)
405 call mpi_bcast(minor_limits_gpt_uppersw, &
406 size(minor_limits_gpt_uppersw), mpi_integer, mpiroot, mpicomm, mpierr)
407 call mpi_bcast(key_speciessw, &
408 size(key_speciessw), mpi_integer, mpiroot, mpicomm, mpierr)
409
410 ! Real arrays
411#ifdef RTE_USE_SP
412 call mpi_bcast(press_refsw, &
413 size(press_refsw), mpi_real, mpiroot, mpicomm, mpierr)
414 call mpi_bcast(temp_refsw, &
415 size(temp_refsw), mpi_real, mpiroot, mpicomm, mpierr)
416 call mpi_bcast(solar_quietsw, &
417 size(solar_quietsw), mpi_real, mpiroot, mpicomm, mpierr)
418 call mpi_bcast(solar_facularsw, &
419 size(solar_facularsw), mpi_real, mpiroot, mpicomm, mpierr)
420 call mpi_bcast(solar_sunspotsw, &
421 size(solar_sunspotsw), mpi_real, mpiroot, mpicomm, mpierr)
422 call mpi_bcast(band_limssw, &
423 size(band_limssw), mpi_real, mpiroot, mpicomm, mpierr)
424 call mpi_bcast(vmr_refsw, &
425 size(vmr_refsw), mpi_real, mpiroot, mpicomm, mpierr)
426 call mpi_bcast(kminor_lowersw, &
427 size(kminor_lowersw), mpi_real, mpiroot, mpicomm, mpierr)
428 call mpi_bcast(kminor_uppersw, &
429 size(kminor_uppersw), mpi_real, mpiroot, mpicomm, mpierr)
430 call mpi_bcast(rayl_lowersw, &
431 size(rayl_lowersw), mpi_real, mpiroot, mpicomm, mpierr)
432 call mpi_bcast(rayl_uppersw, &
433 size(rayl_uppersw), mpi_real, mpiroot, mpicomm, mpierr)
434 call mpi_bcast(kmajorsw, &
435 size(kmajorsw), mpi_real, mpiroot, mpicomm, mpierr)
436#else
437 call mpi_bcast(press_refsw, &
438 size(press_refsw), mpi_double_precision, mpiroot, mpicomm, mpierr)
439 call mpi_bcast(temp_refsw, &
440 size(temp_refsw), mpi_double_precision, mpiroot, mpicomm, mpierr)
441 call mpi_bcast(solar_quietsw, &
442 size(solar_quietsw), mpi_double_precision, mpiroot, mpicomm, mpierr)
443 call mpi_bcast(solar_facularsw, &
444 size(solar_facularsw), mpi_double_precision, mpiroot, mpicomm, mpierr)
445 call mpi_bcast(solar_sunspotsw, &
446 size(solar_sunspotsw), mpi_double_precision, mpiroot, mpicomm, mpierr)
447 call mpi_bcast(band_limssw, &
448 size(band_limssw), mpi_double_precision, mpiroot, mpicomm, mpierr)
449 call mpi_bcast(vmr_refsw, &
450 size(vmr_refsw), mpi_double_precision, mpiroot, mpicomm, mpierr)
451 call mpi_bcast(kminor_lowersw, &
452 size(kminor_lowersw), mpi_double_precision, mpiroot, mpicomm, mpierr)
453 call mpi_bcast(kminor_uppersw, &
454 size(kminor_uppersw), mpi_double_precision, mpiroot, mpicomm, mpierr)
455 call mpi_bcast(rayl_lowersw, &
456 size(rayl_lowersw), mpi_double_precision, mpiroot, mpicomm, mpierr)
457 call mpi_bcast(rayl_uppersw, &
458 size(rayl_uppersw), mpi_double_precision, mpiroot, mpicomm, mpierr)
459 call mpi_bcast(kmajorsw, &
460 size(kmajorsw), mpi_double_precision, mpiroot, mpicomm, mpierr)
461#endif
462 ! Characters
463 do ichar=1,nabsorberssw
464 call mpi_bcast(gas_namessw(ichar), &
465 len(gas_namessw(ichar)), mpi_character, mpiroot, mpicomm, mpierr)
466 enddo
467 do ichar=1,nminorabsorberssw
468 call mpi_bcast(gas_minorsw(ichar), &
469 len(gas_minorsw(ichar)), mpi_character, mpiroot, mpicomm, mpierr)
470 call mpi_bcast(identifier_minorsw(ichar), &
471 len(identifier_minorsw(ichar)), mpi_character, mpiroot, mpicomm, mpierr)
472 enddo
473 do ichar=1,nminor_absorber_intervals_lowersw
474 call mpi_bcast(minor_gases_lowersw(ichar), &
475 len(minor_gases_lowersw(ichar)), mpi_character, mpiroot, mpicomm, mpierr)
476 call mpi_bcast(scaling_gas_lowersw(ichar), &
477 len(scaling_gas_lowersw(ichar)), mpi_character, mpiroot, mpicomm, mpierr)
478 enddo
479
480 do ichar=1,nminor_absorber_intervals_uppersw
481 call mpi_bcast(minor_gases_uppersw(ichar), &
482 len(minor_gases_uppersw(ichar)), mpi_character, mpiroot, mpicomm, mpierr)
483 call mpi_bcast(scaling_gas_uppersw(ichar), &
484 len(scaling_gas_uppersw(ichar)), mpi_character, mpiroot, mpicomm, mpierr)
485 enddo
486
487 ! Logicals
488 call mpi_bcast(minor_scales_with_density_lowersw, &
489 size(minor_scales_with_density_lowersw), mpi_logical, mpiroot, mpicomm, mpierr)
490 call mpi_bcast(minor_scales_with_density_uppersw, &
491 size(minor_scales_with_density_uppersw), mpi_logical, mpiroot, mpicomm, mpierr)
492 call mpi_bcast(scale_by_complement_lowersw, &
493 size(scale_by_complement_lowersw), mpi_logical, mpiroot, mpicomm, mpierr)
494 call mpi_bcast(scale_by_complement_uppersw, &
495 size(scale_by_complement_uppersw), mpi_logical, mpiroot, mpicomm, mpierr)
496
497 call mpi_barrier(mpicomm, mpierr)
498
499 ! #######################################################################################
500 !
501 ! Initialize RRTMGP DDT's...
502 !
503 ! #######################################################################################
504 call check_error_msg('rrtmgp_sw_gas_optics_init_gas_concs',gas_concs%init(active_gases_array))
505 call check_error_msg('rrtmgp_sw_gas_optics_init_load',sw_gas_props%load(gas_concs, &
506 gas_namessw, key_speciessw, band2gptsw, band_limssw, press_refsw, press_ref_tropsw,&
507 temp_refsw, temp_ref_psw, temp_ref_tsw, vmr_refsw, kmajorsw, kminor_lowersw, &
508 kminor_uppersw, gas_minorsw, identifier_minorsw, minor_gases_lowersw, &
509 minor_gases_uppersw, minor_limits_gpt_lowersw, minor_limits_gpt_uppersw, &
510 minor_scales_with_density_lowersw, minor_scales_with_density_uppersw, &
511 scaling_gas_lowersw, scaling_gas_uppersw, scale_by_complement_lowersw, &
512 scale_by_complement_uppersw, kminor_start_lowersw, kminor_start_uppersw, &
513 solar_quietsw, solar_facularsw, solar_sunspotsw, tsi_defaultsw, mg_defaultsw, &
514 sb_defaultsw, rayl_lowersw, rayl_uppersw))
515
516 is_initialized = .true.
517
518 end subroutine rrtmgp_sw_gas_optics_init
519end module rrtmgp_sw_gas_optics
520
radiation_tools
This module contains tools for radiation.
Definition radiation_tools.F90:5
rrtmgp_sw_gas_optics
This module contains a routine to initialize the k-distribution data used by the RRTMGP shortwave rad...
Definition rrtmgp_sw_gas_optics.F90:6