Home

Context Navigation

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

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |