FV3 Bundle
DateTime_Utility.f90
Go to the documentation of this file.
1 !
2 ! DateTime_Utility
3 !
4 ! Module defining the DateTime structure and utility routines.
5 !
6 !
7 ! CREATION HISTORY:
8 ! Written by: Paul van Delst, 14-Sep-2007
9 ! paul.vandelst@noaa.gov
10 !
11 
13 
14  ! -----------------
15  ! Environment setup
16  ! -----------------
17  USE type_kinds , ONLY: fp
18  USE date_utility, ONLY: isleapyear , &
19  dayofyear , &
20  daysinmonth, &
21  nameofmonth, &
22  dayofweek
23  ! Disable implicit typing
24  IMPLICIT NONE
25 
26 
27  ! ------------
28  ! Visibilities
29  ! ------------
30  PRIVATE
31  ! Datatpye
32  PUBLIC :: datetime_type
33  ! Procedures
34  PUBLIC :: datetime_now
35  PUBLIC :: datetime_isleapyear
36  PUBLIC :: datetime_dayofyear
37  PUBLIC :: datetime_daysinmonth
38  PUBLIC :: datetime_nameofmonth
39  PUBLIC :: datetime_dayofweek
40  PUBLIC :: datetime_inspect
41  PUBLIC :: datetime_tostring
42 
43 
44  ! -----------------
45  ! Module parameters
46  ! -----------------
47  CHARACTER(*), PARAMETER :: module_version_id = &
48  '$Id: DateTime_Utility.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $'
49  INTEGER, PARAMETER :: nl = 20
50 
51 
52  ! -----------------------
53  ! Derived type definition
54  ! -----------------------
55  !:tdoc+:
56  TYPE :: datetime_type
57  INTEGER :: year = 0
58  INTEGER :: month = 0
59  INTEGER :: day = 0
60  INTEGER :: utc_delta = 0
61  INTEGER :: hour = 0
62  INTEGER :: minute = 0
63  INTEGER :: second = 0
64  INTEGER :: millisecond = 0
65  INTEGER :: doy = 0
66  CHARACTER(NL) :: month_name
67  CHARACTER(NL) :: day_name
68  END TYPE datetime_type
69  !:tdoc-:
70 
71 
72 CONTAINS
73 
74 
75 !------------------------------------------------------------------------------
76 !:sdoc+:
77 ! NAME:
78 ! DateTime_Now
79 !
80 ! PURPOSE:
81 ! Function to return a DateTime structure with the current
82 ! date and time
83 !
84 ! CALLING SEQUENCE:
85 ! DateTime = DateTime_Now()
86 !
87 ! FUNCTION RESULT:
88 ! DateTime: DateTime structure containing current date and time.
89 ! UNITS: N/A
90 ! TYPE: DateTime_type
91 ! DIMENSION: Scalar
92 !:sdoc-:
93 !------------------------------------------------------------------------------
94 
95  FUNCTION datetime_now() RESULT(DateTime)
96  TYPE(datetime_type) :: datetime
97  INTEGER :: values(8)
98  CALL date_and_time(values=values)
99  datetime%Year = values(1)
100  datetime%Month = values(2)
101  datetime%Day = values(3)
102  datetime%UTC_Delta = values(4)
103  datetime%Hour = values(5)
104  datetime%Minute = values(6)
105  datetime%Second = values(7)
106  datetime%Millisecond = values(8)
107  datetime%DoY = datetime_dayofyear( datetime )
108  datetime%Month_Name = datetime_nameofmonth( datetime )
109  datetime%Day_Name = datetime_dayofweek( datetime )
110  END FUNCTION datetime_now
111 
112 
113 !------------------------------------------------------------------------------
114 !:sdoc+:
115 ! NAME:
116 ! DateTime_IsLeapYear
117 !
118 ! PURPOSE:
119 ! Elemental function to determine if a specified DateTime structure
120 ! is for a leap year.
121 !
122 ! CALLING SEQUENCE:
123 ! Result = DateTime_IsLeapYear( DateTime )
124 !
125 ! INPUTS:
126 ! DateTime: DateTime structure containing date information.
127 ! UNITS: N/A
128 ! TYPE: DateTime_type
129 ! DIMENSION: Scalar or any rank
130 ! ATTRIBUTES: OPTIONAL, INTENT(IN)
131 !
132 ! FUNCTION RESULT:
133 ! Result: The return value is a logical value indicating whether
134 ! the specified year is a leap year.
135 ! If .TRUE. the specified year IS a leap year.
136 ! .FALSE. the specified year is NOT a leap year
137 ! UNITS: N/A
138 ! TYPE: LOGICAL
139 ! DIMENSION: Same as input
140 !:sdoc-:
141 !------------------------------------------------------------------------------
142 
143  ELEMENTAL FUNCTION datetime_isleapyear( DateTime )
144  TYPE(datetime_type), INTENT(IN) :: datetime
145  LOGICAL :: datetime_isleapyear
146  datetime_isleapyear = isleapyear( datetime%Year )
147  END FUNCTION datetime_isleapyear
148 
149 
150 !------------------------------------------------------------------------------
151 !:sdoc+:
152 ! NAME:
153 ! DateTime_DayOfYear
154 !
155 ! PURPOSE:
156 ! Elemental function to determine the day-of-year value for a
157 ! a DateTime structure.
158 !
159 ! CALLING SEQUENCE:
160 ! DoY = DateTime_DayOfYear( DateTime )
161 !
162 ! INPUTS:
163 ! DateTime: DateTime structure containing date information.
164 ! UNITS: N/A
165 ! TYPE: DateTime_type
166 ! DIMENSION: Scalar
167 ! ATTRIBUTES: INTENT(IN)
168 !
169 ! FUNCTION RESULT:
170 ! DoY: Integer defining the day-of-year.
171 ! Return value is 0 for invalid input.
172 ! UNITS: N/A
173 ! TYPE: INTEGER
174 ! DIMENSION: Scalar
175 !:sdoc-:
176 !------------------------------------------------------------------------------
177 
178  ELEMENTAL FUNCTION datetime_dayofyear( DateTime ) RESULT( DoY )
179  TYPE(datetime_type), INTENT(IN) :: datetime
180  INTEGER :: doy
181  doy = dayofyear( datetime%Day, datetime%Month, datetime%Year )
182  END FUNCTION datetime_dayofyear
183 
184 
185 !------------------------------------------------------------------------------
186 !:sdoc+:
187 ! NAME:
188 ! DateTime_DaysInMonth
189 !
190 ! PURPOSE:
191 ! Elemental function to return the number of days in a given
192 ! month and year.
193 !
194 ! CALLING SEQUENCE:
195 ! n_Days = DateTime_DaysInMonth( DateTime )
196 !
197 ! INPUTS:
198 ! DateTime: DateTime structure containing date information.
199 ! UNITS: N/A
200 ! TYPE: DateTime_type
201 ! DIMENSION: Scalar
202 ! ATTRIBUTES: INTENT(IN)
203 !
204 ! FUNCTION RESULT:
205 ! n_Days: The number of days in the month.
206 ! Return value is 0 for invalid input.
207 ! UNITS: N/A
208 ! TYPE: INTEGER
209 ! DIMENSION: Same as input
210 !:sdoc-:
211 !------------------------------------------------------------------------------
212 
213  ELEMENTAL FUNCTION datetime_daysinmonth( DateTime ) RESULT( n_Days )
214  TYPE(datetime_type), INTENT(IN) :: datetime
215  INTEGER :: n_days
216  n_days = daysinmonth( datetime%Month, datetime%Year )
217  END FUNCTION datetime_daysinmonth
218 
219 
220 !------------------------------------------------------------------------------
221 !:sdoc+:
222 !
223 ! NAME:
224 ! DateTime_NameOfMonth
225 !
226 ! PURPOSE:
227 ! Elemental function to return the name of the month.
228 !
229 ! CALLING SEQUENCE:
230 ! name = DateTime_NameOfMonth( DateTime )
231 !
232 ! INPUT ARGUMENTS:
233 ! DateTime: DateTime structure containing date information.
234 ! UNITS: N/A
235 ! TYPE: DateTime_type
236 ! DIMENSION: Scalar
237 ! ATTRIBUTES: INTENT(IN)
238 !
239 ! FUNCTION RESULT:
240 ! name: The return value is a character string containing the
241 ! name of the month.
242 ! UNITS: N/A
243 ! TYPE: CHARACTER
244 ! DIMENSION: Conformable with input DateTime arugment
245 !:sdoc-:
246 !------------------------------------------------------------------------------
247 
248  ELEMENTAL FUNCTION datetime_nameofmonth( DateTime ) RESULT( name )
249  TYPE(datetime_type), INTENT(IN) :: datetime
250  CHARACTER(NL) :: name
251  name = nameofmonth( datetime%Month )
252  END FUNCTION datetime_nameofmonth
253 
254 
255 !------------------------------------------------------------------------------
256 !:sdoc+:
257 !
258 ! NAME:
259 ! DateTime_DayOfWeek
260 !
261 ! PURPOSE:
262 ! Elemental function to return the name of the day of week.
263 !
264 ! CALLING SEQUENCE:
265 ! name = DateTime_DayOfWeek( DateTime )
266 !
267 ! INPUT ARGUMENTS:
268 ! DateTime: DateTime structure containing date information.
269 ! UNITS: N/A
270 ! TYPE: DateTime_type
271 ! DIMENSION: Scalar
272 ! ATTRIBUTES: INTENT(IN)
273 !
274 ! FUNCTION RESULT:
275 ! name: The return value is a character string containing the
276 ! name of the day of the week.
277 ! UNITS: N/A
278 ! TYPE: CHARACTER
279 ! DIMENSION: Conformable with input DateTime argument.
280 !
281 !:sdoc-:
282 !------------------------------------------------------------------------------
283 
284  ELEMENTAL FUNCTION datetime_dayofweek( DateTime ) RESULT( name )
285  TYPE(datetime_type), INTENT(IN) :: datetime
286  CHARACTER(NL) :: name
287  name = dayofweek( datetime%Day, datetime%Month, datetime%Year )
288  END FUNCTION datetime_dayofweek
289 
290 
291 !--------------------------------------------------------------------------------
292 !:sdoc+:
293 !
294 ! NAME:
295 ! DateTime_Inspect
296 !
297 ! PURPOSE:
298 ! Subroutine to print the contents of a DateTime object to stdout.
299 !
300 ! CALLING SEQUENCE:
301 ! CALL DateTime_Inspect( datetime )
302 !
303 ! OBJECTS:
304 ! DateTime: DateTime object to display.
305 ! UNITS: N/A
306 ! TYPE: DateTime_type
307 ! DIMENSION: Scalar
308 ! ATTRIBUTES: INTENT(IN)
309 !
310 !:sdoc-:
311 !--------------------------------------------------------------------------------
312 
313  SUBROUTINE datetime_inspect( self )
314  TYPE(datetime_type), INTENT(IN) :: self
315  WRITE(*,'(1x,"DateTime OBJECT")')
316  WRITE(*,'(3x,"Year : ",i0)') self%Year
317  WRITE(*,'(3x,"Month : ",i0)') self%Month
318  WRITE(*,'(3x,"Day : ",i0)') self%Day
319  WRITE(*,'(3x,"UTC_Delta : ",i0)') self%UTC_Delta
320  WRITE(*,'(3x,"Hour : ",i0)') self%Hour
321  WRITE(*,'(3x,"Minute : ",i0)') self%Minute
322  WRITE(*,'(3x,"Second : ",i0)') self%Second
323  WRITE(*,'(3x,"Millisecond : ",i0)') self%Millisecond
324  WRITE(*,'(3x,"DoY : ",i0)') self%DoY
325  WRITE(*,'(3x,"Month_Name : ",a)') trim(self%Month_Name)
326  WRITE(*,'(3x,"Day_Name : ",a)') trim(self%Day_Name)
327  END SUBROUTINE datetime_inspect
328 
329 
330 !------------------------------------------------------------------------------
331 !:sdoc+:
332 !
333 ! NAME:
334 ! DateTime_ToString
335 !
336 ! PURPOSE:
337 ! Elemental function to return the equivalent string representation
338 ! of the DateTime object.
339 !
340 ! CALLING SEQUENCE:
341 ! string = DateTime_ToString( DateTime, Format=format )
342 !
343 ! OBJECTS:
344 ! DateTime: DateTime structure containing date information.
345 ! UNITS: N/A
346 ! TYPE: DateTime_type
347 ! DIMENSION: Scalar or any rank
348 ! ATTRIBUTES: INTENT(IN)
349 !
350 ! OPTIONAL INPUTS:
351 ! Format: A single character code to determine the output
352 ! string format. Valid format codes are:
353 !
354 ! 'd' Short Date pattern. 6/15/2009 1:45:30 PM -> 06/15/2009
355 ! 'D' Long Date pattern. 6/15/2009 1:45:30 PM -> Monday, June 15, 2009
356 ! 'f' Full Date Short Time pattern. 6/15/2009 1:45:30 PM -> Monday, June 15, 2009 13:45
357 ! 'F' Full Date Long Time pattern. 6/15/2009 1:45:30 PM -> Monday, June 15, 2009 13:45:30
358 ! 'g' General Date Short Time pattern. 6/15/2009 1:45:30 PM -> 06/15/2009 13:45
359 ! 'G' General Date Long Time pattern. 6/15/2009 1:45:30 PM -> 06/15/2009 13:45:30
360 ! 'm','M' Month pattern. 6/15/2009 1:45:30 PM -> June 15
361 ! 'o','O' Round-trip pattern. 6/15/2009 1:45:30 PM -> 2009-06-15T13:45:30.0900000
362 ! 'r','R' * RFC1123 pattern. 6/15/2009 1:45:30 PM -> Mon, 15 Jun 2009 20:45:30 GMT
363 ! 's' Sortable pattern. 6/15/2009 1:45:30 PM -> 2009-06-15T13:45:30
364 ! 't' Short Time pattern. 6/15/2009 1:45:30 PM -> 13:45
365 ! 'T' Long Time pattern. 6/15/2009 1:45:30 PM -> 13:45:30
366 ! 'u' * Universal Sortable pattern. 6/15/2009 1:45:30 PM -> 2009-06-15 20:45:30Z
367 ! 'U' * Universal Full pattern. 6/15/2009 1:45:30 PM -> Monday, June 15, 2009 20:45:30
368 ! 'y','Y' Year Month pattern. 6/15/2009 1:45:30 PM -> June, 2009
369 !
370 ! Format codes marked with a "*" are not yet implemented.
371 ! UNITS: N/A
372 ! TYPE: CHARACTER
373 ! DIMENSION: Conformable with the DateTime input.
374 ! ATTRIBUTES: INTENT(IN), OPTIONAL
375 !
376 ! FUNCTION RESULT:
377 ! string: Equivalent string representation of the DateTime object.
378 ! UNITS: N/A
379 ! TYPE: CHARACTER
380 ! DIMENSION: Conformable with input DateTime argument.
381 !
382 !:sdoc-:
383 !------------------------------------------------------------------------------
384 
385  ELEMENTAL FUNCTION datetime_tostring( DateTime, Format ) RESULT( string )
386  ! Arguments
387  TYPE(datetime_type), INTENT(IN) :: datetime
388  CHARACTER(*) , OPTIONAL, INTENT(IN) :: format
389  ! Function result
390  CHARACTER(80) :: string
391  ! Local variables
392  CHARACTER(1) :: string_format
393  REAL(fp) :: seconds
394 
395  ! Define default format
396  string_format = 'd'
397  IF ( PRESENT(format) ) string_format = trim(adjustl(format))
398 
399 
400  ! Begin monster select construct
401  ! NOTE: This is a brain dead way to implement. But quick. :o)
402  SELECT CASE(string_format)
403 
404  CASE('d') ! Short Date pattern. 6/15/2009 1:45:30 PM -> 06/15/2009
405  WRITE(string,'(i2.2,"/",i2.2,"/",i4)') &
406  datetime%Month, datetime%Day, datetime%Year
407 
408  CASE('D') ! Long Date pattern. 6/15/2009 1:45:30 PM -> Monday, June 15, 2009
409  WRITE(string,'(a,", ",a,1x,i0,", ",i4)') &
410  trim(datetime_dayofweek(datetime)), &
411  trim(datetime_nameofmonth(datetime)), &
412  datetime%Day, datetime%Year
413 
414  CASE('f') ! Full Date Short Time pattern. 6/15/2009 1:45:30 PM -> Monday, June 15, 2009 13:45
415  WRITE(string,'(a,", ",a,1x,i0,", ",i4,1x,i2.2,":",i2.2)') &
416  trim(datetime_dayofweek(datetime)), &
417  trim(datetime_nameofmonth(datetime)), &
418  datetime%Day, datetime%Year, &
419  datetime%Hour, datetime%Minute
420 
421  CASE('F') ! Full Date Long Time pattern. 6/15/2009 1:45:30 PM -> Monday, June 15, 2009 13:45:30
422  WRITE(string,'(a,", ",a,1x,i0,", ",i4,1x,i2.2,":",i2.2,":",i2.2)') &
423  trim(datetime_dayofweek(datetime)), &
424  trim(datetime_nameofmonth(datetime)), &
425  datetime%Day, datetime%Year, &
426  datetime%Hour, datetime%Minute, datetime%Second
427 
428  CASE('g') ! General Date Short Time pattern. 6/15/2009 1:45:30 PM -> 06/15/2009 13:45
429  WRITE(string,'(i2.2,"/",i2.2,"/",i4,1x,i2.2,":",i2.2)') &
430  datetime%Month, datetime%Day, datetime%Year, &
431  datetime%Hour, datetime%Minute
432 
433  CASE('G') ! General Date Long Time pattern. 6/15/2009 1:45:30 PM -> 06/15/2009 13:45:30
434  WRITE(string,'(i2.2,"/",i2.2,"/",i4,1x,i2.2,":",i2.2,":",i2.2)') &
435  datetime%Month, datetime%Day, datetime%Year, &
436  datetime%Hour, datetime%Minute, datetime%Second
437 
438  CASE('m','M') ! Month pattern. 6/15/2009 1:45:30 PM -> June 15
439  WRITE(string,'(a,1x,i0)') &
440  trim(datetime_nameofmonth(datetime)), datetime%Day
441 
442  CASE('o','O') ! Round-trip pattern. 6/15/2009 1:45:30 PM -> 2009-06-15T13:45:30.0900000
443  seconds = REAL(DateTime%Second,fp) + &
444  REAL(datetime%millisecond,fp)*1.0e-03_fp
445  WRITE(string,'(i4,"-",i2.2,"-",i2.2,"T",i2.2,":",i2.2,":",f10.7)') &
446  datetime%Year, datetime%Month, datetime%Day, &
447  datetime%Hour, datetime%Minute, seconds
448 
449  CASE('r','R') ! RFC1123 pattern. 6/15/2009 1:45:30 PM -> Mon, 15 Jun 2009 20:45:30 GMT
450  string = 'RFC1123 format not yet implemented'
451 
452  CASE('s') ! Sortable pattern. 6/15/2009 1:45:30 PM -> 2009-06-15T13:45:30
453  WRITE(string,'(i4,"-",i2.2,"-",i2.2,"T",i2.2,":",i2.2,":",i2.2)') &
454  datetime%Year, datetime%Month, datetime%Day, &
455  datetime%Hour, datetime%Minute, datetime%Second
456 
457  CASE('t') ! Short Time pattern. 6/15/2009 1:45:30 PM -> 13:45
458  WRITE(string,'(i2.2,":",i2.2)') &
459  datetime%Hour, datetime%Minute
460 
461  CASE('T') ! Long Time pattern. 6/15/2009 1:45:30 PM -> 13:45:30
462  WRITE(string,'(i2.2,":",i2.2,":",i2.2)') &
463  datetime%Hour, datetime%Minute, datetime%Second
464 
465  CASE('u') ! Universal Sortable pattern. 6/15/2009 1:45:30 PM -> 2009-06-15 20:45:30Z
466  string = 'Universal Sortable format not yet implemented'
467 
468  CASE('U') ! Universal Full pattern. 6/15/2009 1:45:30 PM -> Monday, June 15, 2009 20:45:30
469  string = 'Universal Full format not yet implemented'
470 
471  CASE('y','Y') ! Year Month pattern. 6/15/2009 1:45:30 PM -> June, 2009
472  WRITE(string,'(a,", ",i4)') &
473  trim(datetime_nameofmonth(datetime)), datetime%Year
474  CASE DEFAULT
475  string = 'Invalid DateTime string format!'
476 
477  END SELECT
478 
479  END FUNCTION datetime_tostring
480 
481 END MODULE datetime_utility
elemental integer function, public datetime_dayofyear(DateTime)
elemental character(nl) function, public datetime_dayofweek(DateTime)
integer, parameter nl
elemental logical function, public isleapyear(Year)
character(len=9) function, public month_name(n)
integer, parameter, public fp
Definition: Type_Kinds.f90:124
elemental logical function, public datetime_isleapyear(DateTime)
elemental character(nl) function, public dayofweek(Day, Month, Year)
character(*), parameter module_version_id
elemental integer function, public dayofyear(Day, Month, Year)
type(datetime_type) function, public datetime_now()
elemental character(80) function, public datetime_tostring(DateTime, Format)
elemental character(nl) function, public nameofmonth(Month)
elemental character(nl) function, public datetime_nameofmonth(DateTime)
elemental integer function, public datetime_daysinmonth(DateTime)
elemental integer function, public daysinmonth(Month, Year)
subroutine, public datetime_inspect(self)