1 | !---------------------------------------------------------------------- |
---|
2 | ! NEMO system team, System and Interface for oceanic RElocable Nesting |
---|
3 | !---------------------------------------------------------------------- |
---|
4 | ! |
---|
5 | ! DESCRIPTION: |
---|
6 | !> @brief This module provide the calculation of Julian dates, and |
---|
7 | !> do many manipulations with dates. |
---|
8 | !> |
---|
9 | !> @details |
---|
10 | !> Actually we use Modified Julian Dates, with |
---|
11 | !> 17 Nov 1858 at 00:00:00 as origin.<br/> |
---|
12 | !> |
---|
13 | !> define type TDATE:<br/> |
---|
14 | !> @code |
---|
15 | !> TYPE(TDATE) :: tl_date1 |
---|
16 | !> @endcode |
---|
17 | !> default date is 17 Nov 1858 at 00:00:00<br/> |
---|
18 | !> |
---|
19 | !> to intialise date : <br/> |
---|
20 | !> - from date of the day at 12:00:00 : |
---|
21 | !> @code |
---|
22 | !> tl_date1=date_today() |
---|
23 | !> @endcode |
---|
24 | !> - from date and time of the day : |
---|
25 | !> @code |
---|
26 | !> tl_date1=date_now() |
---|
27 | !> @endcode |
---|
28 | !> - from julian day : |
---|
29 | !> @code |
---|
30 | !> tl_date1=date_init(dd_jd) |
---|
31 | !> @endcode |
---|
32 | !> - dd_jd julian day (double precision) |
---|
33 | !> - from number of second since julian day origin : |
---|
34 | !> @code |
---|
35 | !> tl_date1=date_init(kd_nsec) |
---|
36 | !> @endcode |
---|
37 | !> - kd_nsec number of second (integer 8) |
---|
38 | !> - from year month day : |
---|
39 | !> @code |
---|
40 | !> tl_date1=date_init(2012,12,10) |
---|
41 | !> @endcode |
---|
42 | !> - from string character formatted date : |
---|
43 | !> @code |
---|
44 | !> tl_date1=date_init(cd_fmtdate) |
---|
45 | !> @endcode |
---|
46 | !> - cd_fmtdate date in format YYYY-MM-DD hh:mm:ss |
---|
47 | !> |
---|
48 | !> to print date in format YYYY-MM-DD hh:mm:ss<br/> |
---|
49 | !> CHARACTER(LEN=lc) :: cl_date<br/> |
---|
50 | !> @code |
---|
51 | !> cl_date=date_print(tl_date1) |
---|
52 | !> PRINT *, TRIM(cl_date) |
---|
53 | !> @endcode |
---|
54 | !> |
---|
55 | !> to print date in another format (only year, month, day): |
---|
56 | !> @code |
---|
57 | !> cl_date=date_print(tl_date1, cd_fmt) |
---|
58 | !> PRINT *, TRIM(cl_date) |
---|
59 | !> @endcode |
---|
60 | !> - cd_fmt ouput format (ex: cd_fmt="('y',i0.4,'m',i0.2,'d',i0.2)" ) |
---|
61 | !> |
---|
62 | !> to print day of the week:<br/> |
---|
63 | !> @code |
---|
64 | !> PRINT *,"dow ", tl_date1\%i_dow |
---|
65 | !> @endcode |
---|
66 | !> to print last day of the month:<br/> |
---|
67 | !> @code |
---|
68 | !> PRINT *,"last day ", tl_date1\%i_lday |
---|
69 | !> @endcode |
---|
70 | !> |
---|
71 | !> to know if year is a leap year:<br/> |
---|
72 | !> @code |
---|
73 | !> ll_isleap=date_leapyear(tl_date1) |
---|
74 | !> @endcode |
---|
75 | !> - ll_isleap is logical |
---|
76 | !> |
---|
77 | !> to compute number of days between two dates:<br/> |
---|
78 | !> @code |
---|
79 | !> tl_date2=date_init(2010,12,10) |
---|
80 | !> dl_diff=tl_date1-tl_date2 |
---|
81 | !> @endcode |
---|
82 | !> - dl_diff is the number of days between date1 and date2 (double precision) |
---|
83 | !> |
---|
84 | !> to add or substract nday to a date:<br/> |
---|
85 | !> @code |
---|
86 | !> tl_date2=tl_date1+2. |
---|
87 | !> tl_date2=tl_date1-2.6 |
---|
88 | !> @endcode |
---|
89 | !> - number of day (double precision) |
---|
90 | !> |
---|
91 | !> to print julian day:<br/> |
---|
92 | !> @code |
---|
93 | !> PRINT *," julian day",tl_date1\%r_jd |
---|
94 | !> @endcode |
---|
95 | !> |
---|
96 | !> to print CNES julian day (origin 1950-01-01 00:00:00)<br/> |
---|
97 | !> @code |
---|
98 | !> PRINT *," CNES julian day",tl_date1\%r_jc |
---|
99 | !> @endcode |
---|
100 | !> |
---|
101 | !> to create pseudo julian day with origin date_now:<br/> |
---|
102 | !> @code |
---|
103 | !> tl_date1=date_init(2012,12,10,td_dateo=date_now()) |
---|
104 | !> @endcode |
---|
105 | !> @note you erase CNES julian day when doing so<br/> |
---|
106 | !> |
---|
107 | !> to print julian day in seconds:<br/> |
---|
108 | !> @code |
---|
109 | !> PRINT *, tl_date1\%k_jdsec |
---|
110 | !> @endcode |
---|
111 | !> to print CNES or new julian day in seconds:<br/> |
---|
112 | !> @code |
---|
113 | !> PRINT *, tl_date1\%k_jcsec |
---|
114 | !> @endcode |
---|
115 | !> |
---|
116 | !> @author J.Paul |
---|
117 | !> |
---|
118 | !> @date November, 2013 - Initial Version |
---|
119 | ! |
---|
120 | !> @note This module is based on Perderabo's date calculator (ksh) |
---|
121 | !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) |
---|
122 | !> |
---|
123 | !> @todo |
---|
124 | !> - see calendar.f90 and select Gregorian, NoLeap, or D360 calendar |
---|
125 | !---------------------------------------------------------------------- |
---|
126 | MODULE date |
---|
127 | |
---|
128 | USE global ! global variable |
---|
129 | USE kind ! F90 kind parameter |
---|
130 | USE fct ! basic useful function |
---|
131 | USE logger ! log file manager |
---|
132 | |
---|
133 | IMPLICIT NONE |
---|
134 | ! NOTE_avoid_public_variables_if_possible |
---|
135 | |
---|
136 | ! type and variable |
---|
137 | PUBLIC :: TDATE !< date structure |
---|
138 | |
---|
139 | PRIVATE :: cm_fmtdate !< date and time format |
---|
140 | PRIVATE :: im_secbyday !< number of second by day |
---|
141 | |
---|
142 | ! function and subroutine |
---|
143 | PUBLIC :: date_today !< return the date of the day at 12:00:00 |
---|
144 | PUBLIC :: date_now !< return the date and time |
---|
145 | PUBLIC :: date_time !< return the date and time in milliseconds |
---|
146 | PUBLIC :: date_init !< initialized date structure form julian day or year month day |
---|
147 | PUBLIC :: date_print !< print the date with format YYYY-MM-DD hh:mm:ss |
---|
148 | PUBLIC :: date_leapyear !< check if year is a leap year |
---|
149 | PUBLIC :: OPERATOR(-) !< substract two dates or n days to a date |
---|
150 | PUBLIC :: OPERATOR(+) !< add n days to a date |
---|
151 | |
---|
152 | PRIVATE :: date__init_fmtdate ! initialized date structure from character YYYY-MM-DD hh:mm:ss |
---|
153 | PRIVATE :: date__init_jd ! initialized date structure from julian day |
---|
154 | PRIVATE :: date__init_nsec ! initialized date structure from number of second since origin of julian day |
---|
155 | PRIVATE :: date__init_ymd ! initialized date structure from year month day |
---|
156 | PRIVATE :: date__addnday ! add nday to a date |
---|
157 | PRIVATE :: date__subnday ! substract nday to a date |
---|
158 | PRIVATE :: date__diffdate ! compute number of days between two dates |
---|
159 | PRIVATE :: date__lastday ! compute last day of the month |
---|
160 | PRIVATE :: date__ymd2jd ! compute julian day from year month day |
---|
161 | PRIVATE :: date__jd2ymd ! compute year month day from julian day |
---|
162 | PRIVATE :: date__jc2jd ! compute julian day from pseudo julian day |
---|
163 | PRIVATE :: date__jd2jc ! compute pseudo julian day with new date origin |
---|
164 | PRIVATE :: date__jd2dow ! compute the day of week from julian day |
---|
165 | PRIVATE :: date__hms2jd ! compute fraction of a day from hour, minute, second |
---|
166 | PRIVATE :: date__jd2hms ! compute hour, minute, second from julian fraction |
---|
167 | PRIVATE :: date__check ! check date in date structure |
---|
168 | PRIVATE :: date__adjust ! adjust date |
---|
169 | PRIVATE :: date__jd2sec ! convert julian day in seconds since julian day origin |
---|
170 | PRIVATE :: date__sec2jd ! convert seconds since julian day origin in julian day |
---|
171 | |
---|
172 | TYPE TDATE !< date structure |
---|
173 | INTEGER(i4) :: i_year = 1858 !< year |
---|
174 | INTEGER(i4) :: i_month = 11 !< month |
---|
175 | INTEGER(i4) :: i_day = 17 !< day |
---|
176 | INTEGER(i4) :: i_hour = 0 !< hour |
---|
177 | INTEGER(i4) :: i_min = 0 !< min |
---|
178 | INTEGER(i4) :: i_sec = 0 !< sec |
---|
179 | INTEGER(i4) :: i_dow = 0 !< day of week |
---|
180 | INTEGER(i4) :: i_lday = 0 !< last day of the month |
---|
181 | REAL(dp) :: d_jd = 0 !< julian day (origin : 1858/11/17 00:00:00) |
---|
182 | REAL(dp) :: d_jc = 0 !< CNES julian day or pseudo julian day with new date origin |
---|
183 | INTEGER(i8) :: k_jdsec = 0 !< number of seconds since julian day origin |
---|
184 | INTEGER(i8) :: k_jcsec = 0 !< number of seconds since CNES or pseudo julian day origin |
---|
185 | END TYPE TDATE |
---|
186 | |
---|
187 | ! module variable |
---|
188 | CHARACTER(LEN=lc), PARAMETER :: cm_fmtdate = & !< date and time format |
---|
189 | & "(i0.4,'-',i0.2,'-',i0.2,1x,i0.2,':',i0.2,':',i0.2)" |
---|
190 | |
---|
191 | INTEGER(i4), PARAMETER :: im_secbyday = 86400 !< number of second by day |
---|
192 | |
---|
193 | INTERFACE date_init |
---|
194 | MODULE PROCEDURE date__init_jd ! initialized date structure from julian day |
---|
195 | MODULE PROCEDURE date__init_nsec ! initialized date structure from number of second since origin of julian day |
---|
196 | MODULE PROCEDURE date__init_ymd ! initialized date structure from year month day |
---|
197 | MODULE PROCEDURE date__init_fmtdate ! initialized date structure from character YYYY-MM-DD hh:mm:ss |
---|
198 | END INTERFACE date_init |
---|
199 | |
---|
200 | INTERFACE OPERATOR(+) |
---|
201 | MODULE PROCEDURE date__addnday ! add nday to a date |
---|
202 | END INTERFACE |
---|
203 | |
---|
204 | INTERFACE OPERATOR(-) |
---|
205 | MODULE PROCEDURE date__subnday ! substract nday to a date |
---|
206 | MODULE PROCEDURE date__diffdate ! compute number of day between two dates |
---|
207 | END INTERFACE |
---|
208 | |
---|
209 | CONTAINS |
---|
210 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
211 | FUNCTION date_print(td_date, cd_fmt) & |
---|
212 | & RESULT (cf_date) |
---|
213 | !------------------------------------------------------------------- |
---|
214 | !> @brief This function print the date and time with |
---|
215 | !> format YYYY/MM/DD hh:mm:ss. |
---|
216 | !> @details |
---|
217 | !> Optionally, you could specify output format. However it will be |
---|
218 | !> only apply to year, month, day. |
---|
219 | !> |
---|
220 | !> @author J.Paul |
---|
221 | !> @date November, 2013 - Initial Version |
---|
222 | !> |
---|
223 | !> @param[in] td_date date strutcutre |
---|
224 | !> @param[in] cd_fmt ouput format (only for year,month,day) |
---|
225 | !> @return date in format YYYY-MM-DD hh:mm:ss |
---|
226 | !------------------------------------------------------------------- |
---|
227 | |
---|
228 | IMPLICIT NONE |
---|
229 | |
---|
230 | ! Argument |
---|
231 | TYPE(TDATE) , INTENT(IN) :: td_date |
---|
232 | CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_fmt |
---|
233 | |
---|
234 | ! function |
---|
235 | CHARACTER(LEN=lc) :: cf_date |
---|
236 | !---------------------------------------------------------------- |
---|
237 | |
---|
238 | IF( PRESENT(cd_fmt) )THEN |
---|
239 | WRITE(cf_date,TRIM(cd_fmt)) & |
---|
240 | & td_date%i_year,td_date%i_month,td_date%i_day |
---|
241 | ELSE |
---|
242 | WRITE(cf_date,cm_fmtdate) & |
---|
243 | & td_date%i_year,td_date%i_month,td_date%i_day, & |
---|
244 | & td_date%i_hour,td_date%i_min,td_date%i_sec |
---|
245 | ENDIF |
---|
246 | |
---|
247 | END FUNCTION date_print |
---|
248 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
249 | FUNCTION date_leapyear(td_date) & |
---|
250 | & RESULT (lf_leap) |
---|
251 | !------------------------------------------------------------------- |
---|
252 | !> @brief This function check if year is a leap year. |
---|
253 | !> |
---|
254 | !> @author J.Paul |
---|
255 | !> @date November, 2013 - Initial Version |
---|
256 | !> |
---|
257 | !> @param[in] td_date date strutcutre |
---|
258 | !> @return true if year is leap year |
---|
259 | !------------------------------------------------------------------- |
---|
260 | |
---|
261 | IMPLICIT NONE |
---|
262 | |
---|
263 | ! Argument |
---|
264 | TYPE(TDATE), INTENT(IN) :: td_date |
---|
265 | |
---|
266 | ! function |
---|
267 | LOGICAL :: lf_leap |
---|
268 | !---------------------------------------------------------------- |
---|
269 | |
---|
270 | lf_leap=.false. |
---|
271 | IF( (MOD(td_date%i_year,100_i4)==0) )THEN |
---|
272 | IF( (MOD(td_date%i_year,400_i4)==0) )THEN |
---|
273 | lf_leap=.true. |
---|
274 | ENDIF |
---|
275 | ELSE |
---|
276 | IF( (MOD(td_date%i_year,4_i4)==0) )THEN |
---|
277 | lf_leap=.true. |
---|
278 | ENDIF |
---|
279 | ENDIF |
---|
280 | |
---|
281 | END FUNCTION date_leapyear |
---|
282 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
283 | FUNCTION date_now() & |
---|
284 | & RESULT (tf_date) |
---|
285 | !------------------------------------------------------------------- |
---|
286 | !> @brief This function return the current date and time. |
---|
287 | !> |
---|
288 | !> @author J.Paul |
---|
289 | !> @date November, 2013 - Initial Version |
---|
290 | !> |
---|
291 | !> @return current date and time in a date structure |
---|
292 | !------------------------------------------------------------------- |
---|
293 | |
---|
294 | IMPLICIT NONE |
---|
295 | |
---|
296 | ! function |
---|
297 | TYPE(TDATE) :: tf_date |
---|
298 | |
---|
299 | ! local variable |
---|
300 | INTEGER(sp), DIMENSION(8) :: il_values |
---|
301 | !---------------------------------------------------------------- |
---|
302 | |
---|
303 | CALL DATE_AND_TIME( values= il_values) |
---|
304 | |
---|
305 | tf_date=date_init( il_values(1), il_values(2), il_values(3), & |
---|
306 | & il_values(5), il_values(6), il_values(7) ) |
---|
307 | |
---|
308 | END FUNCTION date_now |
---|
309 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
310 | SUBROUTINE date_time() |
---|
311 | !------------------------------------------------------------------- |
---|
312 | !> @brief This subroutine print the current date and time in milliseconds. |
---|
313 | !> |
---|
314 | !> @author J.Paul |
---|
315 | !> @date August, 2017 - Initial Version |
---|
316 | !------------------------------------------------------------------- |
---|
317 | |
---|
318 | IMPLICIT NONE |
---|
319 | |
---|
320 | ! local variable |
---|
321 | INTEGER(sp), DIMENSION(8) :: il_values |
---|
322 | CHARACTER(LEN=lc) :: cl_fmtdate = & !< date and time format |
---|
323 | & "(i0.4,'-',i0.2,'-',i0.2,1x,i0.2,':',i0.2,':',i0.2'.',i0.3)" |
---|
324 | !---------------------------------------------------------------- |
---|
325 | |
---|
326 | CALL DATE_AND_TIME( values= il_values) |
---|
327 | |
---|
328 | WRITE(*,cl_fmtdate) il_values(1),il_values(2),il_values(3),il_values(5),il_values(6),il_values(7),il_values(8) |
---|
329 | |
---|
330 | END SUBROUTINE date_time |
---|
331 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
332 | FUNCTION date_today() & |
---|
333 | & RESULT (tf_date) |
---|
334 | !------------------------------------------------------------------- |
---|
335 | !> @brief This function return the date of the day at 12:00:00. |
---|
336 | !> |
---|
337 | !> @author J.Paul |
---|
338 | !> @date November, 2013 - Initial Version |
---|
339 | !> |
---|
340 | !> @return date of the day at 12:00:00 in a date structure |
---|
341 | !------------------------------------------------------------------- |
---|
342 | |
---|
343 | IMPLICIT NONE |
---|
344 | |
---|
345 | ! function |
---|
346 | TYPE(TDATE) :: tf_date |
---|
347 | |
---|
348 | ! local variable |
---|
349 | INTEGER(sp), DIMENSION(8) :: il_values |
---|
350 | !---------------------------------------------------------------- |
---|
351 | |
---|
352 | CALL DATE_AND_TIME( values= il_values) |
---|
353 | |
---|
354 | tf_date=date_init( il_values(1), il_values(2), il_values(3), 12_i4 ) |
---|
355 | |
---|
356 | END FUNCTION date_today |
---|
357 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
358 | FUNCTION date__init_fmtdate(cd_datetime, td_dateo) & |
---|
359 | & RESULT (tf_date) |
---|
360 | !------------------------------------------------------------------- |
---|
361 | !> @brief This function initialized date structure from a character |
---|
362 | !> date with format YYYY-MM-DD hh:mm:ss.<br/> |
---|
363 | !> @details |
---|
364 | !> Optionaly create pseudo julian day with new origin.<br/> |
---|
365 | !> julian day origin is 17 Nov 1858 at 00:00:00 |
---|
366 | !> |
---|
367 | !> @author J.Paul |
---|
368 | !> @date November, 2013 - Initial Version |
---|
369 | !> @date April, 2019 |
---|
370 | !> - check time units CF convention, raise error if not |
---|
371 | !> |
---|
372 | !> @param[in] cd_date date in format YYYY-MM-DD hh:mm:ss |
---|
373 | !> @param[in] td_dateo new date origin for pseudo julian day |
---|
374 | !> @return date structure |
---|
375 | !------------------------------------------------------------------- |
---|
376 | |
---|
377 | IMPLICIT NONE |
---|
378 | |
---|
379 | ! Argument |
---|
380 | CHARACTER(LEN=*), INTENT(IN) :: cd_datetime |
---|
381 | TYPE(TDATE), INTENT(IN), OPTIONAL :: td_dateo |
---|
382 | |
---|
383 | ! function |
---|
384 | TYPE(TDATE) :: tf_date |
---|
385 | |
---|
386 | ! local variable |
---|
387 | CHARACTER(LEN=lc) :: cl_datetime |
---|
388 | CHARACTER(LEN=lc) :: cl_date |
---|
389 | CHARACTER(LEN=lc) :: cl_time |
---|
390 | CHARACTER(LEN=lc) :: cl_year |
---|
391 | CHARACTER(LEN=lc) :: cl_month |
---|
392 | CHARACTER(LEN=lc) :: cl_day |
---|
393 | CHARACTER(LEN=lc) :: cl_hour |
---|
394 | CHARACTER(LEN=lc) :: cl_min |
---|
395 | CHARACTER(LEN=lc) :: cl_sec |
---|
396 | CHARACTER(LEN=lc) :: cl_msg |
---|
397 | |
---|
398 | INTEGER(i4) :: il_year |
---|
399 | INTEGER(i4) :: il_month |
---|
400 | INTEGER(i4) :: il_day |
---|
401 | INTEGER(i4) :: il_hour |
---|
402 | INTEGER(i4) :: il_min |
---|
403 | INTEGER(i4) :: il_sec |
---|
404 | !---------------------------------------------------------------- |
---|
405 | |
---|
406 | cl_datetime=TRIM(ADJUSTL(cd_datetime)) |
---|
407 | |
---|
408 | cl_date=fct_split(cl_datetime,1,' ') |
---|
409 | cl_time=fct_split(cl_datetime,2,' ') |
---|
410 | |
---|
411 | cl_year = fct_split(cl_date,1,'-') |
---|
412 | READ(cl_year,*) il_year |
---|
413 | cl_month= fct_split(cl_date,2,'-') |
---|
414 | READ(cl_month, *) il_month |
---|
415 | cl_day = fct_split(cl_date,3,'-') |
---|
416 | READ(cl_day, *) il_day |
---|
417 | cl_hour = fct_split(cl_time,1,':') |
---|
418 | IF( TRIM(cl_hour) /= '' )THEN |
---|
419 | READ(cl_hour, *) il_hour |
---|
420 | ELSE |
---|
421 | WRITE(cl_msg,*) "time units not conform to CF conventions" |
---|
422 | CALL logger_error(cl_msg) |
---|
423 | il_hour=0 |
---|
424 | ENDIf |
---|
425 | cl_min = fct_split(cl_time,2,':') |
---|
426 | IF( TRIM(cl_min) /= '' )THEN |
---|
427 | READ(cl_min, *) il_min |
---|
428 | ELSE |
---|
429 | WRITE(cl_msg,*) "time units not conform to CF conventions" |
---|
430 | CALL logger_error(cl_msg) |
---|
431 | il_min=0 |
---|
432 | ENDIf |
---|
433 | cl_sec = fct_split(cl_time,3,':') |
---|
434 | IF( TRIM(cl_sec) /= '' )THEN |
---|
435 | READ(cl_sec, *) il_sec |
---|
436 | ELSE |
---|
437 | WRITE(cl_msg,*) "time units not conform to CF conventions" |
---|
438 | CALL logger_error(cl_msg) |
---|
439 | il_sec=0 |
---|
440 | ENDIf |
---|
441 | |
---|
442 | tf_date = date_init( il_year, il_month, il_day, il_hour, & |
---|
443 | & il_min, il_sec, td_dateo=td_dateo ) |
---|
444 | |
---|
445 | END FUNCTION date__init_fmtdate |
---|
446 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
447 | FUNCTION date__init_jd(dd_jd, td_dateo) & |
---|
448 | & RESULT (tf_date) |
---|
449 | !------------------------------------------------------------------- |
---|
450 | !> @brief This function initialized date structure from julian day.<br/> |
---|
451 | !> @details |
---|
452 | !> Optionaly create pseudo julian day with new origin.<br/> |
---|
453 | !> julian day origin is 17 Nov 1858 at 00:00:00 |
---|
454 | !> |
---|
455 | !> @author J.Paul |
---|
456 | !> @date November, 2013 - Initial Version |
---|
457 | !> |
---|
458 | !> @param[in] dd_jd julian day |
---|
459 | !> @param[in] td_dateo new date origin for pseudo julian day |
---|
460 | !> |
---|
461 | !> @return date structure of julian day |
---|
462 | !------------------------------------------------------------------- |
---|
463 | |
---|
464 | IMPLICIT NONE |
---|
465 | |
---|
466 | !Argument |
---|
467 | REAL(dp), INTENT(IN) :: dd_jd |
---|
468 | TYPE(TDATE), INTENT(IN), OPTIONAL :: td_dateo |
---|
469 | |
---|
470 | ! function |
---|
471 | TYPE(TDATE) :: tf_date |
---|
472 | !---------------------------------------------------------------- |
---|
473 | IF( PRESENT(td_dateo) )THEN |
---|
474 | CALL date__check(td_dateo) |
---|
475 | |
---|
476 | ! pseudo julian day with origin dateo |
---|
477 | tf_date%d_jc=dd_jd |
---|
478 | tf_date%k_jcsec=date__jd2sec(dd_jd) |
---|
479 | |
---|
480 | ! convert to truly julian day |
---|
481 | CALL date__jc2jd(tf_date, td_dateo) |
---|
482 | ELSE |
---|
483 | tf_date%d_jd=dd_jd |
---|
484 | tf_date%k_jdsec=date__jd2sec(dd_jd) |
---|
485 | |
---|
486 | ! compute CNES julian day |
---|
487 | CALL date__jd2jc(tf_date) |
---|
488 | ENDIF |
---|
489 | |
---|
490 | ! check input data |
---|
491 | CALL date__check(tf_date) |
---|
492 | |
---|
493 | ! compute year month day hour min sec |
---|
494 | CALL date__jd2ymd(tf_date) |
---|
495 | |
---|
496 | ! compute day of the wekk |
---|
497 | CALL date__jd2dow(tf_date) |
---|
498 | |
---|
499 | !compute last day of the month |
---|
500 | tf_date%i_lday=date__lastday(tf_date) |
---|
501 | |
---|
502 | END FUNCTION date__init_jd |
---|
503 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
504 | FUNCTION date__init_nsec(kd_nsec, td_dateo) & |
---|
505 | & RESULT (tf_date) |
---|
506 | !------------------------------------------------------------------- |
---|
507 | !> @brief This function initialized date structure from number of |
---|
508 | !> second since julian day origin.<br/> |
---|
509 | !> @details |
---|
510 | !> Optionaly create pseudo julian day with new origin. |
---|
511 | !> |
---|
512 | !> @author J.Paul |
---|
513 | !> @date November, 2013 - Initial Version |
---|
514 | !> |
---|
515 | !> @param[in] kd_nsec number of second since julian day origin |
---|
516 | !> @param[in] td_dateo new date origin for pseudo julian day |
---|
517 | !> |
---|
518 | !> @return date structure of julian day |
---|
519 | !------------------------------------------------------------------- |
---|
520 | |
---|
521 | IMPLICIT NONE |
---|
522 | |
---|
523 | !Argument |
---|
524 | INTEGER(i8), INTENT(IN) :: kd_nsec |
---|
525 | TYPE(TDATE), INTENT(IN), OPTIONAL :: td_dateo |
---|
526 | |
---|
527 | ! function |
---|
528 | TYPE(TDATE) :: tf_date |
---|
529 | !---------------------------------------------------------------- |
---|
530 | IF( PRESENT(td_dateo) )THEN |
---|
531 | tf_date=date_init( date__sec2jd(kd_nsec), td_dateo ) |
---|
532 | ELSE |
---|
533 | tf_date=date_init( date__sec2jd(kd_nsec) ) |
---|
534 | ENDIF |
---|
535 | |
---|
536 | END FUNCTION date__init_nsec |
---|
537 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
538 | FUNCTION date__init_ymd(id_year, id_month, id_day, & |
---|
539 | & id_hour, id_min, id_sec, & |
---|
540 | & td_dateo) & |
---|
541 | & RESULT (tf_date) |
---|
542 | !------------------------------------------------------------------- |
---|
543 | !> @brief This function initialized date structure form year month day |
---|
544 | !> and optionnaly hour min sec.<br/> |
---|
545 | !> @details |
---|
546 | !> Optionaly create pseudo julian day with new origin. |
---|
547 | !> |
---|
548 | !> @author J.Paul |
---|
549 | !> @date November, 2013 - Initial Version |
---|
550 | !> |
---|
551 | !> @param[in] id_year |
---|
552 | !> @param[in] id_month |
---|
553 | !> @param[in] id_day |
---|
554 | !> @param[in] id_hour |
---|
555 | !> @param[in] id_min |
---|
556 | !> @param[in] id_sec |
---|
557 | !> @param[in] td_dateo new date origin for pseudo julian day |
---|
558 | !> |
---|
559 | !> @return date structure of year month day |
---|
560 | !------------------------------------------------------------------- |
---|
561 | |
---|
562 | IMPLICIT NONE |
---|
563 | |
---|
564 | !Argument |
---|
565 | INTEGER(i4), INTENT(IN) :: id_year |
---|
566 | INTEGER(i4), INTENT(IN) :: id_month |
---|
567 | INTEGER(i4), INTENT(IN) :: id_day |
---|
568 | INTEGER(i4), INTENT(IN), OPTIONAL :: id_hour |
---|
569 | INTEGER(i4), INTENT(IN), OPTIONAL :: id_min |
---|
570 | INTEGER(i4), INTENT(IN), OPTIONAL :: id_sec |
---|
571 | TYPE(TDATE), INTENT(IN), OPTIONAL :: td_dateo |
---|
572 | |
---|
573 | ! function |
---|
574 | TYPE(TDATE) :: tf_date |
---|
575 | !---------------------------------------------------------------- |
---|
576 | tf_date%i_year=id_year |
---|
577 | tf_date%i_month=id_month |
---|
578 | tf_date%i_day=id_day |
---|
579 | IF( PRESENT(id_hour) )THEN |
---|
580 | tf_date%i_hour=id_hour |
---|
581 | ENDIF |
---|
582 | IF( PRESENT(id_min) )THEN |
---|
583 | tf_date%i_min=id_min |
---|
584 | ENDIF |
---|
585 | IF( PRESENT(id_sec) )THEN |
---|
586 | tf_date%i_sec=id_sec |
---|
587 | ENDIF |
---|
588 | ! check input data |
---|
589 | CALL date__check(tf_date) |
---|
590 | |
---|
591 | ! compute julian day |
---|
592 | CALL date__ymd2jd(tf_date) |
---|
593 | |
---|
594 | IF( PRESENT(td_dateo) )THEN |
---|
595 | CALL date__check(td_dateo) |
---|
596 | ! compute julian day with origin dateo |
---|
597 | CALL date__jd2jc(tf_date, td_dateo) |
---|
598 | ELSE |
---|
599 | ! compute CNES julian day |
---|
600 | CALL date__jd2jc(tf_date) |
---|
601 | ENDIF |
---|
602 | |
---|
603 | ! compute day of the week |
---|
604 | CALL date__jd2dow(tf_date) |
---|
605 | |
---|
606 | !compute last day of the month |
---|
607 | tf_date%i_lday=date__lastday(tf_date) |
---|
608 | |
---|
609 | END FUNCTION date__init_ymd |
---|
610 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
611 | FUNCTION date__diffdate(td_date1, td_date2) & |
---|
612 | & RESULT (df_diff) |
---|
613 | !------------------------------------------------------------------- |
---|
614 | !> @brief This function compute number of day between two dates: |
---|
615 | !> nday= date1 - date2 |
---|
616 | !> |
---|
617 | !> @author J.Paul |
---|
618 | !> @date November, 2013 - Initial Version |
---|
619 | !> |
---|
620 | !> @param[in] td_date1 first date strutcutre |
---|
621 | !> @param[in] td_date2 second date strutcutre |
---|
622 | !> @return nday |
---|
623 | !------------------------------------------------------------------- |
---|
624 | |
---|
625 | IMPLICIT NONE |
---|
626 | |
---|
627 | !Argument |
---|
628 | TYPE(TDATE), INTENT(IN) :: td_date1 |
---|
629 | TYPE(TDATE), INTENT(IN) :: td_date2 |
---|
630 | |
---|
631 | ! function |
---|
632 | REAL(dp) :: df_diff |
---|
633 | !---------------------------------------------------------------- |
---|
634 | |
---|
635 | ! check year month day hour min sec |
---|
636 | CALL date__check(td_date1) |
---|
637 | CALL date__check(td_date2) |
---|
638 | |
---|
639 | df_diff = td_date1%d_jd - td_date2%d_jd |
---|
640 | |
---|
641 | END FUNCTION date__diffdate |
---|
642 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
643 | FUNCTION date__subnday(td_date, dd_nday) & |
---|
644 | & RESULT (tf_date) |
---|
645 | !------------------------------------------------------------------- |
---|
646 | !> @brief This function substract nday to a date: |
---|
647 | !> date2 = date1 - nday |
---|
648 | !> |
---|
649 | !> @author J.Paul |
---|
650 | !> @date November, 2013 - Initial Version |
---|
651 | !> |
---|
652 | !> @param[in] td_date date strutcutre |
---|
653 | !> @param[in] dd_nday number of day |
---|
654 | !> @return date strutcutre of date - nday |
---|
655 | !------------------------------------------------------------------- |
---|
656 | |
---|
657 | IMPLICIT NONE |
---|
658 | |
---|
659 | ! Argument |
---|
660 | TYPE(TDATE), INTENT(IN) :: td_date |
---|
661 | REAL(dp), INTENT(IN) :: dd_nday |
---|
662 | |
---|
663 | ! function |
---|
664 | TYPE(TDATE) :: tf_date |
---|
665 | !---------------------------------------------------------------- |
---|
666 | |
---|
667 | ! check year month day hour min sec |
---|
668 | CALL date__check(td_date) |
---|
669 | |
---|
670 | tf_date=date__init_jd(td_date%d_jd-dd_nday) |
---|
671 | |
---|
672 | END FUNCTION date__subnday |
---|
673 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
674 | FUNCTION date__addnday(td_date, dd_nday) & |
---|
675 | & RESULT (tf_date) |
---|
676 | !------------------------------------------------------------------- |
---|
677 | !> @brief This function add nday to a date: |
---|
678 | !> date2 = date1 + nday |
---|
679 | !> |
---|
680 | !> @author J.Paul |
---|
681 | !> @date November, 2013 - Initial Version |
---|
682 | !> |
---|
683 | !> @param[in] td_date date strutcutre |
---|
684 | !> @param[in] dd_nday number of day |
---|
685 | !> @return date strutcutre of date + nday |
---|
686 | !------------------------------------------------------------------- |
---|
687 | |
---|
688 | IMPLICIT NONE |
---|
689 | |
---|
690 | ! Argument |
---|
691 | TYPE(TDATE), INTENT(IN) :: td_date |
---|
692 | REAL(dp), INTENT(IN) :: dd_nday |
---|
693 | |
---|
694 | ! function |
---|
695 | TYPE(TDATE) :: tf_date |
---|
696 | !---------------------------------------------------------------- |
---|
697 | |
---|
698 | ! check year month day hour min sec |
---|
699 | CALL date__check(td_date) |
---|
700 | |
---|
701 | tf_date=date__init_jd(td_date%d_jd+dd_nday) |
---|
702 | |
---|
703 | END FUNCTION date__addnday |
---|
704 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
705 | FUNCTION date__lastday(td_date) & |
---|
706 | & RESULT (if_lday) |
---|
707 | !------------------------------------------------------------------- |
---|
708 | !> @brief This subroutine compute last day of the month |
---|
709 | !> |
---|
710 | !> @author J.Paul |
---|
711 | !> @date November, 2013 - Initial Version |
---|
712 | !> |
---|
713 | !> @param[in] td_date date strutcutre |
---|
714 | !> @return last day of the month |
---|
715 | !------------------------------------------------------------------- |
---|
716 | |
---|
717 | IMPLICIT NONE |
---|
718 | |
---|
719 | ! Argument |
---|
720 | TYPE(TDATE), INTENT(IN) :: td_date |
---|
721 | |
---|
722 | ! function |
---|
723 | INTEGER(i4) :: if_lday |
---|
724 | |
---|
725 | ! local variable |
---|
726 | INTEGER, DIMENSION(12), PARAMETER :: il_lastdaytab = & |
---|
727 | & (/31,28,31,30,31,30,31,31,30,31,30,31/) |
---|
728 | !---------------------------------------------------------------- |
---|
729 | |
---|
730 | ! general case |
---|
731 | IF( td_date%i_month /= 2 )THEN |
---|
732 | if_lday=il_lastdaytab(td_date%i_month) |
---|
733 | ELSE |
---|
734 | IF( date_leapyear(td_date) )THEN |
---|
735 | if_lday=29 |
---|
736 | ELSE |
---|
737 | if_lday=il_lastdaytab(td_date%i_month) |
---|
738 | ENDIF |
---|
739 | ENDIF |
---|
740 | |
---|
741 | END FUNCTION date__lastday |
---|
742 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
743 | SUBROUTINE date__ymd2jd(td_date) |
---|
744 | !------------------------------------------------------------------- |
---|
745 | !> @brief This subroutine compute julian day from year month day , and fill |
---|
746 | !> input date strutcutre. |
---|
747 | !> |
---|
748 | !> @author J.Paul |
---|
749 | !> @date November, 2013 - Initial Version |
---|
750 | !> |
---|
751 | !> @param[inout] td_date date strutcutre |
---|
752 | !------------------------------------------------------------------- |
---|
753 | |
---|
754 | IMPLICIT NONE |
---|
755 | |
---|
756 | ! Argument |
---|
757 | TYPE(TDATE), INTENT(INOUT) :: td_date |
---|
758 | |
---|
759 | ! local variable |
---|
760 | REAL(dp) :: dl_standard_jd |
---|
761 | REAL(dp) :: dl_frac |
---|
762 | !---------------------------------------------------------------- |
---|
763 | |
---|
764 | dl_standard_jd= td_date%i_day - 32075 & |
---|
765 | & + 1461 * (td_date%i_year + 4800 - (14 - td_date%i_month)/12)/4 & |
---|
766 | & + 367 * (td_date%i_month - 2 + (14 - td_date%i_month)/12*12)/12 & |
---|
767 | & - 3 * ((td_date%i_year + 4900 - (14 - td_date%i_month)/12)/100)/4 |
---|
768 | |
---|
769 | td_date%d_jd = dl_standard_jd-2400001 ! origin : 17 nov 1858 h00m00s00 |
---|
770 | |
---|
771 | ! compute fraction of day |
---|
772 | dl_frac=date__hms2jd(td_date) |
---|
773 | |
---|
774 | td_date%d_jd = td_date%d_jd + dl_frac |
---|
775 | |
---|
776 | td_date%k_jdsec = date__jd2sec( td_date%d_jd ) |
---|
777 | |
---|
778 | END SUBROUTINE date__ymd2jd |
---|
779 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
780 | SUBROUTINE date__jd2ymd(td_date) |
---|
781 | !------------------------------------------------------------------- |
---|
782 | !> @brief This subroutine compute year month day from julian day, and fill |
---|
783 | !> input date strutcutre. |
---|
784 | !> |
---|
785 | !> @author J.Paul |
---|
786 | !> @date November, 2013 - Initial Version |
---|
787 | !> |
---|
788 | !> @param[inout] td_date date strutcutre |
---|
789 | !------------------------------------------------------------------- |
---|
790 | |
---|
791 | IMPLICIT NONE |
---|
792 | |
---|
793 | ! Argument |
---|
794 | TYPE(TDATE), INTENT(INOUT) :: td_date |
---|
795 | |
---|
796 | ! local variable |
---|
797 | INTEGER(i4) :: il_standard_jd |
---|
798 | INTEGER(i4) :: il_temp1 |
---|
799 | INTEGER(i4) :: il_temp2 |
---|
800 | !---------------------------------------------------------------- |
---|
801 | |
---|
802 | ! check year month day hour min sec |
---|
803 | CALL date__check(td_date) |
---|
804 | |
---|
805 | il_standard_jd=INT( td_date%d_jd+2400001, i4 ) |
---|
806 | |
---|
807 | il_temp1=il_standard_jd + 68569 |
---|
808 | il_temp2=4*il_temp1/146097 |
---|
809 | il_temp1=il_temp1 - (146097 * il_temp2 + 3) / 4 |
---|
810 | td_date%i_year = 4000 * (il_temp1 + 1) / 1461001 |
---|
811 | il_temp1 = il_temp1 - 1461 * td_date%i_year/4 + 31 |
---|
812 | td_date%i_month = 80 * il_temp1 / 2447 |
---|
813 | td_date%i_day = il_temp1 - 2447 * td_date%i_month / 80 |
---|
814 | il_temp1 = td_date%i_month / 11 |
---|
815 | td_date%i_month = td_date%i_month + 2 - 12 * il_temp1 |
---|
816 | td_date%i_year = 100 * (il_temp2 - 49) + td_date%i_year + il_temp1 |
---|
817 | |
---|
818 | ! compute hour, minute, second from julian fraction |
---|
819 | CALL date__jd2hms(td_date) |
---|
820 | |
---|
821 | ! adjust date |
---|
822 | CALL date__adjust(td_date) |
---|
823 | |
---|
824 | END SUBROUTINE date__jd2ymd |
---|
825 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
826 | SUBROUTINE date__jc2jd(td_date, td_dateo) |
---|
827 | !------------------------------------------------------------------- |
---|
828 | !> @brief This subroutine compute julian day from pseudo julian day |
---|
829 | !> with new date origin, and fill input date strutcutre. |
---|
830 | !> |
---|
831 | !> @author J.Paul |
---|
832 | !> @date November, 2013 - Initial Version |
---|
833 | !> |
---|
834 | !> @param[inout] td_date date |
---|
835 | !> @param[in] td_dateo new date origin for pseudo julian day |
---|
836 | !------------------------------------------------------------------- |
---|
837 | |
---|
838 | IMPLICIT NONE |
---|
839 | |
---|
840 | ! Argument |
---|
841 | TYPE(TDATE), INTENT(INOUT) :: td_date |
---|
842 | TYPE(TDATE), INTENT(IN) :: td_dateo |
---|
843 | |
---|
844 | ! local variable |
---|
845 | TYPE(TDATE) :: tl_date |
---|
846 | REAL(dp) :: dl_nday |
---|
847 | !---------------------------------------------------------------- |
---|
848 | ! origin julian day |
---|
849 | tl_date=date_init(1858,11,17) |
---|
850 | |
---|
851 | dl_nday=td_dateo-tl_date |
---|
852 | |
---|
853 | ! compute julian day |
---|
854 | td_date%d_jd = td_date%d_jc + dl_nday |
---|
855 | ! compute number of second since julian day origin |
---|
856 | td_date%k_jdsec = date__jd2sec(td_date%d_jd) |
---|
857 | |
---|
858 | END SUBROUTINE date__jc2jd |
---|
859 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
860 | SUBROUTINE date__jd2jc(td_date, td_dateo) |
---|
861 | !------------------------------------------------------------------- |
---|
862 | !> @brief This subroutine compute pseudo julian day with new date origin, and |
---|
863 | !> fill input date structure.<br/> |
---|
864 | !> default new origin is CNES julian day origin: 1950-01-01 00:00:00 |
---|
865 | !> |
---|
866 | !> @author J.Paul |
---|
867 | !> @date November, 2013 - Initial Version |
---|
868 | !> |
---|
869 | !> @param[inout] td_date date |
---|
870 | !> @param[in] td_dateo new origin date |
---|
871 | !------------------------------------------------------------------- |
---|
872 | |
---|
873 | IMPLICIT NONE |
---|
874 | |
---|
875 | ! Argument |
---|
876 | TYPE(TDATE), INTENT(INOUT) :: td_date |
---|
877 | TYPE(TDATE), INTENT(IN), OPTIONAL :: td_dateo |
---|
878 | |
---|
879 | ! local variable |
---|
880 | TYPE(TDATE) :: tl_dateo |
---|
881 | !---------------------------------------------------------------- |
---|
882 | IF( PRESENT(td_dateo) )THEN |
---|
883 | td_date%d_jc=td_date%d_jd-td_dateo%d_jd |
---|
884 | ELSE |
---|
885 | ! CNES julian day origin |
---|
886 | tl_dateo%i_year = 1950 |
---|
887 | tl_dateo%i_month = 1 |
---|
888 | tl_dateo%i_day = 1 |
---|
889 | |
---|
890 | CALL date__ymd2jd(tl_dateo) |
---|
891 | |
---|
892 | td_date%d_jc = td_date%d_jd-tl_dateo%d_jd |
---|
893 | ENDIF |
---|
894 | |
---|
895 | td_date%k_jcsec = date__jd2sec(td_date%d_jc) |
---|
896 | |
---|
897 | END SUBROUTINE date__jd2jc |
---|
898 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
899 | SUBROUTINE date__jd2dow(td_date) |
---|
900 | !------------------------------------------------------------------- |
---|
901 | !> @brief This subroutine compute the day of week from julian day, and fill |
---|
902 | !> input date structure.<br/> |
---|
903 | !> days : Sunday Monday Tuesday Wednesday Thursday Friday Saturday<br/> |
---|
904 | !> numday : 0 1 2 3 4 5 6<br/> |
---|
905 | !> |
---|
906 | !> @author J.Paul |
---|
907 | !> @date November, 2013 - Initial Version |
---|
908 | !> |
---|
909 | !> @param[inout] td_date date strutcutre |
---|
910 | !------------------------------------------------------------------- |
---|
911 | |
---|
912 | IMPLICIT NONE |
---|
913 | |
---|
914 | ! Argument |
---|
915 | TYPE(TDATE), INTENT(INOUT) :: td_date |
---|
916 | !---------------------------------------------------------------- |
---|
917 | |
---|
918 | td_date%i_dow=MOD((INT(AINT(td_date%d_jd))+3),7) |
---|
919 | |
---|
920 | END SUBROUTINE date__jd2dow |
---|
921 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
922 | FUNCTION date__hms2jd(td_date) & |
---|
923 | & RESULT (df_frac) |
---|
924 | !------------------------------------------------------------------- |
---|
925 | !> @brief This function compute fraction of a day from |
---|
926 | !> hour, minute, second. |
---|
927 | !> |
---|
928 | !> @author J.Paul |
---|
929 | !> @date November, 2013 - Initial Version |
---|
930 | !> |
---|
931 | !> @param[in] td_date date strutcutre |
---|
932 | !> @return fraction of the day |
---|
933 | !------------------------------------------------------------------- |
---|
934 | |
---|
935 | IMPLICIT NONE |
---|
936 | |
---|
937 | ! Argument |
---|
938 | TYPE(TDATE), INTENT(IN) :: td_date |
---|
939 | |
---|
940 | ! function |
---|
941 | REAL(dp) :: df_frac |
---|
942 | !---------------------------------------------------------------- |
---|
943 | |
---|
944 | ! compute real seconds |
---|
945 | df_frac = REAL( td_date%i_sec, dp ) |
---|
946 | ! compute real minutes |
---|
947 | df_frac = REAL( td_date%i_min, dp ) + df_frac/60.0 |
---|
948 | ! compute real hours |
---|
949 | df_frac = REAL( td_date%i_hour, dp ) + df_frac/60.0 |
---|
950 | ! julian fraction of a day |
---|
951 | df_frac = df_frac/24.0 |
---|
952 | |
---|
953 | END FUNCTION date__hms2jd |
---|
954 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
955 | SUBROUTINE date__jd2hms(td_date) |
---|
956 | !------------------------------------------------------------------- |
---|
957 | !> @brief This subroutine compute hour, minute, second from julian |
---|
958 | !> fraction, and fill date structure. |
---|
959 | !> |
---|
960 | !> @author J.Paul |
---|
961 | !> @date November, 2013 - Initial Version |
---|
962 | !> |
---|
963 | !> @param[inout] td_date date strutcutre |
---|
964 | !------------------------------------------------------------------- |
---|
965 | |
---|
966 | IMPLICIT NONE |
---|
967 | |
---|
968 | ! Argument |
---|
969 | TYPE(TDATE), INTENT(INOUT) :: td_date |
---|
970 | |
---|
971 | !local variable |
---|
972 | REAL(dp) :: dl_fract |
---|
973 | !---------------------------------------------------------------- |
---|
974 | |
---|
975 | dl_fract=(td_date%d_jd)-AINT(td_date%d_jd) |
---|
976 | ! compute hour |
---|
977 | td_date%i_hour = INT( dl_fract * 24.0, i4 ) |
---|
978 | dl_fract = ( dl_fract - REAL( td_date%i_hour, dp ) / 24.0) * 24.0 |
---|
979 | ! compute minute |
---|
980 | td_date%i_min = INT( dl_fract * 60.0, i4 ) |
---|
981 | dl_fract = ( dl_fract - REAL( td_date%i_min, dp ) / 60.0) * 60.0 |
---|
982 | ! compute second |
---|
983 | td_date%i_sec = NINT( dl_fract * 60.0, i4 ) |
---|
984 | |
---|
985 | END SUBROUTINE date__jd2hms |
---|
986 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
987 | SUBROUTINE date__check(td_date) |
---|
988 | !------------------------------------------------------------------- |
---|
989 | !> @brief This subroutine check date express in date structure |
---|
990 | !> |
---|
991 | !> @author J.Paul |
---|
992 | !> @date November, 2013 - Initial Version |
---|
993 | !> |
---|
994 | !> @param[in] td_date date strutcutre |
---|
995 | !------------------------------------------------------------------- |
---|
996 | |
---|
997 | IMPLICIT NONE |
---|
998 | |
---|
999 | ! Argument |
---|
1000 | TYPE(TDATE), INTENT(IN) :: td_date |
---|
1001 | |
---|
1002 | ! local variable |
---|
1003 | INTEGER(i4) :: il_lastday |
---|
1004 | INTEGER(i4) :: il_status |
---|
1005 | CHARACTER(LEN=lc) :: cl_msg |
---|
1006 | !---------------------------------------------------------------- |
---|
1007 | |
---|
1008 | ! init |
---|
1009 | il_status=0 |
---|
1010 | |
---|
1011 | ! check year |
---|
1012 | IF( td_date%i_year < 1858_i4 .OR. td_date%i_year > 39999_i4 )THEN |
---|
1013 | il_status=il_status+1 |
---|
1014 | WRITE(cl_msg,*) "year ",td_date%i_year," out of range" |
---|
1015 | CALL logger_error(cl_msg) |
---|
1016 | ENDIF |
---|
1017 | ! check month |
---|
1018 | IF( td_date%i_month < 1_i4 .OR. td_date%i_month > 12_i4 )THEN |
---|
1019 | il_status=il_status+1 |
---|
1020 | WRITE(cl_msg,*) "month ",td_date%i_month," out of range" |
---|
1021 | CALL logger_error(cl_msg) |
---|
1022 | ENDIF |
---|
1023 | ! check day |
---|
1024 | il_lastday=date__lastday(td_date) |
---|
1025 | IF( td_date%i_day < 1_i4 .OR. td_date%i_day > il_lastday )THEN |
---|
1026 | il_status=il_status+1 |
---|
1027 | WRITE(cl_msg,*) "day ",td_date%i_day," out of range" |
---|
1028 | CALL logger_error(cl_msg) |
---|
1029 | ENDIF |
---|
1030 | ! check hour |
---|
1031 | IF( td_date%i_hour < 0_i4 .OR. td_date%i_hour > 23_i4 )THEN |
---|
1032 | il_status=il_status+1 |
---|
1033 | WRITE(cl_msg,*) "hour ",td_date%i_hour," out of range" |
---|
1034 | CALL logger_error(cl_msg) |
---|
1035 | ENDIF |
---|
1036 | ! check minutes |
---|
1037 | IF( td_date%i_min < 0_i4 .OR. td_date%i_min > 59_i4 )THEN |
---|
1038 | il_status=il_status+1 |
---|
1039 | WRITE(cl_msg,*) "minutes ",td_date%i_min," out of range" |
---|
1040 | CALL logger_error(cl_msg) |
---|
1041 | ENDIF |
---|
1042 | ! check seconds |
---|
1043 | IF( td_date%i_sec < 0_i4 .OR. td_date%i_sec > 59_i4 )THEN |
---|
1044 | il_status=il_status+1 |
---|
1045 | WRITE(cl_msg,*) "seconds ",td_date%i_sec," out of range" |
---|
1046 | CALL logger_error(cl_msg) |
---|
1047 | ENDIF |
---|
1048 | |
---|
1049 | ! check julian day |
---|
1050 | IF( td_date%d_jd < 0_sp .OR. td_date%d_jd > 782028_sp )THEN |
---|
1051 | il_status=il_status+1 |
---|
1052 | WRITE(cl_msg,*) "julian day ",td_date%d_jd," out of range" |
---|
1053 | CALL logger_error(cl_msg) |
---|
1054 | ENDIF |
---|
1055 | |
---|
1056 | IF( il_status/= 0 )THEN |
---|
1057 | WRITE(cl_msg,*) " date error" |
---|
1058 | CALL logger_fatal(cl_msg) |
---|
1059 | ENDIF |
---|
1060 | |
---|
1061 | END SUBROUTINE date__check |
---|
1062 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
1063 | SUBROUTINE date__adjust(td_date) |
---|
1064 | !------------------------------------------------------------------- |
---|
1065 | !> @brief This subroutine adjust date (correct hour, minutes, and seconds |
---|
1066 | !> value if need be) |
---|
1067 | !> |
---|
1068 | !> @author J.Paul |
---|
1069 | !> @date November, 2013 - Initial Version |
---|
1070 | !> |
---|
1071 | !> @param[inout] td_date date strutcutre |
---|
1072 | !------------------------------------------------------------------- |
---|
1073 | |
---|
1074 | IMPLICIT NONE |
---|
1075 | |
---|
1076 | ! Argument |
---|
1077 | TYPE(TDATE), INTENT(INOUT) :: td_date |
---|
1078 | !---------------------------------------------------------------- |
---|
1079 | |
---|
1080 | IF( td_date%i_sec == 60 )THEN |
---|
1081 | td_date%i_sec=0 |
---|
1082 | td_date%i_min=td_date%i_min+1 |
---|
1083 | ENDIF |
---|
1084 | |
---|
1085 | IF( td_date%i_min == 60 )THEN |
---|
1086 | td_date%i_min=0 |
---|
1087 | td_date%i_hour=td_date%i_hour+1 |
---|
1088 | ENDIF |
---|
1089 | |
---|
1090 | IF( td_date%i_hour == 24 )THEN |
---|
1091 | td_date%i_hour=0 |
---|
1092 | td_date=date__addnday(td_date,1._dp) |
---|
1093 | ENDIF |
---|
1094 | |
---|
1095 | END SUBROUTINE date__adjust |
---|
1096 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
1097 | FUNCTION date__jd2sec(dd_jul) & |
---|
1098 | & RESULT (if_sec) |
---|
1099 | !------------------------------------------------------------------- |
---|
1100 | !> @brief This function convert julian day in seconds |
---|
1101 | !> since julian day origin. |
---|
1102 | !> @author J.Paul |
---|
1103 | !> @date November, 2013 - Initial Version |
---|
1104 | !> |
---|
1105 | !> @param[in] td_date date strutcutre |
---|
1106 | !> @return number of seconds since julian day origin |
---|
1107 | !------------------------------------------------------------------- |
---|
1108 | |
---|
1109 | IMPLICIT NONE |
---|
1110 | |
---|
1111 | ! Argument |
---|
1112 | REAL(dp), INTENT(IN) :: dd_jul |
---|
1113 | |
---|
1114 | ! function |
---|
1115 | INTEGER(i8) :: if_sec |
---|
1116 | !---------------------------------------------------------------- |
---|
1117 | |
---|
1118 | if_sec = NINT( dd_jul * im_secbyday, i8 ) |
---|
1119 | |
---|
1120 | END FUNCTION date__jd2sec |
---|
1121 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
1122 | FUNCTION date__sec2jd(kd_nsec) & |
---|
1123 | & RESULT (df_sec) |
---|
1124 | !------------------------------------------------------------------- |
---|
1125 | !> @brief This function convert seconds since julian day origin in |
---|
1126 | !> julian day. |
---|
1127 | !> @author J.Paul |
---|
1128 | !> @date November, 2013 - Initial Version |
---|
1129 | !> |
---|
1130 | !> @param[in] kd_nsec number of second since julian day origin |
---|
1131 | !> @return julian day |
---|
1132 | !------------------------------------------------------------------- |
---|
1133 | |
---|
1134 | IMPLICIT NONE |
---|
1135 | |
---|
1136 | ! Argument |
---|
1137 | INTEGER(i8), INTENT(IN) :: kd_nsec |
---|
1138 | |
---|
1139 | ! function |
---|
1140 | REAL(dp) :: df_sec |
---|
1141 | !---------------------------------------------------------------- |
---|
1142 | |
---|
1143 | df_sec = REAL( REAL( kd_nsec , dp ) / im_secbyday, dp ) |
---|
1144 | |
---|
1145 | END FUNCTION date__sec2jd |
---|
1146 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
1147 | END MODULE date |
---|
1148 | |
---|