Home

Context Navigation

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

Last change on this file since 4372 was 4360, checked in by suehring, 5 years ago
Bugfix in output of time-averaged plant-canopy quanities; Output of plant-canopy data only where tall canopy is defined; land-surface model: fix wrong location strings; tests: update urban test case; all source code files: copyright update
Property svn:keywords set to `Id`
File size: 28.2 KB

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