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