Home

Context Navigation

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

Last change on this file since 4232 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 knoop $
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.

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |