35 subroutine ccpp_suite_simulator_run(do_ccpp_suite_sim, kdt, nCol, nLay, dtp, jdat, &
36 iactive_T, iactive_u, iactive_v, iactive_q, proc_start, proc_end, physics_process,&
37 in_pre_active, in_post_active, tgrs, ugrs, vgrs, qgrs, active_phys_tend, gt0, gu0,&
38 gv0, gq0, errmsg, errflg)
41 logical,
intent(in) :: do_ccpp_suite_sim
42 integer,
intent(in) :: kdt, ncol, nlay, jdat(8), iactive_t, iactive_u, &
44 real(kind_phys),
intent(in) :: dtp, tgrs(:,:), ugrs(:,:), vgrs(:,:), qgrs(:,:,:), &
45 active_phys_tend(:,:,:)
48 real(kind_phys),
intent(inout) :: gt0(:,:), gu0(:,:), gv0(:,:), gq0(:,:)
49 character(len=*),
intent(out) :: errmsg
50 integer,
intent(out) :: errflg
51 integer,
intent(inout) :: proc_start, proc_end
52 logical,
intent(inout) :: in_pre_active, in_post_active
55 integer :: icol, year, month, day, hour, min, sec, iprc
56 real(kind_phys),
dimension(nCol,nLay) :: gt1, gu1, gv1, dtdt, dudt, dvdt, gq1, dqdt
62 if (.not. do_ccpp_suite_sim)
return
76 gq1(:,:) = qgrs(:,:,1)
85 if (in_pre_active)
then
87 proc_end = max(1,physics_process(1)%iactive_scheme-1)
89 if (in_post_active)
then
90 proc_start = physics_process(1)%iactive_scheme
91 proc_end =
size(physics_process)
97 do iprc = proc_start,proc_end
101 physics_process(iprc)%tend1d%T(:) = 0.
102 physics_process(iprc)%tend1d%u(:) = 0.
103 physics_process(iprc)%tend1d%v(:) = 0.
104 physics_process(iprc)%tend1d%q(:) = 0.
115 if (physics_process(iprc)%use_sim)
then
116 if (physics_process(iprc)%name ==
"LWRAD")
then
117 call sim_lwrad(year, month, day, hour, min, sec, physics_process(iprc))
119 if (physics_process(iprc)%name ==
"SWRAD")
then
120 call sim_swrad(year, month, day, hour, min, sec, physics_process(iprc))
122 if (physics_process(iprc)%name ==
"GWD")
then
123 call sim_gwd(year, month, day, hour, min, sec, physics_process(iprc))
125 if (physics_process(iprc)%name ==
"PBL")
then
126 call sim_pbl(year, month, day, hour, min, sec, physics_process(iprc))
128 if (physics_process(iprc)%name ==
"SCNV")
then
129 call sim_scnv(year, month, day, hour, min, sec, physics_process(iprc))
131 if (physics_process(iprc)%name ==
"DCNV")
then
132 call sim_dcnv(year, month, day, hour, min, sec, physics_process(iprc))
134 if (physics_process(iprc)%name ==
"cldMP")
then
135 call sim_cldmp(year, month, day, hour, min, sec, physics_process(iprc))
140 if (iactive_t > 0) physics_process(iprc)%tend1d%T = active_phys_tend(icol,:,iactive_t)
141 if (iactive_u > 0) physics_process(iprc)%tend1d%u = active_phys_tend(icol,:,iactive_u)
142 if (iactive_v > 0) physics_process(iprc)%tend1d%v = active_phys_tend(icol,:,iactive_v)
143 if (iactive_q > 0) physics_process(iprc)%tend1d%q = active_phys_tend(icol,:,iactive_q)
147 if (physics_process(iprc)%time_split)
then
148 gt1(icol,:) = gt1(icol,:) + (dtdt(icol,:) + physics_process(iprc)%tend1d%T)*dtp
149 gu1(icol,:) = gu1(icol,:) + (dudt(icol,:) + physics_process(iprc)%tend1d%u)*dtp
150 gv1(icol,:) = gv1(icol,:) + (dvdt(icol,:) + physics_process(iprc)%tend1d%v)*dtp
151 gq1(icol,:) = gq1(icol,:) + (dqdt(icol,:) + physics_process(iprc)%tend1d%q)*dtp
158 dtdt(icol,:) = dtdt(icol,:) + physics_process(iprc)%tend1d%T
159 dudt(icol,:) = dudt(icol,:) + physics_process(iprc)%tend1d%u
160 dvdt(icol,:) = dvdt(icol,:) + physics_process(iprc)%tend1d%v
161 dqdt(icol,:) = dqdt(icol,:) + physics_process(iprc)%tend1d%q
166 if (physics_process(iprc)%use_sim)
then
167 if (physics_process(iprc)%time_split)
then
168 write(*,
'(a25,i2,a4,i2,a5,a10,a35)')
'CCPP suite simulator: ',iprc,
' of ',proc_end,
' ',physics_process(iprc)%name,
'time split scheme (simulated)'
170 write(*,
'(a25,i2,a4,i2,a5,a10,a35)')
'CCPP suite simulator: ',iprc,
' of ',proc_end,
' ',physics_process(iprc)%name,
'process split scheme (simulated)'
173 if (physics_process(iprc)%time_split)
then
174 write(*,
'(a25,i2,a4,i2,a5,a10,a35)')
'CCPP suite simulator: ',iprc,
' of ',proc_end,
' ',physics_process(iprc)%name,
'time split scheme (active)'
176 write(*,
'(a25,i2,a4,i2,a5,a10,a35)')
'CCPP suite simulator: ',iprc,
' of ',proc_end,
' ',physics_process(iprc)%name,
'process split scheme (active)'
178 write(*,
'(a25,i2)')
' # prog. vars.: ',physics_process(1)%nprg_active
186 iprc = minval([iprc,proc_end])
187 if (.not. physics_process(iprc)%time_split)
then
189 gt0(icol,:) = gt1(icol,:) + dtdt(icol,:)*dtp
190 gu0(icol,:) = gu1(icol,:) + dudt(icol,:)*dtp
191 gv0(icol,:) = gv1(icol,:) + dvdt(icol,:)*dtp
192 gq0(icol,:) = gq1(icol,:) + dqdt(icol,:)*dtp
199 if (in_pre_active)
then
200 in_pre_active = .false.
201 in_post_active = .true.
204 if (
size(physics_process) == proc_end)
then
205 in_pre_active = .true.
206 in_post_active = .false.