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 1916 of file suews_ctrl_input.f95.
1917
1920
1921 IMPLICIT NONE
1922
1923 INTEGER :: DisaggType !Type of disaggregation: 10 for averaged variables; 20 for instantaneous variables
1924 INTEGER :: Nper_loc !Number of subintervals per interval (local Nper)
1925 INTEGER :: ReadLinesOrig_loc, ReadLinesOrigMax_loc !Number of lines to read in original file (local)
1926 INTEGER :: iBlock
1927 REAL(KIND(1D0)), DIMENSION(ReadLinesOrig_loc*Nper_loc) :: Fast !Array to receive disaggregated data
1928 REAL(KIND(1D0)), DIMENSION(ReadLinesOrig_loc) :: Slow !Array to disaggregate
1929 REAL(KIND(1D0)) :: SlowPrev, SlowNext
1930 INTEGER, DIMENSION(Nper_loc) :: FastRows !Group of rows that are filled with each iteration
1931 INTEGER, DIMENSION(FLOOR(Nper_loc/2.0)) :: FirstRows10 !Rows at the beginning that are not filled during iteration (for averages)
1932 INTEGER, DIMENSION(Nper_loc - FLOOR(Nper_loc/2.0)) :: LastRows10 !Rows at the end that are not filled during iteration
1933 INTEGER, DIMENSION(Nper_loc) :: FirstRows20 !Rows at the beginning that are not filled during iteration (for instantaneous)
1934 INTEGER, DIMENSION(Nper_loc) :: seq1Nper_loc !1 to Nper_loc
1935 INTEGER :: XNper_loc !XNper_loc = 2 for even Nper_loc; XNper_loc=1 for odd Nper_loc
1936 INTEGER :: i, ii !counters
1937
1938 ! Calculate XNper_loc (differentiates between disaggregations with odd and even Nper_loc)
1939 IF (mod(nper_loc, 2) == 0) xnper_loc = 2
1940 IF (mod(nper_loc, 2) == 1) xnper_loc = 1
1941
1942 seq1nper_loc = (/(i, i=1, nper_loc, 1)/)
1943
1944 ! Setup counters for iteration
1945 IF (disaggtype == 10) THEN
1946 fastrows = floor(nper_loc/2.0) + seq1nper_loc ! Rows to create at model time-step
1947 firstrows10 = (/(i, i=1, (fastrows(1) - 1), 1)/) !For start of dataset
1948 lastrows10 = &
1949 (/(i, i=nper_loc*(readlinesorigmax_loc - 1 - 1) + fastrows(nper_loc) + 1, &
1950 (readlinesorigmax_loc*nper_loc), 1)/) ! For end of dataset
1951 ELSEIF (disaggtype == 20) THEN
1952 fastrows = nper_loc + seq1nper_loc !Rows to create at model time-step
1953 firstrows20 = (/(i, i=1, (fastrows(1) - 1), 1)/) !For start of dataset
1954 END IF
1955
1956 ! Initialise fast array to -999
1957 fast = -999
1958 ! Linearly disaggregate
1959 IF (disaggtype == 10) THEN !Averaged variables
1960 IF (diagnosedisagg == 1) WRITE (*, *) 'Linearly disaggregating averaged variable'
1961 DO i = 1, (readlinesorigmax_loc - 1)
1962 fast(nper_loc*(i - 1) + fastrows) = slow(i) - &
1963 (slow(i + 1) - slow(i))/(xnper_loc*nper_loc) + &
1964 (slow(i + 1) - slow(i))/nper_loc*(/(ii, ii=1, nper_loc, 1)/)
1965 END DO
1966
1967 ! For first few rows, use previous met block
1968 IF (iblock == 1) THEN
1969 fast(firstrows10) = fast(fastrows(1)) !Use repeat values at the start of the year
1970 ELSE
1971 fast(firstrows10) = slowprev - &
1972 (slow(1) - slowprev)/(xnper_loc*nper_loc) + &
1973 (slow(1) - slowprev)/nper_loc* &
1974 (/(ii, ii=(nper_loc - SIZE(firstrows10) + 1), nper_loc, 1)/)
1975 END IF
1976 ! For last few rows, use next met block
1977 IF (iblock == readblocksorigmetdata) THEN
1978 fast(lastrows10) = fast(nper_loc*(readlinesorigmax_loc - 1 - 1) + fastrows(nper_loc)) !Use repeat values at the end of the year
1979 ELSE
1980 fast(lastrows10) = slow(readlinesorigmax_loc) - &
1981 (slownext - slow(readlinesorigmax_loc))/(xnper_loc*nper_loc) + &
1982 (slownext - slow(readlinesorigmax_loc))/nper_loc* &
1983 (/(ii, ii=1, SIZE(lastrows10), 1)/)
1984 END IF
1985 ELSEIF (disaggtype == 20) THEN !Instantaneous variables
1986 IF (diagnosedisagg == 1) WRITE (*, *) 'Linearly disaggregating instantaneous variable'
1987 DO i = 1, (readlinesorigmax_loc - 1)
1988 fast(nper_loc*(i - 1) + fastrows) = (slow(i) + &
1989 (slow(i + 1) - slow(i))/nper_loc*2*(seq1nper_loc - 1) + &
1990 slow(i))/2
1991 END DO
1992 ! For first few rows, use previous met block
1993 IF (iblock == 1) THEN
1994 fast(firstrows20) = fast(fastrows(1)) !Use repeat values at the start of the year
1995 ELSE
1996 fast(firstrows20) = (slowprev + &
1997 (slow(1) - slowprev)/nper_loc*2* &
1998 ((/(ii, ii=(nper_loc - SIZE(firstrows20) + 1), nper_loc, 1)/) - 1) + &
1999 slowprev)/2
2000 END IF
2001 !! Last few rows are already filled for the instantaneous value disaggregation
2002 !IF(iBlock==ReadBlocksOrigMetData) THEN
2003 ! Fast(LastRows20) = Fast(Nper_loc*(ReadLinesOrigMax_loc-1-1)+FastRows(Nper_loc)) !Use repeat values at the end of the year
2004 !ELSE
2005 ! Fast(LastRows20) = (Slow(ReadLinesOrigMax_loc) + &
2006 ! (SlowNext-Slow(ReadLinesOrigMax_loc))/Nper_loc*2 * &
2007 ! ((/(ii, ii=1,SIZE(LastRows20), 1)/)-1) + &
2008 ! Slow(ReadLinesOrigMax_loc))/2
2009 !ENDIF
2010 END IF
2011
2012 IF (any(fast(1:readlinesorigmax_loc*nper_loc) == -999)) THEN
2013 WRITE (*, *) 'Problem: -999s (', count(fast(1:readlinesorigmax_loc*nper_loc) == -999), ') in disaggregated data.'
2014 CALL errorhint(13, 'Problem in SUEWS_MetDisagg: -999 values in disaggregated data.', notused, notused, notusedi)
2015 END IF
2016
Definition suews_ctrl_const.f95:1392
Definition suews_ctrl_const.f95:1526
subroutine errorhint(errh, problemfile, value, value2, valuei)
Definition suews_ctrl_error.f95:2
References data_in::diagnosedisagg, errorhint(), defaultnotused::notused, defaultnotused::notusedi, and initial::readblocksorigmetdata.
Referenced by disaggregateestm(), and disaggregatemet().
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 2021 of file suews_ctrl_input.f95.
2022 ! Subroutine to disaggregate precipitation by evenly distributing among N subintervals
2023 ! (i.e. equal intensity in N subintervals)
2024 ! See Ward et al. (in review), meanN, 0.5N or 0.25N approach
2025 ! HCW 10 Feb 2017
2026 !======================================================================================
2027
2030
2031 IMPLICIT NONE
2032
2033 INTEGER :: amongN !Number of subintervals over which rain will be distributed
2034 INTEGER :: Nper_loc !Number of subintervals per interval (local Nper)
2035 INTEGER :: ReadLinesOrig_loc, ReadLinesOrigMax_loc !Number of lines to read in original file (local)
2036 REAL(KIND(1D0)), DIMENSION(ReadLinesOrig_loc*Nper_loc) :: Fast !Array to receive disaggregated data
2037 REAL(KIND(1D0)), DIMENSION(ReadLinesOrig_loc) :: Slow !Array to disaggregate
2038 INTEGER, DIMENSION(:), ALLOCATABLE :: Subintervals !Array of subintervals that contain rain
2039 INTEGER, DIMENSION(Nper_loc) :: seq1Nper_loc !1 to Nper_loc
2040 INTEGER :: i
2041
2042 ! For each averaging period, get subintervals which will receive rain
2043 ALLOCATE (subintervals(amongn))
2044 subintervals(:) = -999
2045
2046 seq1nper_loc = (/(i, i=1, nper_loc, 1)/)
2047
2048 IF (diagnosedisagg == 1) WRITE (*, *) 'Distributing over ', amongn, ' subintervals for variable'
2049 ! If all subintervals are to contain rain, don't need to generate random numbers
2050 IF (amongn == nper_loc) THEN
2051 subintervals(:) = seq1nper_loc
2052 END IF
2053 IF (amongn > nper_loc) &
2054 CALL errorhint(2, 'Problem in SUEWS_MetDisagg: no. of rainy periods cannot exceed number of subintervals', &
2055 REAL(Nper_loc, KIND(1D0)), NotUsed, amongN)
2056
2057 ! Initialise fast array to -999
2058 fast = -999
2059 DO i = 1, readlinesorigmax_loc
2060 fast(nper_loc*(i - 1) + seq1nper_loc) = 0 !Fill all subintervals with zeros initially
2061 IF (slow(i) > 0) THEN !If there is some rainfall during this interval...
2062 IF (amongn < nper_loc) THEN
2063 subintervals(:) = -999
2064 subintervals = randomsamples(amongn, nper_loc)
2065 END IF
2066 fast(nper_loc*(i - 1) + subintervals) = slow(i)/amongn
2067 END IF
2068 END DO
2069
2070 IF (any(fast(1:readlinesorigmax_loc*nper_loc) == -999)) THEN
2071 WRITE (*, *) 'Problem: -999s (', count(fast(1:readlinesorigmax_loc*nper_loc) == -999), ') in disaggregated data'
2072 CALL errorhint(13, 'Problem in SUEWS_MetDisagg: -999 values in disaggregated data.', notused, notused, notusedi)
2073 END IF
2074
References data_in::diagnosedisagg, errorhint(), defaultnotused::notused, defaultnotused::notusedi, and randomsamples().
Referenced by disaggregatemet().
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 2079 of file suews_ctrl_input.f95.
2080 ! Subroutine to disaggregate precipitation by evenly distributing among N subintervals
2081 ! (i.e. equal intensity in N subintervals) for different intensity bins
2082 ! Based on analsysis by Wen Gu
2083 ! HCW 21 Apr 2017
2084 !======================================================================================
2085
2088
2089 IMPLICIT NONE
2090
2091 REAL(KIND(1D0)), DIMENSION(5) :: multupperI !Upper bound of intensity bin
2092 INTEGER, DIMENSION(5) :: multamongN !Number of subintervals over which rain will be distributed (array)
2093 INTEGER :: thisamongN !Number of subintervals over which rain will be distributed
2094 INTEGER :: Nper_loc !Number of subintervals per interval (local Nper)
2095 INTEGER :: ReadLinesOrig_loc, ReadLinesOrigMax_loc !Number of lines to read in original file (local)
2096 REAL(KIND(1D0)), DIMENSION(ReadLinesOrig_loc*Nper_loc) :: Fast !Array to receive disaggregated data
2097 REAL(KIND(1D0)), DIMENSION(ReadLinesOrig_loc) :: Slow !Array to disaggregate
2098 INTEGER, DIMENSION(:), ALLOCATABLE :: Subintervals !Array of subintervals that contain rain
2099 INTEGER, DIMENSION(Nper_loc) :: seq1Nper_loc !1 to Nper_loc
2100 INTEGER :: i
2101
2102 seq1nper_loc = (/(i, i=1, nper_loc, 1)/)
2103
2104 IF (diagnosedisagg == 1) WRITE (*, *) 'Distributing over variable subintervals depending on intensity for variable'
2105
2106 ! Initialise fast array to -999
2107 fast = -999
2108 DO i = 1, readlinesorigmax_loc
2109 fast(nper_loc*(i - 1) + seq1nper_loc) = 0 !Fill all subintervals with zeros initially
2110 IF (slow(i) > 0) THEN !If there is some rainfall during this interval...
2111 !Use intensity in this interval to decide number of subintervals to fill with rain
2112 IF (slow(i) <= multupperi(1)) THEN
2113 thisamongn = multamongn(1)
2114 ELSEIF (slow(i) > multupperi(1) .AND. slow(i) <= multupperi(2)) THEN
2115 thisamongn = multamongn(2)
2116 ELSEIF (slow(i) > multupperi(2) .AND. slow(i) <= multupperi(3)) THEN
2117 thisamongn = multamongn(3)
2118 ELSEIF (slow(i) > multupperi(3) .AND. slow(i) <= multupperi(4)) THEN
2119 thisamongn = multamongn(4)
2120 ELSEIF (slow(i) > multupperi(4) .AND. slow(i) <= multupperi(5)) THEN
2121 thisamongn = multamongn(5)
2122 ELSEIF (slow(i) > multupperi(5)) THEN
2123 thisamongn = multamongn(5)
2126 END IF
2127
2128 ! For each averaging period, get subintervals which will receive rain
2129 ALLOCATE (subintervals(thisamongn))
2130 subintervals(:) = -999
2131
2132 IF (thisamongn > nper_loc) CALL errorhint(2, 'Problem in SUEWS_MetDisagg: no. of rainy periods cannot exceed '// &
2134
2135 IF (thisamongn == nper_loc) THEN ! If all subintervals are to contain rain, don't need to generate random numbers
2136 subintervals(:) = seq1nper_loc
2137 ELSEIF (thisamongn < nper_loc) THEN
2138 subintervals = randomsamples(thisamongn, nper_loc)
2139 END IF
2140 fast(nper_loc*(i - 1) + subintervals) = slow(i)/thisamongn
2141 !write(*,*) Slow(i), thisamongN
2142 DEALLOCATE (subintervals)
2143 END IF
2144 END DO
2145
2146 IF (any(fast(1:readlinesorigmax_loc*nper_loc) == -999)) THEN
2147 WRITE (*, *) 'Problem: -999s (', count(fast(1:readlinesorigmax_loc*nper_loc) == -999), ') in disaggregated data'
2148 CALL errorhint(13, 'Problem in SUEWS_MetDisagg: -999 values in disaggregated data.', notused, notused, notusedi)
2149 END IF
2150
References data_in::diagnosedisagg, errorhint(), data_in::multrainamongnupperi, defaultnotused::notused, defaultnotused::notusedi, and randomsamples().
Referenced by disaggregatemet().
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 1862 of file suews_ctrl_input.f95.
1864 IMPLICIT NONE
1865 INTEGER, INTENT(in) :: tstep, Nper, ReadLinesOrigMetDataMax
1866 REAL(KIND(1D0)), DIMENSION(ReadLinesOrigMetData, 4), INTENT(in) :: DateTimeForDisagg
1867 REAL(KIND(1D0)), DIMENSION(ReadLinesOrigMetData*Nper, 4), INTENT(out) :: DateTimeDscd
1868
1869 REAL(KIND(1D0)), DIMENSION(ReadLinesOrigMetData) :: dectimeOrig
1870 REAL(KIND(1D0)), DIMENSION(Nper) :: temp_dectime !temorary varaibles for disaggragation
1871 INTEGER, DIMENSION(Nper) :: temp_iy, temp_id, temp_ih, temp_im, temp_ihm ! temorary varaibles for disaggragation
1872 INTEGER, DIMENSION(Nper) :: ndays_iy ! number of days in iy
1873
1874 INTEGER :: i, ii
1875 INTEGER, DIMENSION(Nper) :: seq1Nper
1876
1877 ! Generate useful sequences
1878 seq1nper = (/(i, i=1, nper, 1)/)
1879 ! Convert to dectime
1880 ! dectimeOrig = MetForDisagg(:,2) + MetForDisagg(:,3)/24.0 + MetForDisagg(:,4)/(60.0*24.0)
1881 ! 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
1882 dectimeorig = (datetimefordisagg(:, 2) - 1) + datetimefordisagg(:, 3)/24.0 + datetimefordisagg(:, 4)/(60.0*24.0)
1883
1884 DO i = 1, readlinesorigmetdatamax
1885
1886 ! Downscale dectime using dectimeOrig(i) [becomes timestamp of last subinterval]
1887 temp_dectime = dectimeorig(i) - (tstep/60.0)/(60.0*24.0)*(/(ii, ii=(nper - 1), 0, -1)/)
1888 temp_dectime = nint(temp_dectime*60*60*24)/(60*60*24*1.)
1889
1890 ! Convert to required formats
1891 ! get year: year-1 if dectime <0, copy `year` from metforcing otherwise
1892 temp_iy = merge(int(datetimefordisagg(i, 1)) - 1, int(datetimefordisagg(i, 1)), temp_dectime < 0)
1893
1894 ! get day of year:
1895 ndays_iy = daysinyear(temp_iy) ! get days of year for DOY correction when temp_dectime<0 during year-crossing
1896 temp_dectime = merge(temp_dectime + ndays_iy, temp_dectime, temp_dectime < 0) ! correct minus temp_dectime to positive values
1897 temp_id = floor(temp_dectime) + 1 !DOY
1898
1899 temp_ihm = nint((temp_dectime + 1 - temp_id/1.0)*60.0*24.0) !Minutes of the day (1440 max)
1900 temp_ih = (temp_ihm - mod(temp_ihm, 60))/60 !Hours
1901 temp_ih = merge(temp_ih, 0, mask=(temp_ih < 24))
1902 temp_im = mod(temp_ihm, 60) !Minutes
1903
1904 ! Copy to Met_tt array
1905 datetimedscd(nper*(i - 1) + seq1nper, 1) = temp_iy
1906 datetimedscd(nper*(i - 1) + seq1nper, 2) = temp_id
1907 datetimedscd(nper*(i - 1) + seq1nper, 3) = temp_ih
1908 datetimedscd(nper*(i - 1) + seq1nper, 4) = temp_im
1909
1910 END DO
1911
Definition suews_util_datetime.f95:1755
Referenced by disaggregateestm(), and disaggregatemet().
Here is the caller graph for this function:
◆ disaggregateestm()
| subroutine metdisagg::disaggregateestm | ( | integer | iblock | ) |
Definition at line 1658 of file suews_ctrl_input.f95.
1659 ! Subroutine to disaggregate met forcing data to model time-step
1660 ! HCW 10 Feb 2017
1661 !======================================================================================
1662
1665
1666 IMPLICIT NONE
1667
1668 INTEGER :: lunit = 101
1669 INTEGER :: tdiff !Time difference (in minutes) between first and second rows of original met forcing file
1670 INTEGER :: i, ii !counter
1671 INTEGER :: iBlock
1672 INTEGER, DIMENSION(NperESTM) :: seq1NperESTM
1673 INTEGER, DIMENSION(nsd) :: seq1nsd
1674 INTEGER, DIMENSION(ncolsESTMdata) :: ESTMDisaggMethod ! Stores method to use for disaggregating met data
1675 REAL(KIND(1D0)), DIMENSION(ncolsESTMdata) :: ESTMArrayOrig
1676 REAL(KIND(1D0)), DIMENSION(ReadLinesOrigESTMData*NperESTM, ncolsESTMdata) :: ESTM_tt
1677 CHARACTER(LEN=9), DIMENSION(ncolsESTMdata) :: HeaderESTM
1678 CHARACTER(LEN=10*ncolsESTMdata) :: HeaderESTMOut
1679 ! REAL(KIND(1d0)),DIMENSION(ReadLinesOrigESTMData):: dectimeOrig
1680 ! REAL(KIND(1d0)),DIMENSION(ReadLinesOrigESTMData*NperESTM):: dectimeDscd
1681 INTEGER :: iostat_var
1682
1683 ! INTEGER, DIMENSION(NperESTM):: temp_iy, temp_id, temp_ih, temp_im, temp_ihm
1684
1685 ! Allocate and initialise arrays to receive original forcing data --------------------
1686 ALLOCATE (estmfordisagg(readlinesorigestmdata, ncolsestmdata))
1687 ALLOCATE (estmfordisaggprev(ncolsestmdata))
1688 ALLOCATE (estmfordisaggnext(ncolsestmdata))
1689 estmfordisagg(:, :) = -999
1690 estmfordisaggprev(:) = -999
1691 estmfordisaggnext(:) = -999
1692 ! Initialise array to receive disaggregated data
1693 estm_tt = -999
1694 ! Intialise disaggregation method
1695 estmdisaggmethod = -999
1696
1697 ! Generate useful sequences
1698 seq1nperestm = (/(i, i=1, nperestm, 1)/)
1699 seq1nsd = (/(i, i=1, nsd, 1)/)
1700
1701 ! Get methods to use for disaggregation from RunControl
1702 ! (N.B.DisaggMethodESTM is set as 1 or 2 in RunControl; ESTMDisaggMethod is array of ncolsESTMdata used here)
1703 IF (disaggmethodestm == 1) THEN
1704 estmdisaggmethod(:) = 10 !linear disaggregation of averages
1705 ELSEIF (disaggmethodestm == 2) THEN
1706 estmdisaggmethod(:) = 20 !linear disaggregation of instantaneous values
1707 ELSE
1710 END IF
1711
1712 ! Read data ---------------------------------------------------------------------
1713 IF (diagnosedisaggestm == 1) WRITE (*, *) 'Reading file: ', trim(fileorigestm)
1714 OPEN (lunit, file=trim(fileorigestm), status='old')
1715 ! CALL skipHeader(lunit,SkipHeaderMet) !Skip header -> read header instead
1716 READ (lunit, *) headerestm
1717 !write(*,*) HeaderMet
1718 ! Skip over lines that have already been read and downscaled
1719 IF (skippedlinesorigestm > 0) THEN
1720 DO i = 1, skippedlinesorigestm - 1 ! minus 1 here because last line of last block needs to be read again
1721 READ (lunit, *)
1722 END DO
1723 ! Read in last line of previous block
1724 READ (lunit, *, iostat=iostat_var) estmarrayorig
1725 estmfordisaggprev(1:ncolsestmdata) = estmarrayorig
1726 END IF
1727 ! Read in current block
1728 DO i = 1, readlinesorigestmdatamax
1729 READ (lunit, *, iostat=iostat_var) estmarrayorig
1730 estmfordisagg(i, 1:ncolsestmdata) = estmarrayorig
1731 END DO
1732 ! Read in first line of next block (except for last block)
1733 IF (iblock /= readblocksorigmetdata) THEN
1734 READ (lunit, *, iostat=iostat_var) estmarrayorig
1735 estmfordisaggnext(1:ncolsestmdata) = estmarrayorig
1736 END IF
1737 CLOSE (lunit)
1738
1739 ! Check resolution of original met forcing data -------------------------------------
1740 ! Find time difference (in minutes) between first and second row
1741 tdiff = int(estmfordisagg(2, 4) - estmfordisagg(1, 4)) !Try using minutes
1742 IF (tdiff == 0) tdiff = int(estmfordisagg(2, 3) - estmfordisagg(1, 3))*60 !If no difference in minutes, try using hours
1743 IF (tdiff < 0) THEN !If time difference is negative (e.g. change of day), instead use second and third row
1744 tdiff = int(estmfordisagg(3, 4) - estmfordisagg(2, 4))
1745 IF (tdiff == 0) tdiff = int(estmfordisagg(3, 3) - estmfordisagg(2, 3))*60 !If no difference in minutes, try using hours
1746 END IF
1747 ! Check actual resolution matches specified input resolution
1748 IF (tdiff /= resolutionfilesinestm/60) THEN
1749 CALL errorhint(2, 'Problem in SUEWS_ESTMDisagg: timestamps in ESTM forcing file inconsistent with ResolutionFilesInESTM', &
1750 REAL(ResolutionFilesInESTM, KIND(1D0)), NotUsed, tdiff*60)
1751 END IF
1752
1753 ! Disaggregate time columns ---------------------------------------------------------
1754 IF (diagnose == 1) THEN
1755 WRITE (*, *) 'Disaggregating ESTM forcing data (', trim(fileorigestm), ') to model time-step...'
1756 END IF
1757 CALL disaggregatedatetime(estmfordisagg(:, 1:4), tstep, nperestm, readlinesorigmetdatamax, estm_tt(:, 1:4))
1758 ! ! Convert to dectime
1759 ! dectimeOrig = ESTMForDisagg(:,2) + ESTMForDisagg(:,3)/24.0 + ESTMForDisagg(:,4)/(60.0*24.0)
1760 !
1761 ! DO i=1,ReadLinesOrigESTMDataMax
1762 ! ! Downscale dectime using dectimeOrig(i) [becomes timestamp of last subinterval]
1763 ! dectimeDscd(NperESTM*(i-1)+Seq1NperESTM) = dectimeOrig(i) - (tstep/60.0)/(60.0*24.0)*(/(ii, ii=(NperESTM-1),0, -1)/)
1764 ! ! Convert to required formats
1765 ! temp_iy = INT(ESTMForDisagg(i,1)) !Copy year
1766 ! temp_id = FLOOR(dectimeDscd(NperESTM*(i-1)+Seq1NperESTM)) !DOY
1767 ! ! To avoid precision errors, round here
1768 ! ! - this should not be a problem as a difference of 1 = 1 min, so a difference of 0.001 << 1 min
1769 ! 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)
1770 ! temp_ih = (temp_ihm-MOD(temp_ihm,60))/60 !Hours
1771 ! temp_im = MOD(temp_ihm,60) !Minutes
1772 !
1773 ! IF(dectimeOrig(i) == 1.0000 .AND. i > 1) THEN !If year changes and it is not the beginning of the dataset
1774 ! WRITE(*,*) 'Year change encountered: ', dectimeOrig(i), dectimeOrig(i-1)
1775 ! ! Re-downscale dectime using dectimeOrig(i-1)
1776 ! dectimeDscd(NperESTM*(i-1)+Seq1NperESTM) = dectimeOrig(i-1) + (tstep/60.0)/(60.0*24.0)*Seq1NperESTM
1777 ! ! Convert to required formats
1778 ! temp_iy = INT(ESTMForDisagg(i,1)) !Copy year
1779 ! temp_id = FLOOR(dectimeDscd(NperESTM*(i-1)+Seq1NperESTM)) !DOY
1780 ! 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)
1781 ! temp_ih = (temp_ihm-MOD(temp_ihm,60))/60 !Hours
1782 ! temp_im = MOD(temp_ihm,60) !Minutes
1783 ! ! Adjust year and DOY to account for year change
1784 ! temp_iy(1:(NperESTM-1)) = temp_iy(1:(NperESTM-1)) - 1 !Subtract 1 from year for all except final timestamp
1785 ! temp_id(NperESTM) = 1 !Set day for final timestamp to 1
1786 ! ENDIF
1787 !
1788 ! !IF(i==1 .or. i== ReadlinesOrigESTMDataMax) THEN
1789 ! ! write(*,*) temp_iy
1790 ! ! write(*,*) temp_id
1791 ! ! !write(*,*) temp_ihm
1792 ! ! write(*,*) temp_ih
1793 ! ! write(*,*) temp_im
1794 ! !ENDIF
1795 !
1796 ! ! Copy to ESTM_tt array
1797 ! ESTM_tt(NperESTM*(i-1)+Seq1NperESTM,1) = temp_iy
1798 ! ESTM_tt(NperESTM*(i-1)+Seq1NperESTM,2) = temp_id
1799 ! ESTM_tt(NperESTM*(i-1)+Seq1NperESTM,3) = temp_ih
1800 ! ESTM_tt(NperESTM*(i-1)+Seq1NperESTM,4) = temp_im
1801 !
1802 ! ENDDO
1803
1804 ! Disaggregate other columns --------------------------------------------------------
1805 ! All other columns are temperatures
1806 DO ii = 5, ncolsestmdata
1807 IF (all(estmfordisagg(:, ii) == -999)) THEN
1808 !IF(DiagnoseDisaggESTM==1) write(*,*) 'No data for col.', ii
1809 estm_tt(:, ii) = -999
1810 ELSE
1811 estm_tt(:, ii) = disagg_lin(estmfordisagg(:, ii), estmfordisaggprev(ii), estmfordisaggnext(ii), estmdisaggmethod(ii), &
1813 END IF
1814 END DO
1815
1816 ! Copy disaggregated data to MetForcingDataArray
1817 estmforcingdata(:, 1:ncolsestmdata, gridcounter) = estm_tt(:, 1:ncolsestmdata)
1818
1819 ! Write out disaggregated file ------------------------------------------------------
1820 IF (keeptstepfilesin == 1) THEN
1821 IF (iblock == 1) THEN
1822 ! Prepare header
1823 DO i = 1, ncolsestmdata
1824 IF (i == 1) THEN
1825 headerestmout = adjustl(headerestm(i))
1826 ELSE
1827 headerestmout = trim(headerestmout)//' '//adjustl(headerestm(i))
1828 END IF
1829 END DO
1830 ! Write out header
1831 OPEN (78, file=trim(filedscdestm), err=113)
1832 WRITE (78, '(a)') headerestmout
1833 ELSE
1834 OPEN (78, file=trim(filedscdestm), position='append') !,err=113)
1835 END IF
1836 ! Write out data
1838 WRITE (78, 304) (int(estm_tt(i, ii)), ii=1, 4), estm_tt(i, 5:ncolsestmdata)
1839 END DO
1840 !IF(iBlock == ReadBlocksOrigMetData) THEN
1841 ! WRITE(78,'(i2)') -9
1842 ! WRITE(78,'(i2)') -9
1843 !ENDIF
1844 CLOSE (78) !Close output file
1845 END IF
1846
1847304 FORMAT((i4, 1x), 3(i3, 1x), 9(f9.4, 1x))
1848
1849 ! Deallocate arrays -----------------------------------------------------------------
1850 DEALLOCATE (estmfordisagg)
1851 DEALLOCATE (estmfordisaggprev)
1852 DEALLOCATE (estmfordisaggnext)
1853
1854 RETURN
1855
1857
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.
Here is the call graph for this function:
◆ disaggregatemet()
| subroutine metdisagg::disaggregatemet | ( | integer | iblock, |
| integer | igrid ) |
Definition at line 1385 of file suews_ctrl_input.f95.
1386 ! Subroutine to disaggregate met forcing data to model time-step
1387 ! HCW 10 Feb 2017
1388 !======================================================================================
1389
1392
1393 IMPLICIT NONE
1394
1395 INTEGER :: lunit = 100
1396 INTEGER :: tdiff !Time difference (in minutes) between first and second rows of original met forcing file
1397 INTEGER :: i, ii !counter
1398 INTEGER :: iBlock, igrid
1399 INTEGER, DIMENSION(NperTstepIn) :: seq1Nper
1400 INTEGER, DIMENSION(nsd) :: seq1nsd
1401 INTEGER, DIMENSION(nColumnsMetForcingData) :: MetDisaggMethod ! Stores method to use for disaggregating met data
1402 REAL(KIND(1D0)), DIMENSION(nColumnsMetForcingData) :: MetArrayOrig
1403 REAL(KIND(1D0)), DIMENSION(ReadLinesOrigMetData*NperTstepIn, ncolumnsMetForcingData) :: Met_tt
1404 REAL(KIND(1D0)), DIMENSION(ReadLinesOrigMetData*NperTstepIn) :: Met_tt_kdownAdj
1405 CHARACTER(LEN=9), DIMENSION(ncolumnsMetForcingData) :: HeaderMet
1406 CHARACTER(LEN=10*ncolumnsMetForcingData) :: HeaderMetOut
1407 ! REAL(KIND(1d0)),DIMENSION(ReadLinesOrigMetData):: dectimeOrig
1408 ! REAL(KIND(1d0)),DIMENSION(ReadLinesOrigMetData*Nper):: dectimeDscd, dectimeFast
1409 REAL(KIND(1D0)), DIMENSION(ReadLinesOrigMetData*NperTstepIn) :: dectimeFast
1410 REAL(KIND(1D0)), DIMENSION(ReadLinesOrigMetData*NperTstepIn) :: idectime ! sun position at middle of time-step before
1411
1412 ! INTEGER, DIMENSION(Nper):: temp_iy, temp_id, temp_ih, temp_im, temp_ihm ! temorary varaibles for disaggragation
1413 ! REAL(KIND(1d0)), DIMENSION(Nper):: temp_dectime ! temorary varaibles for disaggragation
1414 ! INTEGER :: Days_of_Year
1415 ! INTEGER, DIMENSION(Nper)::ndays_iy ! number of days in iy
1416
1417 ! Allocate and initialise arrays to receive original forcing data --------------------
1418 ALLOCATE (metfordisagg(readlinesorigmetdata, ncolumnsmetforcingdata))
1419 ALLOCATE (metfordisaggprev(ncolumnsmetforcingdata))
1420 ALLOCATE (metfordisaggnext(ncolumnsmetforcingdata))
1421 metfordisagg(:, :) = -999
1422 metfordisaggprev(:) = -999
1423 metfordisaggnext(:) = -999
1424 ! Initialise array to receive disaggregated data
1425 met_tt = -999
1426 ! Intialise disaggregation method
1427 metdisaggmethod = -999
1428
1429 ! Generate useful sequences
1430 seq1nper = (/(i, i=1, npertstepin, 1)/)
1431 seq1nsd = (/(i, i=1, nsd, 1)/)
1432
1433 ! Get methods to use for disaggregation from RunControl
1434 IF (diagnosedisagg == 1) WRITE (*, *) 'DisaggMethod: ', disaggmethod, 'RainDisaggMethod:', raindisaggmethod
1435 IF (disaggmethod == 1) THEN
1436 metdisaggmethod(:) = 10 !linear disaggregation of averages
1437 ELSEIF (disaggmethod == 2) THEN
1438 metdisaggmethod(:) = 20 !linear disaggregation of instantaneous values
1439 ELSEIF (disaggmethod == 3) THEN !WFDEI set up, where T, Q, pres, U are instantaneous
1440 metdisaggmethod(:) = 10 !linear disaggregation of averages
1441 metdisaggmethod(10:13) = 20 !linear disagg instantaneous values for U, RH, Tair, pres
1442 ELSE
1445 END IF
1446 ! Set rainfall
1447 metdisaggmethod(14) = raindisaggmethod
1448
1449 ! Read data ---------------------------------------------------------------------
1450 IF (diagnosedisagg == 1) WRITE (*, *) 'Reading file: ', trim(fileorigmet)
1451 OPEN (lunit, file=trim(fileorigmet), status='old')
1452 ! CALL skipHeader(lunit,SkipHeaderMet) !Skip header -> read header instead
1453 READ (lunit, *) headermet
1454 !write(*,*) HeaderMet
1455 ! Skip over lines that have already been read and downscaled
1456 IF (skippedlinesorig > 0) THEN
1457 DO i = 1, skippedlinesorig - 1 ! minus 1 here because last line of last block needs to be read again
1458 READ (lunit, *)
1459 END DO
1460 ! Read in last line of previous block
1463 metfordisaggprev(1:ncolumnsmetforcingdata) = metarrayorig
1464 END IF
1465 ! print*, 'MetForDisagg',MetForDisagg(1:3,1:4)
1466 ! print*, 'ReadLinesOrigMetDataMax',ReadLinesOrigMetDataMax
1467 ! Read in current block
1468 DO i = 1, readlinesorigmetdatamax
1471 metfordisagg(i, 1:ncolumnsmetforcingdata) = metarrayorig
1472 END DO
1473 ! print*, 'MetForDisagg',MetForDisagg(1:3,1:4)
1474 ! Read in first line of next block (except for last block)
1475 IF (iblock /= readblocksorigmetdata) THEN
1478 metfordisaggnext(1:ncolumnsmetforcingdata) = metarrayorig
1479 END IF
1480 CLOSE (lunit)
1481
1482 ! Check resolution of original met forcing data -------------------------------------
1483 ! Find time difference (in minutes) between first and second row
1484 tdiff = int(metfordisagg(2, 4) - metfordisagg(1, 4)) !Try using minutes
1485 IF (tdiff == 0) tdiff = int(metfordisagg(2, 3) - metfordisagg(1, 3))*60 !If no difference in minutes, try using hours
1486 IF (tdiff < 0) THEN !If time difference is negative (e.g. change of day), instead use second and third row
1487 tdiff = int(metfordisagg(3, 4) - metfordisagg(2, 4))
1488 IF (tdiff == 0) tdiff = int(metfordisagg(3, 3) - metfordisagg(2, 3))*60 !If no difference in minutes, try using hours
1489 END IF
1490 ! Check actual resolution matches specified input resolution
1491 IF (tdiff /= resolutionfilesin/60) THEN
1492 CALL errorhint(2, 'Problem in SUEWS_MetDisagg: timestamps in met forcing file inconsistent with ResolutionFilesIn', &
1493 REAL(ResolutionFilesIn, KIND(1D0)), NotUsed, tdiff*60)
1494 END IF
1495
1496 ! Check file only contains a single year --------------------------------------------
1497 ! Very last data point is allowed to be (should be) timestamped with following year
1498 IF (any(metfordisagg(1:(readlinesorigmetdatamax - 1), 1) /= metfordisagg(1, 1))) THEN
1499 CALL errorhint(3, 'Problem in SUEWS_MetDisagg: multiple years found in original met forcing file.', &
1501 END IF
1502
1503 ! Disaggregate time columns ---------------------------------------------------------
1504 IF (diagnose == 1) WRITE (*, *) 'Disaggregating met forcing data (', trim(fileorigmet), ') to model time-step...'
1505
1506 CALL disaggregatedatetime(metfordisagg(:, 1:4), tstep, npertstepin, readlinesorigmetdatamax, met_tt(:, 1:4))
1507
1508 ! Disaggregate other columns --------------------------------------------------------
1509 DO ii = 5, ncolumnsmetforcingdata
1510 IF (ii == 14) THEN !Do something different for rainfall and snowfall (if present)
1511 IF (metdisaggmethod(14) == 100) THEN
1512 met_tt(:, 14) = disaggp_amongn(metfordisagg(:, 14), &
1514 IF (all(metfordisagg(:, 16) == -999)) THEN
1515 met_tt(:, 16) = -999
1516 ELSE
1517 met_tt(:, 16) = disaggp_amongn(metfordisagg(:, 16), &
1519 END IF
1520 ELSEIF (metdisaggmethod(14) == 101) THEN
1521 IF (rainamongn == -999) THEN
1523 REAL(RainAmongN, KIND(1D0)), NotUsed, RainDisaggMethod)
1526 REAL(NperTstepIn, KIND(1D0)), NotUsed, RainAmongN)
1527 ELSE
1528 met_tt(:, 14) = disaggp_amongn(metfordisagg(:, 14), &
1530 IF (all(metfordisagg(:, 16) == -999)) THEN
1531 met_tt(:, 16) = -999
1532 ELSE
1533 met_tt(:, 16) = disaggp_amongn(metfordisagg(:, 16), &
1535 END IF
1536 END IF
1537 ELSEIF (metdisaggmethod(14) == 102) THEN
1538 IF (all(multrainamongn == -999)) THEN
1540 REAL(MultRainAmongN(1), KIND(1D0)), NotUsed, RainDisaggMethod)
1541 ELSEIF (all(multrainamongnupperi == -999)) THEN
1542 CALL errorhint(2, 'Problem in SUEWS_MetDisagg: RainDisaggMethod requires MultRainAmongNUpperI', &
1545 CALL errorhint(2, 'Problem in SUEWS_MetDisagg: MultRainAmongN > Nper', real(npertstepin, kind(1d0)), notused, &
1546 maxval(multrainamongn))
1547 ELSE
1548 met_tt(:, 14) = disaggp_amongnmult(metfordisagg(:, 14), multrainamongnupperi, multrainamongn, npertstepin, &
1549 readlinesorigmetdata, readlinesorigmetdatamax)
1550 IF (all(metfordisagg(:, 16) == -999)) THEN
1551 met_tt(:, 16) = -999
1552 ELSE
1553 met_tt(:, 16) = disaggp_amongnmult(metfordisagg(:, 16), multrainamongnupperi, multrainamongn, npertstepin, &
1554 readlinesorigmetdata, readlinesorigmetdatamax)
1555 END IF
1556 END IF
1557 ELSE
1558 WRITE (*, *) 'Disaggregation code for rain not recognised'
1559 END IF
1560 ELSEIF (ii == 24) THEN !wind direction disaggregation not coded yet...
1561 IF (any(metfordisagg(:, ii) /= -999)) THEN
1562 WRITE (*, *) 'Disaggregation of wind direction not currently implemented!'
1563 END IF
1564 ELSE
1565 IF (all(metfordisagg(:, ii) == -999)) THEN
1566 !IF(DiagnoseDisagg==1) write(*,*) 'No data for col.', ii
1567 met_tt(:, ii) = -999
1568 ELSE
1569 met_tt(:, ii) = disagg_lin(metfordisagg(:, ii), metfordisaggprev(ii), metfordisaggnext(ii), metdisaggmethod(ii), &
1571 END IF
1572 END IF
1573 END DO
1574
1575 ! Adjust kdown disaggregation using zenith angle
1576 IF (kdownzen == 1) THEN
1577 IF (diagnosedisagg == 1) WRITE (*, *) 'Adjusting disaggregated kdown using zenith angle'
1578 met_tt_kdownadj(:) = met_tt(:, 15)
1579 ! Translate location data from SurfaceChar to find solar angles
1580 lat = surfacechar(igrid, c_lat)
1581 lng = surfacechar(igrid, c_lng)
1582 timezone = surfacechar(igrid, c_tz)
1583 alt = surfacechar(igrid, c_alt)
1584 ! Calculate dectime at downscaled time-step
1585 dectimefast(:) = met_tt(:, 2) + met_tt(:, 3)/24.0 + met_tt(:, 4)/(60.0*24.0)
1588 CALL narp_cal_sunposition(met_tt(i, 2), idectime(i), timezone, lat, lng, alt, azimuth, zenith_deg)
1589 ! If sun below horizon, set disaggregated kdown to zero
1590 IF (zenith_deg > 90) THEN
1591 !write(*,*) Met_tt(i,1:4)
1592 met_tt_kdownadj(i) = 0.0
1593 END IF
1594 END DO
1595 ! Redistribute kdown over each day
1597 met_tt_kdownadj((i - 1)*nsd + seq1nsd) = &
1598 met_tt_kdownadj((i - 1)*nsd + seq1nsd) &
1599 *sum(met_tt((i - 1)*nsd + seq1nsd, 15)) &
1600 /sum(met_tt_kdownadj((i - 1)*nsd + seq1nsd))
1601 END DO
1602 ! Copy adjusted kdown back to Met_tt array
1603 met_tt(:, 15) = met_tt_kdownadj(:)
1604 END IF
1605
1606 ! Copy disaggregated data to MetForcingDataArray
1607 metforcingdata(:, 1:24, gridcounter) = met_tt(:, 1:24)
1608
1609 ! If snow is -999, set to zero (also in LUMPS_metRead.f95)
1610 IF (all(metforcingdata(:, 16, gridcounter) == -999)) metforcingdata(:, 16, gridcounter) = 0
1611
1612 ! Undo pressure conversion again for writing out
1613 met_tt(:, 13) = met_tt(:, 13)/10.0
1614
1615 ! Write out disaggregated file ------------------------------------------------------
1616 IF (keeptstepfilesin == 1) THEN
1617 IF (iblock == 1) THEN
1618 ! Prepare header
1619 DO i = 1, ncolumnsmetforcingdata
1620 IF (i == 1) THEN
1621 headermetout = adjustl(headermet(i))
1622 ELSE
1623 headermetout = trim(headermetout)//' '//adjustl(headermet(i))
1624 END IF
1625 END DO
1626 ! Write out header
1627 OPEN (78, file=trim(filedscdmet), err=112)
1628 WRITE (78, '(a)') headermetout
1629 ELSE
1630 OPEN (78, file=trim(filedscdmet), position='append') !,err=112)
1631 END IF
1632 ! Write out data
1634 WRITE (78, 303) (int(met_tt(i, ii)), ii=1, 4), met_tt(i, 5:ncolumnsmetforcingdata)
1635 END DO
1636 !IF(iBlock == ReadBlocksOrigMetData) THEN
1637 ! WRITE(78,'(i2)') -9
1638 ! WRITE(78,'(i2)') -9
1639 !ENDIF
1640 CLOSE (78) !Close output file
1641 END IF
1642
1643303 FORMAT((i4, 1x), 3(i3, 1x), 9(f12.6, 1x), (f9.4, 1x), 10(f9.4, 1x)) !Allows 4 dp for rainfall
1644
1645 ! Deallocate arrays -----------------------------------------------------------------
1646 DEALLOCATE (metfordisagg)
1647 DEALLOCATE (metfordisaggprev)
1648 DEALLOCATE (metfordisaggnext)
1649
1650 RETURN
1651
1653
subroutine metread(lfn, metarray, inputmetformat, ldown_option, netradiationmethod, snowuse, smdmethod, soildepthmeas, soilrocks, soildensity, smcap)
Definition suews_ctrl_input.f95:15
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::npertstepin, 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.
Here is the call graph for this function:
◆ randomsamples()
| integer function, dimension(:), allocatable metdisagg::randomsamples | ( | integer | n, |
| integer | outof ) |
Definition at line 2155 of file suews_ctrl_input.f95.
2156 ! Generates N/OutOf random samples without repeats
2157 ! e.g. for N = 3 and OutOf = 12, a possibility for Samples = 7,3,11
2158 ! HCW 10 Feb 2017
2159 !======================================================================================
2160
2161 IMPLICIT NONE
2162
2163 INTEGER :: i !counter
2164 INTEGER :: N !number of samples to return
2165 INTEGER :: OutOf !number to sample from
2166 INTEGER :: X !next sample to be added
2167 REAL(KIND(1D0)) :: r !random number
2168 INTEGER, DIMENSION(:), ALLOCATABLE :: Samples !Array to receive random samples
2169
2170 ! Allocate and initialise Samples
2171 ALLOCATE (samples(n))
2172 samples(:) = -999
2173
2174 ! Generate random sample (no repeats)
2175 i = 0 !Set counter to zero initially
2176 DO WHILE (any(samples == -999))
2177 CALL random_number(r)
2178 x = int(r*outof) + 1
2179 !write(*,*) X
2180 !write(*,*) COUNT(Samples == X)
2181 IF (count(samples == x) == 0) THEN
2182 ! Only keep if this subinterval has not already been selected
2183 i = i + 1
2184 samples(i) = x
2185 END IF
2186 !write(*,*) Samples
2187 END DO
2188
Referenced by disaggp_amongn(), and disaggp_amongnmult().
Here is the caller graph for this function:
