!----------------------------------------------------------------------
! NEMO system team, System and Interface for oceanic RElocable Nesting
!----------------------------------------------------------------------
!
! MODULE: date
!
! DESCRIPTION:
!> @brief This module provide the calculation of Julian dates, and
!> do many manipulations with dates.
!>
!> @details
!> Actually we use Modified Julian Dates, with
!> 17 Nov 1858 at 00:00:00 as origin.
!>
!> define type TDATE:
!> @code
!> TYPE(TDATE) :: tl_date1
!> @endcode
!> default date is 17 Nov 1858 at 00:00:00
!>
!> to intialise date :
!> - from date of the day at 12:00:00 :
!> @code
!> tl_date1=date_today()
!> @endcode
!> - from date and time of the day :
!> @code
!> tl_date1=date_now()
!> @endcode
!> - from julian day :
!> @code
!> tl_date1=date_init(dd_jd)
!> @endcode
!> - dd_jd julian day (double precision)
!> - from number of second since julian day origin :
!> @code
!> tl_date1=date_init(kd_nsec)
!> @endcode
!> - kd_nsec number of second (integer 8)
!> - from year month day :
!> @code
!> tl_date1=date_init(2012,12,10)
!> @endcode
!> - from string character formatted date :
!> @code
!> tl_date1=date_init(cd_fmtdate)
!> @endcode
!> - cd_fmtdate date in format YYYY-MM-DD hh:mm:ss
!>
!> to print date in format YYYY-MM-DD hh:mm:ss
!> CHARACTER(LEN=lc) :: cl_date
!> @code
!> cl_date=date_print(tl_date1)
!> PRINT *, TRIM(cl_date)
!> @endcode
!>
!> to print date in another format (only year, month, day):
!> @code
!> cl_date=date_print(tl_date1, cd_fmt)
!> PRINT *, TRIM(cl_date)
!> @endcode
!> - cd_fmt ouput format (ex: cd_fmt="('y',i0.4,'m',i0.2,'d',i0.2)" )
!>
!> to print day of the week:
!> @code
!> PRINT *,"dow ", tl_date1\%i_dow
!> @endcode
!> to print last day of the month:
!> @code
!> PRINT *,"last day ", tl_date1\%i_lday
!> @endcode
!>
!> to know if year is a leap year:
!> @code
!> ll_isleap=date_leapyear(tl_date1)
!> @endcode
!> - ll_isleap is logical
!>
!> to compute number of days between two dates:
!> @code
!> tl_date2=date_init(2010,12,10)
!> dl_diff=tl_date1-tl_date2
!> @endcode
!> - dl_diff is the number of days between date1 and date2 (double precision)
!>
!> to add or substract nday to a date:
!> @code
!> tl_date2=tl_date1+2.
!> tl_date2=tl_date1-2.6
!> @endcode
!> - number of day (double precision)
!>
!> to print julian day:
!> @code
!> PRINT *," julian day",tl_date1\%r_jd
!> @endcode
!>
!> to print CNES julian day (origin 1950-01-01 00:00:00)
!> @code
!> PRINT *," CNES julian day",tl_date1\%r_jc
!> @endcode
!>
!> to create pseudo julian day with origin date_now:
!> @code
!> tl_date1=date_init(2012,12,10,td_dateo=date_now())
!> @endcode
!> @note you erase CNES julian day when doing so
!>
!> to print julian day in seconds:
!> @code
!> PRINT *, tl_date1\%k_jdsec
!> @endcode
!> to print CNES or new julian day in seconds:
!> @code
!> PRINT *, tl_date1\%k_jcsec
!> @endcode
!>
!> @author J.Paul
! REVISION HISTORY:
!> @date November, 2013 - Initial Version
!
!> @note This module is based on Perderabo's date calculator (ksh)
!> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!>
!> @todo
!> - see calendar.f90 and select Gregorian, NoLeap, or D360 calendar
!----------------------------------------------------------------------
MODULE date
USE global ! global variable
USE kind ! F90 kind parameter
USE fct ! basic useful function
USE logger ! log file manager
IMPLICIT NONE
! NOTE_avoid_public_variables_if_possible
! type and variable
PUBLIC :: TDATE !< date structure
PRIVATE :: cm_fmtdate !< date and time format
PRIVATE :: im_secbyday !< number of second by day
! function and subroutine
PUBLIC :: date_today !< return the date of the day at 12:00:00
PUBLIC :: date_now !< return the date and time
PUBLIC :: date_init !< initialized date structure form julian day or year month day
PUBLIC :: date_print !< print the date with format YYYY-MM-DD hh:mm:ss
PUBLIC :: date_leapyear !< check if year is a leap year
PUBLIC :: OPERATOR(-) !< substract two dates or n days to a date
PUBLIC :: OPERATOR(+) !< add n days to a date
PRIVATE :: date__init_fmtdate ! initialized date structure from character YYYY-MM-DD hh:mm:ss
PRIVATE :: date__init_jd ! initialized date structure from julian day
PRIVATE :: date__init_nsec ! initialized date structure from number of second since origin of julian day
PRIVATE :: date__init_ymd ! initialized date structure from year month day
PRIVATE :: date__addnday ! add nday to a date
PRIVATE :: date__subnday ! substract nday to a date
PRIVATE :: date__diffdate ! compute number of days between two dates
PRIVATE :: date__lastday ! compute last day of the month
PRIVATE :: date__ymd2jd ! compute julian day from year month day
PRIVATE :: date__jd2ymd ! compute year month day from julian day
PRIVATE :: date__jc2jd ! compute julian day from pseudo julian day
PRIVATE :: date__jd2jc ! compute pseudo julian day with new date origin
PRIVATE :: date__jd2dow ! compute the day of week from julian day
PRIVATE :: date__hms2jd ! compute fraction of a day from hour, minute, second
PRIVATE :: date__jd2hms ! compute hour, minute, second from julian fraction
PRIVATE :: date__check ! check date in date structure
PRIVATE :: date__adjust ! adjust date
PRIVATE :: date__jd2sec ! convert julian day in seconds since julian day origin
PRIVATE :: date__sec2jd ! convert seconds since julian day origin in julian day
TYPE TDATE !< date structure
INTEGER(i4) :: i_year = 1858 !< year
INTEGER(i4) :: i_month = 11 !< month
INTEGER(i4) :: i_day = 17 !< day
INTEGER(i4) :: i_hour = 0 !< hour
INTEGER(i4) :: i_min = 0 !< min
INTEGER(i4) :: i_sec = 0 !< sec
INTEGER(i4) :: i_dow = 0 !< day of week
INTEGER(i4) :: i_lday = 0 !< last day of the month
REAL(dp) :: d_jd = 0 !< julian day (origin : 1858/11/17 00:00:00)
REAL(dp) :: d_jc = 0 !< CNES julian day or pseudo julian day with new date origin
INTEGER(i8) :: k_jdsec = 0 !< number of seconds since julian day origin
INTEGER(i8) :: k_jcsec = 0 !< number of seconds since CNES or pseudo julian day origin
END TYPE TDATE
! module variable
CHARACTER(LEN=lc), PARAMETER :: cm_fmtdate = & !< date and time format
& "(i0.4,'-',i0.2,'-',i0.2,1x,i0.2,':',i0.2,':',i0.2)"
INTEGER(i4), PARAMETER :: im_secbyday = 86400 !< number of second by day
INTERFACE date_init
MODULE PROCEDURE date__init_jd ! initialized date structure from julian day
MODULE PROCEDURE date__init_nsec ! initialized date structure from number of second since origin of julian day
MODULE PROCEDURE date__init_ymd ! initialized date structure from year month day
MODULE PROCEDURE date__init_fmtdate ! initialized date structure from character YYYY-MM-DD hh:mm:ss
END INTERFACE date_init
INTERFACE OPERATOR(+)
MODULE PROCEDURE date__addnday ! add nday to a date
END INTERFACE
INTERFACE OPERATOR(-)
MODULE PROCEDURE date__subnday ! substract nday to a date
MODULE PROCEDURE date__diffdate ! compute number of day between two dates
END INTERFACE
CONTAINS
!-------------------------------------------------------------------
!> @brief This function print the date and time with
!> format YYYY/MM/DD hh:mm:ss.
!> @details
!> Optionally, you could specify output format. However it will be only apply
!> to year, month, day.
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[in] td_date date strutcutre
!> @param[in] cd_fmt ouput format (only for year,month,day)
!> @return date in format YYYY-MM-DD hh:mm:ss
!-------------------------------------------------------------------
CHARACTER(LEN=lc) FUNCTION date_print(td_date, cd_fmt)
IMPLICIT NONE
! Argument
TYPE(TDATE) , INTENT(IN) :: td_date
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_fmt
!----------------------------------------------------------------
IF( PRESENT(cd_fmt) )THEN
WRITE(date_print,TRIM(cd_fmt)) &
& td_date%i_year,td_date%i_month,td_date%i_day
ELSE
WRITE(date_print,cm_fmtdate) &
& td_date%i_year,td_date%i_month,td_date%i_day, &
& td_date%i_hour,td_date%i_min,td_date%i_sec
ENDIF
END FUNCTION date_print
!-------------------------------------------------------------------
!> @brief This function check if year is a leap year.
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[in] td_date date strutcutre
!> @return true if year is leap year
!-------------------------------------------------------------------
LOGICAL FUNCTION date_leapyear(td_date)
IMPLICIT NONE
! Argument
TYPE(TDATE), INTENT(IN) :: td_date
!----------------------------------------------------------------
date_leapyear=.false.
IF( (MOD(td_date%i_year,100_i4)==0) )THEN
IF( (MOD(td_date%i_year,400_i4)==0) )THEN
date_leapyear=.true.
ENDIF
ELSE
IF( (MOD(td_date%i_year,4_i4)==0) )THEN
date_leapyear=.true.
ENDIF
ENDIF
END FUNCTION date_leapyear
!-------------------------------------------------------------------
!> @brief This function return the current date and time.
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @return current date and time in a date structure
!-------------------------------------------------------------------
TYPE(TDATE) FUNCTION date_now()
IMPLICIT NONE
! local variable
INTEGER(sp), DIMENSION(8) :: il_values
!----------------------------------------------------------------
CALL DATE_AND_TIME( values= il_values)
date_now=date_init( il_values(1), il_values(2), il_values(3), &
& il_values(5), il_values(6), il_values(7) )
END FUNCTION date_now
!-------------------------------------------------------------------
!> @brief This function return the date of the day at 12:00:00.
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @return date of the day at 12:00:00 in a date structure
!-------------------------------------------------------------------
TYPE(TDATE) FUNCTION date_today()
IMPLICIT NONE
! local variable
INTEGER(sp), DIMENSION(8) :: il_values
!----------------------------------------------------------------
CALL DATE_AND_TIME( values= il_values)
date_today=date_init( il_values(1), il_values(2), il_values(3), 12_i4 )
END FUNCTION date_today
!-------------------------------------------------------------------
!> @brief This function initialized date structure from a character
!> date with format YYYY-MM-DD hh:mm:ss.
!> @details
!> Optionaly create pseudo julian day with new origin.
!> julian day origin is 17 Nov 1858 at 00:00:00
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[in] cd_date date in format YYYY-MM-DD hh:mm:ss
!> @param[in] td_dateo new date origin for pseudo julian day
!> @return date structure
!-------------------------------------------------------------------
TYPE(TDATE) FUNCTION date__init_fmtdate(cd_datetime, td_dateo)
IMPLICIT NONE
! Argument
CHARACTER(LEN=*), INTENT(IN) :: cd_datetime
TYPE(TDATE), INTENT(IN), OPTIONAL :: td_dateo
! local variable
CHARACTER(LEN=lc) :: cl_datetime
CHARACTER(LEN=lc) :: cl_date
CHARACTER(LEN=lc) :: cl_time
CHARACTER(LEN=lc) :: cl_year
CHARACTER(LEN=lc) :: cl_month
CHARACTER(LEN=lc) :: cl_day
CHARACTER(LEN=lc) :: cl_hour
CHARACTER(LEN=lc) :: cl_min
CHARACTER(LEN=lc) :: cl_sec
INTEGER(i4) :: il_year
INTEGER(i4) :: il_month
INTEGER(i4) :: il_day
INTEGER(i4) :: il_hour
INTEGER(i4) :: il_min
INTEGER(i4) :: il_sec
!----------------------------------------------------------------
cl_datetime=TRIM(ADJUSTL(cd_datetime))
cl_date=fct_split(cl_datetime,1,' ')
cl_time=fct_split(cl_datetime,2,' ')
cl_year = fct_split(cl_date,1,'-')
READ(cl_year,*) il_year
cl_month= fct_split(cl_date,2,'-')
READ(cl_month, *) il_month
cl_day = fct_split(cl_date,3,'-')
READ(cl_day, *) il_day
cl_hour = fct_split(cl_time,1,':')
READ(cl_hour, *) il_hour
cl_min = fct_split(cl_time,2,':')
READ(cl_min, *) il_min
cl_sec = fct_split(cl_time,3,':')
READ(cl_sec, *) il_sec
date__init_fmtdate = date_init( il_year, il_month, il_day, il_hour, &
& il_min, il_sec, td_dateo=td_dateo )
END FUNCTION date__init_fmtdate
!-------------------------------------------------------------------
!> @brief This function initialized date structure from julian day.
!> @details
!> Optionaly create pseudo julian day with new origin.
!> julian day origin is 17 Nov 1858 at 00:00:00
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[in] dd_jd julian day
!> @param[in] td_dateo new date origin for pseudo julian day
!
!> @return date structure of julian day
!-------------------------------------------------------------------
TYPE(TDATE) FUNCTION date__init_jd(dd_jd, td_dateo)
IMPLICIT NONE
!Argument
REAL(dp), INTENT(IN) :: dd_jd
TYPE(TDATE), INTENT(IN), OPTIONAL :: td_dateo
!----------------------------------------------------------------
IF( PRESENT(td_dateo) )THEN
CALL date__check(td_dateo)
! pseudo julian day with origin dateo
date__init_jd%d_jc=dd_jd
date__init_jd%k_jcsec=date__jd2sec(dd_jd)
! convert to truly julian day
CALL date__jc2jd(date__init_jd, td_dateo)
ELSE
date__init_jd%d_jd=dd_jd
date__init_jd%k_jdsec=date__jd2sec(dd_jd)
! compute CNES julian day
CALL date__jd2jc(date__init_jd)
ENDIF
! check input data
CALL date__check(date__init_jd)
! compute year month day hour min sec
CALL date__jd2ymd(date__init_jd)
! compute day of the wekk
CALL date__jd2dow(date__init_jd)
!compute last day of the month
date__init_jd%i_lday=date__lastday(date__init_jd)
END FUNCTION date__init_jd
!-------------------------------------------------------------------
!> @brief This function initialized date structure from number of
!> second since julian day origin.
!> @details
!> Optionaly create pseudo julian day with new origin.
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[in] kd_nsec number of second since julian day origin
!> @param[in] td_dateo new date origin for pseudo julian day
!
!> @return date structure of julian day
!-------------------------------------------------------------------
TYPE(TDATE) FUNCTION date__init_nsec(kd_nsec, td_dateo)
IMPLICIT NONE
!Argument
INTEGER(i8), INTENT(IN) :: kd_nsec
TYPE(TDATE), INTENT(IN), OPTIONAL :: td_dateo
!----------------------------------------------------------------
IF( PRESENT(td_dateo) )THEN
date__init_nsec=date_init( date__sec2jd(kd_nsec), td_dateo )
ELSE
date__init_nsec=date_init( date__sec2jd(kd_nsec) )
ENDIF
END FUNCTION date__init_nsec
!-------------------------------------------------------------------
!> @brief This function initialized date structure form year month day
!> and optionnaly hour min sec.
!> @details
!> Optionaly create pseudo julian day with new origin.
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!>
!> @param[in] id_year
!> @param[in] id_month
!> @param[in] id_day
!> @param[in] id_hour
!> @param[in] id_min
!> @param[in] id_sec
!> @param[in] td_dateo new date origin for pseudo julian day
!
!> @return date structure of year month day
!-------------------------------------------------------------------
TYPE(TDATE) FUNCTION date__init_ymd(id_year, id_month, id_day, &
& id_hour, id_min, id_sec, &
& td_dateo)
IMPLICIT NONE
!Argument
INTEGER(i4), INTENT(IN) :: id_year
INTEGER(i4), INTENT(IN) :: id_month
INTEGER(i4), INTENT(IN) :: id_day
INTEGER(i4), INTENT(IN), OPTIONAL :: id_hour
INTEGER(i4), INTENT(IN), OPTIONAL :: id_min
INTEGER(i4), INTENT(IN), OPTIONAL :: id_sec
TYPE(TDATE), INTENT(IN), OPTIONAL :: td_dateo
!----------------------------------------------------------------
date__init_ymd%i_year=id_year
date__init_ymd%i_month=id_month
date__init_ymd%i_day=id_day
IF( PRESENT(id_hour) )THEN
date__init_ymd%i_hour=id_hour
ENDIF
IF( PRESENT(id_min) )THEN
date__init_ymd%i_min=id_min
ENDIF
IF( PRESENT(id_sec) )THEN
date__init_ymd%i_sec=id_sec
ENDIF
! check input data
CALL date__check(date__init_ymd)
! compute julian day
CALL date__ymd2jd(date__init_ymd)
IF( PRESENT(td_dateo) )THEN
CALL date__check(td_dateo)
! compute julian day with origin dateo
CALL date__jd2jc(date__init_ymd, td_dateo)
ELSE
! compute CNES julian day
CALL date__jd2jc(date__init_ymd)
ENDIF
! compute day of the week
CALL date__jd2dow(date__init_ymd)
!compute last day of the month
date__init_ymd%i_lday=date__lastday(date__init_ymd)
END FUNCTION date__init_ymd
!-------------------------------------------------------------------
!> @brief This function compute number of day between two dates:
!> nday= date1 - date2
!
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[in] td_date1 first date strutcutre
!> @param[in] td_date2 second date strutcutre
!> @return nday
!-------------------------------------------------------------------
REAL(dp) FUNCTION date__diffdate(td_date1, td_date2)
IMPLICIT NONE
!Argument
TYPE(TDATE), INTENT(IN) :: td_date1
TYPE(TDATE), INTENT(IN) :: td_date2
!----------------------------------------------------------------
! check year month day hour min sec
CALL date__check(td_date1)
CALL date__check(td_date2)
date__diffdate = td_date1%d_jd - td_date2%d_jd
END FUNCTION date__diffdate
!-------------------------------------------------------------------
!> @brief This function substract nday to a date:
!> date2 = date1 - nday
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[in] td_date date strutcutre
!> @param[in] dd_nday number of day
!> @return date strutcutre of date - nday
!-------------------------------------------------------------------
TYPE(TDATE) FUNCTION date__subnday(td_date, dd_nday)
IMPLICIT NONE
!Argument
TYPE(TDATE), INTENT(IN) :: td_date
REAL(dp), INTENT(IN) :: dd_nday
!----------------------------------------------------------------
! check year month day hour min sec
CALL date__check(td_date)
date__subnday=date__init_jd(td_date%d_jd-dd_nday)
END FUNCTION date__subnday
!-------------------------------------------------------------------
!> @brief This function add nday to a date:
!> date2 = date1 + nday
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[in] td_date date strutcutre
!> @param[in] dd_nday number of day
!> @return date strutcutre of date + nday
!-------------------------------------------------------------------
TYPE(TDATE) FUNCTION date__addnday(td_date, dd_nday)
IMPLICIT NONE
!Argument
TYPE(TDATE), INTENT(IN) :: td_date
REAL(dp), INTENT(IN) :: dd_nday
!----------------------------------------------------------------
! check year month day hour min sec
CALL date__check(td_date)
date__addnday=date__init_jd(td_date%d_jd+dd_nday)
END FUNCTION date__addnday
!-------------------------------------------------------------------
!> @brief This subroutine compute last day of the month
!
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[in] td_date date strutcutre
!> @return last day of the month
!-------------------------------------------------------------------
INTEGER(i4) FUNCTION date__lastday(td_date)
IMPLICIT NONE
! Argument
TYPE(TDATE), INTENT(IN) :: td_date
! local variable
INTEGER, DIMENSION(12), PARAMETER :: il_lastdaytab = &
& (/31,28,31,30,31,30,31,31,30,31,30,31/)
!----------------------------------------------------------------
! general case
IF( td_date%i_month /= 2 )THEN
date__lastday=il_lastdaytab(td_date%i_month)
ELSE
IF( date_leapyear(td_date) )THEN
date__lastday=29
ELSE
date__lastday=il_lastdaytab(td_date%i_month)
ENDIF
ENDIF
END FUNCTION date__lastday
!-------------------------------------------------------------------
!> @brief This subroutine compute julian day from year month day , and fill
!> input date strutcutre.
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[inout] td_date date strutcutre
!-------------------------------------------------------------------
SUBROUTINE date__ymd2jd(td_date)
IMPLICIT NONE
! Argument
TYPE(TDATE), INTENT(INOUT) :: td_date
! local variable
REAL(dp) :: dl_standard_jd
REAL(dp) :: dl_frac
!----------------------------------------------------------------
dl_standard_jd= td_date%i_day - 32075 &
& + 1461 * (td_date%i_year + 4800 - (14 - td_date%i_month)/12)/4 &
& + 367 * (td_date%i_month - 2 + (14 - td_date%i_month)/12*12)/12 &
& - 3 * ((td_date%i_year + 4900 - (14 - td_date%i_month)/12)/100)/4
td_date%d_jd = dl_standard_jd-2400001 ! origin : 17 nov 1858 h00m00s00
! compute fraction of day
dl_frac=date__hms2jd(td_date)
td_date%d_jd = td_date%d_jd + dl_frac
td_date%k_jdsec = date__jd2sec( td_date%d_jd )
END SUBROUTINE date__ymd2jd
!-------------------------------------------------------------------
!> @brief This subroutine compute year month day from julian day, and fill
!> input date strutcutre.
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[inout] td_date date strutcutre
!-------------------------------------------------------------------
SUBROUTINE date__jd2ymd(td_date)
IMPLICIT NONE
! Argument
TYPE(TDATE), INTENT(INOUT) :: td_date
! local variable
INTEGER(i4) :: il_standard_jd
INTEGER(i4) :: il_temp1
INTEGER(i4) :: il_temp2
!----------------------------------------------------------------
! check year month day hour min sec
CALL date__check(td_date)
il_standard_jd=INT( td_date%d_jd+2400001, i4 )
il_temp1=il_standard_jd + 68569
il_temp2=4*il_temp1/146097
il_temp1=il_temp1 - (146097 * il_temp2 + 3) / 4
td_date%i_year = 4000 * (il_temp1 + 1) / 1461001
il_temp1 = il_temp1 - 1461 * td_date%i_year/4 + 31
td_date%i_month = 80 * il_temp1 / 2447
td_date%i_day = il_temp1 - 2447 * td_date%i_month / 80
il_temp1 = td_date%i_month / 11
td_date%i_month = td_date%i_month + 2 - 12 * il_temp1
td_date%i_year = 100 * (il_temp2 - 49) + td_date%i_year + il_temp1
! compute hour, minute, second from julian fraction
CALL date__jd2hms(td_date)
! adjust date
CALL date__adjust(td_date)
END SUBROUTINE date__jd2ymd
!-------------------------------------------------------------------
!> @brief This subroutine compute julian day from pseudo julian day
!> with new date origin, and fill input date strutcutre.
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[inout] td_date date
!> @param[in] td_dateo new date origin for pseudo julian day
!-------------------------------------------------------------------
SUBROUTINE date__jc2jd(td_date, td_dateo)
IMPLICIT NONE
! Argument
TYPE(TDATE), INTENT(INOUT) :: td_date
TYPE(TDATE), INTENT(IN) :: td_dateo
! local variable
TYPE(TDATE) :: tl_date
REAL(dp) :: dl_nday
!----------------------------------------------------------------
! origin julian day
tl_date=date_init(1858,11,17)
dl_nday=td_dateo-tl_date
! compute julian day
td_date%d_jd = td_date%d_jc + dl_nday
! compute number of second since julian day origin
td_date%k_jdsec = date__jd2sec(td_date%d_jd)
END SUBROUTINE date__jc2jd
!-------------------------------------------------------------------
!> @brief This subroutine compute pseudo julian day with new date origin, and
!> fill input date structure.
!> default new origin is CNES julian day origin: 1950-01-01 00:00:00
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[inout] td_date date
!> @param[in] td_dateo new origin date
!-------------------------------------------------------------------
SUBROUTINE date__jd2jc(td_date, td_dateo)
IMPLICIT NONE
! Argument
TYPE(TDATE), INTENT(INOUT) :: td_date
TYPE(TDATE), INTENT(IN), OPTIONAL :: td_dateo
! local variable
TYPE(TDATE) :: tl_dateo
!----------------------------------------------------------------
IF( PRESENT(td_dateo) )THEN
td_date%d_jc=td_date%d_jd-td_dateo%d_jd
ELSE
! CNES julian day origin
tl_dateo%i_year = 1950
tl_dateo%i_month = 1
tl_dateo%i_day = 1
CALL date__ymd2jd(tl_dateo)
td_date%d_jc = td_date%d_jd-tl_dateo%d_jd
ENDIF
td_date%k_jcsec = date__jd2sec(td_date%d_jc)
END SUBROUTINE date__jd2jc
!-------------------------------------------------------------------
!> @brief This subroutine compute the day of week from julian day, and fill
!> input date structure.
!> days : Sunday Monday Tuesday Wednesday Thursday Friday Saturday
!> numday : 0 1 2 3 4 5 6
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[inout] td_date date strutcutre
!-------------------------------------------------------------------
SUBROUTINE date__jd2dow(td_date)
IMPLICIT NONE
! Argument
TYPE(TDATE), INTENT(INOUT) :: td_date
!----------------------------------------------------------------
td_date%i_dow=MOD((INT(AINT(td_date%d_jd))+3),7)
END SUBROUTINE date__jd2dow
!-------------------------------------------------------------------
!> @brief This function compute fraction of a day from
!> hour, minute, second.
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[in] td_date date strutcutre
!> @return fraction of the day
!-------------------------------------------------------------------
REAL(dp) FUNCTION date__hms2jd(td_date)
IMPLICIT NONE
! Argument
TYPE(TDATE), INTENT(IN) :: td_date
!----------------------------------------------------------------
! compute real seconds
date__hms2jd = REAL( td_date%i_sec, dp )
! compute real minutes
date__hms2jd = REAL( td_date%i_min, dp ) + date__hms2jd/60.0
! compute real hours
date__hms2jd = REAL( td_date%i_hour, dp ) + date__hms2jd/60.0
! julian fraction of a day
date__hms2jd = date__hms2jd/24.0
END FUNCTION date__hms2jd
!-------------------------------------------------------------------
!> @brief This subroutine compute hour, minute, second from julian
!> fraction, and fill date structure.
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[inout] td_date date strutcutre
!-------------------------------------------------------------------
SUBROUTINE date__jd2hms(td_date)
IMPLICIT NONE
! Argument
TYPE(TDATE), INTENT(INOUT) :: td_date
!local variable
REAL(dp) :: dl_fract
!----------------------------------------------------------------
dl_fract=(td_date%d_jd)-AINT(td_date%d_jd)
! compute hour
td_date%i_hour = INT( dl_fract * 24.0, i4 )
dl_fract = ( dl_fract - REAL( td_date%i_hour, dp ) / 24.0) * 24.0
! compute minute
td_date%i_min = INT( dl_fract * 60.0, i4 )
dl_fract = ( dl_fract - REAL( td_date%i_min, dp ) / 60.0) * 60.0
! compute second
td_date%i_sec = NINT( dl_fract * 60.0, i4 )
END SUBROUTINE date__jd2hms
!-------------------------------------------------------------------
!> @brief This subroutine check date express in date structure
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[in] td_date date strutcutre
!-------------------------------------------------------------------
SUBROUTINE date__check(td_date)
IMPLICIT NONE
! Argument
TYPE(TDATE), INTENT(IN) :: td_date
! local variable
INTEGER(i4) :: il_lastday
INTEGER(i4) :: il_status
CHARACTER(LEN=lc) :: cl_msg
!----------------------------------------------------------------
! init
il_status=0
! check year
IF( td_date%i_year < 1858_i4 .OR. td_date%i_year > 39999_i4 )THEN
il_status=il_status+1
WRITE(cl_msg,*) "year ",td_date%i_year," out of range"
CALL logger_error(cl_msg)
ENDIF
! check month
IF( td_date%i_month < 1_i4 .OR. td_date%i_month > 12_i4 )THEN
il_status=il_status+1
WRITE(cl_msg,*) "month ",td_date%i_month," out of range"
CALL logger_error(cl_msg)
ENDIF
! check day
il_lastday=date__lastday(td_date)
IF( td_date%i_day < 1_i4 .OR. td_date%i_day > il_lastday )THEN
il_status=il_status+1
WRITE(cl_msg,*) "day ",td_date%i_day," out of range"
CALL logger_error(cl_msg)
ENDIF
! check hour
IF( td_date%i_hour < 0_i4 .OR. td_date%i_hour > 23_i4 )THEN
il_status=il_status+1
WRITE(cl_msg,*) "hour ",td_date%i_hour," out of range"
CALL logger_error(cl_msg)
ENDIF
! check minutes
IF( td_date%i_min < 0_i4 .OR. td_date%i_min > 59_i4 )THEN
il_status=il_status+1
WRITE(cl_msg,*) "minutes ",td_date%i_min," out of range"
CALL logger_error(cl_msg)
ENDIF
! check seconds
IF( td_date%i_sec < 0_i4 .OR. td_date%i_sec > 59_i4 )THEN
il_status=il_status+1
WRITE(cl_msg,*) "seconds ",td_date%i_sec," out of range"
CALL logger_error(cl_msg)
ENDIF
! check julian day
IF( td_date%d_jd < 0_sp .OR. td_date%d_jd > 782028_sp )THEN
il_status=il_status+1
WRITE(cl_msg,*) "julian day ",td_date%d_jd," out of range"
CALL logger_error(cl_msg)
ENDIF
IF( il_status/= 0 )THEN
WRITE(cl_msg,*) " date error"
CALL logger_fatal(cl_msg)
ENDIF
END SUBROUTINE date__check
!-------------------------------------------------------------------
!> @brief This subroutine adjust date (correct hour, minutes, and seconds
!> value if need be)
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[inout] td_date date strutcutre
!-------------------------------------------------------------------
SUBROUTINE date__adjust(td_date)
IMPLICIT NONE
! Argument
TYPE(TDATE), INTENT(INOUT) :: td_date
!----------------------------------------------------------------
IF( td_date%i_sec == 60 )THEN
td_date%i_sec=0
td_date%i_min=td_date%i_min+1
ENDIF
IF( td_date%i_min == 60 )THEN
td_date%i_min=0
td_date%i_hour=td_date%i_hour+1
ENDIF
IF( td_date%i_hour == 24 )THEN
td_date%i_hour=0
td_date=date__addnday(td_date,1._dp)
ENDIF
END SUBROUTINE date__adjust
!-------------------------------------------------------------------
!> @brief This function convert julian day in seconds
!> since julian day origin.
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[in] td_date date strutcutre
!> @return number of seconds since julian day origin
!-------------------------------------------------------------------
INTEGER(i8) FUNCTION date__jd2sec(dd_jul)
IMPLICIT NONE
! Argument
REAL(dp), INTENT(IN) :: dd_jul
!----------------------------------------------------------------
date__jd2sec = NINT( dd_jul * im_secbyday, i8 )
END FUNCTION date__jd2sec
!-------------------------------------------------------------------
!> @brief This function convert seconds since julian day origin in
!> julian day.
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[in] kd_nsec number of second since julian day origin
!> @return julian day
!-------------------------------------------------------------------
REAL(dp) FUNCTION date__sec2jd(kd_nsec)
IMPLICIT NONE
! Argument
INTEGER(i8), INTENT(IN) :: kd_nsec
!----------------------------------------------------------------
date__sec2jd = REAL( REAL( kd_nsec , dp ) / im_secbyday, dp )
END FUNCTION date__sec2jd
END MODULE date