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
189 REAL(kind(1d0)) :: yi
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
390 REAL(kind(1d0)) :: tdf
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))
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)
500 w(i) = (t(i + 1)*a(i + 1) + t(i)*a(i))/(a(i) + a(i + 1))
514 *(w(i - 1) - 2*t(i) + w(i)) &
522 qs = (w(0) - t(1))*2*a(1) + (w(n) - t(n))*2*a(n)
529 RECURSIVE SUBROUTINE heatcond1d_ext(T, Qs, Tsfc, dx, dt, k, rhocp, bc, bctype, debug)
530 REAL(kind(1d0)),
INTENT(inout) :: t(:)
531 REAL(kind(1d0)),
INTENT(in) :: dx(:), dt, k(:), rhocp(:), bc(2)
532 REAL(kind(1d0)),
INTENT(out) :: qs, tsfc
533 LOGICAL,
INTENT(in) :: bctype(2)
534 LOGICAL,
INTENT(in) :: debug
536 REAL(kind(1d0)),
ALLOCATABLE :: w(:), a(:), t1(:), cfl(:)
537 REAL(kind(1d0)) :: cfl_max
538 REAL(kind(1d0)),
ALLOCATABLE :: t_in(:), t_out(:)
539 REAL(kind(1d0)) :: dt_x
542 ALLOCATE (w(0:n), a(n), t1(n), cfl(n), t_in(n), t_out(n))
548 w(0) = bc(1); w(n) = bc(2)
551 IF (bctype(1)) w(0) = bc(1)*0.5*dx(1)/k(1) + w(1)
552 IF (bctype(2)) w(n) = bc(2)*0.5*dx(n)/k(n) + w(n)
558 w(i) = (t(i + 1)*a(i + 1) + t(i)*a(i))/(a(i) + a(i + 1))
573 *(w(i - 1) - 2*t(i) + w(i)) &
589 (([bc(1), t_out(1:n - 1)] + t_out)/2. &
590 -([bc(1), t_in(1:n - 1)] + t_in)/2) &
594 cfl = abs((w(0:n - 1) - w(1:n))*k/rhocp/(dx**2)*dt)
595 cfl_max = maxval(cfl)
604 IF (cfl_max > .005 .AND. dt > 1)
THEN
610 print *,
'entering recursion ', cfl_max, dt_x
613 CALL heatcond1d_ext(t, qs, tsfc, dx, dt_x, k, rhocp, bc, bctype, debug)
643 INTEGER,
INTENT(in) :: lunit
645 INTEGER :: iostat_var
646 REAL(KIND(1D0)),
DIMENSION(ncolsESTMdata) :: ESTMArray
647 REAL(KIND(1D0)) :: imin_prev, ih_prev, iday_prev, tstep_estm
658 OPEN (lunit, file=trim(
fileestmts), status=
'old', err=315)
670 READ (lunit, *, iostat=iostat_var) estmarray
674 imin_prev = estmarray(4)
675 ih_prev = estmarray(3)
676 iday_prev = estmarray(2)
678 tstep_estm = ((estmarray(4) + 60*estmarray(3)) - (imin_prev + 60*ih_prev))*60
679 IF (tstep_estm /=
tstep_real .AND. estmarray(2) == iday_prev)
THEN
680 CALL errorhint(39,
'TSTEP in RunControl does not match TSTEP of ESTM data (DOY).', &
681 REAL(tstep, KIND(1D0)), tstep_estm, INT(ESTMArray(2)))
720 OPEN (511, file=trim(
fileinputpath)//
'ESTMinput.nml', status=
'old')
721 READ (511, nml=estminput)
789 INTEGER,
INTENT(IN) :: gridIV
790 INTEGER,
INTENT(IN) :: diagnose
791 LOGICAL,
INTENT(IN) :: MultipleLayoutFiles
792 CHARACTER(len=100) :: FileLayout, str_gridIV
793 INTEGER :: istat, iunit, ERROR_UNIT, i
794 INTEGER :: igroup, ilayer, idepth
795 CHARACTER(len=1000) :: line
796 REAL(KIND(1D0)) :: k, dz
844 IF (multiplelayoutfiles)
THEN
845 CALL writenum(gridiv, str_gridiv,
'i4')
846 filelayout =
'GridLayout'//trim(
filecode)//trim(str_gridiv)//
'.nml'
848 filelayout =
'GridLayout'//trim(
filecode)//
'.nml'
851 IF (diagnose == 1) print *,
'Reading layout file: ', trim(
fileinputpath)//filelayout
853 OPEN (iunit, file=trim(
fileinputpath)//trim(filelayout), status=
'old')
854 IF (diagnose == 1) print *,
'Read dim info of GridLayout'
855 READ (iunit, nml=dim, iostat=istat)
856 IF (diagnose == 1) print *,
'Number of layers to read: ',
nlayer
860 READ (iunit, fmt=
'(A)') line
862 WRITE (error_unit,
'(A)') &
863 'Invalid line in namelist: '//trim(line)
906 OPEN (iunit, file=trim(
fileinputpath)//trim(filelayout), status=
'old')
907 IF (diagnose == 1) print *,
'Read geometry part of GridLayout'
908 READ (iunit, nml=geom, iostat=istat)
909 IF (diagnose == 1) print *,
'height',
height
911 IF (diagnose == 1) print *,
'veg_frac',
veg_frac
913 IF (diagnose == 1) print *,
'veg_scale',
veg_scale
915 IF (diagnose == 1) print *,
'Read roof part of GridLayout'
916 READ (iunit, nml=roof, iostat=istat)
917 IF (diagnose == 1) print *,
'sfr_roof',
sfr_roof
918 IF (diagnose == 1) print *,
'dz_roof',
dz_roof
919 IF (diagnose == 1) print *,
'k_roof',
k_roof
920 IF (diagnose == 1) print *,
'cp_roof',
cp_roof
921 IF (diagnose == 1) print *,
'tin_roof',
tin_roof
922 IF (diagnose == 1) print *,
'alb_roof',
alb_roof
923 IF (diagnose == 1) print *,
'emis_roof',
emis_roof
924 IF (diagnose == 1) print *,
'state_roof',
state_roof
930 IF (diagnose == 1) print *,
'Read wall part of GridLayout'
931 READ (iunit, nml=wall, iostat=istat)
932 IF (diagnose == 1) print *,
'sfr_wall',
sfr_wall
933 IF (diagnose == 1) print *,
'dz_wall',
dz_wall
934 IF (diagnose == 1) print *,
'k_wall',
k_wall
935 IF (diagnose == 1) print *,
'cp_wall',
cp_wall
936 IF (diagnose == 1) print *,
'tin_wall',
tin_wall
937 IF (diagnose == 1) print *,
'alb_wall',
alb_wall
938 IF (diagnose == 1) print *,
'emis_wall',
emis_wall
939 IF (diagnose == 1) print *,
'state_wall',
state_wall
946 READ (iunit, nml=surf, iostat=istat)
949 READ (iunit, fmt=
'(A)') line
951 WRITE (error_unit,
'(A)') &
952 'Invalid line in namelist: '//trim(line)
956 IF (diagnose == 1) print *,
'Read GridLayout'
957 IF (diagnose == 1) print *,
'sfr_roof in load_GridLayout',
sfr_roof
958 IF (diagnose == 1) print *,
'sfr_wall in load_GridLayout',
sfr_wall
959 IF (diagnose == 1) print *,
'tin_surf in load_GridLayout',
tin_surf
960 IF (diagnose == 1) print *,
'dz_surf(1,:) in load_GridLayout',
dz_surf(1, :)
961 IF (diagnose == 1) print *,
'k_surf(1,:) in load_GridLayout',
k_surf(1, :)
1128 LOGICAL :: flag_mutiple_layout_files
1132 flag_mutiple_layout_files = .false.
1134 flag_mutiple_layout_files = .true.
1188 print *,
'Reading layout data for grid ', i_grid
1259 REAL(KIND(1D0)) :: W, WB
1263 INTEGER :: ESTMStart = 0
1269 IF (gridiv == 1) estmstart = estmstart + 1
1271 IF (estmstart == 1)
THEN
1308 IF (.NOT.
ALLOCATED(
tibld))
THEN
1381 IF (
froof < 1.0)
THEN
1388 hw = max(0.00001,
hw)
1449 IF (
nroom == 0)
THEN
1473 print *,
"At least one internal view factor <> 1. Check ivf in ESTMinput.nml"
1514 IF (estmstart == 1)
THEN
1585 avkdn, avu1, temp_c, zenith_deg, avrh, press_hpa, ldown, &
1586 bldgh, Ts5mindata_ir, &
1588 dataOutLineESTM, QS)
1735 INTEGER,
PARAMETER :: ncolsESTMdata = 13
1737 INTEGER,
PARAMETER :: cTs_Tiair = 5
1738 INTEGER,
PARAMETER :: cTs_Tsurf = 6
1739 INTEGER,
PARAMETER :: cTs_Troof = 7
1740 INTEGER,
PARAMETER :: cTs_Troad = 8
1741 INTEGER,
PARAMETER :: cTs_Twall = 9
1742 INTEGER,
PARAMETER :: cTs_Twall_n = 10
1743 INTEGER,
PARAMETER :: cTs_Twall_e = 11
1744 INTEGER,
PARAMETER :: cTs_Twall_s = 12
1745 INTEGER,
PARAMETER :: cTs_Twall_w = 13
1746 REAL(KIND(1D0)),
PARAMETER :: NAN = -999
1748 INTEGER,
INTENT(in) :: Gridiv
1749 INTEGER,
INTENT(in) :: tstep
1755 REAL(KIND(1D0)),
INTENT(in) :: avkdn
1756 REAL(KIND(1D0)),
INTENT(in) :: avu1
1757 REAL(KIND(1D0)),
INTENT(in) :: temp_c
1758 REAL(KIND(1D0)),
INTENT(in) :: zenith_deg
1759 REAL(KIND(1D0)),
INTENT(in) :: avrh
1760 REAL(KIND(1D0)),
INTENT(in) :: press_hpa
1761 REAL(KIND(1D0)),
INTENT(in) :: ldown
1762 REAL(KIND(1D0)),
INTENT(in) :: bldgh
1764 REAL(KIND(1D0)),
DIMENSION(ncolsESTMdata),
INTENT(in) :: Ts5mindata_ir
1765 REAL(KIND(1D0)),
INTENT(in) :: Tair_av
1767 REAL(KIND(1D0)),
DIMENSION(27),
INTENT(out) :: dataOutLineESTM
1769 REAL(KIND(1D0)),
INTENT(out) :: QS
1774 INTEGER :: Tair2Set = 0
1775 REAL(KIND(1D0)) :: AIREXHR, AIREXDT
1776 REAL(KIND(1D0)),
DIMENSION(2) :: bc
1777 REAL(KIND(1D0)) :: chair_ground, chair_wall
1778 REAL(KIND(1D0)) :: EM_EQUIV
1779 REAL(KIND(1D0)) :: kdz
1780 REAL(KIND(1D0)) :: kup_estm, LUP_net, kdn_estm
1781 REAL(KIND(1D0)) :: QHestm
1782 REAL(KIND(1D0)) :: QFBld
1783 REAL(KIND(1D0)) :: shc_airbld
1784 REAL(KIND(1D0)) :: sw_hor, sw_vert
1785 REAL(KIND(1D0)) :: T0
1786 REAL(KIND(1D0)) :: Tinternal, Tsurf_all, Troof_in, Troad, Twall_all, Tw_n, Tw_e, Tw_s, Tw_w
1787 REAL(KIND(1D0)) :: Twallout(5), Troofout(5), Tibldout(5), Tgroundout(5)
1788 REAL(KIND(1D0)) :: Tadd, Tveg
1789 REAL(KIND(1D0)) :: Tairmix
1790 REAL(KIND(1D0)) :: RN
1791 REAL(KIND(1D0)) :: Rs_roof, Rl_roof, RN_ROOF
1792 REAL(KIND(1D0)) :: Rs_wall, Rl_wall, RN_WALL
1793 REAL(KIND(1D0)) :: Rs_ground, Rl_ground, RN_ground
1794 REAL(KIND(1D0)) :: Rs_ibld, Rl_ibld
1795 REAL(KIND(1D0)) :: Rs_iroof, Rl_iroof
1796 REAL(KIND(1D0)) :: Rs_iwall, Rl_iwall
1797 REAL(KIND(1D0)) :: zenith_rad
1798 REAL(KIND(1D0)) :: dum(50)
1799 REAL(KIND(1D0)) :: bldgHX
1800 REAL(KIND(1D0)),
PARAMETER :: WSmin = 0.1
1801 LOGICAL :: radforce, groundradforce
1804 groundradforce = .false.
1806 bldghx = max(bldgh, 0.001)
1814 dum = [(-999, i=1, 50)]
1819 chair_ground =
chair
1825 IF (
ws < wsmin)
ws = wsmin
1828 IF (gridiv == 1) tair2set = tair2set + 1
1829 IF (tair2set == 1)
THEN
1863 tinternal = ts5mindata_ir(cts_tiair)
1864 tsurf_all = ts5mindata_ir(cts_tsurf)
1865 troof_in = ts5mindata_ir(cts_troof)
1866 troad = ts5mindata_ir(cts_troad)
1867 twall_all = ts5mindata_ir(cts_twall)
1869 tw_n = ts5mindata_ir(cts_twall_n)
1870 tw_e = ts5mindata_ir(cts_twall_e)
1871 tw_s = ts5mindata_ir(cts_twall_s)
1872 tw_w = ts5mindata_ir(cts_twall_w)
1905 zenith_rad = zenith_deg/180*pi
1906 IF (zenith_rad > 0 .AND. zenith_rad < pi/2.-
hw)
THEN
1936 ELSEIF (tair_av < 17.+
c2k .OR.
hvac)
THEN
1942 airexdt = airexhr*(tstep/3600.0)
1979 IF (kdn_estm < 0) kdn_estm = 0.
2009 IF (kdn_estm > 10 .AND. kup_estm > 0)
THEN
2046 REAL(Tstep, KIND(1D0)), kibld(1:Ndepth_ibld), &
2047 ribld(1:Ndepth_ibld), bc, bctype)
2115 IF (radforce .OR. groundradforce)
THEN
2131 REAL(Tstep, KIND(1D0)), kground(1:Ndepth_ground), rground(1:Ndepth_ground), bc, bctype)
2156 em_equiv = lup_net/(
sbconst*t0**4)
2157 rn_ground = rs_ground + rl_ground -
lup_ground
2158 rn_roof = rs_roof + rl_roof -
lup_roof
2160 rn = kdn_estm - kup_estm + ldown*em_equiv - lup_net
2179 IF (ndepth_ground < 5)
THEN
2180 tgroundout = (/
tground, (dum(ii), ii=1, (5 - ndepth_ground))/)
2185 IF (ndepth_ibld < 5)
THEN
2186 tibldout = (/
tibld, (dum(ii), ii=1, (5 - ndepth_ibld))/)
2195 dataoutlineestm = [ &
2197 twallout, troofout, tgroundout, tibldout,
tievolve]
2199 dataoutlineestm =
set_nan(dataoutlineestm)
2232 QG_surf, qg_roof, qg_wall, &
2233 tsfc_roof, tin_roof, temp_in_roof, k_roof, cp_roof, dz_roof, sfr_roof, & !input
2234 tsfc_wall, tin_wall, temp_in_wall, k_wall, cp_wall, dz_wall, sfr_wall, & !input
2235 tsfc_surf, tin_surf, temp_in_surf, k_surf, cp_surf, dz_surf, sfr_surf, & !input
2236 temp_out_roof, QS_roof, & !output
2237 temp_out_wall, QS_wall, & !output
2238 temp_out_surf, QS_surf, & !output
2246 INTEGER,
INTENT(in) :: tstep
2247 INTEGER,
INTENT(in) :: nlayer
2249 REAL(KIND(1D0)),
DIMENSION(nsurf),
INTENT(in) :: QG_surf
2262 REAL(KIND(1D0)),
DIMENSION(nlayer),
INTENT(in) :: qg_roof
2263 REAL(KIND(1D0)),
DIMENSION(nlayer),
INTENT(in) :: tsfc_roof
2264 REAL(KIND(1D0)),
DIMENSION(nlayer),
INTENT(in) :: tin_roof
2265 REAL(KIND(1D0)),
DIMENSION(nlayer),
INTENT(in) :: sfr_roof
2266 REAL(KIND(1D0)),
DIMENSION(nlayer, ndepth),
INTENT(in) :: temp_in_roof
2267 REAL(KIND(1D0)),
DIMENSION(nlayer, ndepth),
INTENT(in) :: k_roof
2268 REAL(KIND(1D0)),
DIMENSION(nlayer, ndepth),
INTENT(in) :: cp_roof
2269 REAL(KIND(1D0)),
DIMENSION(nlayer, ndepth),
INTENT(in) :: dz_roof
2271 REAL(KIND(1D0)),
DIMENSION(nlayer),
INTENT(in) :: qg_wall
2272 REAL(KIND(1D0)),
DIMENSION(nlayer),
INTENT(in) :: tsfc_wall
2273 REAL(KIND(1D0)),
DIMENSION(nlayer),
INTENT(in) :: tin_wall
2274 REAL(KIND(1D0)),
DIMENSION(nlayer),
INTENT(in) :: sfr_wall
2275 REAL(KIND(1D0)),
DIMENSION(nlayer, ndepth),
INTENT(in) :: temp_in_wall
2276 REAL(KIND(1D0)),
DIMENSION(nlayer, ndepth),
INTENT(in) :: k_wall
2277 REAL(KIND(1D0)),
DIMENSION(nlayer, ndepth),
INTENT(in) :: cp_wall
2278 REAL(KIND(1D0)),
DIMENSION(nlayer, ndepth),
INTENT(in) :: dz_wall
2280 REAL(KIND(1D0)),
DIMENSION(nsurf),
INTENT(in) :: tsfc_surf
2281 REAL(KIND(1D0)),
DIMENSION(nsurf),
INTENT(in) :: tin_surf
2282 REAL(KIND(1D0)),
DIMENSION(nsurf),
INTENT(in) :: sfr_surf
2283 REAL(KIND(1D0)),
DIMENSION(nsurf, ndepth),
INTENT(in) :: temp_in_surf
2284 REAL(KIND(1D0)),
DIMENSION(nsurf, ndepth),
INTENT(in) :: k_surf
2285 REAL(KIND(1D0)),
DIMENSION(nsurf, ndepth),
INTENT(in) :: cp_surf
2286 REAL(KIND(1D0)),
DIMENSION(nsurf, ndepth),
INTENT(in) :: dz_surf
2290 REAL(KIND(1D0)),
DIMENSION(nlayer),
INTENT(out) :: QS_roof
2291 REAL(KIND(1D0)),
DIMENSION(nlayer, ndepth),
INTENT(out) :: temp_out_roof
2293 REAL(KIND(1D0)),
DIMENSION(nlayer),
INTENT(out) :: QS_wall
2294 REAL(KIND(1D0)),
DIMENSION(nlayer, ndepth),
INTENT(out) :: temp_out_wall
2296 REAL(KIND(1D0)),
DIMENSION(nsurf),
INTENT(out) :: QS_surf
2297 REAL(KIND(1D0)),
DIMENSION(nsurf, ndepth),
INTENT(out) :: temp_out_surf
2300 REAL(KIND(1D0)),
INTENT(out) :: QS
2305 REAL(KIND(1D0)),
DIMENSION(:),
ALLOCATABLE :: tsfc_cal
2306 REAL(KIND(1D0)),
DIMENSION(:),
ALLOCATABLE :: tin_cal
2307 REAL(KIND(1D0)),
DIMENSION(:, :),
ALLOCATABLE :: temp_cal
2308 REAL(KIND(1D0)),
DIMENSION(:, :),
ALLOCATABLE :: k_cal
2309 REAL(KIND(1D0)),
DIMENSION(:, :),
ALLOCATABLE :: cp_cal
2310 REAL(KIND(1D0)),
DIMENSION(:, :),
ALLOCATABLE :: dz_cal
2311 REAL(KIND(1D0)),
DIMENSION(:),
ALLOCATABLE :: qs_cal
2316 INTEGER :: i_facet, i_group, nfacet, i_depth
2319 REAL(KIND(1D0)),
DIMENSION(2) :: bc
2322 LOGICAL,
DIMENSION(2) :: bctype
2326 LOGICAL :: use_heatcond1d, use_heatcond1d_water
2329 REAL(KIND(1D0)),
DIMENSION(nlayer) :: sfr_roof_n
2330 REAL(KIND(1D0)),
DIMENSION(nlayer) :: sfr_wall_n
2333 use_heatcond1d = .true.
2334 use_heatcond1d_water = .false.
2339 sfr_roof_n = sfr_roof/sum(sfr_roof)
2340 sfr_wall_n = sfr_wall/sum(sfr_wall)
2345 IF (i_group == 1)
THEN
2348 ELSE IF (i_group == 2)
THEN
2351 ELSE IF (i_group == 3)
THEN
2356 ALLOCATE (tsfc_cal(nfacet))
2357 ALLOCATE (tin_cal(nfacet))
2358 ALLOCATE (qs_cal(nfacet))
2359 ALLOCATE (temp_cal(nfacet,
ndepth))
2360 ALLOCATE (k_cal(nfacet,
ndepth))
2361 ALLOCATE (cp_cal(nfacet,
ndepth))
2362 ALLOCATE (dz_cal(nfacet,
ndepth))
2366 IF (i_group == 1)
THEN
2369 tsfc_cal(1:nfacet) = tsfc_roof(1:nfacet)
2371 tin_cal(1:nfacet) = tin_roof(1:nfacet)
2373 temp_cal(1:nfacet, 1:
ndepth) = temp_in_roof(1:nfacet, 1:
ndepth)
2377 cp_cal(1:nfacet, 1:
ndepth) = cp_roof(1:nfacet, 1:
ndepth)
2378 dz_cal(1:nfacet, 1:
ndepth) = dz_roof(1:nfacet, 1:
ndepth)
2380 ELSE IF (i_group == 2)
THEN
2383 tsfc_cal(1:nfacet) = tsfc_wall(1:nfacet)
2384 tin_cal(1:nfacet) = tin_wall(1:nfacet)
2385 temp_cal(1:nfacet, 1:
ndepth) = temp_in_wall(1:nfacet, 1:
ndepth)
2388 cp_cal(1:nfacet, 1:
ndepth) = cp_wall(1:nfacet, 1:
ndepth)
2389 dz_cal(1:nfacet, 1:
ndepth) = dz_wall(1:nfacet, 1:
ndepth)
2392 ELSE IF (i_group == 3)
THEN
2395 tsfc_cal(1:nfacet) = tsfc_surf(1:nfacet)
2396 tin_cal(1:nfacet) = tin_surf(1:nfacet)
2397 temp_cal(1:nfacet, 1:
ndepth) = temp_in_surf(1:nfacet, 1:
ndepth)
2400 cp_cal(1:nfacet, 1:
ndepth) = cp_surf(1:nfacet, 1:
ndepth)
2401 dz_cal(1:nfacet, 1:
ndepth) = dz_surf(1:nfacet, 1:
ndepth)
2414 DO i_facet = 1, nfacet
2421 IF (i_group == 3)
THEN
2422 use_heatcond1d = .true.
2425 use_heatcond1d = .false.
2428 use_heatcond1d = .false.
2429 use_heatcond1d_water = .true.
2432 use_heatcond1d = .true.
2436 IF (dz_cal(i_facet, 1) /= -999.0 .AND. use_heatcond1d)
THEN
2439 IF (i_group == 1)
THEN
2440 bc(1) = qg_roof(i_facet)
2441 ELSE IF (i_group == 2)
THEN
2442 bc(1) = qg_wall(i_facet)
2443 ELSE IF (i_group == 3)
THEN
2444 bc(1) = qg_surf(i_facet)
2447 bc(1) = tsfc_cal(i_facet)
2451 bc(2) = tin_cal(i_facet)
2471 temp_cal(i_facet, :), &
2473 tsfc_cal(i_facet), &
2474 dz_cal(i_facet, 1:
ndepth), &
2476 k_cal(i_facet, 1:
ndepth), &
2477 cp_cal(i_facet, 1:
ndepth), &
2495 IF (dz_cal(i_facet, 1) /= -999.0 .AND. use_heatcond1d_water)
THEN
2501 bc(1) = tsfc_cal(i_facet)
2505 bc(2) = tin_cal(i_facet)
2511 temp_cal(i_facet, :), &
2513 tsfc_cal(i_facet), &
2514 dz_cal(i_facet, 1:
ndepth), &
2516 k_cal(i_facet, 1:
ndepth), &
2517 cp_cal(i_facet, 1:
ndepth), &
2528 IF (i_group == 1)
THEN
2529 qs_roof = qs_cal(1:nfacet)
2531 temp_out_roof = temp_cal(:nfacet, :)
2532 ELSE IF (i_group == 2)
THEN
2533 qs_wall = qs_cal(1:nfacet)
2535 temp_out_wall = temp_cal(:nfacet, :)
2536 ELSE IF (i_group == 3)
THEN
2537 qs_surf = qs_cal(1:nfacet)
2539 temp_out_surf = temp_cal(:nfacet, :)
2543 DEALLOCATE (tsfc_cal)
2544 DEALLOCATE (tin_cal)
2546 DEALLOCATE (temp_cal)
2557 qs_surf(
bldgsurf) = (dot_product(qs_roof, sfr_roof) + dot_product(qs_wall, sfr_wall))/sfr_surf(
bldgsurf)
2559 temp_out_surf(
bldgsurf, i_depth) = &
2560 (dot_product(temp_out_roof(:, i_depth), sfr_roof) &
2561 + dot_product(temp_out_wall(:, i_depth), sfr_wall)) &
2562 /(sum(sfr_roof) + sum(sfr_wall))
2566 qs = dot_product(qs_surf, sfr_surf)
2573 REAL(kind(1d0)),
PARAMETER :: pnan = 9999
2574 REAL(kind(1d0)),
PARAMETER :: nan = -999
2575 REAL(kind(1d0)),
INTENT(in) :: x
2576 REAL(kind(1d0)) :: xx
2578 IF (abs(x) > pnan)
THEN
real(kind(1d0)), dimension(:), allocatable statelimit_wall
integer, parameter bldgsurf
real(kind(1d0)), dimension(:, :), allocatable tsfc_wall_grids
real(kind(1d0)), dimension(:, :), allocatable soilstorecap_wall_grids
real(kind(1d0)), dimension(:, :), allocatable dz_wall
real(kind(1d0)), dimension(:, :), allocatable ts5mindata
real(kind(1d0)), dimension(:, :), allocatable soilstore_wall_grids
real(kind(1d0)), dimension(:, :), allocatable tin_surf_grids
integer, parameter ncolsestmdata
integer, parameter conifsurf
real(kind(1d0)), dimension(:, :, :), allocatable cp_wall_grids
real(kind(1d0)), dimension(:, :), allocatable emis_wall_grids
real(kind(1d0)), dimension(:), allocatable soilstorecap_wall
integer, parameter cts_twall
real(kind(1d0)), dimension(:), allocatable alb_roof
real(kind(1d0)), dimension(:, :, :), allocatable temp_surf_grids
real(kind(1d0)), dimension(:), allocatable state_wall
real(kind(1d0)), dimension(:, :), allocatable tin_roof_grids
real(kind(1d0)), dimension(:, :), allocatable building_frac_grids
real(kind(1d0)), dimension(:, :, :), allocatable temp_wall_grids
real(kind(1d0)), dimension(:, :), allocatable tin_wall_grids
real(kind(1d0)), dimension(:), allocatable wetthresh_wall
real(kind(1d0)), dimension(:), allocatable state_roof
real(kind(1d0)), dimension(:, :), allocatable tsfc_roof_grids
real(kind(1d0)), dimension(:, :), allocatable dz_surf
integer, parameter cts_troad
real(kind(1d0)), dimension(nsurf) sfr_surf
integer, dimension(:), allocatable nlayer_grids
real(kind(1d0)), dimension(:, :), allocatable alb_wall_grids
real(kind(1d0)), dimension(:, :, :), allocatable cp_surf_grids
real(kind(1d0)), dimension(:), allocatable sfr_roof
real(kind(1d0)), dimension(nsurf) emis
real(kind(1d0)), dimension(:, :, :), allocatable wall_specular_frac_grids
real(kind(1d0)), dimension(:, :), allocatable alb_roof_grids
real(kind(1d0)), dimension(:, :, :), allocatable k_wall_grids
real(kind(1d0)), dimension(:, :), allocatable emis_roof_grids
real(kind(1d0)), dimension(:), allocatable building_scale
real(kind(1d0)), dimension(:, :, :), allocatable temp_roof_grids
real(kind(1d0)), dimension(:), allocatable soilstore_roof
real(kind(1d0)), dimension(:, :, :), allocatable cp_roof_grids
real(kind(1d0)), dimension(:, :), allocatable sfr_wall_grids
real(kind(1d0)), dimension(:, :), allocatable state_wall_grids
real(kind(1d0)), dimension(:, :), allocatable building_scale_grids
real(kind(1d0)), dimension(:, :, :), allocatable dz_surf_grids
real(kind(1d0)), dimension(:), allocatable height
real(kind(1d0)), dimension(:, :), allocatable cp_wall
real(kind(1d0)), dimension(:), allocatable tair24hr
real(kind(1d0)), dimension(:, :), allocatable soilstore_roof_grids
real(kind(1d0)), dimension(:), allocatable emis_roof
real(kind(1d0)), dimension(:, :), allocatable cp_surf
real(kind(1d0)), dimension(:, :, :), allocatable k_roof_grids
real(kind(1d0)), dimension(:, :), allocatable k_roof
real(kind(1d0)), dimension(:), allocatable wetthresh_roof
real(kind(1d0)), dimension(:), allocatable soilstorecap_roof
real(kind(1d0)), dimension(:), allocatable veg_frac
real(kind(1d0)), dimension(:, :), allocatable k_surf
real(kind(1d0)), dimension(:, :), allocatable statelimit_wall_grids
real(kind(1d0)), dimension(:, :), allocatable wetthresh_roof_grids
real(kind(1d0)), dimension(:, :), allocatable roof_albedo_dir_mult_fact
real(kind(1d0)), dimension(:, :), allocatable soilstorecap_roof_grids
real(kind(1d0)), dimension(:), allocatable tin_surf
integer, parameter watersurf
real(kind(1d0)), dimension(:), allocatable tin_wall
integer, parameter grasssurf
real(kind(1d0)), dimension(:, :, :), allocatable dz_roof_grids
real(kind(1d0)), dimension(:), allocatable statelimit_roof
real(kind(1d0)), dimension(:), allocatable alb_wall
real(kind(1d0)), dimension(:, :, :), allocatable roof_albedo_dir_mult_fact_grids
real(kind(1d0)), dimension(:, :), allocatable wall_specular_frac
real(kind(1d0)), dimension(:, :), allocatable height_grids
real(kind(1d0)), dimension(:, :), allocatable veg_scale_grids
real(kind(1d0)), dimension(:, :), allocatable dz_roof
real(kind(1d0)), dimension(:, :, :), allocatable k_surf_grids
integer, parameter bsoilsurf
real(kind(1d0)), dimension(:), allocatable emis_wall
integer, parameter pavsurf
real(kind(1d0)), dimension(:, :), allocatable cp_roof
real(kind(1d0)), dimension(nsurf) alb
real(kind(1d0)), dimension(:), allocatable building_frac
integer, parameter ndepth
real(kind(1d0)), dimension(:, :), allocatable veg_frac_grids
real(kind(1d0)), dimension(:, :), allocatable state_roof_grids
real(kind(1d0)), dimension(:, :), allocatable statelimit_roof_grids
real(kind(1d0)), dimension(:, :), allocatable sfr_roof_grids
integer, parameter cts_tiair
real(kind(1d0)), dimension(:, :, :), allocatable dz_wall_grids
real(kind(1d0)), dimension(:, :), allocatable k_wall
real(kind(1d0)), dimension(:, :, :), allocatable estmforcingdata
real(kind(1d0)), dimension(:), allocatable sfr_wall
integer, parameter nlayer_max
real(kind(1d0)), dimension(:), allocatable veg_scale
real(kind(1d0)), dimension(:, :), allocatable wetthresh_wall_grids
real(kind(1d0)), dimension(:), allocatable tin_roof
real(kind(1d0)), dimension(:), allocatable soilstore_wall
integer, parameter decidsurf
integer, parameter cts_troof
character(len=20) filecode
character(len=150) fileestmts
integer multiplelayoutfiles
character(len=150) fileinputpath
real(kind(1d0)), dimension(:), allocatable lup_roof_grids
real(kind(1d0)), dimension(5, 3) rsurf_paved
real(kind(1d0)), dimension(5) em_ibld_bldgs
real(kind(1d0)) theat_fix
real(kind(1d0)), dimension(:), allocatable t0_wall_grids
real(kind(1d0)), dimension(5) zground
real(kind(1d0)) em_roof_estm
real(kind(1d0)), dimension(5, 5) ribld_bldgs
real(kind(1d0)), dimension(:), allocatable t0_ground_grids
real(kind(1d0)), dimension(5, 5) kibld_bldgs
real(kind(1d0)), dimension(5, 5) rwall_bldgs
real(kind(1d0)) theat_off
real(kind(1d0)) lup_ground
real(kind(1d0)) t0_ground
real(kind(1d0)), dimension(:), allocatable tground
real(kind(1d0)) zvf_ground
real(kind(1d0)), dimension(5) alb_ibld_bldgs
real(kind(1d0)), dimension(5, 3) zsurf_paved
real(kind(1d0)) minshc_airbld
real(kind(1d0)), dimension(5) kwall
real(kind(1d0)) alb_ground_estm
real(kind(1d0)), dimension(:), allocatable twall
real(kind(1d0)), dimension(5) kroof
real(kind(1d0)), dimension(5) kground
real(kind(1d0)) alb_veg_estm
real(kind(1d0)), dimension(:), allocatable tn_wall_grids
real(kind(1d0)), dimension(5) zibld
real(kind(1d0)), dimension(5, 5) zibld_bldgs
real(kind(1d0)), dimension(:), allocatable troof
real(kind(1d0)), dimension(4) qs_4
real(kind(1d0)) tanzenith
real(kind(1d0)), dimension(5) ch_iwall_bldgs
real(kind(1d0)), dimension(:), allocatable t0_ibld_grids
real(kind(1d0)), dimension(:), allocatable tair2_grids
real(kind(1d0)), dimension(5, 5) kwall_bldgs
real(kind(1d0)), dimension(5) rwall
real(kind(1d0)), dimension(:), allocatable t0_roof_grids
real(kind(1d0)), dimension(5) ch_iroof_bldgs
real(kind(1d0)), dimension(:, :), allocatable tw_4
real(kind(1d0)), dimension(5) pcoeff
real(kind(1d0)), dimension(5, 5) zwall_bldgs
real(kind(1d0)), dimension(5) estmsfr_bldgs
real(kind(1d0)) alb_roof_estm
real(kind(1d0)), dimension(5, 5) rsurf_bldgs
real(kind(1d0)) rvf_ground
real(kind(1d0)), dimension(:, :, :), allocatable tw_4_grids
real(kind(1d0)), dimension(:), allocatable lup_ground_grids
real(kind(1d0)), dimension(:, :), allocatable twall_grids
real(kind(1d0)), dimension(5) rroof
real(kind(1d0)), dimension(:), allocatable lup_wall_grids
real(kind(1d0)), dimension(5, 3) ksurf_paved
real(kind(1d0)) finternal
real(kind(1d0)), dimension(5, 5) ksurf_bldgs
real(kind(1d0)), dimension(:), allocatable tibld
real(kind(1d0)), dimension(:), allocatable tn_roof_grids
real(kind(1d0)), parameter alb_wall_fix
real(kind(1d0)), dimension(5) kibld
real(kind(1d0)) em_veg_estm
real(kind(1d0)) em_ground_estm
real(kind(1d0)), parameter em_wall_fix
real(kind(1d0)), dimension(5) zwall
real(kind(1d0)), dimension(:, :), allocatable tibld_grids
real(kind(1d0)), parameter conv
real(kind(1d0)), dimension(5, 5) zsurf_bldgs
real(kind(1d0)), dimension(3) estmsfr_paved
real(kind(1d0)), dimension(:, :), allocatable troof_grids
real(kind(1d0)), dimension(5) rground
real(kind(1d0)), dimension(:), allocatable tievolve_grids
real(kind(1d0)), dimension(5) nroom_bldgs
real(kind(1d0)) rvf_canyon
real(kind(1d0)), dimension(5) ribld
real(kind(1d0)), dimension(5) ch_ibld_bldgs
integer, parameter maxiter
real(kind(1d0)), dimension(5) zroof
logical, dimension(2) bctype
real(kind(1d0)) svf_ground
real(kind(1d0)), dimension(:, :), allocatable tground_grids
subroutine load_gridlayout(gridIV, MultipleLayoutFiles, diagnose)
subroutine estm(Gridiv, tstep, avkdn, avu1, temp_c, zenith_deg, avrh, press_hpa, ldown, bldgh, Ts5mindata_ir, Tair_av, dataOutLineESTM, QS)
subroutine estm_ext(tstep, nlayer, QG_surf, qg_roof, qg_wall, tsfc_roof, tin_roof, temp_in_roof, k_roof, cp_roof, dz_roof, sfr_roof, tsfc_wall, tin_wall, temp_in_wall, k_wall, cp_wall, dz_wall, sfr_wall, tsfc_surf, tin_surf, temp_in_surf, k_surf, cp_surf, dz_surf, sfr_surf, temp_out_roof, QS_roof, temp_out_wall, QS_wall, temp_out_surf, QS_surf, QS)
subroutine suews_getestmdata(lunit)
elemental real(kind(1d0)) function set_nan(x)
subroutine estm_ext_finalise
subroutine estm_ext_initialise
subroutine estm_translate(Gridiv)
subroutine heatcond1d(T, Qs, dx, dt, k, rhocp, bc, bctype)
recursive subroutine heatcond1d_ext(T, Qs, Tsfc, dx, dt, k, rhocp, bc, bctype, debug)
real(kind(1d0)), parameter dtr
real(kind(1d0)), parameter pi
real(kind(1d0)), parameter rtd
real(kind(1d0)) function heatcapacity_air(TK, RH, P)
elemental real(kind(1d0)) function interp1d(x1, x2, y1, y2, xi)
real(kind(1d0)) function newtonpolynomial(x0, Pcoeff, conv, maxiter)
real(kind(1d0)) function transmissivity_cd(P, Td, G, zenith)
real(kind(1d0)) function min_zenith(lat, doy)
subroutine solar_times(lat, lng, timezone, dectime, sunrise, sunset, snoon)
real(kind(1d0)) function local_apparent_time(lng, dectime)
subroutine solar_angles(lat, lng, timezone, dectime, decl, zenith, azimuth)
real(kind(1d0)) function solar_esdist(doy)
real function, dimension(365) smithlambda(lat)
real(kind(1d0)) function kdown_surface(doy, zenith)
real(kind(1d0)), parameter c2k
real(kind(1d0)), parameter sbconst
real(kind(1d0)) tstep_real
subroutine errorhint(errh, ProblemFile, VALUE, value2, valueI)