33 REAL(KIND(1d0)),
DIMENSION(5)::
zibld, &
79 REAL(KIND(1d0)),
ALLOCATABLE,
DIMENSION(:, :)::
tw_4 82 REAL(KIND(1d0)),
ALLOCATABLE,
DIMENSION(:, :, :)::
tw_4_grids 169 REAL(KIND(1d0)),
PARAMETER::
conv = 0.0001
185 ELEMENTAL FUNCTION interp1d(x1, x2, y1, y2, xi)
RESULT(yi)
186 REAL(KIND(1d0)),
INTENT(in) ::x1, x2, xi
187 REAL(KIND(1d0)),
INTENT(in) ::y1, y2
188 REAL(KIND(1D0))::b0, b1
191 b1 = (y2 - y1)/(x2 - x1)
216 REAL(KIND(1d0)) ::x0, x, conv
217 REAL(KIND(1d0)) ::Pcoeff(:)
218 REAL(KIND(1d0)) ::e, xprev
219 REAL(KIND(1D0))::f, fp
222 LOGICAL ::converged = .false.
229 IF (abs(e) < conv)
THEN 235 f = f + pcoeff(j)*x**(n - j)
236 fp = fp + pcoeff(j)*(n - j)*x**(n - j - 1)
241 IF (fp == 0.) fp = tiny(1.)
246 IF (.NOT. converged)
THEN 247 print *,
"Solution did not converge. Niter=", niter,
" Error=", e
264 REAL(KIND(1d0)) ::lat, dectime, zmin
265 REAL(KIND(1d0)) ::latr, decl
269 decl = 0.409*cos(2*
pi*(dectime - 173)/365.25)
270 zmin =
pi/2.-asin(sin(latr)*sin(decl) - cos(latr)*cos(decl)*(-1))
277 REAL(KIND(1d0)) ::lng, dectime, la_time
278 REAL(KIND(1d0)) ::gamma, eqtime, lmst
280 lmst = dectime - 4.*lng/60./1440.
281 gamma = 2.*
pi/365.*(lmst - 1.)
282 eqtime = 229.18*(7.5e-5 + 1.868e-3*cos(gamma) - 0.032077*sin(gamma)&
283 & - 0.014615*cos(2.*gamma) - 0.040849*sin(2.*gamma))
284 la_time = lmst + eqtime/1440.
288 SUBROUTINE solar_angles(lat, lng, timezone, dectime, decl, zenith, azimuth)
290 REAL,
INTENT(in) ::lat, lng, timezone, dectime
291 INTEGER ::doy, hour, mn
292 REAL(KIND(1d0)),
INTENT(out) ::decl, zenith, azimuth
293 REAL(KIND(1d0)) ::ha, latr, eqtime, tst, &
298 hour = floor((dectime - doy)*24.)
299 mn = floor((dectime - doy - hour/24.)*60.)
301 gamma = 2.*
pi/365.25463*(doy - 1.+(hour - 12.)/24.)
302 eqtime = 229.18*(7.5e-5 + 1.868e-3*cos(gamma) - 0.032077*sin(gamma)&
303 & - 0.014615*cos(2.*gamma) - 0.040849*sin(2.*gamma))
304 decl = 6.918e-3 - 0.399912*cos(gamma) + 0.070257*sin(gamma)&
305 & - 0.006758*cos(2.*gamma) + 9.07e-4*sin(2.*gamma) - 2.697e-3*cos(3.*gamma)&
306 & + 1.48e-3*sin(3.*gamma)
307 time_offset = eqtime - 4.*lng + 60.*timezone
308 tst = hour*60.+mn + time_offset
312 zenith = acos(sin(latr)*sin(decl) + cos(latr)*cos(decl)*cos(ha))
313 azimuth =
pi + acos((sin(latr)*cos(zenith) - sin(decl))/(cos(latr)*sin(zenith)))
319 SUBROUTINE solar_times(lat, lng, timezone, dectime, sunrise, sunset, snoon)
323 REAL(KIND(1d0)),
INTENT(in) ::lat, lng, timezone, dectime
325 REAL(KIND(1d0)),
INTENT(out) ::sunrise, sunset, snoon
326 REAL(KIND(1d0)) :: ha, latr, eqtime, gamma, zenith, decl
330 gamma = 2.*
pi/365.*(float(doy) - 0.5)
331 eqtime = 229.18*(7.5e-5 + 1.868e-3*cos(gamma) - 0.032077*sin(gamma)&
332 & - 0.014615*cos(2.*gamma) - 0.040849*sin(2.*gamma))
333 decl = 6.918e-3 - 0.399912*cos(gamma) + 0.070257*sin(gamma)&
334 & - 0.006758*cos(2.*gamma) + 9.07e-4*sin(2.*gamma) - 2.697e-3*cos(3.*gamma)&
335 & + 1.48e-3*sin(3.*gamma)
336 ha = acos(cos(zenith)/(cos(latr)*cos(decl)) - tan(latr)*tan(decl))
338 sunrise = (720.-4.*(lng - ha) - eqtime)/60.-timezone
339 sunset = (720.-4.*(lng + ha) - eqtime)/60.-timezone
340 snoon = (720.-4.*lng - eqtime)/60.-timezone
348 REAL(KIND(1d0)) ::zenith, Isurf
350 REAL(KIND(1d0))::Rmean, Rse, cosZ, Itoa
354 IF (zenith <
pi/2.)
THEN 356 itoa = 1370*(rmean/rse)**2
368 REAL,
DIMENSION(365):: G
370 OPEN (99, file=
"Smith1966.grd", access=
"direct", action=
"read", recl=365*4, iostat=ios)
372 print *,
"Iostat=", ios,
" reading Smith1966.grd" 375 READ (99, rec=lat + 1, iostat=ios) g
376 IF (ios /= 0) print *,
"Iostat=", ios,
" reading Smith1966.grd" 388 REAL(KIND(1d0)) ::P, Td, zenith, G, trans
389 REAL(KIND(1d0))::m, TrTpg, u, Tw, Ta, cosZ
392 IF (zenith > 80.*
dtr)
THEN 399 m = 35*cosz/sqrt(1224.*cosz*cosz + 1)
400 trtpg = 1.021 - 0.084*sqrt(m*(0.000949*p + 0.051))
401 u = exp(0.113 - log(g + 1) + 0.0393*tdf)
402 tw = 1 - 0.077*(u*m)**0.3
460 REAL(KIND(1d0)) ::Rse
461 REAL(KIND(1d0)) ::MA, nu, e, a
466 ma = 2.*
pi*(doy - 3)/365.25463
467 nu = ma + 0.0333988*sin(ma) + .0003486*sin(2.*ma) + 5e-6*sin(3.*ma)
468 rse = a*(1 - e*e)/(1 + e*cos(nu))
480 SUBROUTINE heatcond1d(T, Qs, dx, dt, k, rhocp, bc, bctype)
481 REAL(KIND(1d0)),
INTENT(inout)::T(:)
482 REAL(KIND(1d0)),
INTENT(in)::dx(:), dt, k(:), rhocp(:), bc(2)
483 REAL(KIND(1d0)),
INTENT(out)::Qs
484 LOGICAL,
INTENT(in)::bctype(2)
486 REAL(KIND(1d0)),
ALLOCATABLE::w(:), a(:), T1(:)
488 ALLOCATE (w(0:n), a(n), t1(n))
491 w(0) = bc(1); w(n) = bc(2)
494 IF (bctype(1)) w(0) = bc(1)*0.5*dx(1)/k(1) + w(1)
495 IF (bctype(2)) w(n) = bc(2)*0.5*dx(n)/k(n) + w(n)
499 w(i) = (t(i + 1)*a(i + 1) + t(i)*a(i))/(a(i) + a(i + 1))
503 t1(i) = (dt/rhocp(i))*(w(i - 1) - 2*t(i) + w(i))*2*a(i)/dx(i) + t(i)
507 qs = (w(0) - t(1))*2*a(1) + (w(n) - t(n))*2*a(n)
536 INTEGER,
INTENT(in)::lunit
538 INTEGER :: iostat_var
539 REAL(KIND(1d0)),
DIMENSION(ncolsESTMdata):: ESTMArray
540 REAL(KIND(1d0)):: imin_prev, ih_prev, iday_prev, tstep_estm
551 OPEN (lunit, file=trim(
fileestmts), status=
'old', err=315)
563 READ (lunit, *, iostat=iostat_var) estmarray
567 imin_prev = estmarray(4)
568 ih_prev = estmarray(3)
569 iday_prev = estmarray(2)
571 tstep_estm = ((estmarray(4) + 60*estmarray(3)) - (imin_prev + 60*ih_prev))*60
572 IF (tstep_estm /=
tstep_real .AND. estmarray(2) == iday_prev)
THEN 573 CALL errorhint(39,
'TSTEP in RunControl does not match TSTEP of ESTM data (DOY).', &
574 REAL(tstep, KIND(1d0)), tstep_estm, INT(estmarray(2)))
613 OPEN (511, file=trim(
fileinputpath)//
'ESTMinput.nml', status=
'old')
614 READ (511, nml=estminput)
651 REAL(KIND(1d0))::W, WB
655 INTEGER:: ESTMStart = 0
661 IF (gridiv == 1) estmstart = estmstart + 1
663 IF (estmstart == 1)
THEN 700 IF (.NOT.
ALLOCATED(
tibld))
THEN 769 IF (
froof < 1.0)
THEN 776 hw = max(0.00001,
hw)
861 print *,
"At least one internal view factor <> 1. Check ivf in ESTMinput.nml" 902 IF (estmstart == 1)
THEN 973 avkdn, avu1, temp_c, zenith_deg, avrh, press_hpa, ldown, &
974 bldgh, Ts5mindata_ir, &
1123 INTEGER,
PARAMETER:: ncolsESTMdata = 13
1125 INTEGER,
PARAMETER:: cTs_Tiair = 5
1126 INTEGER,
PARAMETER:: cTs_Tsurf = 6
1127 INTEGER,
PARAMETER:: cTs_Troof = 7
1128 INTEGER,
PARAMETER:: cTs_Troad = 8
1129 INTEGER,
PARAMETER:: cTs_Twall = 9
1130 INTEGER,
PARAMETER:: cTs_Twall_n = 10
1131 INTEGER,
PARAMETER:: cTs_Twall_e = 11
1132 INTEGER,
PARAMETER:: cTs_Twall_s = 12
1133 INTEGER,
PARAMETER:: cTs_Twall_w = 13
1134 REAL(KIND(1d0)),
PARAMETER::NAN = -999
1136 INTEGER,
INTENT(in)::Gridiv
1137 INTEGER,
INTENT(in)::tstep
1143 REAL(KIND(1d0)),
INTENT(in)::avkdn
1144 REAL(KIND(1d0)),
INTENT(in)::avu1
1145 REAL(KIND(1d0)),
INTENT(in)::temp_c
1146 REAL(KIND(1d0)),
INTENT(in)::zenith_deg
1147 REAL(KIND(1d0)),
INTENT(in)::avrh
1148 REAL(KIND(1d0)),
INTENT(in)::press_hpa
1149 REAL(KIND(1d0)),
INTENT(in)::ldown
1150 REAL(KIND(1d0)),
INTENT(in)::bldgh
1152 REAL(KIND(1d0)),
DIMENSION(ncolsESTMdata),
INTENT(in):: Ts5mindata_ir
1153 REAL(KIND(1d0)),
INTENT(in) :: Tair_av
1155 REAL(KIND(1d0)),
DIMENSION(27),
INTENT(out):: dataOutLineESTM
1157 REAL(KIND(1d0)),
INTENT(out)::QS
1162 INTEGER:: Tair2Set = 0
1163 REAL(KIND(1d0))::AIREXHR, AIREXDT
1164 REAL(KIND(1d0)),
DIMENSION(2)::bc
1165 REAL(KIND(1d0))::chair_ground, chair_wall
1166 REAL(KIND(1d0))::EM_EQUIV
1167 REAL(KIND(1d0))::kdz
1168 REAL(KIND(1d0))::kup_estm, LUP_net, kdn_estm
1169 REAL(KIND(1d0))::QHestm
1170 REAL(KIND(1d0))::QFBld
1171 REAL(KIND(1d0))::shc_airbld
1172 REAL(KIND(1d0))::sw_hor, sw_vert
1174 REAL(KIND(1d0))::Tinternal, Tsurf_all, Troof_in, Troad, Twall_all, Tw_n, Tw_e, Tw_s, Tw_w
1175 REAL(KIND(1d0))::Twallout(5), Troofout(5), Tibldout(5), Tgroundout(5)
1176 REAL(KIND(1d0))::Tadd, Tveg
1177 REAL(KIND(1d0))::Tairmix
1179 REAL(KIND(1d0))::Rs_roof, Rl_roof, RN_ROOF
1180 REAL(KIND(1d0))::Rs_wall, Rl_wall, RN_WALL
1181 REAL(KIND(1d0))::Rs_ground, Rl_ground, RN_ground
1182 REAL(KIND(1d0))::Rs_ibld, Rl_ibld
1183 REAL(KIND(1d0))::Rs_iroof, Rl_iroof
1184 REAL(KIND(1d0))::Rs_iwall, Rl_iwall
1185 REAL(KIND(1d0))::zenith_rad
1186 REAL(KIND(1d0))::dum(50)
1187 REAL(KIND(1d0))::bldgHX
1188 REAL(KIND(1d0)),
PARAMETER::WSmin = 0.1
1189 LOGICAL::radforce, groundradforce
1192 groundradforce = .false.
1194 bldghx = max(bldgh, 0.001)
1202 dum = [(-999, i=1, 50)]
1207 chair_ground =
chair 1213 IF (
ws < wsmin)
ws = wsmin
1216 IF (gridiv == 1) tair2set = tair2set + 1
1217 IF (tair2set == 1)
THEN 1251 tinternal = ts5mindata_ir(cts_tiair)
1252 tsurf_all = ts5mindata_ir(cts_tsurf)
1253 troof_in = ts5mindata_ir(cts_troof)
1254 troad = ts5mindata_ir(cts_troad)
1255 twall_all = ts5mindata_ir(cts_twall)
1257 tw_n = ts5mindata_ir(cts_twall_n)
1258 tw_e = ts5mindata_ir(cts_twall_e)
1259 tw_s = ts5mindata_ir(cts_twall_s)
1260 tw_w = ts5mindata_ir(cts_twall_w)
1293 zenith_rad = zenith_deg/180*
pi 1294 IF (zenith_rad > 0 .AND. zenith_rad <
pi/2.-
hw)
THEN 1324 ELSEIF (tair_av < 17.+
c2k .OR.
hvac)
THEN 1330 airexdt = airexhr*(tstep/3600.0)
1367 IF (kdn_estm < 0) kdn_estm = 0.
1397 IF (kdn_estm > 10 .AND. kup_estm > 0)
THEN 1498 IF (radforce .OR. groundradforce)
THEN 1514 REAL(Tstep, KIND(1d0)), kground(1:
nground), rground(1:
nground), bc, bctype)
1539 em_equiv = lup_net/(
sbconst*t0**4)
1540 rn_ground = rs_ground + rl_ground -
lup_ground 1541 rn_roof = rs_roof + rl_roof -
lup_roof 1543 rn = kdn_estm - kup_estm + ldown*em_equiv - lup_net
1551 twallout = (/
twall, (dum(ii), ii=1, (5 -
nwall))/)
1557 troofout = (/
troof, (dum(ii), ii=1, (5 -
nroof))/);
1569 tibldout = (/
tibld, (dum(ii), ii=1, (5 -
nibld))/)
1578 dataoutlineestm = [ &
1580 twallout, troofout, tgroundout, tibldout,
tievolve]
1582 dataoutlineestm =
set_nan(dataoutlineestm)
1608 ELEMENTAL FUNCTION set_nan(x)
RESULT(xx)
1610 REAL(KIND(1d0)),
PARAMETER::pNAN = 9999
1611 REAL(KIND(1d0)),
PARAMETER::NAN = -999
1612 REAL(KIND(1d0)),
INTENT(in)::x
1615 IF (abs(x) > pnan)
THEN real(kind(1d0)) function kdown_surface(doy, zenith)
integer, parameter cts_troad
real(kind(1d0)), parameter sbconst
real(kind(1d0)), dimension(:), allocatable lup_wall_grids
real(kind(1d0)), dimension(:, :), allocatable troof_grids
integer, parameter maxiter
real(kind(1d0)), dimension(:), allocatable lup_ground_grids
real(kind(1d0)) function heatcapacity_air(TK, RH, P)
real(kind(1d0)), dimension(:, :, :), allocatable tw_4_grids
real(kind(1d0)), parameter alb_wall
real(kind(1d0)), dimension(5, 5) kwall_bldgs
integer, parameter cts_troof
real(kind(1d0)) function local_apparent_time(lng, dectime)
integer, parameter bsoilsurf
integer, parameter cts_twall
real(kind(1d0)), dimension(:), allocatable t0_roof_grids
subroutine estm(Gridiv, tstep, avkdn, avu1, temp_c, zenith_deg, avrh, press_hpa, ldown, bldgh, Ts5mindata_ir, Tair_av, dataOutLineESTM, QS)
real(kind(1d0)), dimension(5) rroof
subroutine solar_times(lat, lng, timezone, dectime, sunrise, sunset, snoon)
real(kind(1d0)), dimension(5) kibld
real(kind(1d0)), dimension(:), allocatable twall
real(kind(1d0)), dimension(:), allocatable lup_roof_grids
real(kind(1d0)), dimension(5) rwall
real(kind(1d0)), dimension(5, 5) ribld_bldgs
real(kind(1d0)), dimension(:, :), allocatable ts5mindata
real(kind(1d0)), dimension(5) kwall
subroutine estm_translate(Gridiv)
real(kind(1d0)), dimension(:), allocatable tibld
real(kind(1d0)), dimension(5, 5) rwall_bldgs
real(kind(1d0)), dimension(5) kroof
real(kind(1d0)), dimension(5, 5) zwall_bldgs
logical, dimension(2) bctype
integer, parameter cts_tiair
real(kind(1d0)) function min_zenith(lat, doy)
real(kind(1d0)) function newtonpolynomial(x0, Pcoeff, conv, maxiter)
real(kind(1d0)), dimension(5, 5) zibld_bldgs
character(len=150) fileestmts
real(kind(1d0)), dimension(:), allocatable t0_ibld_grids
real(kind(1d0)), dimension(5, 3) rsurf_paved
real(kind(1d0)), dimension(5, 5) zsurf_bldgs
real(kind(1d0)), dimension(5) zwall
real(kind(1d0)), dimension(3) estmsfr_paved
real(kind(1d0)) rvf_ground
elemental real(kind(1d0)) function set_nan(x)
integer, parameter conifsurf
real(kind(1d0)) t0_ground
real(kind(1d0)), parameter em_wall
real(kind(1d0)) finternal
real(kind(1d0)) theat_fix
real(kind(1d0)), dimension(5, 3) zsurf_paved
real(kind(1d0)), dimension(:), allocatable tn_wall_grids
real(kind(1d0)) minshc_airbld
real(kind(1d0)), dimension(:), allocatable tair24hr
real(kind(1d0)), dimension(:, :), allocatable tground_grids
real(kind(1d0)), parameter dtr
real(kind(1d0)) zvf_ground
real(kind(1d0)), dimension(5) estmsfr_bldgs
real(kind(1d0)), dimension(:), allocatable tground
real(kind(1d0)), dimension(:, :), allocatable tibld_grids
elemental real(kind(1d0)) function interp1d(x1, x2, y1, y2, xi)
character(len=150) fileinputpath
real(kind(1d0)), dimension(5) zibld
real(kind(1d0)) alb_ground
real(kind(1d0)), dimension(nsurf) emis
real(kind(1d0)) rvf_canyon
integer, parameter grasssurf
real(kind(1d0)), dimension(:), allocatable tair2_grids
real(kind(1d0)), dimension(:, :), allocatable tw_4
real(kind(1d0)), parameter rtd
real(kind(1d0)), dimension(5, 5) ksurf_bldgs
real(kind(1d0)), dimension(5) nroom_bldgs
real(kind(1d0)) tstep_real
integer, parameter ncolsestmdata
real(kind(1d0)), dimension(:), allocatable tn_roof_grids
real(kind(1d0)), dimension(5) ribld
real(kind(1d0)), dimension(:), allocatable troof
real(kind(1d0)), dimension(5, 3) ksurf_paved
real(kind(1d0)), dimension(5) alb_ibld_bldgs
real(kind(1d0)) function solar_esdist(doy)
subroutine heatcond1d(T, Qs, dx, dt, k, rhocp, bc, bctype)
real(kind(1d0)), dimension(5) zroof
real(kind(1d0)), dimension(5) ch_ibld_bldgs
subroutine suews_getestmdata(lunit)
real(kind(1d0)), dimension(:), allocatable tievolve_grids
real(kind(1d0)), dimension(5, 5) rsurf_bldgs
real(kind(1d0)), dimension(5) rground
real(kind(1d0)), dimension(4) qs_4
real(kind(1d0)) em_ground
real(kind(1d0)) function transmissivity_cd(P, Td, G, zenith)
real(kind(1d0)), dimension(5) kground
real(kind(1d0)), dimension(5) ch_iwall_bldgs
real(kind(1d0)), dimension(nsurf) sfr
real(kind(1d0)), dimension(5) zground
real(kind(1d0)), dimension(:, :, :), allocatable estmforcingdata
real(kind(1d0)), parameter conv
integer, parameter decidsurf
real(kind(1d0)), parameter pi
integer, parameter pavsurf
real(kind(1d0)), dimension(nsurf) alb
subroutine solar_angles(lat, lng, timezone, dectime, decl, zenith, azimuth)
real(kind(1d0)), dimension(:), allocatable t0_ground_grids
real(kind(1d0)), dimension(5) pcoeff
real(kind(1d0)) theat_off
real(kind(1d0)), dimension(5, 5) kibld_bldgs
subroutine errorhint(errh, ProblemFile, VALUE, value2, valueI)
real(kind(1d0)), dimension(:), allocatable t0_wall_grids
real(kind(1d0)), dimension(5) em_ibld_bldgs
integer, parameter bldgsurf
integer, parameter watersurf
real(kind(1d0)) svf_ground
real(kind(1d0)), dimension(5) ch_iroof_bldgs
real(kind(1d0)) lup_ground
real function, dimension(365) smithlambda(lat)
real(kind(1d0)), parameter c2k
real(kind(1d0)) tanzenith
real(kind(1d0)), dimension(:, :), allocatable twall_grids