1 | !> @file palm_date_time_mod.f90 |
---|
2 | !--------------------------------------------------------------------------------------------------! |
---|
3 | ! This file is part of the PALM model system. |
---|
4 | ! |
---|
5 | ! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General |
---|
6 | ! Public License as published by the Free Software Foundation, either version 3 of the License, or |
---|
7 | ! (at your option) any later version. |
---|
8 | ! |
---|
9 | ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the |
---|
10 | ! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General |
---|
11 | ! Public License for more details. |
---|
12 | ! |
---|
13 | ! You should have received a copy of the GNU General Public License along with PALM. If not, see |
---|
14 | ! <http://www.gnu.org/licenses/>. |
---|
15 | ! |
---|
16 | ! Copyright 1997-2021 Leibniz Universitaet Hannover |
---|
17 | !--------------------------------------------------------------------------------------------------! |
---|
18 | ! |
---|
19 | ! Current revisions: |
---|
20 | ! ------------------ |
---|
21 | ! |
---|
22 | ! |
---|
23 | ! Former revisions: |
---|
24 | ! ----------------- |
---|
25 | ! $Id: palm_date_time_mod.f90 4828 2021-01-05 11:21:41Z suehring $ |
---|
26 | ! file re-formatted to follow the PALM coding standard |
---|
27 | ! |
---|
28 | ! 4680 2020-09-16 10:20:34Z gronemeier |
---|
29 | ! Add option to fix date and time; renamed set_reference_date_time to init_date_time |
---|
30 | ! |
---|
31 | ! 4360 2020-01-07 11:25:50Z suehring |
---|
32 | ! Add days of northward- and southward equinox |
---|
33 | ! |
---|
34 | ! 4227 2019-09-10 18:04:34Z gronemeier |
---|
35 | ! Complete rework of module date_and_time_mod: |
---|
36 | ! - renamed module to prevent confusion with FORTRAN Standard routine date_and_time |
---|
37 | ! - introduce date_time_type |
---|
38 | ! - add set_reference_date_time |
---|
39 | ! - add get_date_time |
---|
40 | ! - capsule whole calculation of date and time variables within this routine |
---|
41 | ! - removed all variables/routines not belonging to this module |
---|
42 | ! |
---|
43 | ! |
---|
44 | ! Authors: |
---|
45 | ! -------- |
---|
46 | !> @author Tobias Gronemeier (LUH) |
---|
47 | ! |
---|
48 | ! Description: |
---|
49 | ! ------------ |
---|
50 | !> This routine calculates all needed information on date and time used by other modules |
---|
51 | !> |
---|
52 | !> @todo Consider leap seconds |
---|
53 | !> @note Time_zone only supports full-hour time zones, i.e., time zones like Australian Central |
---|
54 | !> Standard Time (UTC+9.5) are not possible |
---|
55 | !--------------------------------------------------------------------------------------------------! |
---|
56 | MODULE palm_date_time_mod |
---|
57 | |
---|
58 | USE control_parameters, & |
---|
59 | ONLY: message_string |
---|
60 | |
---|
61 | USE kinds |
---|
62 | |
---|
63 | IMPLICIT NONE |
---|
64 | |
---|
65 | ! |
---|
66 | !-- Parameter Definition |
---|
67 | INTEGER(iwp), PARAMETER :: date_time_str_len = 23_iwp !< length of date_time strings |
---|
68 | INTEGER(iwp), PARAMETER :: days_per_week = 7_iwp !< days in a week |
---|
69 | INTEGER(iwp), PARAMETER :: hours_per_day = 24_iwp !< hours in a day |
---|
70 | INTEGER(iwp), PARAMETER :: minutes_per_hour = 60_iwp !< minutes in an hour |
---|
71 | INTEGER(iwp), PARAMETER :: months_per_year = 12_iwp !< months in a year |
---|
72 | ! |
---|
73 | !-- Day of year of the mean northward and southward equinox (summer and winter half year) |
---|
74 | INTEGER(iwp), PARAMETER :: northward_equinox = 80_iwp !< Mar 21 (leap year: Mar 20) |
---|
75 | INTEGER(iwp), PARAMETER :: southward_equinox = 264_iwp !< Sep 21 (leap year: Sep 20) |
---|
76 | |
---|
77 | CHARACTER(LEN=3), DIMENSION(days_per_week), PARAMETER :: & |
---|
78 | weekdays = (/"Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun"/) !< names of weekdays |
---|
79 | |
---|
80 | INTEGER, DIMENSION(months_per_year), PARAMETER :: & |
---|
81 | days_per_month_noleapyear = (/31,28,31,30,31,30,31,31,30,31,30,31/) !< days for each month (no leap year) |
---|
82 | |
---|
83 | INTEGER, DIMENSION(months_per_year), PARAMETER :: & |
---|
84 | days_per_month_leapyear = (/31,29,31,30,31,30,31,31,30,31,30,31/) !< days for each month (leap year) |
---|
85 | |
---|
86 | INTEGER, DIMENSION(121), PARAMETER :: leap_years = & !< list of leap years |
---|
87 | (/ 1804_iwp, 1808_iwp, 1812_iwp, 1816_iwp, 1820_iwp, 1824_iwp, 1828_iwp, 1832_iwp, & |
---|
88 | 1836_iwp, 1840_iwp, 1844_iwp, 1848_iwp, 1852_iwp, 1856_iwp, 1860_iwp, 1864_iwp, & |
---|
89 | 1868_iwp, 1872_iwp, 1876_iwp, 1880_iwp, 1884_iwp, 1888_iwp, 1892_iwp, 1896_iwp, & |
---|
90 | 1904_iwp, 1908_iwp, 1912_iwp, 1916_iwp, 1920_iwp, 1924_iwp, 1928_iwp, 1932_iwp, & |
---|
91 | 1936_iwp, 1940_iwp, 1944_iwp, 1948_iwp, 1952_iwp, 1956_iwp, 1960_iwp, 1964_iwp, & |
---|
92 | 1968_iwp, 1972_iwp, 1976_iwp, 1980_iwp, 1984_iwp, 1988_iwp, 1992_iwp, 1996_iwp, & |
---|
93 | 2000_iwp, 2004_iwp, 2008_iwp, 2012_iwp, 2016_iwp, 2020_iwp, 2024_iwp, 2028_iwp, & |
---|
94 | 2032_iwp, 2036_iwp, 2040_iwp, 2044_iwp, 2048_iwp, 2052_iwp, 2056_iwp, 2060_iwp, & |
---|
95 | 2064_iwp, 2068_iwp, 2072_iwp, 2076_iwp, 2080_iwp, 2084_iwp, 2088_iwp, 2092_iwp, & |
---|
96 | 2096_iwp, 2104_iwp, 2108_iwp, 2112_iwp, 2116_iwp, 2120_iwp, 2124_iwp, 2128_iwp, & |
---|
97 | 2132_iwp, 2136_iwp, 2140_iwp, 2144_iwp, 2148_iwp, 2152_iwp, 2156_iwp, 2160_iwp, & |
---|
98 | 2164_iwp, 2168_iwp, 2172_iwp, 2176_iwp, 2180_iwp, 2184_iwp, 2188_iwp, 2192_iwp, & |
---|
99 | 2196_iwp, 2204_iwp, 2208_iwp, 2212_iwp, 2216_iwp, 2220_iwp, 2224_iwp, 2228_iwp, & |
---|
100 | 2232_iwp, 2236_iwp, 2240_iwp, 2244_iwp, 2248_iwp, 2252_iwp, 2256_iwp, 2260_iwp, & |
---|
101 | 2264_iwp, 2268_iwp, 2272_iwp, 2276_iwp, 2280_iwp, 2284_iwp, 2288_iwp, 2292_iwp, & |
---|
102 | 2296_iwp /) |
---|
103 | |
---|
104 | REAL(wp), PARAMETER :: seconds_per_minute = 60.0_wp !< seconds in a minute |
---|
105 | REAL(wp), PARAMETER :: seconds_per_hour = seconds_per_minute * minutes_per_hour !< seconds in an hour |
---|
106 | REAL(wp), PARAMETER :: seconds_per_day = seconds_per_hour * hours_per_day !< seconds in a day |
---|
107 | |
---|
108 | ! |
---|
109 | !-- Type Definition |
---|
110 | TYPE date_time_type |
---|
111 | INTEGER(iwp) :: year = -HUGE(0_iwp) !< year |
---|
112 | INTEGER(iwp) :: month = -HUGE(0_iwp) !< month of year |
---|
113 | INTEGER(iwp) :: day = -HUGE(0_iwp) !< day of month |
---|
114 | INTEGER(iwp) :: hour = -HUGE(0_iwp) !< hour of day |
---|
115 | INTEGER(iwp) :: minute = -HUGE(0_iwp) !< minute of hour |
---|
116 | INTEGER(iwp) :: zone = -HUGE(0_iwp) !< time zone |
---|
117 | |
---|
118 | REAL(wp) :: second = -HUGE(0.0_wp) !< second of minute |
---|
119 | REAL(wp) :: second_of_year = -HUGE(0.0_wp) !< second of year |
---|
120 | |
---|
121 | INTEGER(iwp) :: days_per_year = -HUGE(0_iwp) !< days within a year |
---|
122 | |
---|
123 | INTEGER, DIMENSION(months_per_year) :: days_per_month = days_per_month_noleapyear !< list of total days per month |
---|
124 | END TYPE date_time_type |
---|
125 | |
---|
126 | ! |
---|
127 | !-- Variable Declaration |
---|
128 | LOGICAL :: date_is_fixed = .FALSE. !< if true, date is fixed (time can still change) |
---|
129 | LOGICAL :: reference_date_time_is_set = .FALSE. !< true if reference_date_time is set |
---|
130 | LOGICAL :: time_is_fixed = .FALSE. !< if true, time does not change at all |
---|
131 | |
---|
132 | TYPE(date_time_type) :: reference_date_time !< reference date-time |
---|
133 | |
---|
134 | SAVE |
---|
135 | |
---|
136 | PRIVATE |
---|
137 | ! |
---|
138 | !-- Set reference date and time |
---|
139 | INTERFACE init_date_time |
---|
140 | MODULE PROCEDURE init_date_time |
---|
141 | END INTERFACE init_date_time |
---|
142 | ! |
---|
143 | !-- Return date and time information |
---|
144 | INTERFACE get_date_time |
---|
145 | MODULE PROCEDURE get_date_time |
---|
146 | END INTERFACE get_date_time |
---|
147 | ! |
---|
148 | !-- Public Interfaces |
---|
149 | PUBLIC & |
---|
150 | get_date_time, & |
---|
151 | init_date_time |
---|
152 | ! |
---|
153 | !-- Public variables |
---|
154 | PUBLIC & |
---|
155 | date_time_str_len, & |
---|
156 | days_per_week, & |
---|
157 | hours_per_day, & |
---|
158 | minutes_per_hour, & |
---|
159 | months_per_year, & |
---|
160 | northward_equinox, & |
---|
161 | seconds_per_minute, & |
---|
162 | seconds_per_hour, & |
---|
163 | seconds_per_day, & |
---|
164 | southward_equinox, & |
---|
165 | weekdays |
---|
166 | |
---|
167 | CONTAINS |
---|
168 | |
---|
169 | |
---|
170 | !--------------------------------------------------------------------------------------------------! |
---|
171 | ! Description: |
---|
172 | ! ------------ |
---|
173 | !> Initialize date-time setting by defining a global reference date-time and choosing a variable or |
---|
174 | !> fixed date. |
---|
175 | !> Only a single call is allowed to this routine during execution. |
---|
176 | !--------------------------------------------------------------------------------------------------! |
---|
177 | SUBROUTINE init_date_time( date_time_str, use_fixed_date, use_fixed_time ) |
---|
178 | |
---|
179 | CHARACTER(LEN=date_time_str_len), INTENT(IN) :: date_time_str !< string containing date-time information |
---|
180 | |
---|
181 | LOGICAL, INTENT(IN), OPTIONAL :: use_fixed_date !< flag to fix date |
---|
182 | LOGICAL, INTENT(IN), OPTIONAL :: use_fixed_time !< flag to fix time |
---|
183 | |
---|
184 | ! |
---|
185 | !-- Check if date and time are already set |
---|
186 | IF ( reference_date_time_is_set ) THEN |
---|
187 | !> @note This error should never be observed by a user. |
---|
188 | !> It can only appear if the code was modified. |
---|
189 | WRITE( message_string, * ) 'Multiple calls to init_date_time detected.&' // & |
---|
190 | 'This routine must not be called more than once.' |
---|
191 | CALL message( 'init_date_time', 'PA0680', 2, 2, 0, 6, 0 ) |
---|
192 | RETURN |
---|
193 | |
---|
194 | ELSE |
---|
195 | |
---|
196 | reference_date_time = convert_string_to_date_time( date_time_str ) |
---|
197 | |
---|
198 | reference_date_time_is_set = .TRUE. |
---|
199 | |
---|
200 | IF ( PRESENT( use_fixed_date ) ) date_is_fixed = use_fixed_date |
---|
201 | IF ( PRESENT( use_fixed_time ) ) time_is_fixed = use_fixed_time |
---|
202 | |
---|
203 | ENDIF |
---|
204 | |
---|
205 | END SUBROUTINE init_date_time |
---|
206 | |
---|
207 | |
---|
208 | !--------------------------------------------------------------------------------------------------! |
---|
209 | ! Description: |
---|
210 | ! ------------ |
---|
211 | !> Return requested date-time information of the reference time + time_since_reference. |
---|
212 | !> An alternative reference date-time string can be specified via 'reference_date_time_str'. |
---|
213 | !> Call to this routine is only possible if a reference time is either specified in the call itself |
---|
214 | !> via 'reference_date_time_str' or previously set by calling routine 'init_date_time'. |
---|
215 | !--------------------------------------------------------------------------------------------------! |
---|
216 | SUBROUTINE get_date_time( time_since_reference, reference_date_time_str, year, month, day, hour, & |
---|
217 | minute, second, zone, second_of_day, second_of_year, day_of_year, & |
---|
218 | day_of_week, weekday, date_time_str, days_per_month, days_per_year ) |
---|
219 | |
---|
220 | CHARACTER(LEN=date_time_str_len), INTENT(OUT), OPTIONAL :: date_time_str !< date-time as string |
---|
221 | CHARACTER(LEN=1) :: plus_minus !< either '+' or '-' |
---|
222 | CHARACTER(LEN=date_time_str_len), INTENT(IN), OPTIONAL :: reference_date_time_str !< alternative reference date-time |
---|
223 | CHARACTER(LEN=3), INTENT(OUT), OPTIONAL :: weekday !< weekday |
---|
224 | |
---|
225 | INTEGER(iwp), INTENT(OUT), OPTIONAL :: day !< day of month |
---|
226 | INTEGER(iwp), INTENT(OUT), OPTIONAL :: day_of_week !< number of weekday |
---|
227 | INTEGER(iwp), INTENT(OUT), OPTIONAL :: day_of_year !< day of the year |
---|
228 | INTEGER(iwp), INTENT(OUT), OPTIONAL :: days_per_year !< days per year |
---|
229 | INTEGER(iwp), INTENT(OUT), OPTIONAL :: hour !< hour of day |
---|
230 | INTEGER(iwp), INTENT(OUT), OPTIONAL :: minute !< minute of hour |
---|
231 | INTEGER(iwp), INTENT(OUT), OPTIONAL :: month !< month of year |
---|
232 | INTEGER(iwp), INTENT(OUT), OPTIONAL :: year !< year |
---|
233 | INTEGER(iwp), INTENT(OUT), OPTIONAL :: zone !< time zone |
---|
234 | |
---|
235 | INTEGER(iwp), DIMENSION(months_per_year), INTENT(OUT), OPTIONAL :: days_per_month !< days per year |
---|
236 | |
---|
237 | REAL(wp), INTENT(OUT), OPTIONAL :: second !< second of minute |
---|
238 | REAL(wp), INTENT(OUT), OPTIONAL :: second_of_day !< second of day |
---|
239 | REAL(wp), INTENT(OUT), OPTIONAL :: second_of_year !< second of year |
---|
240 | REAL(wp), INTENT(IN) :: time_since_reference !< seconds between reference time and current time |
---|
241 | |
---|
242 | TYPE(date_time_type) :: date_time !< date-time which to return |
---|
243 | TYPE(date_time_type) :: internal_reference_date_time !< internal reference date-time |
---|
244 | |
---|
245 | ! |
---|
246 | !-- Check if a reference date-time is given |
---|
247 | IF ( .NOT. reference_date_time_is_set .AND. .NOT. PRESENT( reference_date_time_str ) ) THEN |
---|
248 | !> @note This error should never be observed by a user. |
---|
249 | !> It can only appear if the code was modified. |
---|
250 | WRITE( message_string, * ) 'No reference date-time defined. '// & |
---|
251 | 'Returning date-time information is not possible. ' // & |
---|
252 | 'Either specify reference_date_time_str ' // & |
---|
253 | 'or set a reference via init_date_time.' |
---|
254 | CALL message( 'get_date_time', 'PA0677', 2, 2, 0, 6, 0 ) |
---|
255 | RETURN |
---|
256 | ENDIF |
---|
257 | ! |
---|
258 | !-- Set internal reference date-time |
---|
259 | IF ( PRESENT( reference_date_time_str ) ) THEN |
---|
260 | internal_reference_date_time = convert_string_to_date_time( reference_date_time_str ) |
---|
261 | ELSE |
---|
262 | internal_reference_date_time = reference_date_time |
---|
263 | ENDIF |
---|
264 | |
---|
265 | IF ( time_is_fixed ) THEN |
---|
266 | ! |
---|
267 | !-- If time shall not change, set new time to reference time |
---|
268 | date_time = internal_reference_date_time |
---|
269 | ELSE |
---|
270 | ! |
---|
271 | !-- Add time to reference time |
---|
272 | date_time = add_date_time( time_since_reference, internal_reference_date_time ) |
---|
273 | ! |
---|
274 | !-- If date shall be fixed, revert it to the reference date if changed |
---|
275 | IF ( date_is_fixed ) THEN |
---|
276 | IF ( date_time%year /= internal_reference_date_time%year .OR. & |
---|
277 | get_day_of_year( date_time ) /= get_day_of_year( internal_reference_date_time ) ) & |
---|
278 | THEN |
---|
279 | |
---|
280 | date_time%year = internal_reference_date_time%year |
---|
281 | date_time%month = internal_reference_date_time%month |
---|
282 | date_time%day = internal_reference_date_time%day |
---|
283 | date_time = update_leapyear_setting( date_time ) |
---|
284 | date_time%second_of_year = get_second_of_year( date_time ) |
---|
285 | |
---|
286 | ENDIF |
---|
287 | ENDIF |
---|
288 | ENDIF |
---|
289 | ! |
---|
290 | !-- Set requested return values |
---|
291 | IF ( PRESENT( year ) ) year = date_time%year |
---|
292 | IF ( PRESENT( month ) ) month = date_time%month |
---|
293 | IF ( PRESENT( day ) ) day = date_time%day |
---|
294 | IF ( PRESENT( hour ) ) hour = date_time%hour |
---|
295 | IF ( PRESENT( minute ) ) minute = date_time%minute |
---|
296 | IF ( PRESENT( second ) ) second = date_time%second |
---|
297 | IF ( PRESENT( zone ) ) zone = date_time%zone |
---|
298 | IF ( PRESENT( second_of_year ) ) second_of_year = date_time%second_of_year |
---|
299 | IF ( PRESENT( second_of_day ) ) second_of_day = get_second_of_day( date_time ) |
---|
300 | IF ( PRESENT( day_of_year ) ) day_of_year = get_day_of_year( date_time ) |
---|
301 | IF ( PRESENT( day_of_week ) ) day_of_week = get_day_of_week( date_time ) |
---|
302 | IF ( PRESENT( weekday ) ) weekday = weekdays( get_day_of_week( date_time ) ) |
---|
303 | IF ( PRESENT( days_per_month ) ) days_per_month = date_time%days_per_month |
---|
304 | IF ( PRESENT( days_per_year ) ) days_per_year = date_time%days_per_year |
---|
305 | |
---|
306 | IF ( PRESENT( date_time_str ) ) THEN |
---|
307 | IF ( date_time%zone < 0_iwp ) THEN |
---|
308 | plus_minus = '-' |
---|
309 | ELSE |
---|
310 | plus_minus = '+' |
---|
311 | ENDIF |
---|
312 | WRITE( UNIT = date_time_str, & |
---|
313 | FMT = '(I4,"-",I2.2,"-",I2.2,1X,I2.2,":",I2.2,":",I2.2,1X,A1,I2.2)' ) & |
---|
314 | date_time%year, date_time%month, date_time%day, & |
---|
315 | date_time%hour, date_time%minute, INT( date_time%second ), & |
---|
316 | plus_minus, ABS( date_time%zone ) |
---|
317 | ENDIF |
---|
318 | |
---|
319 | END SUBROUTINE get_date_time |
---|
320 | |
---|
321 | |
---|
322 | !--------------------------------------------------------------------------------------------------! |
---|
323 | ! Description: |
---|
324 | ! ------------ |
---|
325 | !> Convert a date-time string into a date_time object. |
---|
326 | !--------------------------------------------------------------------------------------------------! |
---|
327 | FUNCTION convert_string_to_date_time( date_time_str ) RESULT( date_time ) |
---|
328 | |
---|
329 | CHARACTER(LEN=date_time_str_len), INTENT(IN) :: date_time_str !< date-time as string |
---|
330 | |
---|
331 | INTEGER(iwp) :: read_status !< returned status of read command |
---|
332 | |
---|
333 | TYPE(date_time_type) :: date_time !< requested date-time object |
---|
334 | |
---|
335 | ! |
---|
336 | !-- Decompose string to date-time information |
---|
337 | READ( UNIT = date_time_str( 1: 4), IOSTAT = read_status, FMT = '(I4)' ) date_time%year |
---|
338 | IF ( read_status == 0 ) THEN |
---|
339 | READ( UNIT = date_time_str( 6: 7), IOSTAT = read_status, FMT = '(I2)' ) date_time%month |
---|
340 | ENDIF |
---|
341 | IF ( read_status == 0 ) THEN |
---|
342 | READ( UNIT = date_time_str( 9:10), IOSTAT = read_status, FMT = '(I2)' ) date_time%day |
---|
343 | ENDIF |
---|
344 | IF ( read_status == 0 ) THEN |
---|
345 | READ( UNIT = date_time_str(12:13), IOSTAT = read_status, FMT = '(I2)' ) date_time%hour |
---|
346 | ENDIF |
---|
347 | IF ( read_status == 0 ) THEN |
---|
348 | READ( UNIT = date_time_str(15:16), IOSTAT = read_status, FMT = '(I2)' ) date_time%minute |
---|
349 | ENDIF |
---|
350 | IF ( read_status == 0 ) THEN |
---|
351 | READ( UNIT = date_time_str(18:19), IOSTAT = read_status, FMT = '(F2.0)' ) date_time%second |
---|
352 | ENDIF |
---|
353 | IF ( read_status == 0 ) THEN |
---|
354 | READ( UNIT = date_time_str(21:23), IOSTAT = read_status, FMT = '(I3)' ) date_time%zone |
---|
355 | ENDIF |
---|
356 | |
---|
357 | IF ( read_status /= 0 ) THEN |
---|
358 | WRITE( message_string, * ) 'Error while converting date-time string. ' // & |
---|
359 | 'Please check format of date-time string: "' // & |
---|
360 | TRIM( date_time_str ) // '". ' // & |
---|
361 | 'Format must be "YYYY-MM-DD hh:mm:ss ZZZ".' |
---|
362 | CALL message( 'convert_string_to_date_time', 'PA0678', 2, 2, 0, 6, 0 ) |
---|
363 | RETURN |
---|
364 | ENDIF |
---|
365 | |
---|
366 | date_time = update_leapyear_setting( date_time ) |
---|
367 | |
---|
368 | IF ( check_date( date_time, date_time_str ) == 0 ) THEN |
---|
369 | |
---|
370 | date_time%second_of_year = get_second_of_year( date_time ) |
---|
371 | |
---|
372 | ! |
---|
373 | !-- Shift time to UTC and set zone to UTC |
---|
374 | date_time = add_date_time( REAL( -1 * date_time%zone, KIND = wp ) * seconds_per_hour, & |
---|
375 | date_time ) |
---|
376 | date_time%zone = 0_iwp |
---|
377 | ENDIF |
---|
378 | |
---|
379 | END FUNCTION convert_string_to_date_time |
---|
380 | |
---|
381 | |
---|
382 | !--------------------------------------------------------------------------------------------------! |
---|
383 | ! Description: |
---|
384 | ! ------------ |
---|
385 | !> Add time increment (in seconds) to given date-time and return shifted date-time |
---|
386 | !--------------------------------------------------------------------------------------------------! |
---|
387 | FUNCTION add_date_time( inc_seconds, date_time_base ) RESULT( date_time ) |
---|
388 | |
---|
389 | INTEGER(iwp) :: i !< loop index |
---|
390 | |
---|
391 | REAL(wp) :: seconds_left !< seconds which must still be added to new date-time |
---|
392 | REAL(wp) :: seconds_per_year !< number of seconds in a year |
---|
393 | |
---|
394 | REAL(wp), INTENT(IN) :: inc_seconds !< seconds to be added to date-time |
---|
395 | |
---|
396 | TYPE(date_time_type) :: date_time !< shifted date-time |
---|
397 | TYPE(date_time_type), INTENT(IN) :: date_time_base !< date-time to be shifted |
---|
398 | |
---|
399 | ! |
---|
400 | !-- Define some parameters |
---|
401 | date_time = date_time_base |
---|
402 | seconds_per_year = REAL( date_time%days_per_year, KIND = wp ) * seconds_per_day |
---|
403 | ! |
---|
404 | !-- Shift time |
---|
405 | date_time%second_of_year = date_time%second_of_year + inc_seconds |
---|
406 | ! |
---|
407 | !-- Check if year changes. |
---|
408 | !-- First, if year is reduced |
---|
409 | DO WHILE ( date_time%second_of_year < 0.0_wp ) |
---|
410 | date_time%year = date_time%year - 1_iwp |
---|
411 | date_time = update_leapyear_setting( date_time ) |
---|
412 | seconds_per_year = REAL( date_time%days_per_year * seconds_per_day, KIND = wp ) |
---|
413 | date_time%second_of_year = date_time%second_of_year + seconds_per_year |
---|
414 | ENDDO |
---|
415 | ! |
---|
416 | !-- Now, if year is increased |
---|
417 | DO WHILE ( date_time%second_of_year > seconds_per_year ) |
---|
418 | date_time%year = date_time%year + 1_iwp |
---|
419 | date_time = update_leapyear_setting( date_time ) |
---|
420 | date_time%second_of_year = date_time%second_of_year - seconds_per_year |
---|
421 | seconds_per_year = REAL( date_time%days_per_year * seconds_per_day, KIND = wp ) |
---|
422 | ENDDO |
---|
423 | ! |
---|
424 | !-- Based on updated year and second_of_year, update month, day, hour, minute, second |
---|
425 | DO i = 1, months_per_year |
---|
426 | IF ( date_time%second_of_year < SUM( date_time%days_per_month(1:i) ) * seconds_per_day ) & |
---|
427 | THEN |
---|
428 | date_time%month = i |
---|
429 | seconds_left = date_time%second_of_year & |
---|
430 | - REAL( SUM( date_time%days_per_month(1:i-1) ), KIND=wp ) & |
---|
431 | * seconds_per_day |
---|
432 | date_time%day = INT( seconds_left / seconds_per_day, KIND = iwp ) + 1_iwp |
---|
433 | seconds_left = seconds_left & |
---|
434 | - REAL( date_time%day - 1_iwp, KIND = wp ) * seconds_per_day |
---|
435 | date_time%hour = INT( seconds_left / seconds_per_hour, KIND = iwp ) |
---|
436 | seconds_left = seconds_left - REAL( date_time%hour, KIND = wp ) * seconds_per_hour |
---|
437 | date_time%minute = INT( seconds_left / seconds_per_minute, KIND = iwp ) |
---|
438 | date_time%second = seconds_left - REAL( date_time%minute, KIND = wp ) * seconds_per_minute |
---|
439 | EXIT |
---|
440 | ENDIF |
---|
441 | ENDDO |
---|
442 | |
---|
443 | END FUNCTION add_date_time |
---|
444 | |
---|
445 | |
---|
446 | !--------------------------------------------------------------------------------------------------! |
---|
447 | ! Description: |
---|
448 | ! ------------ |
---|
449 | !> Return day of year of given date. |
---|
450 | !--------------------------------------------------------------------------------------------------! |
---|
451 | FUNCTION get_day_of_year( date_time ) RESULT( day_of_year ) |
---|
452 | |
---|
453 | INTEGER(iwp) :: day_of_year !< day of the year |
---|
454 | |
---|
455 | TYPE(date_time_type), INTENT(IN) :: date_time !< date of which to calculate day of year |
---|
456 | TYPE(date_time_type) :: date_time_internal !< internal copy of input date-time |
---|
457 | |
---|
458 | |
---|
459 | date_time_internal = update_leapyear_setting( date_time ) |
---|
460 | |
---|
461 | day_of_year = date_time_internal%day & |
---|
462 | + SUM( date_time_internal%days_per_month(:date_time_internal%month-1) ) |
---|
463 | |
---|
464 | END FUNCTION get_day_of_year |
---|
465 | |
---|
466 | |
---|
467 | !--------------------------------------------------------------------------------------------------! |
---|
468 | ! Description: |
---|
469 | ! ------------ |
---|
470 | !> Return second of day of given time. |
---|
471 | !--------------------------------------------------------------------------------------------------! |
---|
472 | FUNCTION get_second_of_day( date_time ) RESULT( second_of_day ) |
---|
473 | |
---|
474 | REAL(wp) :: second_of_day !< second of the day |
---|
475 | |
---|
476 | TYPE(date_time_type), INTENT(IN) :: date_time !< date of which to calculate second of the day |
---|
477 | |
---|
478 | |
---|
479 | second_of_day = date_time%second & |
---|
480 | + REAL( ( date_time%hour * minutes_per_hour ) + date_time%minute, KIND = wp ) & |
---|
481 | * seconds_per_minute |
---|
482 | |
---|
483 | END FUNCTION get_second_of_day |
---|
484 | |
---|
485 | |
---|
486 | !--------------------------------------------------------------------------------------------------! |
---|
487 | ! Description: |
---|
488 | ! ------------ |
---|
489 | !> Return second of year of given date-time. |
---|
490 | !--------------------------------------------------------------------------------------------------! |
---|
491 | FUNCTION get_second_of_year( date_time ) RESULT( second_of_year ) |
---|
492 | |
---|
493 | REAL(wp) :: second_of_year !< second of the year |
---|
494 | |
---|
495 | TYPE(date_time_type), INTENT(IN) :: date_time !< date of which to calculate second of the year |
---|
496 | |
---|
497 | |
---|
498 | second_of_year = get_second_of_day( date_time ) & |
---|
499 | + REAL( get_day_of_year( date_time ) - 1_iwp, KIND = wp ) * seconds_per_day |
---|
500 | |
---|
501 | END FUNCTION get_second_of_year |
---|
502 | |
---|
503 | |
---|
504 | !--------------------------------------------------------------------------------------------------! |
---|
505 | ! Description: |
---|
506 | ! ------------ |
---|
507 | !> Return index of the day of the week of the given date-time. |
---|
508 | !--------------------------------------------------------------------------------------------------! |
---|
509 | FUNCTION get_day_of_week( date_time_in ) RESULT( day_of_week ) |
---|
510 | |
---|
511 | INTEGER(iwp) :: day_difference !< day between given date and reference |
---|
512 | INTEGER(iwp) :: day_of_week !< day of the week |
---|
513 | INTEGER(iwp) :: date_time_internal_reference_day_of_week !< day of week of reference date |
---|
514 | |
---|
515 | TYPE(date_time_type), INTENT(IN) :: date_time_in !< date of which to get the weekday |
---|
516 | TYPE(date_time_type) :: date_time_internal !< internal date-time |
---|
517 | |
---|
518 | ! |
---|
519 | !-- Define reference date from which on the current day of week can be determined |
---|
520 | date_time_internal%year = 2000_iwp |
---|
521 | date_time_internal%month = 1_iwp |
---|
522 | date_time_internal%day = 1_iwp |
---|
523 | date_time_internal_reference_day_of_week = 6_iwp |
---|
524 | |
---|
525 | ! |
---|
526 | !-- First, get the difference if both dates would be in the same year |
---|
527 | day_difference = get_day_of_year( date_time_in ) - get_day_of_year( date_time_internal ) |
---|
528 | ! |
---|
529 | !-- Now, shift the year and add the corresponding number of days to the difference |
---|
530 | IF ( date_time_internal%year < date_time_in%year ) THEN |
---|
531 | |
---|
532 | DO WHILE ( date_time_internal%year /= date_time_in%year ) |
---|
533 | |
---|
534 | date_time_internal = update_leapyear_setting( date_time_internal ) |
---|
535 | day_difference = day_difference + date_time_internal%days_per_year |
---|
536 | |
---|
537 | date_time_internal%year = date_time_internal%year + 1_iwp |
---|
538 | |
---|
539 | ENDDO |
---|
540 | |
---|
541 | ELSEIF ( date_time_internal%year > date_time_in%year ) THEN |
---|
542 | |
---|
543 | DO WHILE ( date_time_internal%year /= date_time_in%year ) |
---|
544 | |
---|
545 | date_time_internal%year = date_time_internal%year - 1_iwp |
---|
546 | |
---|
547 | date_time_internal = update_leapyear_setting( date_time_internal ) |
---|
548 | day_difference = day_difference - date_time_internal%days_per_year |
---|
549 | |
---|
550 | ENDDO |
---|
551 | |
---|
552 | ENDIF |
---|
553 | ! |
---|
554 | !-- Remove full weeks of day_difference and shift day_of_week of reference by remaining days. |
---|
555 | day_of_week = date_time_internal_reference_day_of_week + MOD( day_difference, days_per_week ) |
---|
556 | |
---|
557 | IF ( day_of_week > days_per_week ) THEN |
---|
558 | ! |
---|
559 | !-- Shift index again if it is next week (above days_per_week)... |
---|
560 | day_of_week = day_of_week - days_per_week |
---|
561 | ELSEIF ( day_of_week <= 0_iwp ) THEN |
---|
562 | ! |
---|
563 | !-- ...or if it is last week (below 1) |
---|
564 | day_of_week = day_of_week + days_per_week |
---|
565 | ENDIF |
---|
566 | |
---|
567 | END FUNCTION get_day_of_week |
---|
568 | |
---|
569 | |
---|
570 | !--------------------------------------------------------------------------------------------------! |
---|
571 | ! Description: |
---|
572 | ! ------------ |
---|
573 | !> Check if given year is a leap year and update days per month accordingly. |
---|
574 | !--------------------------------------------------------------------------------------------------! |
---|
575 | FUNCTION update_leapyear_setting( date_time_in ) RESULT( date_time_out ) |
---|
576 | |
---|
577 | TYPE(date_time_type), INTENT(IN) :: date_time_in !< input date-time |
---|
578 | TYPE(date_time_type) :: date_time_out !< return date-time |
---|
579 | |
---|
580 | |
---|
581 | date_time_out = date_time_in |
---|
582 | |
---|
583 | IF ( ANY( date_time_in%year == leap_years ) ) THEN |
---|
584 | date_time_out%days_per_month = days_per_month_leapyear |
---|
585 | ELSE |
---|
586 | date_time_out%days_per_month = days_per_month_noleapyear |
---|
587 | ENDIF |
---|
588 | |
---|
589 | date_time_out%days_per_year = SUM( date_time_out%days_per_month ) |
---|
590 | |
---|
591 | END FUNCTION update_leapyear_setting |
---|
592 | |
---|
593 | |
---|
594 | !--------------------------------------------------------------------------------------------------! |
---|
595 | ! Description: |
---|
596 | ! ------------ |
---|
597 | !> Check if given date and time are valid. Returns 0 if all checks are passed. |
---|
598 | !> @todo Revise error message. ATM, gives only last errorneous value even if multiple values violate |
---|
599 | !> the bounds. |
---|
600 | !--------------------------------------------------------------------------------------------------! |
---|
601 | FUNCTION check_date( date_time, date_time_str ) RESULT( error_code ) |
---|
602 | |
---|
603 | |
---|
604 | CHARACTER(LEN=6), DIMENSION(7), PARAMETER :: error_str_list = & !< string used for error message |
---|
605 | (/'year ', 'month ', 'day ', 'hour ', 'minute', 'second', 'zone '/) |
---|
606 | |
---|
607 | CHARACTER(LEN=date_time_str_len), INTENT(IN) :: date_time_str !< date-time as string |
---|
608 | |
---|
609 | INTEGER(iwp) :: error_code !< error code |
---|
610 | |
---|
611 | TYPE(date_time_type), INTENT(IN) :: date_time !< date-time to be checked |
---|
612 | |
---|
613 | |
---|
614 | error_code = 0 |
---|
615 | ! |
---|
616 | !-- Check date |
---|
617 | IF ( date_time%month < 1_iwp .OR. date_time%month > months_per_year ) THEN |
---|
618 | error_code = 2 |
---|
619 | ELSE |
---|
620 | IF ( date_time%day < 1_iwp .OR. & |
---|
621 | date_time%day > date_time%days_per_month(date_time%month) ) THEN |
---|
622 | error_code = 3 |
---|
623 | ENDIF |
---|
624 | ENDIF |
---|
625 | ! |
---|
626 | !-- Check time |
---|
627 | IF ( date_time%hour < 0_iwp .OR. date_time%hour > hours_per_day ) THEN |
---|
628 | error_code = 4 |
---|
629 | ELSE |
---|
630 | IF ( date_time%minute < 0_iwp .OR. date_time%minute > minutes_per_hour ) THEN |
---|
631 | error_code = 5 |
---|
632 | ELSE |
---|
633 | IF ( date_time%second < 0.0_wp .OR. date_time%second >= seconds_per_minute ) THEN |
---|
634 | error_code = 6 |
---|
635 | ENDIF |
---|
636 | ENDIF |
---|
637 | ENDIF |
---|
638 | ! |
---|
639 | !-- Check time zone. |
---|
640 | !-- Bounds defined by maximum and minimum time zone present on earth |
---|
641 | IF ( date_time%zone < -12_iwp .OR. date_time%zone > 14_iwp ) THEN |
---|
642 | error_code = 7 |
---|
643 | ENDIF |
---|
644 | ! |
---|
645 | !-- Raise error if any check is marked invalid |
---|
646 | IF ( error_code /= 0 ) THEN |
---|
647 | WRITE( message_string, * ) 'Date-time values out of bounds: "' // & |
---|
648 | TRIM( error_str_list(error_code) ) // & |
---|
649 | '" is out of bounds. Please check date-time string: "' // & |
---|
650 | TRIM( date_time_str ) // '". ' // & |
---|
651 | 'Format must be "YYYY-MM-DD hh:mm:ss ZZZ".' |
---|
652 | CALL message( 'check_date', 'PA0679', 2, 2, 0, 6, 0 ) |
---|
653 | RETURN |
---|
654 | ENDIF |
---|
655 | |
---|
656 | END FUNCTION check_date |
---|
657 | |
---|
658 | END MODULE palm_date_time_mod |
---|