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 1908 of file suews_ctrl_input.f95.

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

Referenced by disaggregateestm(), and disaggregatemet().

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

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

Referenced by disaggregatemet().

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

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

Referenced by disaggregatemet().

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

Referenced by disaggregateestm(), and disaggregatemet().

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

◆ disaggregateestm()

subroutine metdisagg::disaggregateestm ( integer  iBlock)

Definition at line 1650 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().

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

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

Referenced by disaggp_amongn(), and disaggp_amongnmult().

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