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
604 IF (
filename ==
'SUEWS_NonVeg.txt')
THEN 612 ELSEIF (
filename ==
'SUEWS_Veg.txt')
THEN 618 ELSEIF (
filename ==
'SUEWS_Water.txt')
THEN 626 ELSEIF (
filename ==
'SUEWS_Snow.txt')
THEN 632 ELSEIF (
filename ==
'SUEWS_Soil.txt')
THEN 638 ELSEIF (
filename ==
'SUEWS_Conductance.txt')
THEN 644 ELSEIF (
filename ==
'SUEWS_OHMCoefficients.txt')
THEN 647 CALL errorhint(56,
'Names or order of columns in SUEWS_OHMCoefficients.txt does not match model code.', &
651 ELSEIF (
filename ==
'SUEWS_ESTMCoefficients.txt')
THEN 654 CALL errorhint(56,
'Names or order of columns in SUEWS_ESTMCoefficients.txt does not match model code.', &
658 ELSEIF (
filename ==
'SUEWS_AnthropogenicEmission.txt')
THEN 661 CALL errorhint(56,
'Names or order of columns in SUEWS_AnthropogenicEmission.txt does not match model code.', &
665 ELSEIF (
filename ==
'SUEWS_Irrigation.txt')
THEN 670 CALL errorhint(56,
'Names or order of columns in SUEWS_Irrigation.txt does not match model code.', &
674 ELSEIF (
filename ==
'SUEWS_Profiles.txt')
THEN 677 CALL errorhint(56,
'Names or order of columns in SUEWS_Profiles.txt does not match model code.', &
681 ELSEIF (
filename ==
'SUEWS_WithinGridWaterDist.txt')
THEN 684 CALL errorhint(56,
'Names or order of columns in SUEWS_WithinGridWaterDist.txt does not match model code.', &
688 ELSEIF (
filename ==
'SUEWS_BiogenCO2.txt')
THEN 691 CALL errorhint(56,
'Names or order of columns in SUEWS_BiogenCO2.txt does not match model code.', &
696 WRITE (*, *)
'Problem in subroutine InputHeaderCheck. File header not specified in model code for ',
filename 747 INTEGER,
INTENT(IN) :: Hour, Min, Sec
748 INTEGER :: total_sec, SecPerHour
749 REAL(KIND(1d0)),
DIMENSION(0:23),
INTENT(IN) :: Prof_24h
750 REAL(KIND(1d0)):: deltaProf
751 REAL(KIND(1d0)) :: Prof_CurrTime
753 total_sec = min*60 + sec
760 deltaprof = (prof_24h(j) - prof_24h(i))/secperhour
761 prof_currtime = prof_24h(hour) + deltaprof*total_sec
773 INTEGER,
INTENT(IN) :: Hour, Min, Sec
774 INTEGER :: total_sec, SecPerHour
775 REAL(KIND(1d0)),
DIMENSION(0:23),
INTENT(IN) :: Prof_24h
776 REAL(KIND(1d0)),
DIMENSION(0:23):: Prof_24h_mean
777 REAL(KIND(1d0)):: deltaProf
778 REAL(KIND(1d0)) :: Prof_CurrTime
780 total_sec = min*60 + sec
783 prof_24h_mean = merge(prof_24h/(sum(prof_24h)/
size(prof_24h, dim=1)), 0.d0, sum(prof_24h) /= 0)
790 deltaprof = (prof_24h_mean(j) - prof_24h_mean(i))/secperhour
793 prof_currtime = prof_24h_mean(i) + deltaprof*total_sec
805 INTEGER,
INTENT(IN) :: Hour, Min, Sec, dt
806 INTEGER :: total_sec, SecPerHour
807 REAL(KIND(1d0)),
DIMENSION(0:23),
INTENT(IN) :: Prof_24h
808 REAL(KIND(1d0)),
DIMENSION(0:23):: Prof_24h_sum
809 REAL(KIND(1d0)):: deltaProf
810 REAL(KIND(1d0)) :: Prof_CurrTime
812 total_sec = min*60 + sec
815 prof_24h_sum = merge(prof_24h/(sum(prof_24h)), 0.d0, sum(prof_24h) /= 0)
821 deltaprof = (prof_24h_sum(j) - prof_24h_sum(i))/secperhour
822 prof_currtime = prof_24h_sum(hour) + deltaprof*total_sec
823 prof_currtime = prof_currtime*dt/secperhour
846 CHARACTER(len=4):: SWWD
850 IF (swwd ==
'SWet')
THEN 857 'not found in OHM_Coefficients.txt for surface', is,
'.' 862 ELSEIF (swwd ==
'SDry')
THEN 869 'not found in OHM_Coefficients.txt for surface', is,
'.' 874 ELSEIF (swwd ==
'WWet')
THEN 881 'not found in OHM_Coefficients.txt for surface', is,
'.' 886 ELSEIF (swwd ==
'WDry')
THEN 893 'not found in OHM_Coefficients.txt for surface', is,
'.' 899 WRITE (*, *)
'Problem with CodeMatchOHM (in SUEWS_CodeMatch.f95). ', swwd,
' not recognised. Needs to be one of: ', &
900 'SWet = Summer Wet, SDry = Summer Dry, WWet = WinterWet, WDry = Winter Dry. N.B. Case sensitive. ' 932 'not found in ESTM_Coefficients.txt for surface', is,
'.' 964 'not found in ESTM_Coefficients.txt for surface', is,
'.' 974 'not found in ESTM_Coefficients.txt for surface', is,
'.' 979 WRITE (*, *)
'Problem with CodeMatchESTM_Class (in SUEWS_CodeMatch.f95). ', is,
' not correct. Needs to be either ', &
980 '1 = Paved surfaced, 2 = Bldgs surfaces.' 1001 INTEGER:: SurfaceCharCodeCol
1009 WRITE (*, *)
'Program stopped! Profile code ',
surfacechar(gridiv, surfacecharcodecol),
'not found in SUEWS_Profiles.txt.' 1033 INTEGER:: codeCol, codeColSameSurf
1041 WRITE (*, *)
'Program stopped! Within-grid water distribution code ',
siteselect(rr, codecol), &
1042 'not found in SUEWS_WaterDistWithinGrid.txt.' 1049 CALL errorhint(8,
'Diagonal elements should be zero as water cannot move from one surface to the same surface.', &
1059 CALL errorhint(9,
'One of these (ToRunoff,ToSoilStore) should be zero.', &
1068 CALL errorhint(8,
'Total water distribution from each surface should add up to 1.', &
1098 WRITE (*, *)
'Program stopped! NonVeg code ',
siteselect(rr, codecol),
'not found in SUEWS_NonVeg.txt.' 1128 WRITE (*, *)
'Program stopped! Veg code ',
siteselect(rr, codecol),
'not found in SUEWS_Vegs.txt.' 1158 WRITE (*, *)
'Program stopped! Water code ',
siteselect(rr, codecol),
'not found in SUEWS_Water.txt.' 1188 WRITE (*, *)
'Program stopped! Snow code ',
siteselect(rr, codecol),
'not found in SUEWS_Snow.txt.' 1218 WRITE (*, *)
'Program stopped! Conductance code ',
siteselect(rr, codecol),
'not found in SUEWS_Conductance.txt.' 1249 WRITE (*, *)
'Program stopped! Anthropogenic code ',
siteselect(rr, codecol), &
1250 'not found in SUEWS_AnthropogenicEmission.txt.' 1251 CALL errorhint(57,
'Cannot find code in SUEWS_AnthropogenicEmission.txt', &
1281 WRITE (*, *)
'Program stopped! Irrigation code ',
siteselect(rr, codecol),
'not found in SUEWS_Irrigation.txt.' 1303 INTEGER:: SurfaceCharCodeCol
1311 WRITE (*, *)
'Program stopped! Soil code ',
surfacechar(gridiv, surfacecharcodecol),
'not found in SUEWS_Soil.txt.' 1333 INTEGER:: SurfaceCharCodeCol
1341 WRITE (*, *)
'Program stopped! Biogen code ',
surfacechar(gridiv, surfacecharcodecol),
'not found in SUEWS_BiogenCO2.txt.' 1389 INTEGER:: lunit = 100
1392 INTEGER:: iBlock, igrid
1393 INTEGER,
DIMENSION(Nper):: seq1Nper
1394 INTEGER,
DIMENSION(nsd):: seq1nsd
1395 INTEGER,
DIMENSION(nColumnsMetForcingData):: MetDisaggMethod
1396 REAL(KIND(1d0)),
DIMENSION(nColumnsMetForcingData):: MetArrayOrig
1397 REAL(KIND(1d0)),
DIMENSION(ReadLinesOrigMetData*Nper, ncolumnsMetForcingData):: Met_tt
1398 REAL(KIND(1d0)),
DIMENSION(ReadLinesOrigMetData*Nper):: Met_tt_kdownAdj
1399 CHARACTER(LEN=9),
DIMENSION(ncolumnsMetForcingData):: HeaderMet
1400 CHARACTER(LEN=10*ncolumnsMetForcingData):: HeaderMetOut
1403 REAL(KIND(1d0)),
DIMENSION(ReadLinesOrigMetData*Nper):: dectimeFast
1404 REAL(KIND(1d0)),
DIMENSION(ReadLinesOrigMetData*Nper):: idectime
1421 metdisaggmethod = -999
1424 seq1nper = (/(i, i=1,
nper, 1)/)
1425 seq1nsd = (/(i, i=1,
nsd, 1)/)
1430 metdisaggmethod(:) = 10
1432 metdisaggmethod(:) = 20
1434 metdisaggmethod(:) = 10
1435 metdisaggmethod(10:13) = 20
1437 CALL errorhint(2,
'Problem in SUEWS_MetDisagg: DisaggMethod value should be 1, 2, or 3', &
1445 OPEN (lunit, file=trim(
fileorigmet), status=
'old')
1447 READ (lunit, *) headermet
1486 CALL errorhint(2,
'Problem in SUEWS_MetDisagg: timestamps in met forcing file inconsistent with ResolutionFilesIn', &
1487 REAL(ResolutionFilesIn, KIND(1d0)), NotUsed, tdiff*60)
1493 CALL errorhint(3,
'Problem in SUEWS_MetDisagg: multiple years found in original met forcing file.', &
1498 IF (
diagnose == 1)
WRITE (*, *)
'Disaggregating met forcing data (', trim(
fileorigmet),
') to model time-step...' 1505 IF (metdisaggmethod(14) == 100)
THEN 1508 met_tt(:, 16) = -999
1512 ELSEIF (metdisaggmethod(14) == 101)
THEN 1514 CALL errorhint(2,
'Problem in SUEWS_MetDisagg: RainDisaggMethod requires RainAmongN', &
1515 REAL(RainAmongN, KIND(1d0)), NotUsed, RainDisaggMethod)
1517 CALL errorhint(2,
'Problem in SUEWS_MetDisagg: RainAmongN > Nper',
REAL(Nper, KIND(1d0)), NotUsed, RainAmongN)
1522 met_tt(:, 16) = -999
1528 ELSEIF (metdisaggmethod(14) == 102)
THEN 1530 CALL errorhint(2,
'Problem in SUEWS_MetDisagg: RainDisaggMethod requires MultRainAmongN', &
1531 REAL(MultRainAmongN(1), KIND(1d0)), NotUsed, RainDisaggMethod)
1533 CALL errorhint(2,
'Problem in SUEWS_MetDisagg: RainDisaggMethod requires MultRainAmongNUpperI', &
1536 CALL errorhint(2,
'Problem in SUEWS_MetDisagg: MultRainAmongN > Nper',
REAL(Nper, KIND(1d0)), NotUsed, &
1542 met_tt(:, 16) = -999
1549 WRITE (*, *)
'Disaggregation code for rain not recognised' 1551 ELSEIF (ii == 24)
THEN 1553 WRITE (*, *)
'Disaggregation of wind direction not currently implemented!' 1558 met_tt(:, ii) = -999
1568 IF (
diagnosedisagg == 1)
WRITE (*, *)
'Adjusting disaggregated kdown using zenith angle' 1569 met_tt_kdownadj(:) = met_tt(:, 15)
1576 dectimefast(:) = met_tt(:, 2) + met_tt(:, 3)/24.0 + met_tt(:, 4)/(60.0*24.0)
1583 met_tt_kdownadj(i) = 0.0
1588 met_tt_kdownadj((i - 1)*
nsd + seq1nsd) = &
1589 met_tt_kdownadj((i - 1)*
nsd + seq1nsd) &
1590 *sum(met_tt((i - 1)*
nsd + seq1nsd, 15)) &
1591 /sum(met_tt_kdownadj((i - 1)*
nsd + seq1nsd))
1594 met_tt(:, 15) = met_tt_kdownadj(:)
1604 met_tt(:, 13) = met_tt(:, 13)/10.0
1608 IF (iblock == 1)
THEN 1612 headermetout = adjustl(headermet(i))
1614 headermetout = trim(headermetout)//
' '//adjustl(headermet(i))
1619 WRITE (78,
'(a)') headermetout
1621 OPEN (78, file=trim(
filedscdmet), position=
'append')
1634 303
FORMAT((i4, 1x), 3(i3, 1x), 9(f12.6, 1x), (f9.4, 1x), 10(f9.4, 1x))
1659 INTEGER:: lunit = 101
1663 INTEGER,
DIMENSION(NperESTM):: seq1NperESTM
1664 INTEGER,
DIMENSION(nsd):: seq1nsd
1665 INTEGER,
DIMENSION(ncolsESTMdata):: ESTMDisaggMethod
1666 REAL(KIND(1d0)),
DIMENSION(ncolsESTMdata):: ESTMArrayOrig
1667 REAL(KIND(1d0)),
DIMENSION(ReadLinesOrigESTMData*NperESTM, ncolsESTMdata):: ESTM_tt
1668 CHARACTER(LEN=9),
DIMENSION(ncolsESTMdata):: HeaderESTM
1669 CHARACTER(LEN=10*ncolsESTMdata):: HeaderESTMOut
1686 estmdisaggmethod = -999
1689 seq1nperestm = (/(i, i=1,
nperestm, 1)/)
1690 seq1nsd = (/(i, i=1,
nsd, 1)/)
1695 estmdisaggmethod(:) = 10
1697 estmdisaggmethod(:) = 20
1699 CALL errorhint(2,
'Problem in SUEWS_ESTMDisagg: DisaggMethodESTM value should be 1 or 2', &
1707 READ (lunit, *) headerestm
1715 READ (lunit, *, iostat=iostat_var) estmarrayorig
1720 READ (lunit, *, iostat=iostat_var) estmarrayorig
1725 READ (lunit, *, iostat=iostat_var) estmarrayorig
1740 CALL errorhint(2,
'Problem in SUEWS_ESTMDisagg: timestamps in ESTM forcing file inconsistent with ResolutionFilesInESTM', &
1741 REAL(ResolutionFilesInESTM, KIND(1d0)), NotUsed, tdiff*60)
1746 WRITE (*, *)
'Disaggregating ESTM forcing data (', trim(
fileorigestm),
') to model time-step...' 1800 estm_tt(:, ii) = -999
1812 IF (iblock == 1)
THEN 1816 headerestmout = adjustl(headerestm(i))
1818 headerestmout = trim(headerestmout)//
' '//adjustl(headerestm(i))
1823 WRITE (78,
'(a)') headerestmout
1829 WRITE (78, 304) (int(estm_tt(i, ii)), ii=1, 4), estm_tt(i, 5:
ncolsestmdata)
1838 304
FORMAT((i4, 1x), 3(i3, 1x), 9(f9.4, 1x))
1853 SUBROUTINE disaggregatedatetime(DateTimeForDisagg, tstep, Nper, ReadLinesOrigMetDataMax, DateTimeDscd)
1856 INTEGER,
INTENT(in) :: tstep, Nper, ReadLinesOrigMetDataMax
1857 REAL(KIND(1d0)),
DIMENSION(ReadLinesOrigMetData, 4),
INTENT(in):: DateTimeForDisagg
1858 REAL(KIND(1d0)),
DIMENSION(ReadLinesOrigMetData*Nper, 4),
INTENT(out):: DateTimeDscd
1860 REAL(KIND(1d0)),
DIMENSION(ReadLinesOrigMetData):: dectimeOrig
1861 REAL(KIND(1d0)),
DIMENSION(Nper) :: temp_dectime
1862 INTEGER,
DIMENSION(Nper):: temp_iy, temp_id, temp_ih, temp_im, temp_ihm
1863 INTEGER,
DIMENSION(Nper)::ndays_iy
1866 INTEGER,
DIMENSION(Nper):: seq1Nper
1869 seq1nper = (/(i, i=1, nper, 1)/)
1873 dectimeorig = (datetimefordisagg(:, 2) - 1) + datetimefordisagg(:, 3)/24.0 + datetimefordisagg(:, 4)/(60.0*24.0)
1875 DO i = 1, readlinesorigmetdatamax
1878 temp_dectime = dectimeorig(i) - (tstep/60.0)/(60.0*24.0)*(/(ii, ii=(nper - 1), 0, -1)/)
1879 temp_dectime = nint(temp_dectime*60*60*24)/(60*60*24*1.)
1883 temp_iy = merge(int(datetimefordisagg(i, 1)) - 1, int(datetimefordisagg(i, 1)), temp_dectime < 0)
1886 ndays_iy = daysinyear(temp_iy)
1887 temp_dectime = merge(temp_dectime + ndays_iy, temp_dectime, temp_dectime < 0)
1888 temp_id = floor(temp_dectime) + 1
1890 temp_ihm = nint((temp_dectime + 1 - temp_id/1.0)*60.0*24.0)
1891 temp_ih = (temp_ihm - mod(temp_ihm, 60))/60
1892 temp_ih = merge(temp_ih, 0, mask=(temp_ih < 24))
1893 temp_im = mod(temp_ihm, 60)
1896 datetimedscd(nper*(i - 1) + seq1nper, 1) = temp_iy
1897 datetimedscd(nper*(i - 1) + seq1nper, 2) = temp_id
1898 datetimedscd(nper*(i - 1) + seq1nper, 3) = temp_ih
1899 datetimedscd(nper*(i - 1) + seq1nper, 4) = temp_im
1907 FUNCTION disagg_lin(Slow, SlowPrev, SlowNext, DisaggType, Nper_loc, ReadLinesOrig_loc, ReadLinesOrigMax_loc, iBlock)
RESULT(Fast)
1914 INTEGER:: DisaggType
1916 INTEGER:: ReadLinesOrig_loc, ReadLinesOrigMax_loc
1918 REAL(KIND(1d0)),
DIMENSION(ReadLinesOrig_loc*Nper_loc):: Fast
1919 REAL(KIND(1d0)),
DIMENSION(ReadLinesOrig_loc):: Slow
1920 REAL(KIND(1d0)):: SlowPrev, SlowNext
1921 INTEGER,
DIMENSION(Nper_loc):: FastRows
1922 INTEGER,
DIMENSION(FLOOR(Nper_loc/2.0)):: FirstRows10
1923 INTEGER,
DIMENSION(Nper_loc - FLOOR(Nper_loc/2.0)):: LastRows10
1924 INTEGER,
DIMENSION(Nper_loc):: FirstRows20
1925 INTEGER,
DIMENSION(Nper_loc):: seq1Nper_loc
1930 IF (mod(nper_loc, 2) == 0) xnper_loc = 2
1931 IF (mod(nper_loc, 2) == 1) xnper_loc = 1
1933 seq1nper_loc = (/(i, i=1, nper_loc, 1)/)
1936 IF (disaggtype == 10)
THEN 1937 fastrows = floor(nper_loc/2.0) + seq1nper_loc
1938 firstrows10 = (/(i, i=1, (fastrows(1) - 1), 1)/)
1940 (/(i, i=nper_loc*(readlinesorigmax_loc - 1 - 1) + fastrows(nper_loc) + 1, &
1941 (readlinesorigmax_loc*nper_loc), 1)/)
1942 ELSEIF (disaggtype == 20)
THEN 1943 fastrows = nper_loc + seq1nper_loc
1944 firstrows20 = (/(i, i=1, (fastrows(1) - 1), 1)/)
1950 IF (disaggtype == 10)
THEN 1951 IF (
diagnosedisagg == 1)
WRITE (*, *)
'Linearly disaggregating averaged variable' 1952 DO i = 1, (readlinesorigmax_loc - 1)
1953 fast(nper_loc*(i - 1) + fastrows) = slow(i) - &
1954 (slow(i + 1) - slow(i))/(xnper_loc*nper_loc) + &
1955 (slow(i + 1) - slow(i))/nper_loc*(/(ii, ii=1, nper_loc, 1)/)
1959 IF (iblock == 1)
THEN 1960 fast(firstrows10) = fast(fastrows(1))
1962 fast(firstrows10) = slowprev - &
1963 (slow(1) - slowprev)/(xnper_loc*nper_loc) + &
1964 (slow(1) - slowprev)/nper_loc* &
1965 (/(ii, ii=(nper_loc -
SIZE(firstrows10) + 1), nper_loc, 1)/)
1969 fast(lastrows10) = fast(nper_loc*(readlinesorigmax_loc - 1 - 1) + fastrows(nper_loc))
1971 fast(lastrows10) = slow(readlinesorigmax_loc) - &
1972 (slownext - slow(readlinesorigmax_loc))/(xnper_loc*nper_loc) + &
1973 (slownext - slow(readlinesorigmax_loc))/nper_loc* &
1974 (/(ii, ii=1,
SIZE(lastrows10), 1)/)
1976 ELSEIF (disaggtype == 20)
THEN 1977 IF (
diagnosedisagg == 1)
WRITE (*, *)
'Linearly disaggregating instantaneous variable' 1978 DO i = 1, (readlinesorigmax_loc - 1)
1979 fast(nper_loc*(i - 1) + fastrows) = (slow(i) + &
1980 (slow(i + 1) - slow(i))/nper_loc*2*(seq1nper_loc - 1) + &
1984 IF (iblock == 1)
THEN 1985 fast(firstrows20) = fast(fastrows(1))
1987 fast(firstrows20) = (slowprev + &
1988 (slow(1) - slowprev)/nper_loc*2* &
1989 ((/(ii, ii=(nper_loc -
SIZE(firstrows20) + 1), nper_loc, 1)/) - 1) + &
2003 IF (any(fast(1:readlinesorigmax_loc*nper_loc) == -999))
THEN 2004 WRITE (*, *)
'Problem: -999s (', count(fast(1:readlinesorigmax_loc*nper_loc) == -999),
') in disaggregated data.' 2012 FUNCTION disaggp_amongn(Slow, amongN, Nper_loc, ReadLinesOrig_loc, ReadLinesOrigMax_loc)
RESULT(Fast)
2026 INTEGER:: ReadLinesOrig_loc, ReadLinesOrigMax_loc
2027 REAL(KIND(1d0)),
DIMENSION(ReadLinesOrig_loc*Nper_loc):: Fast
2028 REAL(KIND(1d0)),
DIMENSION(ReadLinesOrig_loc):: Slow
2029 INTEGER,
DIMENSION(:),
ALLOCATABLE:: Subintervals
2030 INTEGER,
DIMENSION(Nper_loc):: seq1Nper_loc
2034 ALLOCATE (subintervals(amongn))
2035 subintervals(:) = -999
2037 seq1nper_loc = (/(i, i=1, nper_loc, 1)/)
2039 IF (
diagnosedisagg == 1)
WRITE (*, *)
'Distributing over ', amongn,
' subintervals for variable' 2041 IF (amongn == nper_loc)
THEN 2042 subintervals(:) = seq1nper_loc
2044 IF (amongn > nper_loc) &
2045 CALL errorhint(2,
'Problem in SUEWS_MetDisagg: no. of rainy periods cannot exceed number of subintervals', &
2046 REAL(Nper_loc, KIND(1d0)), NotUsed, amongN)
2050 DO i = 1, readlinesorigmax_loc
2051 fast(nper_loc*(i - 1) + seq1nper_loc) = 0
2052 IF (slow(i) > 0)
THEN 2053 IF (amongn < nper_loc)
THEN 2054 subintervals(:) = -999
2057 fast(nper_loc*(i - 1) + subintervals) = slow(i)/amongn
2061 IF (any(fast(1:readlinesorigmax_loc*nper_loc) == -999))
THEN 2062 WRITE (*, *)
'Problem: -999s (', count(fast(1:readlinesorigmax_loc*nper_loc) == -999),
') in disaggregated data' 2063 CALL errorhint(13,
'Problem in SUEWS_MetDisagg: -999 values in disaggregated data.', notused, notused,
notusedi)
2070 FUNCTION disaggp_amongnmult(Slow, multupperI, multamongN, Nper_loc, ReadLinesOrig_loc, ReadLinesOrigMax_loc)
RESULT(Fast)
2082 REAL(KIND(1d0)),
DIMENSION(5):: multupperI
2083 INTEGER,
DIMENSION(5):: multamongN
2084 INTEGER:: thisamongN
2086 INTEGER:: ReadLinesOrig_loc, ReadLinesOrigMax_loc
2087 REAL(KIND(1d0)),
DIMENSION(ReadLinesOrig_loc*Nper_loc):: Fast
2088 REAL(KIND(1d0)),
DIMENSION(ReadLinesOrig_loc):: Slow
2089 INTEGER,
DIMENSION(:),
ALLOCATABLE:: Subintervals
2090 INTEGER,
DIMENSION(Nper_loc):: seq1Nper_loc
2093 seq1nper_loc = (/(i, i=1, nper_loc, 1)/)
2095 IF (
diagnosedisagg == 1)
WRITE (*, *)
'Distributing over variable subintervals depending on intensity for variable' 2099 DO i = 1, readlinesorigmax_loc
2100 fast(nper_loc*(i - 1) + seq1nper_loc) = 0
2101 IF (slow(i) > 0)
THEN 2103 IF (slow(i) <= multupperi(1))
THEN 2104 thisamongn = multamongn(1)
2105 ELSEIF (slow(i) > multupperi(1) .AND. slow(i) <= multupperi(2))
THEN 2106 thisamongn = multamongn(2)
2107 ELSEIF (slow(i) > multupperi(2) .AND. slow(i) <= multupperi(3))
THEN 2108 thisamongn = multamongn(3)
2109 ELSEIF (slow(i) > multupperi(3) .AND. slow(i) <= multupperi(4))
THEN 2110 thisamongn = multamongn(4)
2111 ELSEIF (slow(i) > multupperi(4) .AND. slow(i) <= multupperi(5))
THEN 2112 thisamongn = multamongn(5)
2113 ELSEIF (slow(i) > multupperi(5))
THEN 2114 thisamongn = multamongn(5)
2115 CALL errorhint(4,
'Precip in met forcing file exceeds maxiumum MultRainAmongNUpperI', &
2120 ALLOCATE (subintervals(thisamongn))
2121 subintervals(:) = -999
2123 IF (thisamongn > nper_loc)
CALL errorhint(2,
'Problem in SUEWS_MetDisagg: no. of rainy periods cannot exceed '// &
2124 'number of subintervals',
REAL(Nper_loc, KIND(1d0)), NotUsed, thisamongN)
2126 IF (thisamongn == nper_loc)
THEN 2127 subintervals(:) = seq1nper_loc
2128 ELSEIF (thisamongn < nper_loc)
THEN 2131 fast(nper_loc*(i - 1) + subintervals) = slow(i)/thisamongn
2133 DEALLOCATE (subintervals)
2137 IF (any(fast(1:readlinesorigmax_loc*nper_loc) == -999))
THEN 2138 WRITE (*, *)
'Problem: -999s (', count(fast(1:readlinesorigmax_loc*nper_loc) == -999),
') in disaggregated data' 2139 CALL errorhint(13,
'Problem in SUEWS_MetDisagg: -999 values in disaggregated data.', notused, notused,
notusedi)
2159 INTEGER,
DIMENSION(:),
ALLOCATABLE:: Samples
2162 ALLOCATE (samples(n))
2167 DO WHILE (any(samples == -999))
2168 CALL random_number(r)
2169 x = int(r*outof) + 1
2172 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