source: palm/trunk/SOURCE/palm_date_time_mod.f90 @ 4260

Last change on this file since 4260 was 4227, checked in by gronemeier, 5 years ago

implement new palm_date_time_mod; replaced namelist parameters time_utc_init and day_of_year_init by origin_date_time

  • Property svn:keywords set to Id
File size: 27.8 KB
Line 
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
Note: See TracBrowser for help on using the repository browser.