SUEWS API Site
Documentation of SUEWS source code
Functions/Subroutines
metdisagg Module Reference

Functions/Subroutines

subroutine disaggregatemet (iBlock, igrid)
 
subroutine disaggregateestm (iBlock)
 
subroutine disaggregatedatetime (DateTimeForDisagg, tstep, Nper, ReadLinesOrigMetDataMax, DateTimeDscd)
 
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)) function, dimension(readlinesorig_loc *nper_loc) disaggp_amongn (Slow, amongN, Nper_loc, ReadLinesOrig_loc, ReadLinesOrigMax_loc)
 
real(kind(1d0)) function, dimension(readlinesorig_loc *nper_loc) disaggp_amongnmult (Slow, multupperI, multamongN, Nper_loc, ReadLinesOrig_loc, ReadLinesOrigMax_loc)
 
integer function, dimension(:), allocatable randomsamples (N, OutOf)
 

Function/Subroutine Documentation

◆ disagg_lin()

real(kind(1d0)) function, dimension(readlinesorig_loc*nper_loc) metdisagg::disagg_lin ( real(kind(1d0)), dimension(readlinesorig_loc)  Slow,
real(kind(1d0))  SlowPrev,
real(kind(1d0))  SlowNext,
integer  DisaggType,
integer  Nper_loc,
integer  ReadLinesOrig_loc,
integer  ReadLinesOrigMax_loc,
integer  iBlock 
)

Definition at line 1909 of file suews_ctrl_input.f95.

References data_in::diagnosedisagg, errorhint(), defaultnotused::notused, defaultnotused::notusedi, and initial::readblocksorigmetdata.

Referenced by disaggregateestm(), and disaggregatemet().

1909 
1910  USE defaultnotused
1911  USE sues_data
1912 
1913  IMPLICIT NONE
1914 
1915  INTEGER:: disaggtype !Type of disaggregation: 10 for averaged variables; 20 for instantaneous variables
1916  INTEGER:: nper_loc !Number of subintervals per interval (local Nper)
1917  INTEGER:: readlinesorig_loc, readlinesorigmax_loc !Number of lines to read in original file (local)
1918  INTEGER:: iblock
1919  REAL(KIND(1d0)), DIMENSION(ReadLinesOrig_loc*Nper_loc):: fast !Array to receive disaggregated data
1920  REAL(KIND(1d0)), DIMENSION(ReadLinesOrig_loc):: slow !Array to disaggregate
1921  REAL(KIND(1d0)):: slowprev, slownext
1922  INTEGER, DIMENSION(Nper_loc):: fastrows !Group of rows that are filled with each iteration
1923  INTEGER, DIMENSION(FLOOR(Nper_loc/2.0)):: firstrows10 !Rows at the beginning that are not filled during iteration (for averages)
1924  INTEGER, DIMENSION(Nper_loc - FLOOR(Nper_loc/2.0)):: lastrows10 !Rows at the end that are not filled during iteration
1925  INTEGER, DIMENSION(Nper_loc):: firstrows20 !Rows at the beginning that are not filled during iteration (for instantaneous)
1926  INTEGER, DIMENSION(Nper_loc):: seq1nper_loc !1 to Nper_loc
1927  INTEGER:: xnper_loc !XNper_loc = 2 for even Nper_loc; XNper_loc=1 for odd Nper_loc
1928  INTEGER:: i, ii !counters
1929 
1930  ! Calculate XNper_loc (differentiates between disaggregations with odd and even Nper_loc)
1931  IF (mod(nper_loc, 2) == 0) xnper_loc = 2
1932  IF (mod(nper_loc, 2) == 1) xnper_loc = 1
1933 
1934  seq1nper_loc = (/(i, i=1, nper_loc, 1)/)
1935 
1936  ! Setup counters for iteration
1937  IF (disaggtype == 10) THEN
1938  fastrows = floor(nper_loc/2.0) + seq1nper_loc ! Rows to create at model time-step
1939  firstrows10 = (/(i, i=1, (fastrows(1) - 1), 1)/) !For start of dataset
1940  lastrows10 = &
1941  (/(i, i=nper_loc*(readlinesorigmax_loc - 1 - 1) + fastrows(nper_loc) + 1, &
1942  (readlinesorigmax_loc*nper_loc), 1)/) ! For end of dataset
1943  ELSEIF (disaggtype == 20) THEN
1944  fastrows = nper_loc + seq1nper_loc !Rows to create at model time-step
1945  firstrows20 = (/(i, i=1, (fastrows(1) - 1), 1)/) !For start of dataset
1946  ENDIF
1947 
1948  ! Initialise fast array to -999
1949  fast = -999
1950  ! Linearly disaggregate
1951  IF (disaggtype == 10) THEN !Averaged variables
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)/)
1957  ENDDO
1958 
1959  ! For first few rows, use previous met block
1960  IF (iblock == 1) THEN
1961  fast(firstrows10) = fast(fastrows(1)) !Use repeat values at the start of the year
1962  ELSE
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)/)
1967  ENDIF
1968  ! For last few rows, use next met block
1969  IF (iblock == readblocksorigmetdata) THEN
1970  fast(lastrows10) = fast(nper_loc*(readlinesorigmax_loc - 1 - 1) + fastrows(nper_loc)) !Use repeat values at the end of the year
1971  ELSE
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)/)
1976  ENDIF
1977  ELSEIF (disaggtype == 20) THEN !Instantaneous variables
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) + &
1982  slow(i))/2
1983  ENDDO
1984  ! For first few rows, use previous met block
1985  IF (iblock == 1) THEN
1986  fast(firstrows20) = fast(fastrows(1)) !Use repeat values at the start of the year
1987  ELSE
1988  fast(firstrows20) = (slowprev + &
1989  (slow(1) - slowprev)/nper_loc*2* &
1990  ((/(ii, ii=(nper_loc - SIZE(firstrows20) + 1), nper_loc, 1)/) - 1) + &
1991  slowprev)/2
1992  ENDIF
1993  !! Last few rows are already filled for the instantaneous value disaggregation
1994  !IF(iBlock==ReadBlocksOrigMetData) THEN
1995  ! Fast(LastRows20) = Fast(Nper_loc*(ReadLinesOrigMax_loc-1-1)+FastRows(Nper_loc)) !Use repeat values at the end of the year
1996  !ELSE
1997  ! Fast(LastRows20) = (Slow(ReadLinesOrigMax_loc) + &
1998  ! (SlowNext-Slow(ReadLinesOrigMax_loc))/Nper_loc*2 * &
1999  ! ((/(ii, ii=1,SIZE(LastRows20), 1)/)-1) + &
2000  ! Slow(ReadLinesOrigMax_loc))/2
2001  !ENDIF
2002  ENDIF
2003 
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.'
2006  CALL errorhint(13, 'Problem in SUEWS_MetDisagg: -999 values in disaggregated data.', notused, notused, notusedi)
2007  ENDIF
2008 
real(kind(1d0)) notused
subroutine errorhint(errh, ProblemFile, VALUE, value2, valueI)
Here is the call graph for this function:
Here is the caller graph for this function:

◆ disaggp_amongn()

real(kind(1d0)) function, dimension(readlinesorig_loc*nper_loc) metdisagg::disaggp_amongn ( real(kind(1d0)), dimension(readlinesorig_loc)  Slow,
integer  amongN,
integer  Nper_loc,
integer  ReadLinesOrig_loc,
integer  ReadLinesOrigMax_loc 
)

Definition at line 2014 of file suews_ctrl_input.f95.

References data_in::diagnosedisagg, errorhint(), defaultnotused::notusedi, and randomsamples().

Referenced by disaggregatemet().

2014  ! Subroutine to disaggregate precipitation by evenly distributing among N subintervals
2015  ! (i.e. equal intensity in N subintervals)
2016  ! See Ward et al. (in review), meanN, 0.5N or 0.25N approach
2017  ! HCW 10 Feb 2017
2018  !======================================================================================
2019 
2020  USE defaultnotused
2021  USE sues_data
2022 
2023  IMPLICIT NONE
2024 
2025  INTEGER:: amongn !Number of subintervals over which rain will be distributed
2026  INTEGER:: nper_loc !Number of subintervals per interval (local Nper)
2027  INTEGER:: readlinesorig_loc, readlinesorigmax_loc !Number of lines to read in original file (local)
2028  REAL(KIND(1d0)), DIMENSION(ReadLinesOrig_loc*Nper_loc):: fast !Array to receive disaggregated data
2029  REAL(KIND(1d0)), DIMENSION(ReadLinesOrig_loc):: slow !Array to disaggregate
2030  INTEGER, DIMENSION(:), ALLOCATABLE:: subintervals !Array of subintervals that contain rain
2031  INTEGER, DIMENSION(Nper_loc):: seq1nper_loc !1 to Nper_loc
2032  INTEGER:: i
2033 
2034  ! For each averaging period, get subintervals which will receive rain
2035  ALLOCATE (subintervals(amongn))
2036  subintervals(:) = -999
2037 
2038  seq1nper_loc = (/(i, i=1, nper_loc, 1)/)
2039 
2040  IF (diagnosedisagg == 1) WRITE (*, *) 'Distributing over ', amongn, ' subintervals for variable'
2041  ! If all subintervals are to contain rain, don't need to generate random numbers
2042  IF (amongn == nper_loc) THEN
2043  subintervals(:) = seq1nper_loc
2044  ENDIF
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)
2048 
2049  ! Initialise fast array to -999
2050  fast = -999
2051  DO i = 1, readlinesorigmax_loc
2052  fast(nper_loc*(i - 1) + seq1nper_loc) = 0 !Fill all subintervals with zeros initially
2053  IF (slow(i) > 0) THEN !If there is some rainfall during this interval...
2054  IF (amongn < nper_loc) THEN
2055  subintervals(:) = -999
2056  subintervals = randomsamples(amongn, nper_loc)
2057  ENDIF
2058  fast(nper_loc*(i - 1) + subintervals) = slow(i)/amongn
2059  ENDIF
2060  ENDDO
2061 
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)
2065  ENDIF
2066 
real(kind(1d0)) notused
subroutine errorhint(errh, ProblemFile, VALUE, value2, valueI)
Here is the call graph for this function:
Here is the caller graph for this function:

◆ disaggp_amongnmult()

real(kind(1d0)) function, dimension(readlinesorig_loc*nper_loc) metdisagg::disaggp_amongnmult ( real(kind(1d0)), dimension(readlinesorig_loc)  Slow,
real(kind(1d0)), dimension(5)  multupperI,
integer, dimension(5)  multamongN,
integer  Nper_loc,
integer  ReadLinesOrig_loc,
integer  ReadLinesOrigMax_loc 
)

Definition at line 2072 of file suews_ctrl_input.f95.

References data_in::diagnosedisagg, errorhint(), data_in::multrainamongnupperi, defaultnotused::notusedi, and randomsamples().

Referenced by disaggregatemet().

2072  ! Subroutine to disaggregate precipitation by evenly distributing among N subintervals
2073  ! (i.e. equal intensity in N subintervals) for different intensity bins
2074  ! Based on analsysis by Wen Gu
2075  ! HCW 21 Apr 2017
2076  !======================================================================================
2077 
2078  USE defaultnotused
2079  USE sues_data
2080 
2081  IMPLICIT NONE
2082 
2083  REAL(KIND(1d0)), DIMENSION(5):: multupperi !Upper bound of intensity bin
2084  INTEGER, DIMENSION(5):: multamongn !Number of subintervals over which rain will be distributed (array)
2085  INTEGER:: thisamongn !Number of subintervals over which rain will be distributed
2086  INTEGER:: nper_loc !Number of subintervals per interval (local Nper)
2087  INTEGER:: readlinesorig_loc, readlinesorigmax_loc !Number of lines to read in original file (local)
2088  REAL(KIND(1d0)), DIMENSION(ReadLinesOrig_loc*Nper_loc):: fast !Array to receive disaggregated data
2089  REAL(KIND(1d0)), DIMENSION(ReadLinesOrig_loc):: slow !Array to disaggregate
2090  INTEGER, DIMENSION(:), ALLOCATABLE:: subintervals !Array of subintervals that contain rain
2091  INTEGER, DIMENSION(Nper_loc):: seq1nper_loc !1 to Nper_loc
2092  INTEGER:: i
2093 
2094  seq1nper_loc = (/(i, i=1, nper_loc, 1)/)
2095 
2096  IF (diagnosedisagg == 1) WRITE (*, *) 'Distributing over variable subintervals depending on intensity for variable'
2097 
2098  ! Initialise fast array to -999
2099  fast = -999
2100  DO i = 1, readlinesorigmax_loc
2101  fast(nper_loc*(i - 1) + seq1nper_loc) = 0 !Fill all subintervals with zeros initially
2102  IF (slow(i) > 0) THEN !If there is some rainfall during this interval...
2103  !Use intensity in this interval to decide number of subintervals to fill with rain
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', &
2117  slow(i), multrainamongnupperi(5), notusedi)
2118  ENDIF
2119 
2120  ! For each averaging period, get subintervals which will receive rain
2121  ALLOCATE (subintervals(thisamongn))
2122  subintervals(:) = -999
2123 
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)
2126 
2127  IF (thisamongn == nper_loc) THEN ! If all subintervals are to contain rain, don't need to generate random numbers
2128  subintervals(:) = seq1nper_loc
2129  ELSEIF (thisamongn < nper_loc) THEN
2130  subintervals = randomsamples(thisamongn, nper_loc)
2131  ENDIF
2132  fast(nper_loc*(i - 1) + subintervals) = slow(i)/thisamongn
2133  !write(*,*) Slow(i), thisamongN
2134  DEALLOCATE (subintervals)
2135  ENDIF
2136  ENDDO
2137 
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)
2141  ENDIF
2142 
real(kind(1d0)) notused
subroutine errorhint(errh, ProblemFile, VALUE, value2, valueI)
Here is the call graph for this function:
Here is the caller graph for this function:

◆ disaggregatedatetime()

subroutine metdisagg::disaggregatedatetime ( real(kind(1d0)), dimension(readlinesorigmetdata, 4), intent(in)  DateTimeForDisagg,
integer, intent(in)  tstep,
integer, intent(in)  Nper,
integer, intent(in)  ReadLinesOrigMetDataMax,
real(kind(1d0)), dimension(readlinesorigmetdata*nper, 4), intent(out)  DateTimeDscd 
)

Definition at line 1855 of file suews_ctrl_input.f95.

Referenced by disaggregateestm(), and disaggregatemet().

1855  USE datetime_module, ONLY: daysinyear
1856  IMPLICIT NONE
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
1860 
1861  REAL(KIND(1d0)), DIMENSION(ReadLinesOrigMetData):: dectimeorig
1862  REAL(KIND(1d0)), DIMENSION(Nper) :: temp_dectime !temorary varaibles for disaggragation
1863  INTEGER, DIMENSION(Nper):: temp_iy, temp_id, temp_ih, temp_im, temp_ihm ! temorary varaibles for disaggragation
1864  INTEGER, DIMENSION(Nper)::ndays_iy ! number of days in iy
1865 
1866  INTEGER :: i, ii
1867  INTEGER, DIMENSION(Nper):: seq1nper
1868 
1869  ! Generate useful sequences
1870  seq1nper = (/(i, i=1, nper, 1)/)
1871  ! Convert to dectime
1872  ! dectimeOrig = MetForDisagg(:,2) + MetForDisagg(:,3)/24.0 + MetForDisagg(:,4)/(60.0*24.0)
1873  ! correct to dectime(year_start)=0 and dectime(year_end)=days of year (i.e., 365 or 366 if leap year) ! TS 09 May 2018
1874  dectimeorig = (datetimefordisagg(:, 2) - 1) + datetimefordisagg(:, 3)/24.0 + datetimefordisagg(:, 4)/(60.0*24.0)
1875 
1876  DO i = 1, readlinesorigmetdatamax
1877 
1878  ! Downscale dectime using dectimeOrig(i) [becomes timestamp of last subinterval]
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.)
1881 
1882  ! Convert to required formats
1883  ! get year: year-1 if dectime <0, copy `year` from metforcing otherwise
1884  temp_iy = merge(int(datetimefordisagg(i, 1)) - 1, int(datetimefordisagg(i, 1)), temp_dectime < 0)
1885 
1886  ! get day of year:
1887  ndays_iy = daysinyear(temp_iy) ! get days of year for DOY correction when temp_dectime<0 during year-crossing
1888  temp_dectime = merge(temp_dectime + ndays_iy, temp_dectime, temp_dectime < 0) ! correct minus temp_dectime to positive values
1889  temp_id = floor(temp_dectime) + 1 !DOY
1890 
1891  temp_ihm = nint((temp_dectime + 1 - temp_id/1.0)*60.0*24.0) !Minutes of the day (1440 max)
1892  temp_ih = (temp_ihm - mod(temp_ihm, 60))/60 !Hours
1893  temp_ih = merge(temp_ih, 0, mask=(temp_ih < 24))
1894  temp_im = mod(temp_ihm, 60) !Minutes
1895 
1896  ! Copy to Met_tt array
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
1901 
1902  ENDDO
1903 
Here is the caller graph for this function:

◆ disaggregateestm()

subroutine metdisagg::disaggregateestm ( integer  iBlock)

Definition at line 1651 of file suews_ctrl_input.f95.

References data_in::diagnose, data_in::diagnosedisaggestm, disagg_lin(), data_in::disaggmethodestm, disaggregatedatetime(), errorhint(), allocatearray::estmforcingdata, allocatearray::estmfordisagg, allocatearray::estmfordisaggnext, allocatearray::estmfordisaggprev, data_in::filedscdestm, data_in::fileorigestm, initial::gridcounter, data_in::keeptstepfilesin, allocatearray::ncolsestmdata, defaultnotused::notused, defaultnotused::notusedi, sues_data::nperestm, sues_data::nsd, initial::readblocksorigmetdata, initial::readlinesorigestmdata, initial::readlinesorigestmdatamax, initial::readlinesorigmetdatamax, data_in::resolutionfilesinestm, initial::skippedlinesorigestm, and sues_data::tstep.

Referenced by suews_program().

1651  ! Subroutine to disaggregate met forcing data to model time-step
1652  ! HCW 10 Feb 2017
1653  !======================================================================================
1654 
1655  USE sues_data
1656  USE defaultnotused
1657 
1658  IMPLICIT NONE
1659 
1660  INTEGER:: lunit = 101
1661  INTEGER:: tdiff !Time difference (in minutes) between first and second rows of original met forcing file
1662  INTEGER:: i, ii !counter
1663  INTEGER:: iblock
1664  INTEGER, DIMENSION(NperESTM):: seq1nperestm
1665  INTEGER, DIMENSION(nsd):: seq1nsd
1666  INTEGER, DIMENSION(ncolsESTMdata):: estmdisaggmethod ! Stores method to use for disaggregating met data
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
1671  ! REAL(KIND(1d0)),DIMENSION(ReadLinesOrigESTMData):: dectimeOrig
1672  ! REAL(KIND(1d0)),DIMENSION(ReadLinesOrigESTMData*NperESTM):: dectimeDscd
1673  INTEGER::iostat_var
1674 
1675  ! INTEGER, DIMENSION(NperESTM):: temp_iy, temp_id, temp_ih, temp_im, temp_ihm
1676 
1677  ! Allocate and initialise arrays to receive original forcing data --------------------
1678  ALLOCATE (estmfordisagg(readlinesorigestmdata, ncolsestmdata))
1679  ALLOCATE (estmfordisaggprev(ncolsestmdata))
1680  ALLOCATE (estmfordisaggnext(ncolsestmdata))
1681  estmfordisagg(:, :) = -999
1682  estmfordisaggprev(:) = -999
1683  estmfordisaggnext(:) = -999
1684  ! Initialise array to receive disaggregated data
1685  estm_tt = -999
1686  ! Intialise disaggregation method
1687  estmdisaggmethod = -999
1688 
1689  ! Generate useful sequences
1690  seq1nperestm = (/(i, i=1, nperestm, 1)/)
1691  seq1nsd = (/(i, i=1, nsd, 1)/)
1692 
1693  ! Get methods to use for disaggregation from RunControl
1694  ! (N.B.DisaggMethodESTM is set as 1 or 2 in RunControl; ESTMDisaggMethod is array of ncolsESTMdata used here)
1695  IF (disaggmethodestm == 1) THEN
1696  estmdisaggmethod(:) = 10 !linear disaggregation of averages
1697  ELSEIF (disaggmethodestm == 2) THEN
1698  estmdisaggmethod(:) = 20 !linear disaggregation of instantaneous values
1699  ELSE
1700  CALL errorhint(2, 'Problem in SUEWS_ESTMDisagg: DisaggMethodESTM value should be 1 or 2', &
1701  notused, notused, disaggmethodestm)
1702  ENDIF
1703 
1704  ! Read data ---------------------------------------------------------------------
1705  IF (diagnosedisaggestm == 1) WRITE (*, *) 'Reading file: ', trim(fileorigestm)
1706  OPEN (lunit, file=trim(fileorigestm), status='old')
1707  ! CALL skipHeader(lunit,SkipHeaderMet) !Skip header -> read header instead
1708  READ (lunit, *) headerestm
1709  !write(*,*) HeaderMet
1710  ! Skip over lines that have already been read and downscaled
1711  IF (skippedlinesorigestm > 0) THEN
1712  DO i = 1, skippedlinesorigestm - 1 ! minus 1 here because last line of last block needs to be read again
1713  READ (lunit, *)
1714  ENDDO
1715  ! Read in last line of previous block
1716  READ (lunit, *, iostat=iostat_var) estmarrayorig
1717  estmfordisaggprev(1:ncolsestmdata) = estmarrayorig
1718  ENDIF
1719  ! Read in current block
1720  DO i = 1, readlinesorigestmdatamax
1721  READ (lunit, *, iostat=iostat_var) estmarrayorig
1722  estmfordisagg(i, 1:ncolsestmdata) = estmarrayorig
1723  ENDDO
1724  ! Read in first line of next block (except for last block)
1725  IF (iblock /= readblocksorigmetdata) THEN
1726  READ (lunit, *, iostat=iostat_var) estmarrayorig
1727  estmfordisaggnext(1:ncolsestmdata) = estmarrayorig
1728  ENDIF
1729  CLOSE (lunit)
1730 
1731  ! Check resolution of original met forcing data -------------------------------------
1732  ! Find time difference (in minutes) between first and second row
1733  tdiff = int(estmfordisagg(2, 4) - estmfordisagg(1, 4)) !Try using minutes
1734  IF (tdiff == 0) tdiff = int(estmfordisagg(2, 3) - estmfordisagg(1, 3))*60 !If no difference in minutes, try using hours
1735  IF (tdiff < 0) THEN !If time difference is negative (e.g. change of day), instead use second and third row
1736  tdiff = int(estmfordisagg(3, 4) - estmfordisagg(2, 4))
1737  IF (tdiff == 0) tdiff = int(estmfordisagg(3, 3) - estmfordisagg(2, 3))*60 !If no difference in minutes, try using hours
1738  ENDIF
1739  ! Check actual resolution matches specified input resolution
1740  IF (tdiff /= resolutionfilesinestm/60) THEN
1741  CALL errorhint(2, 'Problem in SUEWS_ESTMDisagg: timestamps in ESTM forcing file inconsistent with ResolutionFilesInESTM', &
1742  REAL(ResolutionFilesInESTM, KIND(1d0)), notused, tdiff*60)
1743  ENDIF
1744 
1745  ! Disaggregate time columns ---------------------------------------------------------
1746  IF (diagnose == 1) THEN
1747  WRITE (*, *) 'Disaggregating ESTM forcing data (', trim(fileorigestm), ') to model time-step...'
1748  END IF
1749  CALL disaggregatedatetime(estmfordisagg(:, 1:4), tstep, nperestm, readlinesorigmetdatamax, estm_tt(:, 1:4))
1750  ! ! Convert to dectime
1751  ! dectimeOrig = ESTMForDisagg(:,2) + ESTMForDisagg(:,3)/24.0 + ESTMForDisagg(:,4)/(60.0*24.0)
1752  !
1753  ! DO i=1,ReadLinesOrigESTMDataMax
1754  ! ! Downscale dectime using dectimeOrig(i) [becomes timestamp of last subinterval]
1755  ! dectimeDscd(NperESTM*(i-1)+Seq1NperESTM) = dectimeOrig(i) - (tstep/60.0)/(60.0*24.0)*(/(ii, ii=(NperESTM-1),0, -1)/)
1756  ! ! Convert to required formats
1757  ! temp_iy = INT(ESTMForDisagg(i,1)) !Copy year
1758  ! temp_id = FLOOR(dectimeDscd(NperESTM*(i-1)+Seq1NperESTM)) !DOY
1759  ! ! To avoid precision errors, round here
1760  ! ! - this should not be a problem as a difference of 1 = 1 min, so a difference of 0.001 << 1 min
1761  ! temp_ihm = NINT(((dectimeDscd(NperESTM*(i-1)+Seq1NperESTM) - temp_id/1.0)*60.0*24.0)*1000.0)/1000 !Minutes of the day (1440 max)
1762  ! temp_ih = (temp_ihm-MOD(temp_ihm,60))/60 !Hours
1763  ! temp_im = MOD(temp_ihm,60) !Minutes
1764  !
1765  ! IF(dectimeOrig(i) == 1.0000 .AND. i > 1) THEN !If year changes and it is not the beginning of the dataset
1766  ! WRITE(*,*) 'Year change encountered: ', dectimeOrig(i), dectimeOrig(i-1)
1767  ! ! Re-downscale dectime using dectimeOrig(i-1)
1768  ! dectimeDscd(NperESTM*(i-1)+Seq1NperESTM) = dectimeOrig(i-1) + (tstep/60.0)/(60.0*24.0)*Seq1NperESTM
1769  ! ! Convert to required formats
1770  ! temp_iy = INT(ESTMForDisagg(i,1)) !Copy year
1771  ! temp_id = FLOOR(dectimeDscd(NperESTM*(i-1)+Seq1NperESTM)) !DOY
1772  ! temp_ihm = NINT(((dectimeDscd(NperESTM*(i-1)+Seq1NperESTM) - temp_id/1.0)*60.0*24.0)*1000.0)/1000 !Mins of the day (1440 max)
1773  ! temp_ih = (temp_ihm-MOD(temp_ihm,60))/60 !Hours
1774  ! temp_im = MOD(temp_ihm,60) !Minutes
1775  ! ! Adjust year and DOY to account for year change
1776  ! temp_iy(1:(NperESTM-1)) = temp_iy(1:(NperESTM-1)) - 1 !Subtract 1 from year for all except final timestamp
1777  ! temp_id(NperESTM) = 1 !Set day for final timestamp to 1
1778  ! ENDIF
1779  !
1780  ! !IF(i==1 .or. i== ReadlinesOrigESTMDataMax) THEN
1781  ! ! write(*,*) temp_iy
1782  ! ! write(*,*) temp_id
1783  ! ! !write(*,*) temp_ihm
1784  ! ! write(*,*) temp_ih
1785  ! ! write(*,*) temp_im
1786  ! !ENDIF
1787  !
1788  ! ! Copy to ESTM_tt array
1789  ! ESTM_tt(NperESTM*(i-1)+Seq1NperESTM,1) = temp_iy
1790  ! ESTM_tt(NperESTM*(i-1)+Seq1NperESTM,2) = temp_id
1791  ! ESTM_tt(NperESTM*(i-1)+Seq1NperESTM,3) = temp_ih
1792  ! ESTM_tt(NperESTM*(i-1)+Seq1NperESTM,4) = temp_im
1793  !
1794  ! ENDDO
1795 
1796  ! Disaggregate other columns --------------------------------------------------------
1797  ! All other columns are temperatures
1798  DO ii = 5, ncolsestmdata
1799  IF (all(estmfordisagg(:, ii) == -999)) THEN
1800  !IF(DiagnoseDisaggESTM==1) write(*,*) 'No data for col.', ii
1801  estm_tt(:, ii) = -999
1802  ELSE
1803  estm_tt(:, ii) = disagg_lin(estmfordisagg(:, ii), estmfordisaggprev(ii), estmfordisaggnext(ii), estmdisaggmethod(ii), &
1804  nperestm, readlinesorigestmdata, readlinesorigestmdatamax, iblock)
1805  ENDIF
1806  ENDDO
1807 
1808  ! Copy disaggregated data to MetForcingDataArray
1810 
1811  ! Write out disaggregated file ------------------------------------------------------
1812  IF (keeptstepfilesin == 1) THEN
1813  IF (iblock == 1) THEN
1814  ! Prepare header
1815  DO i = 1, ncolsestmdata
1816  IF (i == 1) THEN
1817  headerestmout = adjustl(headerestm(i))
1818  ELSE
1819  headerestmout = trim(headerestmout)//' '//adjustl(headerestm(i))
1820  ENDIF
1821  ENDDO
1822  ! Write out header
1823  OPEN (78, file=trim(filedscdestm), err=113)
1824  WRITE (78, '(a)') headerestmout
1825  ELSE
1826  OPEN (78, file=trim(filedscdestm), position='append')!,err=113)
1827  ENDIF
1828  ! Write out data
1829  DO i = 1, (readlinesorigestmdatamax*nperestm)
1830  WRITE (78, 304) (int(estm_tt(i, ii)), ii=1, 4), estm_tt(i, 5:ncolsestmdata)
1831  ENDDO
1832  !IF(iBlock == ReadBlocksOrigMetData) THEN
1833  ! WRITE(78,'(i2)') -9
1834  ! WRITE(78,'(i2)') -9
1835  !ENDIF
1836  CLOSE (78) !Close output file
1837  ENDIF
1838 
1839 304 FORMAT((i4, 1x), 3(i3, 1x), 9(f9.4, 1x))
1840 
1841  ! Deallocate arrays -----------------------------------------------------------------
1842  DEALLOCATE (estmfordisagg)
1843  DEALLOCATE (estmfordisaggprev)
1844  DEALLOCATE (estmfordisaggnext)
1845 
1846  RETURN
1847 
1848 113 CALL errorhint(52, trim(filedscdestm), notused, notused, notusedi)
1849 
real(kind(1d0)) notused
integer, parameter ncolsestmdata
real(kind(1d0)), dimension(:, :, :), allocatable estmforcingdata
subroutine errorhint(errh, ProblemFile, VALUE, value2, valueI)
integer gridcounter
Here is the call graph for this function:
Here is the caller graph for this function:

◆ disaggregatemet()

subroutine metdisagg::disaggregatemet ( integer  iBlock,
integer  igrid 
)

Definition at line 1381 of file suews_ctrl_input.f95.

References data_in::alt, data_in::azimuth, colnamesinputfiles::c_alt, colnamesinputfiles::c_lat, colnamesinputfiles::c_lng, colnamesinputfiles::c_tz, data_in::diagnose, data_in::diagnosedisagg, disagg_lin(), data_in::disaggmethod, disaggp_amongn(), disaggp_amongnmult(), disaggregatedatetime(), errorhint(), data_in::filedscdmet, data_in::fileorigmet, initial::gridcounter, sues_data::halftimestep, data_in::inputmetformat, data_in::kdownzen, data_in::keeptstepfilesin, data_in::lat, data_in::ldown_option, data_in::lng, allocatearray::metforcingdata, allocatearray::metfordisagg, allocatearray::metfordisaggnext, allocatearray::metfordisaggprev, metread(), data_in::multrainamongn, data_in::multrainamongnupperi, narp_module::narp_cal_sunposition(), allocatearray::ncolumnsmetforcingdata, data_in::netradiationmethod, defaultnotused::notused, defaultnotused::notusedi, sues_data::nper, sues_data::nsd, data_in::rainamongn, data_in::raindisaggmethod, initial::readblocksorigmetdata, initial::readlinesorigmetdata, initial::readlinesorigmetdatamax, data_in::resolutionfilesin, initial::skippedlinesorig, sues_data::smcap, data_in::smdmethod, data_in::snowuse, sues_data::soildensity, sues_data::soildepthmeas, sues_data::soilrocks, allocatearray::surfacechar, data_in::timezone, sues_data::tstep, and data_in::zenith_deg.

Referenced by suews_program().

1381  ! Subroutine to disaggregate met forcing data to model time-step
1382  ! HCW 10 Feb 2017
1383  !======================================================================================
1384 
1385  USE sues_data
1386  USE defaultnotused
1387 
1388  IMPLICIT NONE
1389 
1390  INTEGER:: lunit = 100
1391  INTEGER:: tdiff !Time difference (in minutes) between first and second rows of original met forcing file
1392  INTEGER:: i, ii !counter
1393  INTEGER:: iblock, igrid
1394  INTEGER, DIMENSION(Nper):: seq1nper
1395  INTEGER, DIMENSION(nsd):: seq1nsd
1396  INTEGER, DIMENSION(nColumnsMetForcingData):: metdisaggmethod ! Stores method to use for disaggregating met data
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
1402  ! REAL(KIND(1d0)),DIMENSION(ReadLinesOrigMetData):: dectimeOrig
1403  ! REAL(KIND(1d0)),DIMENSION(ReadLinesOrigMetData*Nper):: dectimeDscd, dectimeFast
1404  REAL(KIND(1d0)), DIMENSION(ReadLinesOrigMetData*Nper):: dectimefast
1405  REAL(KIND(1d0)), DIMENSION(ReadLinesOrigMetData*Nper):: idectime ! sun position at middle of time-step before
1406 
1407  ! INTEGER, DIMENSION(Nper):: temp_iy, temp_id, temp_ih, temp_im, temp_ihm ! temorary varaibles for disaggragation
1408  ! REAL(KIND(1d0)), DIMENSION(Nper):: temp_dectime ! temorary varaibles for disaggragation
1409  ! INTEGER :: Days_of_Year
1410  ! INTEGER, DIMENSION(Nper)::ndays_iy ! number of days in iy
1411 
1412  ! Allocate and initialise arrays to receive original forcing data --------------------
1413  ALLOCATE (metfordisagg(readlinesorigmetdata, ncolumnsmetforcingdata))
1414  ALLOCATE (metfordisaggprev(ncolumnsmetforcingdata))
1415  ALLOCATE (metfordisaggnext(ncolumnsmetforcingdata))
1416  metfordisagg(:, :) = -999
1417  metfordisaggprev(:) = -999
1418  metfordisaggnext(:) = -999
1419  ! Initialise array to receive disaggregated data
1420  met_tt = -999
1421  ! Intialise disaggregation method
1422  metdisaggmethod = -999
1423 
1424  ! Generate useful sequences
1425  seq1nper = (/(i, i=1, nper, 1)/)
1426  seq1nsd = (/(i, i=1, nsd, 1)/)
1427 
1428  ! Get methods to use for disaggregation from RunControl
1429  IF (diagnosedisagg == 1) WRITE (*, *) 'DisaggMethod: ', disaggmethod, 'RainDisaggMethod:', raindisaggmethod
1430  IF (disaggmethod == 1) THEN
1431  metdisaggmethod(:) = 10 !linear disaggregation of averages
1432  ELSEIF (disaggmethod == 2) THEN
1433  metdisaggmethod(:) = 20 !linear disaggregation of instantaneous values
1434  ELSEIF (disaggmethod == 3) THEN !WFDEI set up, where T, Q, pres, U are instantaneous
1435  metdisaggmethod(:) = 10 !linear disaggregation of averages
1436  metdisaggmethod(10:13) = 20 !linear disagg instantaneous values for U, RH, Tair, pres
1437  ELSE
1438  CALL errorhint(2, 'Problem in SUEWS_MetDisagg: DisaggMethod value should be 1, 2, or 3', &
1439  notused, notused, disaggmethod)
1440  ENDIF
1441  ! Set rainfall
1442  metdisaggmethod(14) = raindisaggmethod
1443 
1444  ! Read data ---------------------------------------------------------------------
1445  IF (diagnosedisagg == 1) WRITE (*, *) 'Reading file: ', trim(fileorigmet)
1446  OPEN (lunit, file=trim(fileorigmet), status='old')
1447  ! CALL skipHeader(lunit,SkipHeaderMet) !Skip header -> read header instead
1448  READ (lunit, *) headermet
1449  !write(*,*) HeaderMet
1450  ! Skip over lines that have already been read and downscaled
1451  IF (skippedlinesorig > 0) THEN
1452  DO i = 1, skippedlinesorig - 1 ! minus 1 here because last line of last block needs to be read again
1453  READ (lunit, *)
1454  ENDDO
1455  ! Read in last line of previous block
1456  CALL metread(lunit, metarrayorig, inputmetformat, ldown_option, netradiationmethod, &
1457  snowuse, smdmethod, soildepthmeas, soilrocks, soildensity, smcap)
1458  metfordisaggprev(1:ncolumnsmetforcingdata) = metarrayorig
1459  ENDIF
1460  ! print*, 'MetForDisagg',MetForDisagg(1:3,1:4)
1461  ! print*, 'ReadLinesOrigMetDataMax',ReadLinesOrigMetDataMax
1462  ! Read in current block
1463  DO i = 1, readlinesorigmetdatamax
1464  CALL metread(lunit, metarrayorig, inputmetformat, ldown_option, netradiationmethod, &
1465  snowuse, smdmethod, soildepthmeas, soilrocks, soildensity, smcap)
1466  metfordisagg(i, 1:ncolumnsmetforcingdata) = metarrayorig
1467  ENDDO
1468  ! print*, 'MetForDisagg',MetForDisagg(1:3,1:4)
1469  ! Read in first line of next block (except for last block)
1470  IF (iblock /= readblocksorigmetdata) THEN
1471  CALL metread(lunit, metarrayorig, inputmetformat, ldown_option, netradiationmethod, &
1472  snowuse, smdmethod, soildepthmeas, soilrocks, soildensity, smcap)
1473  metfordisaggnext(1:ncolumnsmetforcingdata) = metarrayorig
1474  ENDIF
1475  CLOSE (lunit)
1476 
1477  ! Check resolution of original met forcing data -------------------------------------
1478  ! Find time difference (in minutes) between first and second row
1479  tdiff = int(metfordisagg(2, 4) - metfordisagg(1, 4)) !Try using minutes
1480  IF (tdiff == 0) tdiff = int(metfordisagg(2, 3) - metfordisagg(1, 3))*60 !If no difference in minutes, try using hours
1481  IF (tdiff < 0) THEN !If time difference is negative (e.g. change of day), instead use second and third row
1482  tdiff = int(metfordisagg(3, 4) - metfordisagg(2, 4))
1483  IF (tdiff == 0) tdiff = int(metfordisagg(3, 3) - metfordisagg(2, 3))*60 !If no difference in minutes, try using hours
1484  ENDIF
1485  ! Check actual resolution matches specified input resolution
1486  IF (tdiff /= resolutionfilesin/60) THEN
1487  CALL errorhint(2, 'Problem in SUEWS_MetDisagg: timestamps in met forcing file inconsistent with ResolutionFilesIn', &
1488  REAL(ResolutionFilesIn, KIND(1d0)), notused, tdiff*60)
1489  ENDIF
1490 
1491  ! Check file only contains a single year --------------------------------------------
1492  ! Very last data point is allowed to be (should be) timestamped with following year
1493  IF (any(metfordisagg(1:(readlinesorigmetdatamax - 1), 1) /= metfordisagg(1, 1))) THEN
1494  CALL errorhint(3, 'Problem in SUEWS_MetDisagg: multiple years found in original met forcing file.', &
1495  metfordisagg(1, 1), notused, notusedi)
1496  ENDIF
1497 
1498  ! Disaggregate time columns ---------------------------------------------------------
1499  IF (diagnose == 1) WRITE (*, *) 'Disaggregating met forcing data (', trim(fileorigmet), ') to model time-step...'
1500 
1501  CALL disaggregatedatetime(metfordisagg(:, 1:4), tstep, nper, readlinesorigmetdatamax, met_tt(:, 1:4))
1502 
1503  ! Disaggregate other columns --------------------------------------------------------
1504  DO ii = 5, ncolumnsmetforcingdata
1505  IF (ii == 14) THEN !Do something different for rainfall and snowfall (if present)
1506  IF (metdisaggmethod(14) == 100) THEN
1507  met_tt(:, 14) = disaggp_amongn(metfordisagg(:, 14), nper, nper, readlinesorigmetdata, readlinesorigmetdatamax)
1508  IF (all(metfordisagg(:, 16) == -999)) THEN
1509  met_tt(:, 16) = -999
1510  ELSE
1511  met_tt(:, 16) = disaggp_amongn(metfordisagg(:, 16), nper, nper, readlinesorigmetdata, readlinesorigmetdatamax)
1512  ENDIF
1513  ELSEIF (metdisaggmethod(14) == 101) THEN
1514  IF (rainamongn == -999) THEN
1515  CALL errorhint(2, 'Problem in SUEWS_MetDisagg: RainDisaggMethod requires RainAmongN', &
1516  REAL(RainAmongN, KIND(1d0)), notused, raindisaggmethod)
1517  ELSEIF (rainamongn > nper) THEN
1518  CALL errorhint(2, 'Problem in SUEWS_MetDisagg: RainAmongN > Nper', REAL(Nper, KIND(1d0)), notused, rainamongn)
1519  ELSE
1520  met_tt(:, 14) = disaggp_amongn(metfordisagg(:, 14), &
1521  rainamongn, nper, readlinesorigmetdata, readlinesorigmetdatamax)
1522  IF (all(metfordisagg(:, 16) == -999)) THEN
1523  met_tt(:, 16) = -999
1524  ELSE
1525  met_tt(:, 16) = disaggp_amongn(metfordisagg(:, 16), &
1526  rainamongn, nper, readlinesorigmetdata, readlinesorigmetdatamax)
1527  ENDIF
1528  ENDIF
1529  ELSEIF (metdisaggmethod(14) == 102) THEN
1530  IF (all(multrainamongn == -999)) THEN
1531  CALL errorhint(2, 'Problem in SUEWS_MetDisagg: RainDisaggMethod requires MultRainAmongN', &
1532  REAL(MultRainAmongN(1), KIND(1d0)), notused, raindisaggmethod)
1533  ELSEIF (all(multrainamongnupperi == -999)) THEN
1534  CALL errorhint(2, 'Problem in SUEWS_MetDisagg: RainDisaggMethod requires MultRainAmongNUpperI', &
1535  multrainamongnupperi(1), notused, raindisaggmethod)
1536  ELSEIF (any(multrainamongn > nper)) THEN
1537  CALL errorhint(2, 'Problem in SUEWS_MetDisagg: MultRainAmongN > Nper', REAL(Nper, KIND(1d0)), notused, &
1538  maxval(multrainamongn))
1539  ELSE
1540  met_tt(:, 14) = disaggp_amongnmult(metfordisagg(:, 14), multrainamongnupperi, multrainamongn, nper, &
1541  readlinesorigmetdata, readlinesorigmetdatamax)
1542  IF (all(metfordisagg(:, 16) == -999)) THEN
1543  met_tt(:, 16) = -999
1544  ELSE
1545  met_tt(:, 16) = disaggp_amongnmult(metfordisagg(:, 16), multrainamongnupperi, multrainamongn, nper, &
1546  readlinesorigmetdata, readlinesorigmetdatamax)
1547  ENDIF
1548  ENDIF
1549  ELSE
1550  WRITE (*, *) 'Disaggregation code for rain not recognised'
1551  ENDIF
1552  ELSEIF (ii == 24) THEN !wind direction disaggregation not coded yet...
1553  IF (any(metfordisagg(:, ii) /= -999)) THEN
1554  WRITE (*, *) 'Disaggregation of wind direction not currently implemented!'
1555  ENDIF
1556  ELSE
1557  IF (all(metfordisagg(:, ii) == -999)) THEN
1558  !IF(DiagnoseDisagg==1) write(*,*) 'No data for col.', ii
1559  met_tt(:, ii) = -999
1560  ELSE
1561  met_tt(:, ii) = disagg_lin(metfordisagg(:, ii), metfordisaggprev(ii), metfordisaggnext(ii), metdisaggmethod(ii), &
1562  nper, readlinesorigmetdata, readlinesorigmetdatamax, iblock)
1563  ENDIF
1564  ENDIF
1565  ENDDO
1566 
1567  ! Adjust kdown disaggregation using zenith angle
1568  IF (kdownzen == 1) THEN
1569  IF (diagnosedisagg == 1) WRITE (*, *) 'Adjusting disaggregated kdown using zenith angle'
1570  met_tt_kdownadj(:) = met_tt(:, 15)
1571  ! Translate location data from SurfaceChar to find solar angles
1572  lat = surfacechar(igrid, c_lat)
1573  lng = surfacechar(igrid, c_lng)
1574  timezone = surfacechar(igrid, c_tz)
1575  alt = surfacechar(igrid, c_alt)
1576  ! Calculate dectime at downscaled time-step
1577  dectimefast(:) = met_tt(:, 2) + met_tt(:, 3)/24.0 + met_tt(:, 4)/(60.0*24.0)
1578  idectime = dectimefast - halftimestep! sun position at middle of timestep before
1579  DO i = 1, (readlinesorigmetdatamax*nper)
1580  CALL narp_cal_sunposition(met_tt(i, 2), idectime(i), timezone, lat, lng, alt, azimuth, zenith_deg)
1581  ! If sun below horizon, set disaggregated kdown to zero
1582  IF (zenith_deg > 90) THEN
1583  !write(*,*) Met_tt(i,1:4)
1584  met_tt_kdownadj(i) = 0.0
1585  ENDIF
1586  ENDDO
1587  ! Redistribute kdown over each day
1588  DO i = 1, (readlinesorigmetdatamax*nper/nsd) ! Loop over each day
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))
1593  ENDDO
1594  ! Copy adjusted kdown back to Met_tt array
1595  met_tt(:, 15) = met_tt_kdownadj(:)
1596  ENDIF
1597 
1598  ! Copy disaggregated data to MetForcingDataArray
1599  metforcingdata(:, 1:24, gridcounter) = met_tt(:, 1:24)
1600 
1601  ! If snow is -999, set to zero (also in LUMPS_metRead.f95)
1602  IF (all(metforcingdata(:, 16, gridcounter) == -999)) metforcingdata(:, 16, gridcounter) = 0
1603 
1604  ! Undo pressure conversion again for writing out
1605  met_tt(:, 13) = met_tt(:, 13)/10.0
1606 
1607  ! Write out disaggregated file ------------------------------------------------------
1608  IF (keeptstepfilesin == 1) THEN
1609  IF (iblock == 1) THEN
1610  ! Prepare header
1611  DO i = 1, ncolumnsmetforcingdata
1612  IF (i == 1) THEN
1613  headermetout = adjustl(headermet(i))
1614  ELSE
1615  headermetout = trim(headermetout)//' '//adjustl(headermet(i))
1616  ENDIF
1617  ENDDO
1618  ! Write out header
1619  OPEN (78, file=trim(filedscdmet), err=112)
1620  WRITE (78, '(a)') headermetout
1621  ELSE
1622  OPEN (78, file=trim(filedscdmet), position='append')!,err=112)
1623  ENDIF
1624  ! Write out data
1625  DO i = 1, (readlinesorigmetdatamax*nper)
1626  WRITE (78, 303) (int(met_tt(i, ii)), ii=1, 4), met_tt(i, 5:ncolumnsmetforcingdata)
1627  ENDDO
1628  !IF(iBlock == ReadBlocksOrigMetData) THEN
1629  ! WRITE(78,'(i2)') -9
1630  ! WRITE(78,'(i2)') -9
1631  !ENDIF
1632  CLOSE (78) !Close output file
1633  ENDIF
1634 
1635 303 FORMAT((i4, 1x), 3(i3, 1x), 9(f12.6, 1x), (f9.4, 1x), 10(f9.4, 1x)) !Allows 4 dp for rainfall
1636 
1637  ! Deallocate arrays -----------------------------------------------------------------
1638  DEALLOCATE (metfordisagg)
1639  DEALLOCATE (metfordisaggprev)
1640  DEALLOCATE (metfordisaggnext)
1641 
1642  RETURN
1643 
1644 112 CALL errorhint(52, trim(filedscdmet), notused, notused, notusedi)
1645 
real(kind(1d0)) halftimestep
real(kind(1d0)) notused
real(kind(1d0)) soilrocks
subroutine metread(lfn, MetArray, InputmetFormat, ldown_option, NetRadiationMethod, snowUse, SMDMethod, SoilDepthMeas, SoilRocks, SoilDensity, SmCap)
real(kind(1d0)) soildensity
real(kind(1d0)) soildepthmeas
real(kind(1d0)) smcap
subroutine errorhint(errh, ProblemFile, VALUE, value2, valueI)
integer gridcounter
Here is the call graph for this function:
Here is the caller graph for this function:

◆ randomsamples()

integer function, dimension(:), allocatable metdisagg::randomsamples ( integer  N,
integer  OutOf 
)

Definition at line 2148 of file suews_ctrl_input.f95.

Referenced by disaggp_amongn(), and disaggp_amongnmult().

2148  ! Generates N/OutOf random samples without repeats
2149  ! e.g. for N = 3 and OutOf = 12, a possibility for Samples = 7,3,11
2150  ! HCW 10 Feb 2017
2151  !======================================================================================
2152 
2153  IMPLICIT NONE
2154 
2155  INTEGER:: i !counter
2156  INTEGER:: n !number of samples to return
2157  INTEGER:: outof !number to sample from
2158  INTEGER:: x !next sample to be added
2159  REAL(KIND(1D0)):: r !random number
2160  INTEGER, DIMENSION(:), ALLOCATABLE:: samples !Array to receive random samples
2161 
2162  ! Allocate and initialise Samples
2163  ALLOCATE (samples(n))
2164  samples(:) = -999
2165 
2166  ! Generate random sample (no repeats)
2167  i = 0 !Set counter to zero initially
2168  DO WHILE (any(samples == -999))
2169  CALL random_number(r)
2170  x = int(r*outof) + 1
2171  !write(*,*) X
2172  !write(*,*) COUNT(Samples == X)
2173  IF (count(samples == x) == 0) THEN
2174  ! Only keep if this subinterval has not already been selected
2175  i = i + 1
2176  samples(i) = x
2177  ENDIF
2178  !write(*,*) Samples
2179  ENDDO
2180 
Here is the caller graph for this function: