- Timestamp:
- 2015-07-16T13:55:15+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/SIREN/src/date.f90
r4213 r5602 7 7 ! DESCRIPTION: 8 8 !> @brief This module provide the calculation of Julian dates, and 9 !> do many manipulations with dates.<br/> 10 !> Actually we use Modified Julian Dates, with origin the 11 !> 17 Nov 1858 at 00:00:00 12 ! 9 !> do many manipulations with dates. 10 !> 13 11 !> @details 12 !> Actually we use Modified Julian Dates, with 13 !> 17 Nov 1858 at 00:00:00 as origin.<br/> 14 !> 14 15 !> define type TDATE:<br/> 15 !> TYPE(TDATE) :: tl_date1<br/> 16 !> @code 17 !> TYPE(TDATE) :: tl_date1 18 !> @endcode 16 19 !> default date is 17 Nov 1858 at 00:00:00<br/> 17 20 !> 18 21 !> to intialise date : <br/> 19 !> - from date of the day at 12:00:00 : tl_date1=date_today()<br/> 20 !> - from date and time of the day : tl_date1=date_now()<br/> 21 !> - from julian day : tl_date1=date_init(1.)<br/> 22 !> - from year month day : tl_date1=date_init(2012,12,10)<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 23 49 !> 24 50 !> to print date in format YYYY-MM-DD hh:mm:ss<br/> 25 51 !> CHARACTER(LEN=lc) :: cl_date<br/> 26 !> cl_date=date_print(tl_date1)<br/> 27 !> PRINT *, TRIM(cl_date)<br/> 28 !> 29 !> to print day if the week:<br/> 30 !> PRINT *,"dow ", tl_date1\%i_dow<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 31 68 !> to print last day of the month:<br/> 32 !> PRINT *,"last day ", tl_date1\%i_lday<br/> 69 !> @code 70 !> PRINT *,"last day ", tl_date1\%i_lday 71 !> @endcode 72 !> 33 73 !> to know if year is a leap year:<br/> 34 !> LOGICAL :: ll_isleap<br/> 35 !> ll_isleap=date_leapyear(tl_date1)<br/> 36 !> 37 !> to compute difference between to dates:<br/> 38 !> tl_date2=date_init(2010,12,10)<br/> 39 !> print *,"diff ",tl_date1-tl_date2<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) 40 85 !> 41 86 !> to add or substract nday to a date:<br/> 42 !> tl_date2=tl_date1+2.<br/> 43 !> print *,"add ",trim(date_print(tl_date2))<br/> 44 !> tl_date2=tl_date1-2.6<br/> 45 !> print *,"sub ",trim(date_print(tl_date2))<br/> 87 !> @code 88 !> tl_date2=tl_date1+2. 89 !> tl_date2=tl_date1-2.6 90 !> @endcode 91 !> - number of day (double precision) 46 92 !> 47 93 !> to print julian day:<br/> 48 !> print *," julian day",tl_date1\%r_jd<br/> 94 !> @code 95 !> PRINT *," julian day",tl_date1\%r_jd 96 !> @endcode 49 97 !> 50 98 !> to print CNES julian day (origin 1950-01-01 00:00:00)<br/> 51 !> print *," CNES julian day",tl_date1\%r_jc<br/> 99 !> @code 100 !> PRINT *," CNES julian day",tl_date1\%r_jc 101 !> @endcode 52 102 !> 53 103 !> to create pseudo julian day with origin date_now:<br/> 54 !> tl_date1=date_init(2012,12,10,td_dateo=date_now())<br/> 55 !> print *," new julian day",tl_date1\%r_jc<br/> 56 !> Note that you erase CNES julian day when doing so<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/> 57 108 !> 58 109 !> to print julian day in seconds:<br/> 59 !> print *, tl_date1\%k_jdsec<br/> 110 !> @code 111 !> PRINT *, tl_date1\%k_jdsec 112 !> @endcode 60 113 !> to print CNES or new julian day in seconds:<br/> 61 !> print *, tl_date1\%k_jcsec<br/> 62 !> 63 !> @author 64 !> J.Paul 114 !> @code 115 !> PRINT *, tl_date1\%k_jcsec 116 !> @endcode 117 !> 118 !> @author J.Paul 65 119 ! REVISION HISTORY: 66 !> @date Nov , 2013 - Initial Version120 !> @date November, 2013 - Initial Version 67 121 ! 68 122 !> @note This module is based on Perderabo's date calculator (ksh) 69 123 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 124 !> 70 125 !> @todo 71 !> - check if real(sp), integer(i8) is enough72 126 !> - see calendar.f90 and select Gregorian, NoLeap, or D360 calendar 73 !> - add suffix to number74 !> - add log message75 127 !---------------------------------------------------------------------- 76 128 MODULE date … … 78 130 USE kind ! F90 kind parameter 79 131 USE fct ! basic useful function 80 USE logger 132 USE logger ! log file manager 81 133 IMPLICIT NONE 82 PRIVATE83 134 ! NOTE_avoid_public_variables_if_possible 84 135 85 136 ! type and variable 86 PUBLIC :: TDATE ! date structure 137 PUBLIC :: TDATE !< date structure 138 139 PRIVATE :: cm_fmtdate !< date and time format 140 PRIVATE :: im_secbyday !< number of second by day 87 141 88 142 ! function and subroutine 89 PUBLIC :: OPERATOR(-) ! substract two dates or n days to a date90 PUBLIC :: OPERATOR(+) ! add n days to a date91 PUBLIC :: date_init ! initiazed date structure form julian day or year month day92 PUBLIC :: date_ now ! return the date and time93 PUBLIC :: date_ today ! return the date of the day at 12:00:0094 PUBLIC :: date_print ! print the date with format YYYY-MM-DD hh:mm:ss95 PUBLIC :: date_leapyear ! check if year is a leap year96 97 PRIVATE :: date__init_fmtdate ! initia zed date structure from character YYYY-MM-DD hh:mm:ss98 PRIVATE :: date__init_jd ! initia zed date structure from julian day99 PRIVATE :: date__init_nsec ! initia zed date structure from number of second since origin of julian day100 PRIVATE :: date__init_ymd ! initia zed date structure from year month day143 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 101 155 PRIVATE :: date__addnday ! add nday to a date 102 156 PRIVATE :: date__subnday ! substract nday to a date 103 PRIVATE :: date__diffdate ! compute number of day between two dates157 PRIVATE :: date__diffdate ! compute number of days between two dates 104 158 PRIVATE :: date__lastday ! compute last day of the month 105 159 PRIVATE :: date__ymd2jd ! compute julian day from year month day … … 115 169 PRIVATE :: date__sec2jd ! convert seconds since julian day origin in julian day 116 170 117 !> @struct TDATE 118 TYPE TDATE 171 TYPE TDATE !< date structure 119 172 INTEGER(i4) :: i_year = 1858 !< year 120 173 INTEGER(i4) :: i_month = 11 !< month 121 174 INTEGER(i4) :: i_day = 17 !< day 122 INTEGER(i4) :: i_hms = 0 !< fraction of the day123 175 INTEGER(i4) :: i_hour = 0 !< hour 124 176 INTEGER(i4) :: i_min = 0 !< min … … 126 178 INTEGER(i4) :: i_dow = 0 !< day of week 127 179 INTEGER(i4) :: i_lday = 0 !< last day of the month 128 REAL( sp) :: r_jd = 0 !< julian day (origin : 1858/11/17 00:00:00)129 REAL( sp) :: r_jc = 0 !< CNES julian day or pseudo julian day with new date origin180 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 130 182 INTEGER(i8) :: k_jdsec = 0 !< number of seconds since julian day origin 131 183 INTEGER(i8) :: k_jcsec = 0 !< number of seconds since CNES or pseudo julian day origin … … 133 185 134 186 ! module variable 135 CHARACTER(LEN=lc), PARAMETER :: cm_fmtdate = & !< date format187 CHARACTER(LEN=lc), PARAMETER :: cm_fmtdate = & !< date and time format 136 188 & "(i0.4,'-',i0.2,'-',i0.2,1x,i0.2,':',i0.2,':',i0.2)" 137 189 … … 139 191 140 192 INTERFACE date_init 141 MODULE PROCEDURE date__init_jd ! initia zed date structure from julian day142 MODULE PROCEDURE date__init_nsec ! initia zed date structure from number of second since origin of julian day143 MODULE PROCEDURE date__init_ymd ! initia zed date structure from year month day144 MODULE PROCEDURE date__init_fmtdate ! initia zed date structure from character YYYY-MM-DD hh:mm:ss193 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 145 197 END INTERFACE date_init 146 198 … … 156 208 CONTAINS 157 209 !------------------------------------------------------------------- 158 !> @brief This function print the date with 159 !> format YYYY/MM/DD hh:mm:ss 160 !> 161 !> @author J.Paul 162 !> - Nov, 2013- Initial Version 163 ! 164 !> @param[in] td_date : date strutcutre 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) 165 221 !> @return date in format YYYY-MM-DD hh:mm:ss 166 222 !------------------------------------------------------------------- 167 ! @code 168 CHARACTER(LEN=lc) FUNCTION date_print(td_date) 169 IMPLICIT NONE 170 ! Argument 171 TYPE(TDATE), INTENT(IN) :: td_date 172 !---------------------------------------------------------------- 173 174 WRITE(date_print,cm_fmtdate) & 175 & td_date%i_year,td_date%i_month,td_date%i_day, & 176 & td_date%i_hour,td_date%i_min,td_date%i_sec 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 177 238 178 239 END FUNCTION date_print 179 ! @endcode180 240 !------------------------------------------------------------------- 181 241 !> @brief This function check if year is a leap year. 182 242 !> 183 243 !> @author J.Paul 184 !> - Nov, 2013- Initial Version185 ! 186 !> @param[in] td_date :date strutcutre244 !> @date November, 2013 - Initial Version 245 ! 246 !> @param[in] td_date date strutcutre 187 247 !> @return true if year is leap year 188 248 !------------------------------------------------------------------- 189 ! @code190 249 LOGICAL FUNCTION date_leapyear(td_date) 191 250 IMPLICIT NONE … … 206 265 207 266 END FUNCTION date_leapyear 208 ! @endcode 209 !------------------------------------------------------------------- 210 !> @brief This function return the date and time 211 !> 212 !> @author J.Paul 213 !> - Nov, 2013- Initial Version 214 ! 215 !> @return date and time of the day in a date structure 216 !------------------------------------------------------------------- 217 ! @code 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 !------------------------------------------------------------------- 218 275 TYPE(TDATE) FUNCTION date_now() 219 276 IMPLICIT NONE … … 228 285 229 286 END FUNCTION date_now 230 ! @endcode 231 !------------------------------------------------------------------- 232 !> @brief This function return the date of the day at 12:00:00 233 !> 234 !> @author J.Paul 235 !> - Nov, 2013- Initial Version 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 236 292 ! 237 293 !> @return date of the day at 12:00:00 in a date structure 238 294 !------------------------------------------------------------------- 239 ! @code240 295 TYPE(TDATE) FUNCTION date_today() 241 296 IMPLICIT NONE … … 249 304 250 305 END FUNCTION date_today 251 ! @endcode 252 !------------------------------------------------------------------- 253 !> @brief This function initiazed date structure from a character 254 !> date with format YYYY-MM-DD hh:mm:ss 255 !> 256 !> @author J.Paul 257 !> - Nov, 2013- Initial Version 258 ! 259 !> @param[in] cd_date : date in format YYYY-MM-DD hh:mm:ss 260 !> @param[in] td_dateo : new date origin for pseudo julian day 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 261 318 !> @return date structure 262 319 !------------------------------------------------------------------- 263 ! @code 264 TYPE(TDATE) FUNCTION date__init_fmtdate(cd_date, td_dateo) 265 IMPLICIT NONE 266 ! Argument 267 CHARACTER(LEN=*), INTENT(IN) :: cd_date 320 TYPE(TDATE) FUNCTION date__init_fmtdate(cd_datetime, td_dateo) 321 IMPLICIT NONE 322 ! Argument 323 CHARACTER(LEN=*), INTENT(IN) :: cd_datetime 268 324 TYPE(TDATE), INTENT(IN), OPTIONAL :: td_dateo 269 325 270 326 ! local variable 327 CHARACTER(LEN=lc) :: cl_datetime 271 328 CHARACTER(LEN=lc) :: cl_date 329 CHARACTER(LEN=lc) :: cl_time 272 330 CHARACTER(LEN=lc) :: cl_year 273 331 CHARACTER(LEN=lc) :: cl_month … … 285 343 !---------------------------------------------------------------- 286 344 287 cl_date=TRIM(ADJUSTL(cd_date)) 288 289 cl_year=cl_date(1:4) 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,'-') 290 351 READ(cl_year,*) il_year 291 cl_month= cl_date(6:7)352 cl_month= fct_split(cl_date,2,'-') 292 353 READ(cl_month, *) il_month 293 cl_day =cl_date(9:10)354 cl_day = fct_split(cl_date,3,'-') 294 355 READ(cl_day, *) il_day 295 cl_hour =cl_date(12:13)356 cl_hour = fct_split(cl_time,1,':') 296 357 READ(cl_hour, *) il_hour 297 cl_min =cl_date(15:16)358 cl_min = fct_split(cl_time,2,':') 298 359 READ(cl_min, *) il_min 299 cl_sec =cl_date(18:19)360 cl_sec = fct_split(cl_time,3,':') 300 361 READ(cl_sec, *) il_sec 301 362 … … 304 365 305 366 END FUNCTION date__init_fmtdate 306 ! @endcode307 ! -------------------------------------------------------------------308 !> @ brief This function initiazed date structure from julian day<br/>309 !> optionaly create pseudo julian day with new origin<br/>367 !------------------------------------------------------------------- 368 !> @brief This function initialized date structure from julian day.<br/> 369 !> @details 370 !> Optionaly create pseudo julian day with new origin.<br/> 310 371 !> julian day origin is 17 Nov 1858 at 00:00:00 311 372 !> 312 373 !> @author J.Paul 313 !> - Nov, 2013- Initial Version314 ! 315 !> @param[in] rd_jd :julian day316 !> @param[in] td_dateo :new date origin for pseudo julian day374 !> @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 317 378 ! 318 379 !> @return date structure of julian day 319 380 !------------------------------------------------------------------- 320 ! @code 321 TYPE(TDATE) FUNCTION date__init_jd(rd_jd, td_dateo) 381 TYPE(TDATE) FUNCTION date__init_jd(dd_jd, td_dateo) 322 382 IMPLICIT NONE 323 383 !Argument 324 REAL( sp), INTENT(IN) :: rd_jd384 REAL(dp), INTENT(IN) :: dd_jd 325 385 TYPE(TDATE), INTENT(IN), OPTIONAL :: td_dateo 326 386 !---------------------------------------------------------------- … … 329 389 330 390 ! pseudo julian day with origin dateo 331 date__init_jd% r_jc=rd_jd332 date__init_jd%k_jcsec=date__jd2sec( rd_jd)391 date__init_jd%d_jc=dd_jd 392 date__init_jd%k_jcsec=date__jd2sec(dd_jd) 333 393 334 394 ! convert to truly julian day 335 395 CALL date__jc2jd(date__init_jd, td_dateo) 336 396 ELSE 337 date__init_jd% r_jd=rd_jd338 date__init_jd%k_jdsec=date__jd2sec( rd_jd)397 date__init_jd%d_jd=dd_jd 398 date__init_jd%k_jdsec=date__jd2sec(dd_jd) 339 399 340 400 ! compute CNES julian day … … 355 415 356 416 END FUNCTION date__init_jd 357 ! @endcode358 ! -------------------------------------------------------------------359 !> @brief This function initiazed date structure from number of360 !> second since julian day origin<br/>361 !> optionaly create pseudo julian day with new origin362 !> 363 !> @author J.Paul 364 !> - Nov, 2013- Initial Version365 ! 366 !> @param[in] rd_jd : julian day367 !> @param[in] td_dateo :new date origin for pseudo julian day417 !------------------------------------------------------------------- 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 368 428 ! 369 429 !> @return date structure of julian day 370 430 !------------------------------------------------------------------- 371 ! @code372 431 TYPE(TDATE) FUNCTION date__init_nsec(kd_nsec, td_dateo) 373 432 IMPLICIT NONE … … 383 442 384 443 END FUNCTION date__init_nsec 385 ! @endcode386 ! -------------------------------------------------------------------387 !> @brief This function initiazed date structure form year month day388 !> and optionnaly hour min sec<br/>389 !> optionaly create pseudo julian day with new origin390 ! 391 !> @author J.Paul 392 !> - Nov, 2013- Initial Version393 ! 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 !> 394 453 !> @param[in] id_year 395 454 !> @param[in] id_month … … 398 457 !> @param[in] id_min 399 458 !> @param[in] id_sec 400 !> @param[in] td_dateo :new date origin for pseudo julian day459 !> @param[in] td_dateo new date origin for pseudo julian day 401 460 ! 402 461 !> @return date structure of year month day 403 462 !------------------------------------------------------------------- 404 ! @code405 463 TYPE(TDATE) FUNCTION date__init_ymd(id_year, id_month, id_day, & 406 464 & id_hour, id_min, id_sec, & … … 450 508 451 509 END FUNCTION date__init_ymd 452 ! @endcode 453 !------------------------------------------------------------------- 454 !> @brief This function compute number of day between two dates<br/> 510 !------------------------------------------------------------------- 511 !> @brief This function compute number of day between two dates: 455 512 !> nday= date1 - date2 456 513 ! 457 514 !> @author J.Paul 458 !> - Nov, 2013- Initial Version459 ! 460 !> @param[in] td_date1 :first date strutcutre461 !> @param[in] td_date2 :second date strutcutre515 !> @date November, 2013 - Initial Version 516 ! 517 !> @param[in] td_date1 first date strutcutre 518 !> @param[in] td_date2 second date strutcutre 462 519 !> @return nday 463 520 !------------------------------------------------------------------- 464 ! @code 465 REAL(sp) FUNCTION date__diffdate(td_date1, td_date2) 521 REAL(dp) FUNCTION date__diffdate(td_date1, td_date2) 466 522 IMPLICIT NONE 467 523 … … 475 531 CALL date__check(td_date2) 476 532 477 date__diffdate = td_date1% r_jd - td_date2%r_jd533 date__diffdate = td_date1%d_jd - td_date2%d_jd 478 534 479 535 END FUNCTION date__diffdate 480 ! @endcode 481 !------------------------------------------------------------------- 482 !> @brief This function substract nday to a date 536 !------------------------------------------------------------------- 537 !> @brief This function substract nday to a date: 483 538 !> date2 = date1 - nday 484 539 !> 485 540 !> @author J.Paul 486 !> - Nov, 2013- Initial Version487 ! 488 !> @param[in] td_date :date strutcutre489 !> @param[in] rd_nday :number of day541 !> @date November, 2013 - Initial Version 542 ! 543 !> @param[in] td_date date strutcutre 544 !> @param[in] dd_nday number of day 490 545 !> @return date strutcutre of date - nday 491 546 !------------------------------------------------------------------- 492 ! @code 493 TYPE(TDATE) FUNCTION date__subnday(td_date, rd_nday) 547 TYPE(TDATE) FUNCTION date__subnday(td_date, dd_nday) 494 548 IMPLICIT NONE 495 549 !Argument 496 550 TYPE(TDATE), INTENT(IN) :: td_date 497 REAL( sp), INTENT(IN) :: rd_nday551 REAL(dp), INTENT(IN) :: dd_nday 498 552 !---------------------------------------------------------------- 499 553 … … 501 555 CALL date__check(td_date) 502 556 503 date__subnday=date__init_jd(td_date% r_jd-rd_nday)557 date__subnday=date__init_jd(td_date%d_jd-dd_nday) 504 558 505 559 END FUNCTION date__subnday 506 ! @endcode 507 !------------------------------------------------------------------- 508 !> @brief This function add nday to a date 560 !------------------------------------------------------------------- 561 !> @brief This function add nday to a date: 509 562 !> date2 = date1 + nday 510 563 !> 511 564 !> @author J.Paul 512 !> - Nov, 2013- Initial Version513 ! 514 !> @param[in] td_date :date strutcutre515 !> @param[in] rd_nday :number of day565 !> @date November, 2013 - Initial Version 566 ! 567 !> @param[in] td_date date strutcutre 568 !> @param[in] dd_nday number of day 516 569 !> @return date strutcutre of date + nday 517 570 !------------------------------------------------------------------- 518 ! @code 519 TYPE(TDATE) FUNCTION date__addnday(td_date, rd_nday) 571 TYPE(TDATE) FUNCTION date__addnday(td_date, dd_nday) 520 572 IMPLICIT NONE 521 573 !Argument 522 574 TYPE(TDATE), INTENT(IN) :: td_date 523 REAL( sp), INTENT(IN) :: rd_nday575 REAL(dp), INTENT(IN) :: dd_nday 524 576 !---------------------------------------------------------------- 525 577 … … 527 579 CALL date__check(td_date) 528 580 529 date__addnday=date__init_jd(td_date% r_jd+rd_nday)581 date__addnday=date__init_jd(td_date%d_jd+dd_nday) 530 582 531 583 END FUNCTION date__addnday 532 ! @endcode533 584 !------------------------------------------------------------------- 534 585 !> @brief This subroutine compute last day of the month 535 586 ! 536 587 !> @author J.Paul 537 !> - Nov, 2013- Initial Version538 ! 539 !> @param[in out] td_date :date strutcutre540 ! -------------------------------------------------------------------541 ! @code588 !> @date November, 2013 - Initial Version 589 ! 590 !> @param[in] td_date date strutcutre 591 !> @return last day of the month 592 !------------------------------------------------------------------- 542 593 INTEGER(i4) FUNCTION date__lastday(td_date) 543 594 IMPLICIT NONE … … 562 613 563 614 END FUNCTION date__lastday 564 ! @endcode 565 !------------------------------------------------------------------- 566 !> @brief This subroutine compute julian day from year month day 567 !> 568 !> @author J.Paul 569 !> - Nov, 2013- Initial Version 570 ! 571 !> @param[inout] td_date : date strutcutre 572 !> @return julian day in the date strutcutre 573 !------------------------------------------------------------------- 574 ! @code 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 !------------------------------------------------------------------- 575 624 SUBROUTINE date__ymd2jd(td_date) 576 625 IMPLICIT NONE … … 579 628 580 629 ! local variable 581 REAL( sp) :: rl_standard_jd582 REAL( sp) :: rl_frac583 !---------------------------------------------------------------- 584 585 rl_standard_jd= td_date%i_day - 32075 &630 REAL(dp) :: dl_standard_jd 631 REAL(dp) :: dl_frac 632 !---------------------------------------------------------------- 633 634 dl_standard_jd= td_date%i_day - 32075 & 586 635 & + 1461 * (td_date%i_year + 4800 - (14 - td_date%i_month)/12)/4 & 587 636 & + 367 * (td_date%i_month - 2 + (14 - td_date%i_month)/12*12)/12 & 588 637 & - 3 * ((td_date%i_year + 4900 - (14 - td_date%i_month)/12)/100)/4 589 638 590 td_date% r_jd = rl_standard_jd-2400001 ! origin : 17 nov 1858 h00m00s00639 td_date%d_jd = dl_standard_jd-2400001 ! origin : 17 nov 1858 h00m00s00 591 640 592 641 ! compute fraction of day 593 rl_frac=date__hms2jd(td_date)594 595 td_date% r_jd = td_date%r_jd + rl_frac596 597 td_date%k_jdsec = date__jd2sec( td_date% r_jd )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 ) 598 647 599 648 END SUBROUTINE date__ymd2jd 600 ! @endcode 601 !------------------------------------------------------------------- 602 !> @brief This subroutine compute year month day from julian day 603 !> 604 !> @author J.Paul 605 !> - Nov, 2013- Initial Version 606 ! 607 !> @param[inout] td_date : date strutcutre 608 !> @return year month day in the date strutcutre 609 !------------------------------------------------------------------- 610 ! @code 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 !------------------------------------------------------------------- 611 658 SUBROUTINE date__jd2ymd(td_date) 612 659 IMPLICIT NONE … … 615 662 616 663 ! local variable 617 REAL(sp) :: rl_frac618 664 INTEGER(i4) :: il_standard_jd 619 665 INTEGER(i4) :: il_temp1 … … 624 670 CALL date__check(td_date) 625 671 626 il_standard_jd=INT( td_date%r_jd+2400001, i4 ) 627 rl_frac=(td_date%r_jd+2400001)-il_standard_jd 672 il_standard_jd=INT( td_date%d_jd+2400001, i4 ) 628 673 629 674 il_temp1=il_standard_jd + 68569 … … 645 690 646 691 END SUBROUTINE date__jd2ymd 647 ! @endcode648 692 !------------------------------------------------------------------- 649 693 !> @brief This subroutine compute julian day from pseudo julian day 650 !> with new date origin<br/> 651 !> 652 !> @author J.Paul 653 !> - Nov, 2013- Initial Version 654 ! 655 !> @param[inout] td_date : date 656 !> @return julian day inside input date structure 657 !------------------------------------------------------------------- 658 ! @code 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 !------------------------------------------------------------------- 659 702 SUBROUTINE date__jc2jd(td_date, td_dateo) 660 703 IMPLICIT NONE … … 665 708 ! local variable 666 709 TYPE(TDATE) :: tl_date 667 REAL( sp) :: rl_nday710 REAL(dp) :: dl_nday 668 711 !---------------------------------------------------------------- 669 712 ! origin julian day 670 713 tl_date=date_init(1858,11,17) 671 714 672 rl_nday=td_dateo-tl_date715 dl_nday=td_dateo-tl_date 673 716 674 717 ! compute julian day 675 td_date% r_jd = td_date%r_jc + rl_nday718 td_date%d_jd = td_date%d_jc + dl_nday 676 719 ! compute number of second since julian day origin 677 td_date%k_jdsec = date__jd2sec(td_date% r_jd)720 td_date%k_jdsec = date__jd2sec(td_date%d_jd) 678 721 679 722 END SUBROUTINE date__jc2jd 680 ! @endcode 681 !------------------------------------------------------------------- 682 !> @brief This subroutine compute pseudo julian day with new date origin<br/> 683 !> default new origin is CNES julian day origin: 1950/01/01 684 !> 685 !> @author J.Paul 686 !> - Nov, 2013- Initial Version 687 ! 688 !> @param[inout] td_date : date 689 !> @param[in] td_dateo : new origin date 690 !> @return pseudo julian day inside input date structure 691 !------------------------------------------------------------------- 692 ! @code 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 !------------------------------------------------------------------- 693 734 SUBROUTINE date__jd2jc(td_date, td_dateo) 694 735 IMPLICIT NONE … … 701 742 !---------------------------------------------------------------- 702 743 IF( PRESENT(td_dateo) )THEN 703 td_date% r_jc=td_date%r_jd-td_dateo%r_jd744 td_date%d_jc=td_date%d_jd-td_dateo%d_jd 704 745 ELSE 705 746 ! CNES julian day origin … … 710 751 CALL date__ymd2jd(tl_dateo) 711 752 712 td_date% r_jc = td_date%r_jd-tl_dateo%r_jd713 ENDIF 714 715 td_date%k_jcsec = date__jd2sec(td_date% r_jc)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) 716 757 717 758 END SUBROUTINE date__jd2jc 718 ! @endcode719 ! -------------------------------------------------------------------720 !> @brief This subroutine compute the day of week from julian day<br/>759 !------------------------------------------------------------------- 760 !> @brief This subroutine compute the day of week from julian day, and fill 761 !> input date structure.<br/> 721 762 !> days : Sunday Monday Tuesday Wednesday Thursday Friday Saturday<br/> 722 763 !> numday : 0 1 2 3 4 5 6<br/> 723 764 !> 724 765 !> @author J.Paul 725 !> - Nov, 2013- Initial Version 726 ! 727 !> @param[inout] td_date : date strutcutre 728 !> @return day of week inside input date structure 729 !------------------------------------------------------------------- 730 ! @code 766 !> @date November, 2013 - Initial Version 767 ! 768 !> @param[inout] td_date date strutcutre 769 !------------------------------------------------------------------- 731 770 SUBROUTINE date__jd2dow(td_date) 732 771 IMPLICIT NONE … … 735 774 !---------------------------------------------------------------- 736 775 737 td_date%i_dow=MOD((INT(AINT(td_date% r_jd))+3),7)776 td_date%i_dow=MOD((INT(AINT(td_date%d_jd))+3),7) 738 777 739 778 END SUBROUTINE date__jd2dow 740 ! @endcode741 779 !------------------------------------------------------------------- 742 780 !> @brief This function compute fraction of a day from 743 !> hour, minute, second 744 !> 745 !> @author J.Paul 746 !> - Nov, 2013- Initial Version747 ! 748 !> @param[in] td_date :date strutcutre781 !> hour, minute, second. 782 !> 783 !> @author J.Paul 784 !> @date November, 2013 - Initial Version 785 ! 786 !> @param[in] td_date date strutcutre 749 787 !> @return fraction of the day 750 788 !------------------------------------------------------------------- 751 ! @code 752 REAL(sp) FUNCTION date__hms2jd(td_date) 789 REAL(dp) FUNCTION date__hms2jd(td_date) 753 790 IMPLICIT NONE 754 791 ! Argument … … 757 794 758 795 ! compute real seconds 759 date__hms2jd = REAL( td_date%i_sec, sp )796 date__hms2jd = REAL( td_date%i_sec, dp ) 760 797 ! compute real minutes 761 date__hms2jd = REAL( td_date%i_min, sp ) + date__hms2jd/60.0798 date__hms2jd = REAL( td_date%i_min, dp ) + date__hms2jd/60.0 762 799 ! compute real hours 763 date__hms2jd = REAL( td_date%i_hour, sp ) + date__hms2jd/60.0800 date__hms2jd = REAL( td_date%i_hour, dp ) + date__hms2jd/60.0 764 801 ! julian fraction of a day 765 802 date__hms2jd = date__hms2jd/24.0 766 803 767 804 END FUNCTION date__hms2jd 768 ! @endcode 769 !------------------------------------------------------------------- 770 !> @brief This function compute hour, minute, second from julian 771 !> fraction 772 !> 773 !> @author J.Paul 774 !> - Nov, 2013- Initial Version 775 ! 776 !> @param[in] td_date : date strutcutre 777 !> @return date strutcutre 778 !------------------------------------------------------------------- 779 ! @code 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 !------------------------------------------------------------------- 780 814 SUBROUTINE date__jd2hms(td_date) 781 815 IMPLICIT NONE … … 784 818 785 819 !local variable 786 REAL( sp) :: rl_fract787 !---------------------------------------------------------------- 788 789 rl_fract=(td_date%r_jd)-AINT(td_date%r_jd)820 REAL(dp) :: dl_fract 821 !---------------------------------------------------------------- 822 823 dl_fract=(td_date%d_jd)-AINT(td_date%d_jd) 790 824 ! compute hour 791 td_date%i_hour = INT( rl_fract * 24.0, i4 )792 rl_fract = ( rl_fract - REAL( td_date%i_hour, sp ) / 24.0) * 24.0825 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 793 827 ! compute minute 794 td_date%i_min = INT( rl_fract * 60.0, i4 )795 rl_fract = ( rl_fract - REAL( td_date%i_min, sp ) / 60.0) * 60.0828 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 796 830 ! compute second 797 td_date%i_sec = NINT( rl_fract * 60.0, i4 )831 td_date%i_sec = NINT( dl_fract * 60.0, i4 ) 798 832 799 833 END SUBROUTINE date__jd2hms 800 ! @endcode801 834 !------------------------------------------------------------------- 802 835 !> @brief This subroutine check date express in date structure 803 836 !> 804 837 !> @author J.Paul 805 !> - Nov, 2013- Initial Version 806 ! 807 !> @param[in] td_date : date strutcutre 808 !------------------------------------------------------------------- 809 ! @code 838 !> @date November, 2013 - Initial Version 839 ! 840 !> @param[in] td_date date strutcutre 841 !------------------------------------------------------------------- 810 842 SUBROUTINE date__check(td_date) 811 843 IMPLICIT NONE … … 819 851 !---------------------------------------------------------------- 820 852 853 ! init 854 il_status=0 855 821 856 ! check year 822 857 IF( td_date%i_year < 1858_i4 .OR. td_date%i_year > 39999_i4 )THEN 858 il_status=il_status+1 823 859 WRITE(cl_msg,*) "year ",td_date%i_year," out of range" 824 860 CALL logger_error(cl_msg) 825 CALL fct_err(il_status)826 861 ENDIF 827 862 ! check month 828 863 IF( td_date%i_month < 1_i4 .OR. td_date%i_month > 12_i4 )THEN 864 il_status=il_status+1 829 865 WRITE(cl_msg,*) "month ",td_date%i_month," out of range" 830 866 CALL logger_error(cl_msg) 831 CALL fct_err(il_status)832 867 ENDIF 833 868 ! check day 834 869 il_lastday=date__lastday(td_date) 835 870 IF( td_date%i_day < 1_i4 .OR. td_date%i_day > il_lastday )THEN 871 il_status=il_status+1 836 872 WRITE(cl_msg,*) "day ",td_date%i_day," out of range" 837 873 CALL logger_error(cl_msg) 838 CALL fct_err(il_status)839 874 ENDIF 840 875 ! check hour 841 876 IF( td_date%i_hour < 0_i4 .OR. td_date%i_hour > 23_i4 )THEN 877 il_status=il_status+1 842 878 WRITE(cl_msg,*) "hour ",td_date%i_hour," out of range" 843 879 CALL logger_error(cl_msg) 844 CALL fct_err(il_status)845 880 ENDIF 846 881 ! check minutes 847 882 IF( td_date%i_min < 0_i4 .OR. td_date%i_min > 59_i4 )THEN 883 il_status=il_status+1 848 884 WRITE(cl_msg,*) "minutes ",td_date%i_min," out of range" 849 885 CALL logger_error(cl_msg) 850 CALL fct_err(il_status)851 886 ENDIF 852 887 ! check seconds 853 888 IF( td_date%i_sec < 0_i4 .OR. td_date%i_sec > 59_i4 )THEN 889 il_status=il_status+1 854 890 WRITE(cl_msg,*) "seconds ",td_date%i_sec," out of range" 855 891 CALL logger_error(cl_msg) 856 CALL fct_err(il_status)857 892 ENDIF 858 893 859 894 ! check julian day 860 IF( td_date%r_jd < 0_sp .OR. td_date%r_jd > 782028_sp )THEN 861 WRITE(cl_msg,*) "julian day ",td_date%r_jd," out of range" 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" 862 898 CALL logger_error(cl_msg) 863 CALL fct_err(il_status) 899 ENDIF 900 901 IF( il_status/= 0 )THEN 902 WRITE(cl_msg,*) " date error" 903 CALL logger_fatal(cl_msg) 864 904 ENDIF 865 905 866 906 END SUBROUTINE date__check 867 ! @endcode 868 !------------------------------------------------------------------- 869 !> @brief This subroutine adjust date 870 !> 871 !> @author J.Paul 872 !> - Nov, 2013- Initial Version 873 ! 874 !> @param[inout] td_date : date strutcutre 875 !------------------------------------------------------------------- 876 ! @code 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 !------------------------------------------------------------------- 877 916 SUBROUTINE date__adjust(td_date) 878 917 IMPLICIT NONE … … 893 932 IF( td_date%i_hour == 24 )THEN 894 933 td_date%i_hour=0 895 td_date=date__addnday(td_date,1._ sp)934 td_date=date__addnday(td_date,1._dp) 896 935 ENDIF 897 936 898 937 END SUBROUTINE date__adjust 899 ! @endcode900 938 !------------------------------------------------------------------- 901 939 !> @brief This function convert julian day in seconds 902 !> since julian day origin 903 !> @author J.Paul 904 !> - Nov, 2013- Initial Version905 ! 906 !> @param[in] td_date :date strutcutre940 !> since julian day origin. 941 !> @author J.Paul 942 !> @date November, 2013 - Initial Version 943 ! 944 !> @param[in] td_date date strutcutre 907 945 !> @return number of seconds since julian day origin 908 946 !------------------------------------------------------------------- 909 ! @code 910 INTEGER(i8) FUNCTION date__jd2sec(rd_jul) 911 IMPLICIT NONE 912 ! Argument 913 REAL(sp), INTENT(IN) :: rd_jul 914 !---------------------------------------------------------------- 915 916 date__jd2sec = NINT( rd_jul * im_secbyday, i8 ) 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 ) 917 954 918 955 END FUNCTION date__jd2sec 919 ! @endcode920 956 !------------------------------------------------------------------- 921 957 !> @brief This function convert seconds since julian day origin in 922 !> julian day 923 !> @author J.Paul 924 !> - Nov, 2013- Initial Version 925 ! 926 !> @param[in] td_date : date strutcutre 927 !> @return number of seconds since julian day origin 928 !------------------------------------------------------------------- 929 ! @code 930 REAL(sp) FUNCTION date__sec2jd(kd_nsec) 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) 931 966 IMPLICIT NONE 932 967 ! Argument … … 934 969 !---------------------------------------------------------------- 935 970 936 date__sec2jd = REAL( REAL( kd_nsec , sp ) / im_secbyday, sp )971 date__sec2jd = REAL( REAL( kd_nsec , dp ) / im_secbyday, dp ) 937 972 938 973 END FUNCTION date__sec2jd 939 ! @endcode940 974 END MODULE date 941 975
Note: See TracChangeset
for help on using the changeset viewer.