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