26 subroutine gfs_ccpp_suite_sim_pre_run(do_ccpp_suite_sim, dtend, ntqv, dtidx, dtp, &
27 index_of_process_dcnv, index_of_process_longwave, index_of_process_shortwave, &
28 index_of_process_scnv, index_of_process_orographic_gwd, index_of_process_pbl, &
29 index_of_process_mp, index_of_temperature, index_of_x_wind, index_of_y_wind, &
30 physics_process, iactive_T, iactive_u, iactive_v, iactive_q, active_phys_tend, &
34 logical,
intent(in) :: do_ccpp_suite_sim
35 integer,
intent(in) :: ntqv, index_of_process_dcnv, index_of_process_longwave, &
36 index_of_process_shortwave, index_of_process_scnv, &
37 index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, &
38 index_of_temperature, index_of_x_wind, index_of_y_wind
39 integer,
intent(in),
dimension(:,:) :: dtidx
40 real(kind_phys),
intent(in) :: dtp
41 real(kind_phys),
intent(in),
dimension(:,:,:),
optional :: dtend
43 integer,
intent(in) :: iactive_t, iactive_u, iactive_v, iactive_q
46 real(kind_phys),
intent(out) :: active_phys_tend(:,:,:)
47 character(len=*),
intent(out) :: errmsg
48 integer,
intent(out) :: errflg
51 integer :: idtend, iactive
57 if (.not. do_ccpp_suite_sim)
return
76 if (physics_process(1)%active_name ==
"LWRAD") iactive = index_of_process_longwave
77 if (physics_process(1)%active_name ==
"SWRAD") iactive = index_of_process_shortwave
78 if (physics_process(1)%active_name ==
"PBL") iactive = index_of_process_pbl
79 if (physics_process(1)%active_name ==
"GWD") iactive = index_of_process_orographic_gwd
80 if (physics_process(1)%active_name ==
"SCNV") iactive = index_of_process_scnv
81 if (physics_process(1)%active_name ==
"DCNV") iactive = index_of_process_dcnv
82 if (physics_process(1)%active_name ==
"cldMP") iactive = index_of_process_mp
85 idtend = dtidx(index_of_temperature,iactive)
87 active_phys_tend(:,:,iactive_t) = dtend(:,:,idtend)/dtp
91 idtend = dtidx(index_of_x_wind,iactive)
93 active_phys_tend(:,:,iactive_u) = dtend(:,:,idtend)/dtp
97 idtend = dtidx(index_of_y_wind,iactive)
99 active_phys_tend(:,:,iactive_v) = dtend(:,:,idtend)/dtp
103 idtend = dtidx(100+ntqv,iactive)
104 if (idtend >= 1)
then
105 active_phys_tend(:,:,iactive_q) = dtend(:,:,idtend)/dtp
112 subroutine load_ccpp_suite_sim(nlunit, nml_file, physics_process, iactive_T, &
113 iactive_u, iactive_v, iactive_q, errmsg, errflg)
116 integer,
intent (in) :: nlunit
117 character(len=*),
intent (in) :: nml_file
121 integer,
intent(inout) :: iactive_t, iactive_u, iactive_v, iactive_q
122 integer,
intent(out) :: errflg
123 character(len=256),
intent(out) :: errmsg
126 integer :: ncid, dimid, varid, status, ios, iprc, nlev_data, ntime_data
127 character(len=256) :: suite_sim_file
128 logical :: exists, do_ccpp_suite_sim
134 integer,
dimension(3) :: &
135 prc_lwrad_cfg = (/0,0,0/), &
136 prc_swrad_cfg = (/0,0,0/), &
137 prc_pbl_cfg = (/0,0,0/), &
138 prc_gwd_cfg = (/0,0,0/), &
139 prc_scnv_cfg = (/0,0,0/), &
140 prc_dcnv_cfg = (/0,0,0/), &
141 prc_cldmp_cfg = (/0,0,0/)
144 namelist / ccpp_suite_sim_nml / do_ccpp_suite_sim, suite_sim_file, nprc_sim, &
145 prc_lwrad_cfg, prc_swrad_cfg, prc_pbl_cfg, prc_gwd_cfg, prc_scnv_cfg, &
146 prc_dcnv_cfg, prc_cldmp_cfg
152 inquire (file = trim(nml_file), exist = exists)
153 if (.not. exists)
then
154 errmsg =
'CCPP suite simulator namelist file: '//trim(nml_file)//
' does not exist.'
158 open (unit = nlunit, file = nml_file, action =
'read', status =
'old', iostat = ios)
161 read (nlunit, nml = ccpp_suite_sim_nml, iostat=status)
165 if (prc_swrad_cfg(1) == 1 .or. prc_lwrad_cfg(1) == 1 .or. prc_pbl_cfg(1) == 1 .or. &
166 prc_gwd_cfg(1) == 1 .or. prc_scnv_cfg(1) == 1 .or. prc_dcnv_cfg(1) == 1 .or. &
167 prc_cldmp_cfg(1) == 1 )
then
173 inquire (file = trim(suite_sim_file), exist = exists)
174 if (.not. exists)
then
175 errmsg =
'CCPP suite simulator file: '//trim(suite_sim_file)//
' does not exist'
185 status = nf90_open(trim(suite_sim_file), nf90_nowrite, ncid)
186 if (status /= nf90_noerr)
then
187 errmsg =
'Error reading in CCPP suite simulator file: '//trim(suite_sim_file)
193 status = nf90_inq_dimid(ncid,
'time', dimid)
194 if (status == nf90_noerr)
then
195 status = nf90_inquire_dimension(ncid, dimid, len = ntime_data)
197 errmsg =
'CCPP suite simulator file: '//trim(suite_sim_file)//
' does not contain [time] dimension'
202 status = nf90_inq_dimid(ncid,
'lev', dimid)
203 if (status == nf90_noerr)
then
204 status = nf90_inquire_dimension(ncid, dimid, len = nlev_data)
206 errmsg =
'CCPP suite simulator file: '//trim(suite_sim_file)//
' does not contain [lev] dimension'
212 allocate(physics_process(nprc_sim))
213 physics_process(1)%active_name =
''
214 physics_process(1)%iactive_scheme = 0
215 physics_process(1)%active_tsp = .false.
217 allocate(physics_process(iprc)%tend1d%T( nlev_data ))
218 allocate(physics_process(iprc)%tend1d%u( nlev_data ))
219 allocate(physics_process(iprc)%tend1d%v( nlev_data ))
220 allocate(physics_process(iprc)%tend1d%q( nlev_data ))
221 allocate(physics_process(iprc)%tend2d%time( ntime_data))
222 allocate(physics_process(iprc)%tend2d%T( nlev_data, ntime_data))
223 allocate(physics_process(iprc)%tend2d%u( nlev_data, ntime_data))
224 allocate(physics_process(iprc)%tend2d%v( nlev_data, ntime_data))
225 allocate(physics_process(iprc)%tend2d%q( nlev_data, ntime_data))
228 status = nf90_inq_varid(ncid,
'times', varid)
229 if (status == nf90_noerr)
then
230 status = nf90_get_var( ncid, varid, physics_process(iprc)%tend2d%time)
232 errmsg =
'SCM data tendency file: '//trim(suite_sim_file)//
' does not contain times variable'
237 if (iprc == prc_swrad_cfg(3))
then
239 physics_process(iprc)%order = iprc
240 physics_process(iprc)%name =
"SWRAD"
241 if (prc_swrad_cfg(1) == 1)
then
242 physics_process(iprc)%use_sim = .true.
244 physics_process(1)%nprg_active = 1
247 if (prc_swrad_cfg(2) == 1)
then
248 physics_process(iprc)%time_split = .true.
252 status = nf90_inq_varid(ncid,
'dT_dt_swrad', varid)
253 if (status == nf90_noerr) status = nf90_get_var( ncid, varid, physics_process(iprc)%tend2d%T)
256 if (iprc == prc_lwrad_cfg(3))
then
258 physics_process(iprc)%order = iprc
259 physics_process(iprc)%name =
"LWRAD"
260 if (prc_lwrad_cfg(1) == 1)
then
261 physics_process(iprc)%use_sim = .true.
263 physics_process(1)%nprg_active = 1
266 if (prc_lwrad_cfg(2) == 1)
then
267 physics_process(iprc)%time_split = .true.
271 status = nf90_inq_varid(ncid,
'dT_dt_lwrad', varid)
272 if (status == nf90_noerr) status = nf90_get_var( ncid, varid, physics_process(iprc)%tend2d%T)
275 if (iprc == prc_gwd_cfg(3))
then
277 physics_process(iprc)%order = iprc
278 physics_process(iprc)%name =
"GWD"
279 if (prc_gwd_cfg(1) == 1)
then
280 physics_process(iprc)%use_sim = .true.
282 physics_process(1)%nprg_active = 3
287 if (prc_gwd_cfg(2) == 1)
then
288 physics_process(iprc)%time_split = .true.
292 status = nf90_inq_varid(ncid,
'dT_dt_cgwd', varid)
293 if (status == nf90_noerr) status = nf90_get_var( ncid, varid, physics_process(iprc)%tend2d%T)
294 status = nf90_inq_varid(ncid,
'du_dt_cgwd', varid)
295 if (status == nf90_noerr) status = nf90_get_var( ncid, varid, physics_process(iprc)%tend2d%u)
296 status = nf90_inq_varid(ncid,
'dv_dt_cgwd', varid)
297 if (status == nf90_noerr) status = nf90_get_var( ncid, varid, physics_process(iprc)%tend2d%v)
300 if (iprc == prc_pbl_cfg(3))
then
302 physics_process(iprc)%order = iprc
303 physics_process(iprc)%name =
"PBL"
304 if (prc_pbl_cfg(1) == 1)
then
305 physics_process(iprc)%use_sim = .true.
307 physics_process(1)%nprg_active = 4
313 if (prc_pbl_cfg(2) == 1)
then
314 physics_process(iprc)%time_split = .true.
318 status = nf90_inq_varid(ncid,
'dT_dt_pbl', varid)
319 if (status == nf90_noerr) status = nf90_get_var( ncid, varid, physics_process(iprc)%tend2d%T)
320 status = nf90_inq_varid(ncid,
'dq_dt_pbl', varid)
321 if (status == nf90_noerr) status = nf90_get_var( ncid, varid, physics_process(iprc)%tend2d%q)
322 status = nf90_inq_varid(ncid,
'du_dt_pbl', varid)
323 if (status == nf90_noerr) status = nf90_get_var( ncid, varid, physics_process(iprc)%tend2d%u)
324 status = nf90_inq_varid(ncid,
'dv_dt_pbl', varid)
325 if (status == nf90_noerr) status = nf90_get_var( ncid, varid, physics_process(iprc)%tend2d%v)
328 if (iprc == prc_scnv_cfg(3))
then
330 physics_process(iprc)%order = iprc
331 physics_process(iprc)%name =
"SCNV"
332 if (prc_scnv_cfg(1) == 1)
then
333 physics_process(iprc)%use_sim = .true.
335 physics_process(1)%nprg_active = 4
341 if (prc_scnv_cfg(2) == 1)
then
342 physics_process(iprc)%time_split = .true.
346 status = nf90_inq_varid(ncid,
'dT_dt_shalconv', varid)
347 if (status == nf90_noerr) status = nf90_get_var( ncid, varid, physics_process(iprc)%tend2d%T)
348 status = nf90_inq_varid(ncid,
'du_dt_shalconv', varid)
349 if (status == nf90_noerr) status = nf90_get_var( ncid, varid, physics_process(iprc)%tend2d%u)
350 status = nf90_inq_varid(ncid,
'dv_dt_shalconv', varid)
351 if (status == nf90_noerr) status = nf90_get_var( ncid, varid, physics_process(iprc)%tend2d%v)
352 status = nf90_inq_varid(ncid,
'dq_dt_shalconv', varid)
353 if (status == nf90_noerr) status = nf90_get_var( ncid, varid, physics_process(iprc)%tend2d%q)
356 if (iprc == prc_dcnv_cfg(3))
then
358 physics_process(iprc)%order = iprc
359 physics_process(iprc)%name =
"DCNV"
360 if (prc_dcnv_cfg(1) == 1)
then
361 physics_process(iprc)%use_sim = .true.
363 physics_process(1)%nprg_active = 4
369 if (prc_dcnv_cfg(2) == 1)
then
370 physics_process(iprc)%time_split = .true.
373 status = nf90_inq_varid(ncid,
'dT_dt_deepconv', varid)
374 if (status == nf90_noerr) status = nf90_get_var( ncid, varid, physics_process(iprc)%tend2d%T)
375 status = nf90_inq_varid(ncid,
'du_dt_deepconv', varid)
376 if (status == nf90_noerr) status = nf90_get_var( ncid, varid, physics_process(iprc)%tend2d%u)
377 status = nf90_inq_varid(ncid,
'dv_dt_deepconv', varid)
378 if (status == nf90_noerr) status = nf90_get_var( ncid, varid, physics_process(iprc)%tend2d%v)
379 status = nf90_inq_varid(ncid,
'dq_dt_deepconv', varid)
380 if (status == nf90_noerr) status = nf90_get_var( ncid, varid, physics_process(iprc)%tend2d%q)
383 if (iprc == prc_cldmp_cfg(3))
then
385 physics_process(iprc)%order = iprc
386 physics_process(iprc)%name =
"cldMP"
387 if (prc_cldmp_cfg(1) == 1)
then
388 physics_process(iprc)%use_sim = .true.
390 physics_process(1)%nprg_active = 2
394 if (prc_cldmp_cfg(2) == 1)
then
395 physics_process(iprc)%time_split = .true.
399 status = nf90_inq_varid(ncid,
'dT_dt_micro', varid)
400 if (status == nf90_noerr) status = nf90_get_var( ncid, varid, physics_process(iprc)%tend2d%T)
401 status = nf90_inq_varid(ncid,
'dq_dt_micro', varid)
402 if (status == nf90_noerr) status = nf90_get_var( ncid, varid, physics_process(iprc)%tend2d%q)
406 if (.not. physics_process(iprc)%use_sim)
then
407 physics_process(1)%iactive_scheme = iprc
408 physics_process(1)%active_name = physics_process(iprc)%name
409 if (physics_process(iprc)%time_split)
then
410 physics_process(1)%active_tsp = .true.
416 if (physics_process(1)%iactive_scheme == 0)
then
418 errmsg =
"ERROR: No active suite set for CCPP suite simulator"
422 print*,
"-----------------------------------"
423 print*,
"--- Using CCPP suite simulator ---"
424 print*,
"-----------------------------------"
426 if (physics_process(iprc)%use_sim)
then
427 print*,
" simulate_suite: ", trim(physics_process(iprc)%name)
428 print*,
" order: ", physics_process(iprc)%order
429 print*,
" time_split: ", physics_process(iprc)%time_split
431 print*,
" active_suite: ", trim(physics_process(1)%active_name)
432 print*,
" order: ", physics_process(physics_process(1)%iactive_scheme)%order
433 print*,
" time_split : ", physics_process(1)%active_tsp
436 print*,
"-----------------------------------"
437 print*,
"-----------------------------------"