13 SUBROUTINE metread(lfn, MetArray, InputmetFormat, ldown_option, NetRadiationMethod, &
14 snowUse, SMDMethod, SoilDepthMeas, SoilRocks, SoilDensity, SmCap)
21 REAL(KIND(1d0)),
DIMENSION(24)::MetArray
25 REAL(KIND(1d0))::SmCap, &
30 INTEGER::InputmetFormat, &
37 REAL(KIND(1d0))::avkdn, &
64 INTEGER::iostat_var, lfn
69 IF (inputmetformat == 0)
THEN 71 READ (lfn, *, iostat=iostat_var) iy, id, it, imin, qn1_obs, avu1, avrh, &
72 temp_c, wdir, pres_kpa, precip, avkdn, snowfrac_obs, ldown_obs, fcld_obs
84 ELSEIF (inputmetformat == 10)
THEN 85 READ (lfn, *, iostat=iostat_var) iy, id, it, imin, qn1_obs, qh_obs, qe_obs, qs_obs, qf_obs, avu1, avrh, &
86 temp_c, pres_kpa, precip, avkdn, snowfrac_obs, ldown_obs, fcld_obs, &
87 wu_m3, xsmd, lai_obs, kdiff, kdir, wdir
96 IF (smdmethod == 1 .AND. xsmd /= -999)
THEN 97 xsmd = (smcap - xsmd)*soildepthmeas*soilrocks
98 ELSEIF (smdmethod == 2 .AND. xsmd /= -999)
THEN 99 xsmd = (smcap - xsmd)*soildensity*soildepthmeas*soilrocks
109 pres_hpa = pres_kpa*10.
111 IF (iostat_var < 0)
THEN 118 CALL errorhint(27,
'Met Data: avKdn - needed for StoreDrainPrm. resistance, If present, check file not tab delimited', &
124 IF ((ldown_option == 1) .AND. (ldown_obs < 0))
THEN 125 CALL errorhint(27,
'Met Data: LWdn (ldown_obs) - impact Q* calc', ldown_obs, dectime,
notusedi)
127 ELSEIF (ldown_option == 2)
THEN 128 IF (fcld_obs == -999.0 .OR. fcld_obs < 0 .OR. fcld_obs > 1)
THEN 129 CALL errorhint(27,
'Met Data: flcd_obs - impacts LW & Q* radiation', fcld_obs, dectime,
notusedi)
133 IF (qn1_obs == -999 .AND. netradiationmethod == 0)
THEN 134 CALL errorhint(27,
'Met Data: Q* - will impact everything', qn1_obs, dectime,
notusedi)
138 CALL errorhint(27,
'Met Data: avU1 - impacts aeroydnamic resistances', avu1, dectime,
notusedi)
141 IF (temp_c < -50 .OR. temp_c > 60)
THEN 142 CALL errorhint(27,
'Met Data: Temp_C - beyond what is expected', temp_c, dectime,
notusedi)
145 IF (avrh > 100 .OR. avrh < 1)
THEN 146 CALL errorhint(27,
'Met Data: avRH - beyond what is expected', avrh, dectime,
notusedi)
149 IF (pres_kpa < 80)
THEN 150 CALL errorhint(27,
'Met Data: Pres_kPa - too low - this could be fixed in model', pres_kpa, dectime,
notusedi)
157 IF (snowfrac_obs ==
nan) snowfrac_obs = 0
159 IF (snowuse == 0 .AND. (snowfrac_obs < 0 .OR. snowfrac_obs > 1))
THEN 160 CALL errorhint(27,
'Met Data: snow not between [0 1]', snowfrac_obs, dectime,
notusedi)
163 IF (xsmd < 0 .AND. smdmethod == 1)
THEN 168 metarray(1:24) = (/iy, id, it, imin, qn1_obs, qh_obs, qe_obs, qs_obs, qf_obs, avu1, &
169 avrh, temp_c, pres_hpa, precip, avkdn, snowfrac_obs, ldown_obs, &
170 fcld_obs, wu_m3, xsmd, lai_obs, kdiff, kdir, wdir/)
192 CHARACTER(len=90),
DIMENSION(14)::
text 200 SUBROUTINE run_control(eval, LowerLimit, Upperlimit)
205 INTEGER::eval, i, lowerlimit, upperlimit
206 CHARACTER(len=4)::check
209 101
READ (
lfn_us, *) check
212 IF (check(i:i) ==
"#")
THEN 224 WRITE (12, 120) eval,
text(1)
226 IF (eval < lowerlimit .OR. eval > upperlimit)
THEN 227 WRITE (*, *)
"Value out of range" 228 WRITE (*, *) eval,
text(1)
232 WRITE (*, 120) eval,
text(1)
233 120
FORMAT(i4, 2x, a90)
243 INTEGER::skip, lfn, i
245 READ (lfn, *, err=201, iostat=
ios_out)
250 201
reall =
REAL(skip)
273 CHARACTER(len=50):: FileName
605 IF (
filename ==
'SUEWS_NonVeg.txt')
THEN 613 ELSEIF (
filename ==
'SUEWS_Veg.txt')
THEN 619 ELSEIF (
filename ==
'SUEWS_Water.txt')
THEN 627 ELSEIF (
filename ==
'SUEWS_Snow.txt')
THEN 633 ELSEIF (
filename ==
'SUEWS_Soil.txt')
THEN 639 ELSEIF (
filename ==
'SUEWS_Conductance.txt')
THEN 645 ELSEIF (
filename ==
'SUEWS_OHMCoefficients.txt')
THEN 648 CALL errorhint(56,
'Names or order of columns in SUEWS_OHMCoefficients.txt does not match model code.', &
652 ELSEIF (
filename ==
'SUEWS_ESTMCoefficients.txt')
THEN 655 CALL errorhint(56,
'Names or order of columns in SUEWS_ESTMCoefficients.txt does not match model code.', &
659 ELSEIF (
filename ==
'SUEWS_AnthropogenicEmission.txt')
THEN 662 CALL errorhint(56,
'Names or order of columns in SUEWS_AnthropogenicEmission.txt does not match model code.', &
666 ELSEIF (
filename ==
'SUEWS_Irrigation.txt')
THEN 671 CALL errorhint(56,
'Names or order of columns in SUEWS_Irrigation.txt does not match model code.', &
675 ELSEIF (
filename ==
'SUEWS_Profiles.txt')
THEN 678 CALL errorhint(56,
'Names or order of columns in SUEWS_Profiles.txt does not match model code.', &
682 ELSEIF (
filename ==
'SUEWS_WithinGridWaterDist.txt')
THEN 685 CALL errorhint(56,
'Names or order of columns in SUEWS_WithinGridWaterDist.txt does not match model code.', &
689 ELSEIF (
filename ==
'SUEWS_BiogenCO2.txt')
THEN 692 CALL errorhint(56,
'Names or order of columns in SUEWS_BiogenCO2.txt does not match model code.', &
697 WRITE (*, *)
'Problem in subroutine InputHeaderCheck. File header not specified in model code for ',
filename 748 INTEGER,
INTENT(IN) :: Hour, Min, Sec
749 INTEGER :: total_sec, SecPerHour
750 REAL(KIND(1d0)),
DIMENSION(0:23),
INTENT(IN) :: Prof_24h
751 REAL(KIND(1d0)):: deltaProf
752 REAL(KIND(1d0)) :: Prof_CurrTime
754 total_sec = min*60 + sec
761 deltaprof = (prof_24h(j) - prof_24h(i))/secperhour
762 prof_currtime = prof_24h(hour) + deltaprof*total_sec
774 INTEGER,
INTENT(IN) :: Hour, Min, Sec
775 INTEGER :: total_sec, SecPerHour
776 REAL(KIND(1d0)),
DIMENSION(0:23),
INTENT(IN) :: Prof_24h
777 REAL(KIND(1d0)),
DIMENSION(0:23):: Prof_24h_mean
778 REAL(KIND(1d0)):: deltaProf
779 REAL(KIND(1d0)) :: Prof_CurrTime
781 total_sec = min*60 + sec
784 prof_24h_mean = merge(prof_24h/(sum(prof_24h)/
size(prof_24h, dim=1)), 0.d0, sum(prof_24h) /= 0)
791 deltaprof = (prof_24h_mean(j) - prof_24h_mean(i))/secperhour
794 prof_currtime = prof_24h_mean(i) + deltaprof*total_sec
806 INTEGER,
INTENT(IN) :: Hour, Min, Sec, dt
807 INTEGER :: total_sec, SecPerHour
808 REAL(KIND(1d0)),
DIMENSION(0:23),
INTENT(IN) :: Prof_24h
809 REAL(KIND(1d0)),
DIMENSION(0:23):: Prof_24h_sum
810 REAL(KIND(1d0)):: deltaProf
811 REAL(KIND(1d0)) :: Prof_CurrTime
813 total_sec = min*60 + sec
816 prof_24h_sum = merge(prof_24h/(sum(prof_24h)), 0.d0, sum(prof_24h) /= 0)
822 deltaprof = (prof_24h_sum(j) - prof_24h_sum(i))/secperhour
823 prof_currtime = prof_24h_sum(hour) + deltaprof*total_sec
824 prof_currtime = prof_currtime*dt/secperhour
847 CHARACTER(len=4):: SWWD
851 IF (swwd ==
'SWet')
THEN 858 'not found in OHM_Coefficients.txt for surface', is,
'.' 863 ELSEIF (swwd ==
'SDry')
THEN 870 'not found in OHM_Coefficients.txt for surface', is,
'.' 875 ELSEIF (swwd ==
'WWet')
THEN 882 'not found in OHM_Coefficients.txt for surface', is,
'.' 887 ELSEIF (swwd ==
'WDry')
THEN 894 'not found in OHM_Coefficients.txt for surface', is,
'.' 900 WRITE (*, *)
'Problem with CodeMatchOHM (in SUEWS_CodeMatch.f95). ', swwd,
' not recognised. Needs to be one of: ', &
901 'SWet = Summer Wet, SDry = Summer Dry, WWet = WinterWet, WDry = Winter Dry. N.B. Case sensitive. ' 933 'not found in ESTM_Coefficients.txt for surface', is,
'.' 965 'not found in ESTM_Coefficients.txt for surface', is,
'.' 975 'not found in ESTM_Coefficients.txt for surface', is,
'.' 980 WRITE (*, *)
'Problem with CodeMatchESTM_Class (in SUEWS_ctrl_input.f95). ', is,
' not correct. Needs to be either ', &
981 '1 = Paved surfaced, 2 = Bldgs surfaces.' 1002 INTEGER:: SurfaceCharCodeCol
1010 WRITE (*, *)
'Program stopped! Profile code ',
surfacechar(gridiv, surfacecharcodecol),
'not found in SUEWS_Profiles.txt.' 1034 INTEGER:: codeCol, codeColSameSurf
1042 WRITE (*, *)
'Program stopped! Within-grid water distribution code ',
siteselect(rr, codecol), &
1043 'not found in SUEWS_WaterDistWithinGrid.txt.' 1050 CALL errorhint(8,
'Diagonal elements should be zero as water cannot move from one surface to the same surface.', &
1060 CALL errorhint(9,
'One of these (ToRunoff,ToSoilStore) should be zero.', &
1069 CALL errorhint(8,
'Total water distribution from each surface should add up to 1.', &
1099 WRITE (*, *)
'Program stopped! NonVeg code ',
siteselect(rr, codecol),
'not found in SUEWS_NonVeg.txt.' 1129 WRITE (*, *)
'Program stopped! Veg code ',
siteselect(rr, codecol),
'not found in SUEWS_Vegs.txt.' 1159 WRITE (*, *)
'Program stopped! Water code ',
siteselect(rr, codecol),
'not found in SUEWS_Water.txt.' 1189 WRITE (*, *)
'Program stopped! Snow code ',
siteselect(rr, codecol),
'not found in SUEWS_Snow.txt.' 1219 WRITE (*, *)
'Program stopped! Conductance code ',
siteselect(rr, codecol),
'not found in SUEWS_Conductance.txt.' 1250 WRITE (*, *)
'Program stopped! Anthropogenic code ',
siteselect(rr, codecol), &
1251 'not found in SUEWS_AnthropogenicEmission.txt.' 1252 CALL errorhint(57,
'Cannot find code in SUEWS_AnthropogenicEmission.txt', &
1282 WRITE (*, *)
'Program stopped! Irrigation code ',
siteselect(rr, codecol),
'not found in SUEWS_Irrigation.txt.' 1304 INTEGER:: SurfaceCharCodeCol
1312 WRITE (*, *)
'Program stopped! Soil code ',
surfacechar(gridiv, surfacecharcodecol),
'not found in SUEWS_Soil.txt.' 1334 INTEGER:: SurfaceCharCodeCol
1342 WRITE (*, *)
'Program stopped! Biogen code ',
surfacechar(gridiv, surfacecharcodecol),
'not found in SUEWS_BiogenCO2.txt.' 1390 INTEGER:: lunit = 100
1393 INTEGER:: iBlock, igrid
1394 INTEGER,
DIMENSION(Nper):: seq1Nper
1395 INTEGER,
DIMENSION(nsd):: seq1nsd
1396 INTEGER,
DIMENSION(nColumnsMetForcingData):: MetDisaggMethod
1397 REAL(KIND(1d0)),
DIMENSION(nColumnsMetForcingData):: MetArrayOrig
1398 REAL(KIND(1d0)),
DIMENSION(ReadLinesOrigMetData*Nper, ncolumnsMetForcingData):: Met_tt
1399 REAL(KIND(1d0)),
DIMENSION(ReadLinesOrigMetData*Nper):: Met_tt_kdownAdj
1400 CHARACTER(LEN=9),
DIMENSION(ncolumnsMetForcingData):: HeaderMet
1401 CHARACTER(LEN=10*ncolumnsMetForcingData):: HeaderMetOut
1404 REAL(KIND(1d0)),
DIMENSION(ReadLinesOrigMetData*Nper):: dectimeFast
1405 REAL(KIND(1d0)),
DIMENSION(ReadLinesOrigMetData*Nper):: idectime
1422 metdisaggmethod = -999
1425 seq1nper = (/(i, i=1,
nper, 1)/)
1426 seq1nsd = (/(i, i=1,
nsd, 1)/)
1431 metdisaggmethod(:) = 10
1433 metdisaggmethod(:) = 20
1435 metdisaggmethod(:) = 10
1436 metdisaggmethod(10:13) = 20
1438 CALL errorhint(2,
'Problem in SUEWS_MetDisagg: DisaggMethod value should be 1, 2, or 3', &
1446 OPEN (lunit, file=trim(
fileorigmet), status=
'old')
1448 READ (lunit, *) headermet
1487 CALL errorhint(2,
'Problem in SUEWS_MetDisagg: timestamps in met forcing file inconsistent with ResolutionFilesIn', &
1488 REAL(ResolutionFilesIn, KIND(1d0)), NotUsed, tdiff*60)
1494 CALL errorhint(3,
'Problem in SUEWS_MetDisagg: multiple years found in original met forcing file.', &
1499 IF (
diagnose == 1)
WRITE (*, *)
'Disaggregating met forcing data (', trim(
fileorigmet),
') to model time-step...' 1506 IF (metdisaggmethod(14) == 100)
THEN 1509 met_tt(:, 16) = -999
1513 ELSEIF (metdisaggmethod(14) == 101)
THEN 1515 CALL errorhint(2,
'Problem in SUEWS_MetDisagg: RainDisaggMethod requires RainAmongN', &
1516 REAL(RainAmongN, KIND(1d0)), NotUsed, RainDisaggMethod)
1518 CALL errorhint(2,
'Problem in SUEWS_MetDisagg: RainAmongN > Nper',
REAL(Nper, KIND(1d0)), NotUsed, RainAmongN)
1523 met_tt(:, 16) = -999
1529 ELSEIF (metdisaggmethod(14) == 102)
THEN 1531 CALL errorhint(2,
'Problem in SUEWS_MetDisagg: RainDisaggMethod requires MultRainAmongN', &
1532 REAL(MultRainAmongN(1), KIND(1d0)), NotUsed, RainDisaggMethod)
1534 CALL errorhint(2,
'Problem in SUEWS_MetDisagg: RainDisaggMethod requires MultRainAmongNUpperI', &
1537 CALL errorhint(2,
'Problem in SUEWS_MetDisagg: MultRainAmongN > Nper',
REAL(Nper, KIND(1d0)), NotUsed, &
1543 met_tt(:, 16) = -999
1550 WRITE (*, *)
'Disaggregation code for rain not recognised' 1552 ELSEIF (ii == 24)
THEN 1554 WRITE (*, *)
'Disaggregation of wind direction not currently implemented!' 1559 met_tt(:, ii) = -999
1569 IF (
diagnosedisagg == 1)
WRITE (*, *)
'Adjusting disaggregated kdown using zenith angle' 1570 met_tt_kdownadj(:) = met_tt(:, 15)
1577 dectimefast(:) = met_tt(:, 2) + met_tt(:, 3)/24.0 + met_tt(:, 4)/(60.0*24.0)
1584 met_tt_kdownadj(i) = 0.0
1589 met_tt_kdownadj((i - 1)*
nsd + seq1nsd) = &
1590 met_tt_kdownadj((i - 1)*
nsd + seq1nsd) &
1591 *sum(met_tt((i - 1)*
nsd + seq1nsd, 15)) &
1592 /sum(met_tt_kdownadj((i - 1)*
nsd + seq1nsd))
1595 met_tt(:, 15) = met_tt_kdownadj(:)
1605 met_tt(:, 13) = met_tt(:, 13)/10.0
1609 IF (iblock == 1)
THEN 1613 headermetout = adjustl(headermet(i))
1615 headermetout = trim(headermetout)//
' '//adjustl(headermet(i))
1620 WRITE (78,
'(a)') headermetout
1622 OPEN (78, file=trim(
filedscdmet), position=
'append')
1635 303
FORMAT((i4, 1x), 3(i3, 1x), 9(f12.6, 1x), (f9.4, 1x), 10(f9.4, 1x))
1660 INTEGER:: lunit = 101
1664 INTEGER,
DIMENSION(NperESTM):: seq1NperESTM
1665 INTEGER,
DIMENSION(nsd):: seq1nsd
1666 INTEGER,
DIMENSION(ncolsESTMdata):: ESTMDisaggMethod
1667 REAL(KIND(1d0)),
DIMENSION(ncolsESTMdata):: ESTMArrayOrig
1668 REAL(KIND(1d0)),
DIMENSION(ReadLinesOrigESTMData*NperESTM, ncolsESTMdata):: ESTM_tt
1669 CHARACTER(LEN=9),
DIMENSION(ncolsESTMdata):: HeaderESTM
1670 CHARACTER(LEN=10*ncolsESTMdata):: HeaderESTMOut
1687 estmdisaggmethod = -999
1690 seq1nperestm = (/(i, i=1,
nperestm, 1)/)
1691 seq1nsd = (/(i, i=1,
nsd, 1)/)
1696 estmdisaggmethod(:) = 10
1698 estmdisaggmethod(:) = 20
1700 CALL errorhint(2,
'Problem in SUEWS_ESTMDisagg: DisaggMethodESTM value should be 1 or 2', &
1708 READ (lunit, *) headerestm
1716 READ (lunit, *, iostat=iostat_var) estmarrayorig
1721 READ (lunit, *, iostat=iostat_var) estmarrayorig
1726 READ (lunit, *, iostat=iostat_var) estmarrayorig
1741 CALL errorhint(2,
'Problem in SUEWS_ESTMDisagg: timestamps in ESTM forcing file inconsistent with ResolutionFilesInESTM', &
1742 REAL(ResolutionFilesInESTM, KIND(1d0)), NotUsed, tdiff*60)
1747 WRITE (*, *)
'Disaggregating ESTM forcing data (', trim(
fileorigestm),
') to model time-step...' 1801 estm_tt(:, ii) = -999
1813 IF (iblock == 1)
THEN 1817 headerestmout = adjustl(headerestm(i))
1819 headerestmout = trim(headerestmout)//
' '//adjustl(headerestm(i))
1824 WRITE (78,
'(a)') headerestmout
1830 WRITE (78, 304) (int(estm_tt(i, ii)), ii=1, 4), estm_tt(i, 5:
ncolsestmdata)
1839 304
FORMAT((i4, 1x), 3(i3, 1x), 9(f9.4, 1x))
1854 SUBROUTINE disaggregatedatetime(DateTimeForDisagg, tstep, Nper, ReadLinesOrigMetDataMax, DateTimeDscd)
1857 INTEGER,
INTENT(in) :: tstep, Nper, ReadLinesOrigMetDataMax
1858 REAL(KIND(1d0)),
DIMENSION(ReadLinesOrigMetData, 4),
INTENT(in):: DateTimeForDisagg
1859 REAL(KIND(1d0)),
DIMENSION(ReadLinesOrigMetData*Nper, 4),
INTENT(out):: DateTimeDscd
1861 REAL(KIND(1d0)),
DIMENSION(ReadLinesOrigMetData):: dectimeOrig
1862 REAL(KIND(1d0)),
DIMENSION(Nper) :: temp_dectime
1863 INTEGER,
DIMENSION(Nper):: temp_iy, temp_id, temp_ih, temp_im, temp_ihm
1864 INTEGER,
DIMENSION(Nper)::ndays_iy
1867 INTEGER,
DIMENSION(Nper):: seq1Nper
1870 seq1nper = (/(i, i=1, nper, 1)/)
1874 dectimeorig = (datetimefordisagg(:, 2) - 1) + datetimefordisagg(:, 3)/24.0 + datetimefordisagg(:, 4)/(60.0*24.0)
1876 DO i = 1, readlinesorigmetdatamax
1879 temp_dectime = dectimeorig(i) - (tstep/60.0)/(60.0*24.0)*(/(ii, ii=(nper - 1), 0, -1)/)
1880 temp_dectime = nint(temp_dectime*60*60*24)/(60*60*24*1.)
1884 temp_iy = merge(int(datetimefordisagg(i, 1)) - 1, int(datetimefordisagg(i, 1)), temp_dectime < 0)
1887 ndays_iy = daysinyear(temp_iy)
1888 temp_dectime = merge(temp_dectime + ndays_iy, temp_dectime, temp_dectime < 0)
1889 temp_id = floor(temp_dectime) + 1
1891 temp_ihm = nint((temp_dectime + 1 - temp_id/1.0)*60.0*24.0)
1892 temp_ih = (temp_ihm - mod(temp_ihm, 60))/60
1893 temp_ih = merge(temp_ih, 0, mask=(temp_ih < 24))
1894 temp_im = mod(temp_ihm, 60)
1897 datetimedscd(nper*(i - 1) + seq1nper, 1) = temp_iy
1898 datetimedscd(nper*(i - 1) + seq1nper, 2) = temp_id
1899 datetimedscd(nper*(i - 1) + seq1nper, 3) = temp_ih
1900 datetimedscd(nper*(i - 1) + seq1nper, 4) = temp_im
1908 FUNCTION disagg_lin(Slow, SlowPrev, SlowNext, DisaggType, Nper_loc, ReadLinesOrig_loc, ReadLinesOrigMax_loc, iBlock)
RESULT(Fast)
1915 INTEGER:: DisaggType
1917 INTEGER:: ReadLinesOrig_loc, ReadLinesOrigMax_loc
1919 REAL(KIND(1d0)),
DIMENSION(ReadLinesOrig_loc*Nper_loc):: Fast
1920 REAL(KIND(1d0)),
DIMENSION(ReadLinesOrig_loc):: Slow
1921 REAL(KIND(1d0)):: SlowPrev, SlowNext
1922 INTEGER,
DIMENSION(Nper_loc):: FastRows
1923 INTEGER,
DIMENSION(FLOOR(Nper_loc/2.0)):: FirstRows10
1924 INTEGER,
DIMENSION(Nper_loc - FLOOR(Nper_loc/2.0)):: LastRows10
1925 INTEGER,
DIMENSION(Nper_loc):: FirstRows20
1926 INTEGER,
DIMENSION(Nper_loc):: seq1Nper_loc
1931 IF (mod(nper_loc, 2) == 0) xnper_loc = 2
1932 IF (mod(nper_loc, 2) == 1) xnper_loc = 1
1934 seq1nper_loc = (/(i, i=1, nper_loc, 1)/)
1937 IF (disaggtype == 10)
THEN 1938 fastrows = floor(nper_loc/2.0) + seq1nper_loc
1939 firstrows10 = (/(i, i=1, (fastrows(1) - 1), 1)/)
1941 (/(i, i=nper_loc*(readlinesorigmax_loc - 1 - 1) + fastrows(nper_loc) + 1, &
1942 (readlinesorigmax_loc*nper_loc), 1)/)
1943 ELSEIF (disaggtype == 20)
THEN 1944 fastrows = nper_loc + seq1nper_loc
1945 firstrows20 = (/(i, i=1, (fastrows(1) - 1), 1)/)
1951 IF (disaggtype == 10)
THEN 1952 IF (
diagnosedisagg == 1)
WRITE (*, *)
'Linearly disaggregating averaged variable' 1953 DO i = 1, (readlinesorigmax_loc - 1)
1954 fast(nper_loc*(i - 1) + fastrows) = slow(i) - &
1955 (slow(i + 1) - slow(i))/(xnper_loc*nper_loc) + &
1956 (slow(i + 1) - slow(i))/nper_loc*(/(ii, ii=1, nper_loc, 1)/)
1960 IF (iblock == 1)
THEN 1961 fast(firstrows10) = fast(fastrows(1))
1963 fast(firstrows10) = slowprev - &
1964 (slow(1) - slowprev)/(xnper_loc*nper_loc) + &
1965 (slow(1) - slowprev)/nper_loc* &
1966 (/(ii, ii=(nper_loc -
SIZE(firstrows10) + 1), nper_loc, 1)/)
1970 fast(lastrows10) = fast(nper_loc*(readlinesorigmax_loc - 1 - 1) + fastrows(nper_loc))
1972 fast(lastrows10) = slow(readlinesorigmax_loc) - &
1973 (slownext - slow(readlinesorigmax_loc))/(xnper_loc*nper_loc) + &
1974 (slownext - slow(readlinesorigmax_loc))/nper_loc* &
1975 (/(ii, ii=1,
SIZE(lastrows10), 1)/)
1977 ELSEIF (disaggtype == 20)
THEN 1978 IF (
diagnosedisagg == 1)
WRITE (*, *)
'Linearly disaggregating instantaneous variable' 1979 DO i = 1, (readlinesorigmax_loc - 1)
1980 fast(nper_loc*(i - 1) + fastrows) = (slow(i) + &
1981 (slow(i + 1) - slow(i))/nper_loc*2*(seq1nper_loc - 1) + &
1985 IF (iblock == 1)
THEN 1986 fast(firstrows20) = fast(fastrows(1))
1988 fast(firstrows20) = (slowprev + &
1989 (slow(1) - slowprev)/nper_loc*2* &
1990 ((/(ii, ii=(nper_loc -
SIZE(firstrows20) + 1), nper_loc, 1)/) - 1) + &
2004 IF (any(fast(1:readlinesorigmax_loc*nper_loc) == -999))
THEN 2005 WRITE (*, *)
'Problem: -999s (', count(fast(1:readlinesorigmax_loc*nper_loc) == -999),
') in disaggregated data.' 2013 FUNCTION disaggp_amongn(Slow, amongN, Nper_loc, ReadLinesOrig_loc, ReadLinesOrigMax_loc)
RESULT(Fast)
2027 INTEGER:: ReadLinesOrig_loc, ReadLinesOrigMax_loc
2028 REAL(KIND(1d0)),
DIMENSION(ReadLinesOrig_loc*Nper_loc):: Fast
2029 REAL(KIND(1d0)),
DIMENSION(ReadLinesOrig_loc):: Slow
2030 INTEGER,
DIMENSION(:),
ALLOCATABLE:: Subintervals
2031 INTEGER,
DIMENSION(Nper_loc):: seq1Nper_loc
2035 ALLOCATE (subintervals(amongn))
2036 subintervals(:) = -999
2038 seq1nper_loc = (/(i, i=1, nper_loc, 1)/)
2040 IF (
diagnosedisagg == 1)
WRITE (*, *)
'Distributing over ', amongn,
' subintervals for variable' 2042 IF (amongn == nper_loc)
THEN 2043 subintervals(:) = seq1nper_loc
2045 IF (amongn > nper_loc) &
2046 CALL errorhint(2,
'Problem in SUEWS_MetDisagg: no. of rainy periods cannot exceed number of subintervals', &
2047 REAL(Nper_loc, KIND(1d0)), NotUsed, amongN)
2051 DO i = 1, readlinesorigmax_loc
2052 fast(nper_loc*(i - 1) + seq1nper_loc) = 0
2053 IF (slow(i) > 0)
THEN 2054 IF (amongn < nper_loc)
THEN 2055 subintervals(:) = -999
2058 fast(nper_loc*(i - 1) + subintervals) = slow(i)/amongn
2062 IF (any(fast(1:readlinesorigmax_loc*nper_loc) == -999))
THEN 2063 WRITE (*, *)
'Problem: -999s (', count(fast(1:readlinesorigmax_loc*nper_loc) == -999),
') in disaggregated data' 2064 CALL errorhint(13,
'Problem in SUEWS_MetDisagg: -999 values in disaggregated data.', notused, notused,
notusedi)
2071 FUNCTION disaggp_amongnmult(Slow, multupperI, multamongN, Nper_loc, ReadLinesOrig_loc, ReadLinesOrigMax_loc)
RESULT(Fast)
2083 REAL(KIND(1d0)),
DIMENSION(5):: multupperI
2084 INTEGER,
DIMENSION(5):: multamongN
2085 INTEGER:: thisamongN
2087 INTEGER:: ReadLinesOrig_loc, ReadLinesOrigMax_loc
2088 REAL(KIND(1d0)),
DIMENSION(ReadLinesOrig_loc*Nper_loc):: Fast
2089 REAL(KIND(1d0)),
DIMENSION(ReadLinesOrig_loc):: Slow
2090 INTEGER,
DIMENSION(:),
ALLOCATABLE:: Subintervals
2091 INTEGER,
DIMENSION(Nper_loc):: seq1Nper_loc
2094 seq1nper_loc = (/(i, i=1, nper_loc, 1)/)
2096 IF (
diagnosedisagg == 1)
WRITE (*, *)
'Distributing over variable subintervals depending on intensity for variable' 2100 DO i = 1, readlinesorigmax_loc
2101 fast(nper_loc*(i - 1) + seq1nper_loc) = 0
2102 IF (slow(i) > 0)
THEN 2104 IF (slow(i) <= multupperi(1))
THEN 2105 thisamongn = multamongn(1)
2106 ELSEIF (slow(i) > multupperi(1) .AND. slow(i) <= multupperi(2))
THEN 2107 thisamongn = multamongn(2)
2108 ELSEIF (slow(i) > multupperi(2) .AND. slow(i) <= multupperi(3))
THEN 2109 thisamongn = multamongn(3)
2110 ELSEIF (slow(i) > multupperi(3) .AND. slow(i) <= multupperi(4))
THEN 2111 thisamongn = multamongn(4)
2112 ELSEIF (slow(i) > multupperi(4) .AND. slow(i) <= multupperi(5))
THEN 2113 thisamongn = multamongn(5)
2114 ELSEIF (slow(i) > multupperi(5))
THEN 2115 thisamongn = multamongn(5)
2116 CALL errorhint(4,
'Precip in met forcing file exceeds maxiumum MultRainAmongNUpperI', &
2121 ALLOCATE (subintervals(thisamongn))
2122 subintervals(:) = -999
2124 IF (thisamongn > nper_loc)
CALL errorhint(2,
'Problem in SUEWS_MetDisagg: no. of rainy periods cannot exceed '// &
2125 'number of subintervals',
REAL(Nper_loc, KIND(1d0)), NotUsed, thisamongN)
2127 IF (thisamongn == nper_loc)
THEN 2128 subintervals(:) = seq1nper_loc
2129 ELSEIF (thisamongn < nper_loc)
THEN 2132 fast(nper_loc*(i - 1) + subintervals) = slow(i)/thisamongn
2134 DEALLOCATE (subintervals)
2138 IF (any(fast(1:readlinesorigmax_loc*nper_loc) == -999))
THEN 2139 WRITE (*, *)
'Problem: -999s (', count(fast(1:readlinesorigmax_loc*nper_loc) == -999),
') in disaggregated data' 2140 CALL errorhint(13,
'Problem in SUEWS_MetDisagg: -999 values in disaggregated data.', notused, notused,
notusedi)
2160 INTEGER,
DIMENSION(:),
ALLOCATABLE:: Samples
2163 ALLOCATE (samples(n))
2168 DO WHILE (any(samples == -999))
2169 CALL random_number(r)
2170 x = int(r*outof) + 1
2173 IF (count(samples == x) == 0)
THEN
integer readlinesorigmetdata
character(len=20), dimension(ncolumnsbiogen) headerbiogen_reqd
integer, dimension(nsurfincsnow) c_ohmcode_swet
real(kind(1d0)), dimension(:), allocatable metfordisaggprev
character(len=20), dimension(ncolumnssoil) headersoil_reqd
integer diagnosedisaggestm
real(kind(1d0)) halftimestep
real(kind(1d0)), dimension(:, :), allocatable water_coeff
integer, parameter ncolumnsmetforcingdata
real(kind(1d0)), dimension(:, :), allocatable irrigation_coeff
integer nlinesestmcoefficients
subroutine narp_cal_sunposition(year, idectime, UTC, locationlatitude, locationlongitude, locationaltitude, sunazimuth, sunzenith)
real(kind(1d0)), dimension(:, :), allocatable soil_coeff
real(kind(1d0)) zenith_deg
subroutine disaggregatemet(iBlock, igrid)
integer readlinesorigestmdatamax
real(kind(1d0)), dimension(:, :), allocatable estmcoefficients_coeff
character(len=150) fileorigmet
real(kind(1d0)), dimension(:, :), allocatable snow_coeff
real(kind(1d0)), dimension(:), allocatable estmfordisaggnext
character(len=20), dimension(ncolumnswgwaterdist) headerwgwaterdist_file
integer, dimension(nsurfincsnow) c_ohmcode_wwet
character(len=20), dimension(ncolumnswgwaterdist) headerwgwaterdist_reqd
real(kind(1d0)) soilrocks
integer, dimension(nsurfincsnow) c_estmcode
integer, dimension(nsurfincsnow) c_ohmcode_wdry
real(kind(1d0)), dimension(5) multrainamongnupperi
character(len=90), dimension(14) text
real(kind(1d0)), dimension(:, :), allocatable surfacechar
character(len=20), dimension(ncolumnsprofiles) headerprofiles_file
character(len=20), dimension(ncolumnsirrigation) headerirrigation_file
integer function, dimension(:), allocatable randomsamples(N, OutOf)
character(len=20), dimension(ncolumnsanthropogenic) headeranthropogenic_file
integer nlinesanthropogenic
integer resolutionfilesinestm
subroutine disaggregateestm(iBlock)
real(kind(1d0)) soildensity
real(kind(1d0)), dimension(:), allocatable estmfordisaggprev
integer readlinesorigmetdatamax
integer nlinesconductance
character(len=150) filedscdestm
integer nlinesohmcoefficients
character(len=150) filedscdmet
character(len=20), dimension(ncolumnswater) headerwater_reqd
real(kind(1d0)) soildepthmeas
character(len=20), dimension(ncolumnssoil) headersoil_file
real(kind(1d0)), dimension(:, :), allocatable siteselect
real(kind(1d0)), dimension(:, :), allocatable ohmcoefficients_coeff
real(kind(1d0)), dimension(:, :), allocatable anthropogenic_coeff
real(kind(1d0)) function, dimension(readlinesorig_loc *nper_loc) disagg_lin(Slow, SlowPrev, SlowNext, DisaggType, Nper_loc, ReadLinesOrig_loc, ReadLinesOrigMax_loc, iBlock)
real(kind(1d0)), dimension(:, :), allocatable estmfordisagg
real(kind(1d0)), dimension(:), allocatable metfordisaggnext
character(len=20), dimension(ncolumnsbiogen) headerbiogen_file
integer, parameter ncolsestmdata
real(kind(1d0)), dimension(:, :), allocatable biogen_coeff
character(len=20), dimension(ncolumnssnow) headersnow_file
integer readblocksorigmetdata
real(kind(1d0)), dimension(:, :), allocatable wgwaterdist_coeff
real(kind(1d0)) function, dimension(readlinesorig_loc *nper_loc) disaggp_amongnmult(Slow, multupperI, multamongN, Nper_loc, ReadLinesOrig_loc, ReadLinesOrigMax_loc)
character(len=20), dimension(ncolumnsnonveg) headernonveg_file
real(kind(1d0)), dimension(:, :), allocatable veg_coeff
character(len=20), dimension(ncolumnssnow) headersnow_reqd
character(len=20), dimension(ncolumnsohmcoefficients) headerohmcoefficients_file
character(len=20), dimension(ncolumnswater) headerwater_file
character(len=20), dimension(ncolumnsveg) headerveg_file
real(kind(1d0)) function, dimension(readlinesorig_loc *nper_loc) disaggp_amongn(Slow, amongN, Nper_loc, ReadLinesOrig_loc, ReadLinesOrigMax_loc)
character(len=20), dimension(ncolumnsprofiles) headerprofiles_reqd
integer nlineswgwaterdist
integer readlinesorigestmdata
integer, dimension(nsurfincsnow) c_ohmcode_sdry
character(len=20), dimension(ncolumnsirrigation) headerirrigation_reqd
character(len=150) fileorigestm
integer resolutionfilesin
integer netradiationmethod
subroutine disaggregatedatetime(DateTimeForDisagg, tstep, Nper, ReadLinesOrigMetDataMax, DateTimeDscd)
real(kind(1d0)), dimension(:, :), allocatable nonveg_coeff
real(kind(1d0)), dimension(:, :, :), allocatable metforcingdata
integer, dimension(5) multrainamongn
character(len=20), dimension(ncolumnsveg) headerveg_reqd
character(len=20), dimension(ncolumnsestmcoefficients) headerestmcoefficients_reqd
real(kind(1d0)), dimension(:, :, :), allocatable estmforcingdata
real(kind(1d0)), dimension(:, :), allocatable conductance_coeff
character(len=20), dimension(ncolumnsohmcoefficients) headerohmcoefficients_reqd
character(len=20), dimension(ncolumnsanthropogenic) headeranthropogenic_reqd
integer, parameter pavsurf
character(len=20), dimension(ncolumnsestmcoefficients) headerestmcoefficients_file
subroutine errorhint(errh, ProblemFile, VALUE, value2, valueI)
integer, parameter bldgsurf
character(len=20), dimension(ncolumnsconductance) headercond_file
character(len=20), dimension(ncolumnsconductance) headercond_reqd
real(kind(1d0)), dimension(:, :), allocatable profiles_coeff
real(kind(1d0)), dimension(:, :), allocatable metfordisagg
integer skippedlinesorigestm
character(len=20), dimension(ncolumnsnonveg) headernonveg_reqd