[4213] | 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 |
---|
[5037] | 9 | !> do many manipulations with dates. |
---|
| 10 | !> |
---|
[4213] | 11 | !> @details |
---|
[5037] | 12 | !> Actually we use Modified Julian Dates, with |
---|
| 13 | !> 17 Nov 1858 at 00:00:00 as origin.<br/> |
---|
| 14 | !> |
---|
[4213] | 15 | !> define type TDATE:<br/> |
---|
[5037] | 16 | !> @code |
---|
| 17 | !> TYPE(TDATE) :: tl_date1 |
---|
| 18 | !> @endcode |
---|
[4213] | 19 | !> default date is 17 Nov 1858 at 00:00:00<br/> |
---|
| 20 | !> |
---|
| 21 | !> to intialise date : <br/> |
---|
[5037] | 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 |
---|
[4213] | 49 | !> |
---|
| 50 | !> to print date in format YYYY-MM-DD hh:mm:ss<br/> |
---|
| 51 | !> CHARACTER(LEN=lc) :: cl_date<br/> |
---|
[5037] | 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)" ) |
---|
[4213] | 63 | !> |
---|
[5037] | 64 | !> to print day of the week:<br/> |
---|
| 65 | !> @code |
---|
| 66 | !> PRINT *,"dow ", tl_date1\%i_dow |
---|
| 67 | !> @endcode |
---|
[4213] | 68 | !> to print last day of the month:<br/> |
---|
[5037] | 69 | !> @code |
---|
| 70 | !> PRINT *,"last day ", tl_date1\%i_lday |
---|
| 71 | !> @endcode |
---|
| 72 | !> |
---|
[4213] | 73 | !> to know if year is a leap year:<br/> |
---|
[5037] | 74 | !> @code |
---|
| 75 | !> ll_isleap=date_leapyear(tl_date1) |
---|
| 76 | !> @endcode |
---|
| 77 | !> - ll_isleap is logical |
---|
[4213] | 78 | !> |
---|
[5037] | 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) |
---|
[4213] | 85 | !> |
---|
| 86 | !> to add or substract nday to a date:<br/> |
---|
[5037] | 87 | !> @code |
---|
| 88 | !> tl_date2=tl_date1+2. |
---|
| 89 | !> tl_date2=tl_date1-2.6 |
---|
| 90 | !> @endcode |
---|
| 91 | !> - number of day (double precision) |
---|
[4213] | 92 | !> |
---|
| 93 | !> to print julian day:<br/> |
---|
[5037] | 94 | !> @code |
---|
| 95 | !> PRINT *," julian day",tl_date1\%r_jd |
---|
| 96 | !> @endcode |
---|
[4213] | 97 | !> |
---|
| 98 | !> to print CNES julian day (origin 1950-01-01 00:00:00)<br/> |
---|
[5037] | 99 | !> @code |
---|
| 100 | !> PRINT *," CNES julian day",tl_date1\%r_jc |
---|
| 101 | !> @endcode |
---|
[4213] | 102 | !> |
---|
| 103 | !> to create pseudo julian day with origin date_now:<br/> |
---|
[5037] | 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/> |
---|
[4213] | 108 | !> |
---|
| 109 | !> to print julian day in seconds:<br/> |
---|
[5037] | 110 | !> @code |
---|
| 111 | !> PRINT *, tl_date1\%k_jdsec |
---|
| 112 | !> @endcode |
---|
[4213] | 113 | !> to print CNES or new julian day in seconds:<br/> |
---|
[5037] | 114 | !> @code |
---|
| 115 | !> PRINT *, tl_date1\%k_jcsec |
---|
| 116 | !> @endcode |
---|
[4213] | 117 | !> |
---|
[5037] | 118 | !> @author J.Paul |
---|
[4213] | 119 | ! REVISION HISTORY: |
---|
[5037] | 120 | !> @date November, 2013 - Initial Version |
---|
[4213] | 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) |
---|
[5037] | 124 | !> |
---|
[4213] | 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 |
---|
[5037] | 132 | USE logger ! log file manager |
---|
[4213] | 133 | IMPLICIT NONE |
---|
| 134 | ! NOTE_avoid_public_variables_if_possible |
---|
| 135 | |
---|
| 136 | ! type and variable |
---|
[5037] | 137 | PUBLIC :: TDATE !< date structure |
---|
[4213] | 138 | |
---|
[5037] | 139 | PRIVATE :: cm_fmtdate !< date and time format |
---|
| 140 | PRIVATE :: im_secbyday !< number of second by day |
---|
| 141 | |
---|
[4213] | 142 | ! function and subroutine |
---|
[5037] | 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 |
---|
[4213] | 150 | |
---|
[5037] | 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 |
---|
[4213] | 155 | PRIVATE :: date__addnday ! add nday to a date |
---|
| 156 | PRIVATE :: date__subnday ! substract nday to a date |
---|
[5037] | 157 | PRIVATE :: date__diffdate ! compute number of days between two dates |
---|
[4213] | 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 | |
---|
[5037] | 171 | TYPE TDATE !< date structure |
---|
[4213] | 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 |
---|
[5037] | 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 |
---|
[4213] | 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 |
---|
[5037] | 187 | CHARACTER(LEN=lc), PARAMETER :: cm_fmtdate = & !< date and time format |
---|
[4213] | 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 |
---|
[5037] | 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 |
---|
[4213] | 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 | !------------------------------------------------------------------- |
---|
[5037] | 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. |
---|
[4213] | 215 | !> |
---|
| 216 | !> @author J.Paul |
---|
[5037] | 217 | !> @date November, 2013 - Initial Version |
---|
[4213] | 218 | ! |
---|
[5037] | 219 | !> @param[in] td_date date strutcutre |
---|
| 220 | !> @param[in] cd_fmt ouput format (only for year,month,day) |
---|
[4213] | 221 | !> @return date in format YYYY-MM-DD hh:mm:ss |
---|
| 222 | !------------------------------------------------------------------- |
---|
[5037] | 223 | CHARACTER(LEN=lc) FUNCTION date_print(td_date, cd_fmt) |
---|
[4213] | 224 | IMPLICIT NONE |
---|
| 225 | ! Argument |
---|
[5037] | 226 | TYPE(TDATE) , INTENT(IN) :: td_date |
---|
| 227 | CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_fmt |
---|
[4213] | 228 | !---------------------------------------------------------------- |
---|
| 229 | |
---|
[5037] | 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 |
---|
[4213] | 238 | |
---|
| 239 | END FUNCTION date_print |
---|
| 240 | !------------------------------------------------------------------- |
---|
| 241 | !> @brief This function check if year is a leap year. |
---|
| 242 | !> |
---|
| 243 | !> @author J.Paul |
---|
[5037] | 244 | !> @date November, 2013 - Initial Version |
---|
[4213] | 245 | ! |
---|
[5037] | 246 | !> @param[in] td_date date strutcutre |
---|
[4213] | 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 | !------------------------------------------------------------------- |
---|
[5037] | 268 | !> @brief This function return the current date and time. |
---|
[4213] | 269 | !> |
---|
| 270 | !> @author J.Paul |
---|
[5037] | 271 | !> @date November, 2013 - Initial Version |
---|
[4213] | 272 | ! |
---|
[5037] | 273 | !> @return current date and time in a date structure |
---|
[4213] | 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 | !------------------------------------------------------------------- |
---|
[5037] | 288 | !> @brief This function return the date of the day at 12:00:00. |
---|
[4213] | 289 | !> |
---|
| 290 | !> @author J.Paul |
---|
[5037] | 291 | !> @date November, 2013 - Initial Version |
---|
[4213] | 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 | !------------------------------------------------------------------- |
---|
[5037] | 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 |
---|
[4213] | 312 | !> |
---|
| 313 | !> @author J.Paul |
---|
[5037] | 314 | !> @date November, 2013 - Initial Version |
---|
[4213] | 315 | ! |
---|
[5037] | 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 |
---|
[4213] | 318 | !> @return date structure |
---|
| 319 | !------------------------------------------------------------------- |
---|
[5037] | 320 | TYPE(TDATE) FUNCTION date__init_fmtdate(cd_datetime, td_dateo) |
---|
[4213] | 321 | IMPLICIT NONE |
---|
| 322 | ! Argument |
---|
[5037] | 323 | CHARACTER(LEN=*), INTENT(IN) :: cd_datetime |
---|
[4213] | 324 | TYPE(TDATE), INTENT(IN), OPTIONAL :: td_dateo |
---|
| 325 | |
---|
| 326 | ! local variable |
---|
[5037] | 327 | CHARACTER(LEN=lc) :: cl_datetime |
---|
[4213] | 328 | CHARACTER(LEN=lc) :: cl_date |
---|
[5037] | 329 | CHARACTER(LEN=lc) :: cl_time |
---|
[4213] | 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 | |
---|
[5037] | 345 | cl_datetime=TRIM(ADJUSTL(cd_datetime)) |
---|
[4213] | 346 | |
---|
[5037] | 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,'-') |
---|
[4213] | 351 | READ(cl_year,*) il_year |
---|
[5037] | 352 | cl_month= fct_split(cl_date,2,'-') |
---|
[4213] | 353 | READ(cl_month, *) il_month |
---|
[5037] | 354 | cl_day = fct_split(cl_date,3,'-') |
---|
[4213] | 355 | READ(cl_day, *) il_day |
---|
[5037] | 356 | cl_hour = fct_split(cl_time,1,':') |
---|
[4213] | 357 | READ(cl_hour, *) il_hour |
---|
[5037] | 358 | cl_min = fct_split(cl_time,2,':') |
---|
[4213] | 359 | READ(cl_min, *) il_min |
---|
[5037] | 360 | cl_sec = fct_split(cl_time,3,':') |
---|
[4213] | 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 | !------------------------------------------------------------------- |
---|
[5037] | 368 | !> @brief This function initialized date structure from julian day.<br/> |
---|
| 369 | !> @details |
---|
| 370 | !> Optionaly create pseudo julian day with new origin.<br/> |
---|
[4213] | 371 | !> julian day origin is 17 Nov 1858 at 00:00:00 |
---|
| 372 | !> |
---|
| 373 | !> @author J.Paul |
---|
[5037] | 374 | !> @date November, 2013 - Initial Version |
---|
[4213] | 375 | ! |
---|
[5037] | 376 | !> @param[in] dd_jd julian day |
---|
| 377 | !> @param[in] td_dateo new date origin for pseudo julian day |
---|
[4213] | 378 | ! |
---|
| 379 | !> @return date structure of julian day |
---|
| 380 | !------------------------------------------------------------------- |
---|
[5037] | 381 | TYPE(TDATE) FUNCTION date__init_jd(dd_jd, td_dateo) |
---|
[4213] | 382 | IMPLICIT NONE |
---|
| 383 | !Argument |
---|
[5037] | 384 | REAL(dp), INTENT(IN) :: dd_jd |
---|
[4213] | 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 |
---|
[5037] | 391 | date__init_jd%d_jc=dd_jd |
---|
| 392 | date__init_jd%k_jcsec=date__jd2sec(dd_jd) |
---|
[4213] | 393 | |
---|
| 394 | ! convert to truly julian day |
---|
| 395 | CALL date__jc2jd(date__init_jd, td_dateo) |
---|
| 396 | ELSE |
---|
[5037] | 397 | date__init_jd%d_jd=dd_jd |
---|
| 398 | date__init_jd%k_jdsec=date__jd2sec(dd_jd) |
---|
[4213] | 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 | !------------------------------------------------------------------- |
---|
[5037] | 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. |
---|
[4213] | 422 | !> |
---|
| 423 | !> @author J.Paul |
---|
[5037] | 424 | !> @date November, 2013 - Initial Version |
---|
[4213] | 425 | ! |
---|
[5037] | 426 | !> @param[in] kd_nsec number of second since julian day origin |
---|
| 427 | !> @param[in] td_dateo new date origin for pseudo julian day |
---|
[4213] | 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 | !------------------------------------------------------------------- |
---|
[5037] | 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 | !> |
---|
[4213] | 450 | !> @author J.Paul |
---|
[5037] | 451 | !> @date November, 2013 - Initial Version |
---|
| 452 | !> |
---|
[4213] | 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 |
---|
[5037] | 459 | !> @param[in] td_dateo new date origin for pseudo julian day |
---|
[4213] | 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 | !------------------------------------------------------------------- |
---|
[5037] | 511 | !> @brief This function compute number of day between two dates: |
---|
[4213] | 512 | !> nday= date1 - date2 |
---|
| 513 | ! |
---|
| 514 | !> @author J.Paul |
---|
[5037] | 515 | !> @date November, 2013 - Initial Version |
---|
[4213] | 516 | ! |
---|
[5037] | 517 | !> @param[in] td_date1 first date strutcutre |
---|
| 518 | !> @param[in] td_date2 second date strutcutre |
---|
[4213] | 519 | !> @return nday |
---|
| 520 | !------------------------------------------------------------------- |
---|
[5037] | 521 | REAL(dp) FUNCTION date__diffdate(td_date1, td_date2) |
---|
[4213] | 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 | |
---|
[5037] | 533 | date__diffdate = td_date1%d_jd - td_date2%d_jd |
---|
[4213] | 534 | |
---|
| 535 | END FUNCTION date__diffdate |
---|
| 536 | !------------------------------------------------------------------- |
---|
[5037] | 537 | !> @brief This function substract nday to a date: |
---|
[4213] | 538 | !> date2 = date1 - nday |
---|
| 539 | !> |
---|
| 540 | !> @author J.Paul |
---|
[5037] | 541 | !> @date November, 2013 - Initial Version |
---|
[4213] | 542 | ! |
---|
[5037] | 543 | !> @param[in] td_date date strutcutre |
---|
| 544 | !> @param[in] dd_nday number of day |
---|
[4213] | 545 | !> @return date strutcutre of date - nday |
---|
| 546 | !------------------------------------------------------------------- |
---|
[5037] | 547 | TYPE(TDATE) FUNCTION date__subnday(td_date, dd_nday) |
---|
[4213] | 548 | IMPLICIT NONE |
---|
| 549 | !Argument |
---|
| 550 | TYPE(TDATE), INTENT(IN) :: td_date |
---|
[5037] | 551 | REAL(dp), INTENT(IN) :: dd_nday |
---|
[4213] | 552 | !---------------------------------------------------------------- |
---|
| 553 | |
---|
| 554 | ! check year month day hour min sec |
---|
| 555 | CALL date__check(td_date) |
---|
| 556 | |
---|
[5037] | 557 | date__subnday=date__init_jd(td_date%d_jd-dd_nday) |
---|
[4213] | 558 | |
---|
| 559 | END FUNCTION date__subnday |
---|
| 560 | !------------------------------------------------------------------- |
---|
[5037] | 561 | !> @brief This function add nday to a date: |
---|
[4213] | 562 | !> date2 = date1 + nday |
---|
| 563 | !> |
---|
| 564 | !> @author J.Paul |
---|
[5037] | 565 | !> @date November, 2013 - Initial Version |
---|
[4213] | 566 | ! |
---|
[5037] | 567 | !> @param[in] td_date date strutcutre |
---|
| 568 | !> @param[in] dd_nday number of day |
---|
[4213] | 569 | !> @return date strutcutre of date + nday |
---|
| 570 | !------------------------------------------------------------------- |
---|
[5037] | 571 | TYPE(TDATE) FUNCTION date__addnday(td_date, dd_nday) |
---|
[4213] | 572 | IMPLICIT NONE |
---|
| 573 | !Argument |
---|
| 574 | TYPE(TDATE), INTENT(IN) :: td_date |
---|
[5037] | 575 | REAL(dp), INTENT(IN) :: dd_nday |
---|
[4213] | 576 | !---------------------------------------------------------------- |
---|
| 577 | |
---|
| 578 | ! check year month day hour min sec |
---|
| 579 | CALL date__check(td_date) |
---|
| 580 | |
---|
[5037] | 581 | date__addnday=date__init_jd(td_date%d_jd+dd_nday) |
---|
[4213] | 582 | |
---|
| 583 | END FUNCTION date__addnday |
---|
| 584 | !------------------------------------------------------------------- |
---|
| 585 | !> @brief This subroutine compute last day of the month |
---|
| 586 | ! |
---|
| 587 | !> @author J.Paul |
---|
[5037] | 588 | !> @date November, 2013 - Initial Version |
---|
[4213] | 589 | ! |
---|
[5037] | 590 | !> @param[in] td_date date strutcutre |
---|
| 591 | !> @return last day of the month |
---|
[4213] | 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 | !------------------------------------------------------------------- |
---|
[5037] | 616 | !> @brief This subroutine compute julian day from year month day , and fill |
---|
| 617 | !> input date strutcutre. |
---|
[4213] | 618 | !> |
---|
| 619 | !> @author J.Paul |
---|
[5037] | 620 | !> @date November, 2013 - Initial Version |
---|
[4213] | 621 | ! |
---|
[5037] | 622 | !> @param[inout] td_date date strutcutre |
---|
[4213] | 623 | !------------------------------------------------------------------- |
---|
| 624 | SUBROUTINE date__ymd2jd(td_date) |
---|
| 625 | IMPLICIT NONE |
---|
| 626 | ! Argument |
---|
| 627 | TYPE(TDATE), INTENT(INOUT) :: td_date |
---|
| 628 | |
---|
| 629 | ! local variable |
---|
[5037] | 630 | REAL(dp) :: dl_standard_jd |
---|
| 631 | REAL(dp) :: dl_frac |
---|
[4213] | 632 | !---------------------------------------------------------------- |
---|
| 633 | |
---|
[5037] | 634 | dl_standard_jd= td_date%i_day - 32075 & |
---|
[4213] | 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 | |
---|
[5037] | 639 | td_date%d_jd = dl_standard_jd-2400001 ! origin : 17 nov 1858 h00m00s00 |
---|
[4213] | 640 | |
---|
| 641 | ! compute fraction of day |
---|
[5037] | 642 | dl_frac=date__hms2jd(td_date) |
---|
[4213] | 643 | |
---|
[5037] | 644 | td_date%d_jd = td_date%d_jd + dl_frac |
---|
[4213] | 645 | |
---|
[5037] | 646 | td_date%k_jdsec = date__jd2sec( td_date%d_jd ) |
---|
[4213] | 647 | |
---|
| 648 | END SUBROUTINE date__ymd2jd |
---|
| 649 | !------------------------------------------------------------------- |
---|
[5037] | 650 | !> @brief This subroutine compute year month day from julian day, and fill |
---|
| 651 | !> input date strutcutre. |
---|
[4213] | 652 | !> |
---|
| 653 | !> @author J.Paul |
---|
[5037] | 654 | !> @date November, 2013 - Initial Version |
---|
[4213] | 655 | ! |
---|
[5037] | 656 | !> @param[inout] td_date date strutcutre |
---|
[4213] | 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 | |
---|
[5037] | 672 | il_standard_jd=INT( td_date%d_jd+2400001, i4 ) |
---|
[4213] | 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 |
---|
[5037] | 694 | !> with new date origin, and fill input date strutcutre. |
---|
[4213] | 695 | !> |
---|
| 696 | !> @author J.Paul |
---|
[5037] | 697 | !> @date November, 2013 - Initial Version |
---|
[4213] | 698 | ! |
---|
[5037] | 699 | !> @param[inout] td_date date |
---|
| 700 | !> @param[in] td_dateo new date origin for pseudo julian day |
---|
[4213] | 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 |
---|
[5037] | 710 | REAL(dp) :: dl_nday |
---|
[4213] | 711 | !---------------------------------------------------------------- |
---|
| 712 | ! origin julian day |
---|
| 713 | tl_date=date_init(1858,11,17) |
---|
| 714 | |
---|
[5037] | 715 | dl_nday=td_dateo-tl_date |
---|
[4213] | 716 | |
---|
| 717 | ! compute julian day |
---|
[5037] | 718 | td_date%d_jd = td_date%d_jc + dl_nday |
---|
[4213] | 719 | ! compute number of second since julian day origin |
---|
[5037] | 720 | td_date%k_jdsec = date__jd2sec(td_date%d_jd) |
---|
[4213] | 721 | |
---|
| 722 | END SUBROUTINE date__jc2jd |
---|
| 723 | !------------------------------------------------------------------- |
---|
[5037] | 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 |
---|
[4213] | 727 | !> |
---|
| 728 | !> @author J.Paul |
---|
[5037] | 729 | !> @date November, 2013 - Initial Version |
---|
[4213] | 730 | ! |
---|
[5037] | 731 | !> @param[inout] td_date date |
---|
| 732 | !> @param[in] td_dateo new origin date |
---|
[4213] | 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 |
---|
[5037] | 744 | td_date%d_jc=td_date%d_jd-td_dateo%d_jd |
---|
[4213] | 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 | |
---|
[5037] | 753 | td_date%d_jc = td_date%d_jd-tl_dateo%d_jd |
---|
[4213] | 754 | ENDIF |
---|
| 755 | |
---|
[5037] | 756 | td_date%k_jcsec = date__jd2sec(td_date%d_jc) |
---|
[4213] | 757 | |
---|
| 758 | END SUBROUTINE date__jd2jc |
---|
| 759 | !------------------------------------------------------------------- |
---|
[5037] | 760 | !> @brief This subroutine compute the day of week from julian day, and fill |
---|
| 761 | !> input date structure.<br/> |
---|
[4213] | 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 |
---|
[5037] | 766 | !> @date November, 2013 - Initial Version |
---|
[4213] | 767 | ! |
---|
[5037] | 768 | !> @param[inout] td_date date strutcutre |
---|
[4213] | 769 | !------------------------------------------------------------------- |
---|
| 770 | SUBROUTINE date__jd2dow(td_date) |
---|
| 771 | IMPLICIT NONE |
---|
| 772 | ! Argument |
---|
| 773 | TYPE(TDATE), INTENT(INOUT) :: td_date |
---|
| 774 | !---------------------------------------------------------------- |
---|
| 775 | |
---|
[5037] | 776 | td_date%i_dow=MOD((INT(AINT(td_date%d_jd))+3),7) |
---|
[4213] | 777 | |
---|
| 778 | END SUBROUTINE date__jd2dow |
---|
| 779 | !------------------------------------------------------------------- |
---|
| 780 | !> @brief This function compute fraction of a day from |
---|
[5037] | 781 | !> hour, minute, second. |
---|
[4213] | 782 | !> |
---|
| 783 | !> @author J.Paul |
---|
[5037] | 784 | !> @date November, 2013 - Initial Version |
---|
[4213] | 785 | ! |
---|
[5037] | 786 | !> @param[in] td_date date strutcutre |
---|
[4213] | 787 | !> @return fraction of the day |
---|
| 788 | !------------------------------------------------------------------- |
---|
[5037] | 789 | REAL(dp) FUNCTION date__hms2jd(td_date) |
---|
[4213] | 790 | IMPLICIT NONE |
---|
| 791 | ! Argument |
---|
| 792 | TYPE(TDATE), INTENT(IN) :: td_date |
---|
| 793 | !---------------------------------------------------------------- |
---|
| 794 | |
---|
| 795 | ! compute real seconds |
---|
[5037] | 796 | date__hms2jd = REAL( td_date%i_sec, dp ) |
---|
[4213] | 797 | ! compute real minutes |
---|
[5037] | 798 | date__hms2jd = REAL( td_date%i_min, dp ) + date__hms2jd/60.0 |
---|
[4213] | 799 | ! compute real hours |
---|
[5037] | 800 | date__hms2jd = REAL( td_date%i_hour, dp ) + date__hms2jd/60.0 |
---|
[4213] | 801 | ! julian fraction of a day |
---|
| 802 | date__hms2jd = date__hms2jd/24.0 |
---|
| 803 | |
---|
| 804 | END FUNCTION date__hms2jd |
---|
| 805 | !------------------------------------------------------------------- |
---|
[5037] | 806 | !> @brief This subroutine compute hour, minute, second from julian |
---|
| 807 | !> fraction, and fill date structure. |
---|
[4213] | 808 | !> |
---|
| 809 | !> @author J.Paul |
---|
[5037] | 810 | !> @date November, 2013 - Initial Version |
---|
[4213] | 811 | ! |
---|
[5037] | 812 | !> @param[inout] td_date date strutcutre |
---|
[4213] | 813 | !------------------------------------------------------------------- |
---|
| 814 | SUBROUTINE date__jd2hms(td_date) |
---|
| 815 | IMPLICIT NONE |
---|
| 816 | ! Argument |
---|
| 817 | TYPE(TDATE), INTENT(INOUT) :: td_date |
---|
| 818 | |
---|
| 819 | !local variable |
---|
[5037] | 820 | REAL(dp) :: dl_fract |
---|
[4213] | 821 | !---------------------------------------------------------------- |
---|
| 822 | |
---|
[5037] | 823 | dl_fract=(td_date%d_jd)-AINT(td_date%d_jd) |
---|
[4213] | 824 | ! compute hour |
---|
[5037] | 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 |
---|
[4213] | 827 | ! compute minute |
---|
[5037] | 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 |
---|
[4213] | 830 | ! compute second |
---|
[5037] | 831 | td_date%i_sec = NINT( dl_fract * 60.0, i4 ) |
---|
[4213] | 832 | |
---|
| 833 | END SUBROUTINE date__jd2hms |
---|
| 834 | !------------------------------------------------------------------- |
---|
| 835 | !> @brief This subroutine check date express in date structure |
---|
| 836 | !> |
---|
| 837 | !> @author J.Paul |
---|
[5037] | 838 | !> @date November, 2013 - Initial Version |
---|
[4213] | 839 | ! |
---|
[5037] | 840 | !> @param[in] td_date date strutcutre |
---|
[4213] | 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 | |
---|
[5037] | 853 | ! init |
---|
| 854 | il_status=0 |
---|
| 855 | |
---|
[4213] | 856 | ! check year |
---|
| 857 | IF( td_date%i_year < 1858_i4 .OR. td_date%i_year > 39999_i4 )THEN |
---|
[5037] | 858 | il_status=il_status+1 |
---|
[4213] | 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 |
---|
[5037] | 864 | il_status=il_status+1 |
---|
[4213] | 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 |
---|
[5037] | 871 | il_status=il_status+1 |
---|
[4213] | 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 |
---|
[5037] | 877 | il_status=il_status+1 |
---|
[4213] | 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 |
---|
[5037] | 883 | il_status=il_status+1 |
---|
[4213] | 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 |
---|
[5037] | 889 | il_status=il_status+1 |
---|
[4213] | 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 |
---|
[5037] | 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" |
---|
[4213] | 898 | CALL logger_error(cl_msg) |
---|
| 899 | ENDIF |
---|
| 900 | |
---|
[5037] | 901 | IF( il_status/= 0 )THEN |
---|
| 902 | WRITE(cl_msg,*) " date error" |
---|
| 903 | CALL logger_fatal(cl_msg) |
---|
| 904 | ENDIF |
---|
| 905 | |
---|
[4213] | 906 | END SUBROUTINE date__check |
---|
| 907 | !------------------------------------------------------------------- |
---|
[5037] | 908 | !> @brief This subroutine adjust date (correct hour, minutes, and seconds |
---|
| 909 | !> value if need be) |
---|
[4213] | 910 | !> |
---|
| 911 | !> @author J.Paul |
---|
[5037] | 912 | !> @date November, 2013 - Initial Version |
---|
[4213] | 913 | ! |
---|
[5037] | 914 | !> @param[inout] td_date date strutcutre |
---|
[4213] | 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 |
---|
[5037] | 934 | td_date=date__addnday(td_date,1._dp) |
---|
[4213] | 935 | ENDIF |
---|
| 936 | |
---|
| 937 | END SUBROUTINE date__adjust |
---|
| 938 | !------------------------------------------------------------------- |
---|
| 939 | !> @brief This function convert julian day in seconds |
---|
[5037] | 940 | !> since julian day origin. |
---|
[4213] | 941 | !> @author J.Paul |
---|
[5037] | 942 | !> @date November, 2013 - Initial Version |
---|
[4213] | 943 | ! |
---|
[5037] | 944 | !> @param[in] td_date date strutcutre |
---|
[4213] | 945 | !> @return number of seconds since julian day origin |
---|
| 946 | !------------------------------------------------------------------- |
---|
[5037] | 947 | INTEGER(i8) FUNCTION date__jd2sec(dd_jul) |
---|
[4213] | 948 | IMPLICIT NONE |
---|
| 949 | ! Argument |
---|
[5037] | 950 | REAL(dp), INTENT(IN) :: dd_jul |
---|
[4213] | 951 | !---------------------------------------------------------------- |
---|
| 952 | |
---|
[5037] | 953 | date__jd2sec = NINT( dd_jul * im_secbyday, i8 ) |
---|
[4213] | 954 | |
---|
| 955 | END FUNCTION date__jd2sec |
---|
| 956 | !------------------------------------------------------------------- |
---|
| 957 | !> @brief This function convert seconds since julian day origin in |
---|
[5037] | 958 | !> julian day. |
---|
[4213] | 959 | !> @author J.Paul |
---|
[5037] | 960 | !> @date November, 2013 - Initial Version |
---|
[4213] | 961 | ! |
---|
[5037] | 962 | !> @param[in] kd_nsec number of second since julian day origin |
---|
| 963 | !> @return julian day |
---|
[4213] | 964 | !------------------------------------------------------------------- |
---|
[5037] | 965 | REAL(dp) FUNCTION date__sec2jd(kd_nsec) |
---|
[4213] | 966 | IMPLICIT NONE |
---|
| 967 | ! Argument |
---|
| 968 | INTEGER(i8), INTENT(IN) :: kd_nsec |
---|
| 969 | !---------------------------------------------------------------- |
---|
| 970 | |
---|
[5037] | 971 | date__sec2jd = REAL( REAL( kd_nsec , dp ) / im_secbyday, dp ) |
---|
[4213] | 972 | |
---|
| 973 | END FUNCTION date__sec2jd |
---|
| 974 | END MODULE date |
---|
| 975 | |
---|