SUEWS API Site
Documentation of SUEWS source code
suews_util_time.f95
Go to the documentation of this file.
1 ! subroutines included:
2 ! day2month
3 !
4 ! month2day
5 ! leapYearCalc
6 ! returns -- number of days in actual year
7 ! used -- LUMPS phenology (initalization)
8 !
9 ! DayofWeek
10 ! returns -- day of week
11 ! used -- for water use and anthropogenic heat
12 !
13 ! dectime_to_timevec
14 ! This subroutine converts dectime to individual
15 ! hours, minutes and seconds
16 !
17 ! daylen
18 ! Computes solar day length
19 !
20 !sg feb 2012 - moved all time related subroutines together
21 !===============================================================================
22 
23 SUBROUTINE day2month(b, mb, md, seas, year, latitude)
24  IMPLICIT NONE
25  INTEGER, INTENT(in) ::b !b=doy --IN
26  INTEGER, INTENT(out) ::mb !month=mb --OUT
27  INTEGER, INTENT(out) ::md !date=md --OUT
28  INTEGER, INTENT(out) ::seas
29  INTEGER, INTENT(in) ::year
30  INTEGER::t1, t2, t3
31  INTEGER::k ! k- accounts for leap year
32 
33  REAL(KIND(1d0))::latitude
34 
35  ! initialisation
36  mb = 1
37 
38  !Corrected and calculation of date added LJ (Jun 2010)
39 
40  t1 = 4
41  t2 = 100
42  t3 = 400
43 
44  IF ((modulo(year, t1) == 0) .AND. (modulo(year, t2) /= 0) .OR. (modulo(year, t3) == 0)) THEN
45  k = 1
46  ELSE
47  k = 0
48  ENDIF
49 
50  IF (b <= 31) THEN !January
51  mb = 1
52  md = b
53  ELSEIF (b > 31 .AND. b <= 59 + k) THEN
54  mb = 2
55  md = b - 31
56  ELSEIF (b > 59 + k .AND. b <= 90 + k) THEN
57  mb = 3
58  md = b - (59 + k)
59  ELSEIF (b > 90 + k .AND. b <= 120 + k) THEN
60  mb = 4
61  md = b - (90 + k)
62  ELSEIF (b > 120 + k .AND. b <= 151 + k) THEN
63  mb = 5
64  md = b - (120 + k)
65  ELSEIF (b > 151 + k .AND. b <= 181 + k) THEN
66  mb = 6
67  md = b - (151 + k)
68  ELSEIF (b > 181 + k .AND. b <= 212 + k) THEN
69  mb = 7
70  md = b - (181 + k)
71  ELSEIF (b > 212 + k .AND. b <= 243 + k) THEN
72  mb = 8
73  md = b - (212 + k)
74  ELSEIF (b > 243 + k .AND. b <= 273 + k) THEN
75  mb = 9
76  md = b - (243 + k)
77  ELSEIF (b > 273 + k .AND. b <= 304 + k) THEN
78  mb = 10
79  md = b - (273 + k)
80  ELSEIF (b > 304 + k .AND. b <= 334 + k) THEN
81  mb = 11
82  md = b - (304 + k)
83  ELSEIF (b > 334 + k) THEN
84  mb = 12
85  md = b - (334 + k)
86  ENDIF
87 
88  !
89  IF (latitude > 0) THEN ! Northern Hemisphere
90  IF (mb > 3 .AND. mb < 10) THEN !Summer is from Apr to Sep
91  seas = 1
92  ELSE
93  seas = 2 !Winter rest of the months
94  ENDIF
95  ELSE ! southern hemisphere
96  IF (mb < 4 .OR. mb > 9) THEN !Summer is from Oct to Mar
97  seas = 1
98  ELSE
99  seas = 2 !Winter rest of the months
100  ENDIF
101  ENDIF
102  RETURN
103 END SUBROUTINE day2month
104 !===============================================================================
105 SUBROUTINE month2day(mon, ne, k, b)
106  IMPLICIT NONE
107  INTEGER:: mon, ne, k, b
108 
109  IF (mon == 1) THEN
110  ne = 32 - b
111  ELSE IF (mon == 2) THEN
112  ne = 60 + k - b
113  ELSE IF (mon == 3) THEN
114  ne = 91 + k - b
115  ELSE IF (mon == 4) THEN
116  ne = 121 + k - b
117  ELSE IF (mon == 5) THEN
118  ne = 152 + k - b
119  ELSE IF (mon == 6) THEN
120  ne = 182 + k - b
121  ELSE IF (mon == 7) THEN
122  ne = 213 + k - b
123  ELSE IF (mon == 8) THEN
124  ne = 244 + k - b
125  !**********PAGE 151 STARTS HERE**************
126  ELSE IF (mon == 9) THEN
127  ne = 274 + k - b
128  ELSE IF (mon == 10) THEN
129  ne = 305 + k - b
130  ELSE IF (mon == 11) THEN
131  ne = 335 + k - b
132  ELSE IF (mon == 12) THEN
133  ne = 366 + k - b
134  END IF
135 END SUBROUTINE month2day
136 !===============================================================================
137 !Defines the number or days in each year (defines the leap year)
138 SUBROUTINE leapyearcalc(year_int, nroDays)
140  IMPLICIT NONE
141 
142  INTEGER :: nroDays, year_int
143 
144  IF (mod(year_int, 100) /= 0 .AND. mod(year_int, 4) == 0) THEN
145  nrodays = 366
146  ELSEIF (mod(year_int, 400) == 0) THEN
147  nrodays = 366
148  ELSE
149  nrodays = 365
150  ENDIF
151 END SUBROUTINE leapyearcalc
152 
153 !===============================================================================
154 !Defines the number or days in each year (defines the leap year)
155 ! Ting Sun 09 May 2018
156 ELEMENTAL FUNCTION days_of_year(year_int) RESULT(nDays)
157  IMPLICIT NONE
158  INTEGER, INTENT(in) :: year_int
159  INTEGER :: nDays
160 
161  IF (mod(year_int, 100) /= 0 .AND. mod(year_int, 4) == 0) THEN
162  ndays = 366
163  ELSEIF (mod(year_int, 400) == 0) THEN
164  ndays = 366
165  ELSE
166  ndays = 365
167  ENDIF
168 
169 END FUNCTION days_of_year
170 
171 !===============================================================================
172 
173 SUBROUTINE day_of_week(DATE, MONTH, YEAR, DOW)
174  ! Calculate weekday from year, month and day information.
175  ! DOW: Sunday=1,...Saturday=7
176  ! YEAR fixed to integer, LJ March 2015
177 
178  IMPLICIT NONE
179 
180  INTEGER DATE, MONTH, DAY, YR, MN, N1, N2, DOW, YEAR
181 
182  yr = year
183  mn = month
184 
185  !C
186  !C IF JANUARY OR FEBRUARY, ADJUST MONTH AND YEAR
187  !C
188  IF (mn > 2) GO TO 10
189  mn = mn + 12
190  yr = yr - 1
191 10 n1 = (26*(mn + 1))/10
192  n2 = (125*yr)/100
193  day = (date + n1 + n2 - (yr/100) + (yr/400) - 1)
194  dow = mod(day, 7) + 1
195 
196  RETURN
197 END SUBROUTINE day_of_week
198 
199 !===============================================================================
200 
201 !FL
202 SUBROUTINE dectime_to_timevec(dectime, HOURS, MINS, SECS)
203  !This subroutine converts dectime to individual
204  !hours, minutes and seconds
205  INTEGER :: HOURS, MINS, doy
206  REAL(KIND(1d0)) :: dectime, SECS, DH, DM, DS
207  !INTEGER :: year
208 
209  doy = floor(dectime)
210 
211  dh = dectime - doy !Decimal hours
212  hours = int(24*dh)
213 
214  dm = 24*dh - hours !Decimal minutes
215  mins = int(60*dm)
216 
217  ds = 60*dm - mins
218  secs = int(60*ds)
219 
220 END SUBROUTINE dectime_to_timevec
221 
222 !==============================================================================
223 
224 !FL
225 
226 SUBROUTINE daylen(DOY, XLAT, DAYL, DEC, SNDN, SNUP)
227  !=======================================================================
228  ! DAYLEN, Real Function, N.B. Pickering, 09/23/1993
229  ! Computes solar day length (Spitters, 1986).
230  !=======================================================================
231  !-----------------------------------------------------------------------
232  IMPLICIT NONE
233  INTEGER :: DOY
234  REAL(KIND(1d0)), INTENT(IN) :: XLAT
235  REAL(KIND(1d0)), INTENT(OUT) :: DEC, DAYL, SNDN, SNUP
236  REAL(KIND(1d0)):: SOC
237  REAL(KIND(1d0)), PARAMETER :: PI = 3.14159, rad = pi/180.0
238 
239  !-----------------------------------------------------------------------
240  ! Calculation of declination of sun (Eqn. 16). Amplitude= +/-23.45
241  ! deg. Minimum = DOY 355 (DEC 21), maximum = DOY 172.5 (JUN 21/22).
242  dec = -23.45*cos(2.0*pi*(doy + 10.0)/365.0)
243 
244  ! Sun angles. SOC limited for latitudes above polar circles.
245  soc = tan(rad*dec)*tan(rad*xlat)
246  soc = min(max(soc, -1.0), 1.0)
247 
248  ! Calculate daylength, sunrise and sunset (Eqn. 17)
249  dayl = 12.0 + 24.0*asin(soc)/pi
250  snup = 12.0 - dayl/2.0
251  sndn = 12.0 + dayl/2.0
252 
253 END SUBROUTINE daylen
254 
255 !=======================================================================
256 ! DAYLEN Variables
257 !-----------------------------------------------------------------------
258 ! DAYL Day length on day of simulation (from sunrise to sunset) (hr)
259 ! DEC Solar declination or (90o - solar elevation at noon) (deg.)
260 ! DOY Day of year (d)
261 ! PI PI=3.14159 (rad)
262 ! RAD RAD=PI/180. (rad./deg.)
263 ! SNDN Time of sunset (hr)
264 ! SNUP Time of sunrise (hr)
265 ! SOC Sine over cosine (intermediate calculation)
266 ! XLAT Latitude (deg.)
267 !=======================================================================
268 
269 ! Calculate dectime
270 SUBROUTINE suews_cal_dectime( &
271  id, it, imin, isec, & ! input
272  dectime) ! output
273  IMPLICIT NONE
274  INTEGER, INTENT(in)::id, it, imin, isec
275 
276  REAL(KIND(1D0)), INTENT(out)::dectime ! nsh in type real
277 
278  dectime = REAL(id - 1, KIND(1d0)) &
279  + REAL(it, kind(1d0))/24 &
280  + REAL(imin, kind(1d0))/(60*24) &
281  + REAL(isec, kind(1d0))/(60*60*24)
282 
283 END SUBROUTINE suews_cal_dectime
284 
285 ! Calculate tstep-derived variables
286 SUBROUTINE suews_cal_tstep( &
287  tstep, & ! input
288  nsh, nsh_real, tstep_real) ! output
289  IMPLICIT NONE
290  INTEGER, INTENT(in)::tstep ! number of timesteps per hour
291  ! values that are derived from tstep
292  INTEGER, INTENT(out)::nsh ! number of timesteps per hour
293  REAL(KIND(1D0)), INTENT(out)::nsh_real ! nsh in type real
294  REAL(KIND(1D0)), INTENT(out)::tstep_real ! tstep in type real
295  nsh = 3600/tstep
296  nsh_real = nsh*1.0
297  tstep_real = tstep*1.0
298 
299 END SUBROUTINE suews_cal_tstep
300 
301 SUBROUTINE suews_cal_weekday( &
302  iy, id, lat, & !input
303  dayofWeek_id) !output
304  IMPLICIT NONE
305 
306  INTEGER, INTENT(in) :: iy ! year
307  INTEGER, INTENT(in) :: id ! day of year
308  REAL(KIND(1d0)), INTENT(in):: lat
309 
310  INTEGER, DIMENSION(3), INTENT(OUT) ::dayofWeek_id
311 
312  INTEGER::wd
313  INTEGER::mb
314  INTEGER::date
315  INTEGER::seas
316 
317  CALL day2month(id, mb, date, seas, iy, lat) !Calculate real date from doy
318  CALL day_of_week(date, mb, iy, wd) !Calculate weekday (1=Sun, ..., 7=Sat)
319 
320  dayofweek_id(1) = wd !Day of week
321  dayofweek_id(2) = mb !Month
322  dayofweek_id(3) = seas !Season
323 
324 END SUBROUTINE suews_cal_weekday
325 
326 SUBROUTINE suews_cal_dls( &
327  id, startDLS, endDLS, & !input
328  DLS) !output
329  IMPLICIT NONE
330 
331  INTEGER, INTENT(in) :: id, startDLS, endDLS
332  INTEGER, INTENT(out) :: DLS
333 
334  dls = 0
335  IF (id > startdls .AND. id < enddls) dls = 1
336 
337 END SUBROUTINE suews_cal_dls
subroutine day2month(b, mb, md, seas, year, latitude)
subroutine leapyearcalc(year_int, nroDays)
subroutine month2day(mon, ne, k, b)
subroutine suews_cal_tstep(tstep, nsh, nsh_real, tstep_real)
elemental integer function days_of_year(year_int)
subroutine suews_cal_dectime(id, it, imin, isec, dectime)
subroutine suews_cal_weekday(iy, id, lat, dayofWeek_id)
subroutine day_of_week(DATE, MONTH, YEAR, DOW)
subroutine dectime_to_timevec(dectime, HOURS, MINS, SECS)
subroutine suews_cal_dls(id, startDLS, endDLS, DLS)
subroutine daylen(DOY, XLAT, DAYL, DEC, SNDN, SNUP)