168 & ( solhr,slag,sdec,cdec,sinlat,coslat, &
169 & con_g, con_cp, con_pi, con_sbc, &
170 & xlon,coszen,tsfc_lnd,tsfc_ice,tsfc_wat,tf,tsflw,tsfc, &
171 & sfcemis_lnd, sfcemis_ice, sfcemis_wat, &
172 & sfcdsw,sfcnsw,sfcdlw,swh,swhc,hlw,hlwc, &
173 & sfcnirbmu,sfcnirdfu,sfcvisbmu,sfcvisdfu, &
174 & sfcnirbmd,sfcnirdfd,sfcvisbmd,sfcvisdfd, &
175 & im, levs, deltim, fhswr, &
176 & dry, icy, wet, damp_lw_fluxadj, lfnc_k, lfnc_p0, &
177 & use_lw_jacobian, sfculw, use_med_flux, sfculw_med, &
178 & fluxlwup_jac, t_lay, p_lay, p_lev, flux2d_lwup, &
179 & flux2d_lwdown,pert_radtend,do_sppt,ca_global,tsfc_radtime, &
182 & dtdt,dtdtnp,htrlw, &
184 & adjsfcdsw,adjsfcnsw,adjsfcdlw, &
185 & adjsfculw_lnd,adjsfculw_ice,adjsfculw_wat,xmu,xcosz, &
186 & adjnirbmu,adjnirdfu,adjvisbmu,adjvisdfu, &
187 & adjnirbmd,adjnirdfd,adjvisbmd,adjvisdfd, &
196 real(kind=kind_phys),
parameter :: f_eps = 0.0001_kind_phys, &
197 & zero = 0.0d0, one = 1.0d0, &
198 & hour12 = 12.0_kind_phys, &
199 & f3600 = one/3600.0_kind_phys, &
200 & f7200 = one/7200.0_kind_phys, &
201 & czlimt = 0.0001_kind_phys
204 integer,
intent(in) :: im, levs
208 logical,
dimension(:),
intent(in) :: dry, icy, wet
209 logical,
intent(in) :: use_lw_jacobian, damp_lw_fluxadj, &
210 & pert_radtend, use_med_flux
211 logical,
intent(in) :: do_sppt,ca_global
212 real(kind=kind_phys),
intent(in) :: solhr, slag, cdec, sdec, &
213 & deltim, fhswr, lfnc_k, lfnc_p0
215 real(kind=kind_phys),
dimension(:),
intent(in) :: &
216 & sinlat, coslat, xlon, coszen, tf, tsflw, sfcdlw, &
217 & sfcdsw, sfcnsw, sfculw, tsfc
218 real(kind=kind_phys),
dimension(:),
intent(in),
optional :: &
219 & sfculw_med, tsfc_radtime
220 real(kind=kind_phys),
dimension(:),
intent(in) :: &
221 & tsfc_lnd, tsfc_ice, tsfc_wat, &
222 & sfcemis_lnd, sfcemis_ice, sfcemis_wat
224 real(kind=kind_phys),
dimension(:),
intent(in) :: &
225 & sfcnirbmu, sfcnirdfu, sfcvisbmu, sfcvisdfu, &
226 & sfcnirbmd, sfcnirdfd, sfcvisbmd, sfcvisdfd
228 real(kind=kind_phys),
dimension(:,:),
intent(in) :: swh, hlw, &
229 & swhc, hlwc, p_lay, t_lay
231 real(kind=kind_phys),
dimension(:,:),
intent(in) :: p_lev
232 real(kind=kind_phys),
dimension(:,:),
intent(in),
optional :: &
233 & flux2d_lwup, flux2d_lwdown, fluxlwup_jac
235 real(kind_phys),
intent(in ) :: con_g, con_cp, &
238 real(kind_phys) :: pid12
242 real(kind=kind_phys),
dimension(:,:),
intent(inout) :: dtdt
243 real(kind=kind_phys),
dimension(:,:),
intent(inout),
optional :: &
247 real(kind=kind_phys),
dimension(:),
intent(out) :: &
248 & adjsfcdsw, adjsfcnsw, adjsfcdlw, xmu, xcosz, &
249 & adjnirbmu, adjnirdfu, adjvisbmu, adjvisdfu, &
250 & adjnirbmd, adjnirdfd, adjvisbmd, adjvisdfd
252 real(kind=kind_phys),
dimension(:),
intent(out) :: &
253 & adjsfculw_lnd, adjsfculw_ice, adjsfculw_wat
255 character(len=*),
intent(out) :: errmsg
256 integer,
intent(out) :: errflg
259 integer :: i, k, nstp, nstl, it, istsun(im),isfc,itoa
260 real(kind=kind_phys) :: cns, coszn, tem1, tem2, anginc, &
262 real(kind=kind_phys),
dimension(im,levs+1) :: flxlwup_adj, &
264 real(kind=kind_phys) :: fluxlwnet_adj,fluxlwnet,dt_sfc, &
265 &fluxlwdown_jac,lfnc,c1
267 real(kind=kind_phys),
parameter :: &
270 real(kind=kind_phys),
parameter :: &
280 if (p_lev(1,1) .lt. p_lev(1, levs))
then
288 tem1 = fhswr / deltim
289 nstp = max(6, nint(tem1))
290 nstl = max(1, nint(nstp/tem1))
291 pid12 = con_pi / hour12
296 cns = pid12 * (solhr + deltim*f7200 - hour12) + slag
298 xcosz(i) = sdec*sinlat(i) + cdec*coslat(i)*cos(cns+xlon(i))
300 elseif (nstl == nstp)
then
305 rstl = one / float(nstl)
306 solang = pid12 * (solhr - hour12)
307 anginc = pid12 * deltim * f3600 * rstl
313 cns = solang + (float(it)-0.5_kind_phys)*anginc + slag
315 coszn = sdec*sinlat(i) + cdec*coslat(i)*cos(cns+xlon(i))
316 xcosz(i) = xcosz(i) + max(zero, coszn)
317 if (coszn > czlimt) istsun(i) = istsun(i) + 1
321 if (istsun(i) > 0) xcosz(i) = xcosz(i) / istsun(i)
328 tem1 = tf(i) / tsflw(i)
330 adjsfcdlw(i) = sfcdlw(i) * tem2 * tem2
334 tem2 = tsfc_lnd(i) * tsfc_lnd(i)
335 adjsfculw_lnd(i) = sfcemis_lnd(i) * con_sbc * tem2 * tem2
336 & + (one - sfcemis_lnd(i)) * adjsfcdlw(i)
339 tem2 = tsfc_ice(i) * tsfc_ice(i)
340 adjsfculw_ice(i) = sfcemis_ice(i) * con_sbc * tem2 * tem2
341 & + (one - sfcemis_ice(i)) * adjsfcdlw(i)
344 tem2 = tsfc_wat(i) * tsfc_wat(i)
345 adjsfculw_wat(i) = sfcemis_wat(i) * con_sbc *
347 & + (one - sfcemis_wat(i)) * adjsfcdlw(i)
349 if (use_med_flux)
then
350 if (sfculw_med(i) > f_eps)
then
351 adjsfculw_wat(i) = sfculw_med(i)
362 if ( xcosz(i) > f_eps .and. coszen(i) > f_eps )
then
363 xmu(i) = xcosz(i) / coszen(i)
371 adjsfcnsw(i) = sfcnsw(i) * xmu(i)
372 adjsfcdsw(i) = sfcdsw(i) * xmu(i)
374 adjnirbmu(i) = sfcnirbmu(i) * xmu(i)
375 adjnirdfu(i) = sfcnirdfu(i) * xmu(i)
376 adjvisbmu(i) = sfcvisbmu(i) * xmu(i)
377 adjvisdfu(i) = sfcvisdfu(i) * xmu(i)
379 adjnirbmd(i) = sfcnirbmd(i) * xmu(i)
380 adjnirdfd(i) = sfcnirdfd(i) * xmu(i)
381 adjvisbmd(i) = sfcvisbmd(i) * xmu(i)
382 adjvisdfd(i) = sfcvisdfd(i) * xmu(i)
388 if (use_lw_jacobian)
then
403 c1 = fluxlwup_jac(i,itoa) / fluxlwup_jac(i,isfc)
405 dt_sfc = tsfc(i) - tsfc_radtime(i)
408 fluxlwnet = (flux2d_lwup(i, k+1) - flux2d_lwup(i, k) - &
409 & flux2d_lwdown(i,k+1) + flux2d_lwdown(i,k))
411 fluxlwdown_jac = gamma * &
412 & (fluxlwup_jac(i,k)/fluxlwup_jac(i,isfc) - c1) / &
415 fluxlwnet_adj = fluxlwnet + dt_sfc* &
416 & (fluxlwup_jac(i,k)/fluxlwup_jac(i,isfc) - &
419 htrlw(i,k) = fluxlwnet_adj * con_g / &
420 & (con_cp * (p_lev(i,k+1) - p_lev(i,k)))
424 if (damp_lw_fluxadj)
then
425 lfnc = l / (1+exp(-(p_lev(i,k) - lfnc_p0)/lfnc_k))
429 dtdt(i,k) = dtdt(i,k) + swh(i,k)*xmu(i) + &
430 & htrlw(i,k)*lfnc + (1.-lfnc)*hlw(i,k)
436 dtdt(i,k) = dtdt(i,k) + swh(i,k)*xmu(i) + hlw(i,k)
441 if (do_sppt .or. ca_global)
then
442 if (pert_radtend)
then
446 dtdtnp(i,k) = dtdtnp(i,k) + swhc(i,k)*xmu(i) + hlwc(i,k)
453 dtdtnp(i,k) = dtdtnp(i,k) + swh(i,k)*xmu(i) + hlw(i,k)
subroutine, public dcyc2t3_run(solhr, slag, sdec, cdec, sinlat, coslat, con_g, con_cp, con_pi, con_sbc, xlon, coszen, tsfc_lnd, tsfc_ice, tsfc_wat, tf, tsflw, tsfc, sfcemis_lnd, sfcemis_ice, sfcemis_wat, sfcdsw, sfcnsw, sfcdlw, swh, swhc, hlw, hlwc, sfcnirbmu, sfcnirdfu, sfcvisbmu, sfcvisdfu, sfcnirbmd, sfcnirdfd, sfcvisbmd, sfcvisdfd, im, levs, deltim, fhswr, dry, icy, wet, damp_lw_fluxadj, lfnc_k, lfnc_p0, use_lw_jacobian, sfculw, use_med_flux, sfculw_med, fluxlwup_jac, t_lay, p_lay, p_lev, flux2d_lwup, flux2d_lwdown, pert_radtend, do_sppt, ca_global, tsfc_radtime, dtdt, dtdtnp, htrlw, adjsfcdsw, adjsfcnsw, adjsfcdlw, adjsfculw_lnd, adjsfculw_ice, adjsfculw_wat, xmu, xcosz, adjnirbmu, adjnirdfu, adjvisbmu, adjvisdfu, adjnirbmd, adjnirdfd, adjvisbmd, adjvisdfd, errmsg, errflg)