!
! DateTime_Utility
!
! Module defining the DateTime structure and utility routines.
!
!
! CREATION HISTORY:
!       Written by:     Paul van Delst, 14-Sep-2007
!                       paul.vandelst@noaa.gov
!

MODULE DateTime_Utility

  ! -----------------
  ! Environment setup
  ! -----------------
  USE Type_Kinds  , ONLY: fp
  USE Date_Utility, ONLY: IsLeapYear , &
                          DayOfYear  , &
                          DaysInMonth, &
                          NameOfMonth, &
                          DayOfWeek
  ! Disable implicit typing
  IMPLICIT NONE


  ! ------------
  ! Visibilities
  ! ------------
  PRIVATE
  ! Datatpye
  PUBLIC :: DateTime_type
  ! Procedures
  PUBLIC :: DateTime_Now
  PUBLIC :: DateTime_IsLeapYear
  PUBLIC :: DateTime_DayOfYear
  PUBLIC :: DateTime_DaysInMonth
  PUBLIC :: DateTime_NameOfMonth
  PUBLIC :: DateTime_DayOfWeek
  PUBLIC :: DateTime_Inspect
  PUBLIC :: DateTime_ToString


  ! -----------------
  ! Module parameters
  ! -----------------
  CHARACTER(*), PARAMETER :: MODULE_VERSION_ID = &
  '$Id: DateTime_Utility.f90 99117 2017-11-27 18:37:14Z tong.zhu@noaa.gov $'
  INTEGER, PARAMETER :: NL = 20


  ! -----------------------
  ! Derived type definition
  ! -----------------------
  !:tdoc+:
  TYPE :: DateTime_type
    INTEGER :: Year        = 0
    INTEGER :: Month       = 0
    INTEGER :: Day         = 0
    INTEGER :: UTC_Delta   = 0
    INTEGER :: Hour        = 0
    INTEGER :: Minute      = 0
    INTEGER :: Second      = 0
    INTEGER :: Millisecond = 0
    INTEGER :: DoY         = 0
    CHARACTER(NL) :: Month_Name
    CHARACTER(NL) :: Day_Name
  END TYPE DateTime_type
  !:tdoc-:


CONTAINS


!------------------------------------------------------------------------------
!:sdoc+:
! NAME:
!       DateTime_Now
!
! PURPOSE:
!       Function to return a DateTime structure with the current
!       date and time
!
! CALLING SEQUENCE:
!       DateTime = DateTime_Now()
!
! FUNCTION RESULT:
!       DateTime:  DateTime structure containing current date and time.
!                  UNITS:      N/A
!                  TYPE:       DateTime_type
!                  DIMENSION:  Scalar
!:sdoc-:
!------------------------------------------------------------------------------

  FUNCTION DateTime_Now() RESULT(DateTime)
    TYPE(DateTime_type) :: DateTime
    INTEGER :: Values(8)
    CALL DATE_AND_TIME(VALUES=Values)
    DateTime%Year        = Values(1)
    DateTime%Month       = Values(2)
    DateTime%Day         = Values(3)
    DateTime%UTC_Delta   = Values(4)
    DateTime%Hour        = Values(5)
    DateTime%Minute      = Values(6)
    DateTime%Second      = Values(7)
    DateTime%Millisecond = Values(8)
    DateTime%DoY        = DateTime_DayOfYear( DateTime )
    DateTime%Month_Name = DateTime_NameOfMonth( DateTime )
    DateTime%Day_Name   = DateTime_DayOfWeek( DateTime )
  END FUNCTION DateTime_Now


!------------------------------------------------------------------------------
!:sdoc+:
! NAME:
!       DateTime_IsLeapYear
!
! PURPOSE:
!       Elemental function to determine if a specified DateTime structure
!       is for a leap year.
!
! CALLING SEQUENCE:
!       Result = DateTime_IsLeapYear( DateTime )
!
! INPUTS:
!       DateTime:  DateTime structure containing date information.
!                  UNITS:      N/A
!                  TYPE:       DateTime_type
!                  DIMENSION:  Scalar or any rank
!                  ATTRIBUTES: OPTIONAL, INTENT(IN)
!
! FUNCTION RESULT:
!       Result:    The return value is a logical value indicating whether
!                  the specified year is a leap year.
!                  If .TRUE.  the specified year IS a leap year.
!                     .FALSE. the specified year is NOT a leap year
!                  UNITS:      N/A
!                  TYPE:       LOGICAL
!                  DIMENSION:  Same as input
!:sdoc-:
!------------------------------------------------------------------------------

  ELEMENTAL FUNCTION DateTime_IsLeapYear( DateTime )
    TYPE(DateTime_type), INTENT(IN) :: DateTime
    LOGICAL :: DateTime_IsLeapYear
    DateTime_IsLeapYear = IsLeapYear( DateTime%Year )
  END FUNCTION DateTime_IsLeapYear


!------------------------------------------------------------------------------
!:sdoc+:
! NAME:
!       DateTime_DayOfYear
!
! PURPOSE:
!       Elemental function to determine the day-of-year value for a
!       a DateTime structure.
!
! CALLING SEQUENCE:
!       DoY = DateTime_DayOfYear( DateTime )
!
! INPUTS:
!       DateTime:  DateTime structure containing date information.
!                  UNITS:      N/A
!                  TYPE:       DateTime_type
!                  DIMENSION:  Scalar
!                  ATTRIBUTES: INTENT(IN)
!
! FUNCTION RESULT:
!       DoY:       Integer defining the day-of-year.
!                  Return value is 0 for invalid input.
!                  UNITS:      N/A
!                  TYPE:       INTEGER
!                  DIMENSION:  Scalar
!:sdoc-:
!------------------------------------------------------------------------------

  ELEMENTAL FUNCTION DateTime_DayOfYear( DateTime ) RESULT( DoY )
    TYPE(DateTime_type), INTENT(IN) :: DateTime
    INTEGER :: DoY
    DoY = DayOfYear( DateTime%Day, DateTime%Month, DateTime%Year )
  END FUNCTION DateTime_DayOfYear


!------------------------------------------------------------------------------
!:sdoc+:
! NAME:
!       DateTime_DaysInMonth
!
! PURPOSE:
!       Elemental function to return the number of days in a given
!       month and year.
!
! CALLING SEQUENCE:
!       n_Days = DateTime_DaysInMonth( DateTime )
!
! INPUTS:
!       DateTime:  DateTime structure containing date information.
!                  UNITS:      N/A
!                  TYPE:       DateTime_type
!                  DIMENSION:  Scalar
!                  ATTRIBUTES: INTENT(IN)
!
! FUNCTION RESULT:
!       n_Days:    The number of days in the month.
!                  Return value is 0 for invalid input.
!                  UNITS:      N/A
!                  TYPE:       INTEGER
!                  DIMENSION:  Same as input
!:sdoc-:
!------------------------------------------------------------------------------

  ELEMENTAL FUNCTION DateTime_DaysInMonth( DateTime ) RESULT( n_Days )
    TYPE(DateTime_type), INTENT(IN) :: DateTime
    INTEGER :: n_Days
    n_Days = DaysInMonth( DateTime%Month, DateTime%Year )
  END FUNCTION DateTime_DaysInMonth


!------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       DateTime_NameOfMonth
!
! PURPOSE:
!       Elemental function to return the name of the month.
!
! CALLING SEQUENCE:
!       name = DateTime_NameOfMonth( DateTime )
!
! INPUT ARGUMENTS:
!       DateTime:  DateTime structure containing date information.
!                  UNITS:      N/A
!                  TYPE:       DateTime_type
!                  DIMENSION:  Scalar
!                  ATTRIBUTES: INTENT(IN)
!
! FUNCTION RESULT:
!       name:      The return value is a character string containing the
!                  name of the month.
!                  UNITS:      N/A
!                  TYPE:       CHARACTER
!                  DIMENSION:  Conformable with input DateTime arugment
!:sdoc-:
!------------------------------------------------------------------------------

  ELEMENTAL FUNCTION DateTime_NameOfMonth( DateTime ) RESULT( name )
    TYPE(DateTime_type), INTENT(IN) :: DateTime
    CHARACTER(NL) :: name
    name = NameOfMonth( DateTime%Month )
  END FUNCTION DateTime_NameOfMonth


!------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       DateTime_DayOfWeek
!
! PURPOSE:
!       Elemental function to return the name of the day of week.
!
! CALLING SEQUENCE:
!       name = DateTime_DayOfWeek( DateTime )
!
! INPUT ARGUMENTS:
!       DateTime:  DateTime structure containing date information.
!                  UNITS:      N/A
!                  TYPE:       DateTime_type
!                  DIMENSION:  Scalar
!                  ATTRIBUTES: INTENT(IN)
!
! FUNCTION RESULT:
!       name:      The return value is a character string containing the
!                  name of the day of the week.
!                  UNITS:      N/A
!                  TYPE:       CHARACTER
!                  DIMENSION:  Conformable with input DateTime argument.
!
!:sdoc-:
!------------------------------------------------------------------------------

  ELEMENTAL FUNCTION DateTime_DayOfWeek( DateTime ) RESULT( name )
    TYPE(DateTime_type), INTENT(IN) :: DateTime
    CHARACTER(NL) :: name
    name = DayOfWeek( DateTime%Day, DateTime%Month, DateTime%Year )
  END FUNCTION DateTime_DayOfWeek


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!   DateTime_Inspect
!
! PURPOSE:
!   Subroutine to print the contents of a DateTime object to stdout.
!
! CALLING SEQUENCE:
!   CALL DateTime_Inspect( datetime )
!
! OBJECTS:
!   DateTime:  DateTime object to display.
!              UNITS:      N/A
!              TYPE:       DateTime_type
!              DIMENSION:  Scalar
!              ATTRIBUTES: INTENT(IN)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  SUBROUTINE DateTime_Inspect( self )
    TYPE(DateTime_type), INTENT(IN) :: self
    WRITE(*,'(1x,"DateTime OBJECT")')
    WRITE(*,'(3x,"Year        : ",i0)') self%Year
    WRITE(*,'(3x,"Month       : ",i0)') self%Month
    WRITE(*,'(3x,"Day         : ",i0)') self%Day
    WRITE(*,'(3x,"UTC_Delta   : ",i0)') self%UTC_Delta
    WRITE(*,'(3x,"Hour        : ",i0)') self%Hour
    WRITE(*,'(3x,"Minute      : ",i0)') self%Minute
    WRITE(*,'(3x,"Second      : ",i0)') self%Second
    WRITE(*,'(3x,"Millisecond : ",i0)') self%Millisecond
    WRITE(*,'(3x,"DoY         : ",i0)') self%DoY
    WRITE(*,'(3x,"Month_Name  : ",a)') TRIM(self%Month_Name)
    WRITE(*,'(3x,"Day_Name    : ",a)') TRIM(self%Day_Name)
  END SUBROUTINE DateTime_Inspect


!------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       DateTime_ToString
!
! PURPOSE:
!       Elemental function to return the equivalent string representation
!       of the DateTime object.
!
! CALLING SEQUENCE:
!       string = DateTime_ToString( DateTime, Format=format )
!
! OBJECTS:
!       DateTime:  DateTime structure containing date information.
!                  UNITS:      N/A
!                  TYPE:       DateTime_type
!                  DIMENSION:  Scalar or any rank
!                  ATTRIBUTES: INTENT(IN)
!
! OPTIONAL INPUTS:
!       Format:    A single character code to determine the output
!                  string format. Valid format codes are:
!
!   'd'        Short Date pattern.               6/15/2009 1:45:30 PM -> 06/15/2009
!   'D'        Long Date pattern.                6/15/2009 1:45:30 PM -> Monday, June 15, 2009
!   'f'        Full Date Short Time pattern.     6/15/2009 1:45:30 PM -> Monday, June 15, 2009 13:45
!   'F'        Full Date Long Time pattern.      6/15/2009 1:45:30 PM -> Monday, June 15, 2009 13:45:30
!   'g'        General Date Short Time pattern.  6/15/2009 1:45:30 PM -> 06/15/2009 13:45
!   'G'        General Date Long Time pattern.   6/15/2009 1:45:30 PM -> 06/15/2009 13:45:30
!   'm','M'    Month pattern.                    6/15/2009 1:45:30 PM -> June 15
!   'o','O'    Round-trip pattern.               6/15/2009 1:45:30 PM -> 2009-06-15T13:45:30.0900000
!   'r','R'  * RFC1123 pattern.                  6/15/2009 1:45:30 PM -> Mon, 15 Jun 2009 20:45:30 GMT
!   's'        Sortable pattern.                 6/15/2009 1:45:30 PM -> 2009-06-15T13:45:30
!   't'        Short Time pattern.               6/15/2009 1:45:30 PM -> 13:45
!   'T'        Long Time pattern.                6/15/2009 1:45:30 PM -> 13:45:30
!   'u'      * Universal Sortable pattern.       6/15/2009 1:45:30 PM -> 2009-06-15 20:45:30Z
!   'U'      * Universal Full pattern.           6/15/2009 1:45:30 PM -> Monday, June 15, 2009 20:45:30
!   'y','Y'    Year Month pattern.               6/15/2009 1:45:30 PM -> June, 2009
!
!                  Format codes marked with a "*" are not yet implemented.
!                  UNITS:      N/A
!                  TYPE:       CHARACTER
!                  DIMENSION:  Conformable with the DateTime input.
!                  ATTRIBUTES: INTENT(IN), OPTIONAL
!
! FUNCTION RESULT:
!       string:    Equivalent string representation of the DateTime object.
!                  UNITS:      N/A
!                  TYPE:       CHARACTER
!                  DIMENSION:  Conformable with input DateTime argument.
!
!:sdoc-:
!------------------------------------------------------------------------------

  ELEMENTAL FUNCTION DateTime_ToString( DateTime, Format ) RESULT( string )
    ! Arguments
    TYPE(DateTime_type),           INTENT(IN) :: DateTime
    CHARACTER(*)       , OPTIONAL, INTENT(IN) :: Format
    ! Function result
    CHARACTER(80) :: string
    ! Local variables
    CHARACTER(1) :: string_format
    REAL(fp) :: seconds

    ! Define default format
    string_format = 'd'
    IF ( PRESENT(Format) ) string_format = TRIM(ADJUSTL(Format))


    ! Begin monster select construct
    ! NOTE: This is a brain dead way to implement. But quick. :o)
    SELECT CASE(string_format)

      CASE('d')      ! Short Date pattern.  6/15/2009 1:45:30 PM -> 06/15/2009
        WRITE(string,'(i2.2,"/",i2.2,"/",i4)') &
                     DateTime%Month, DateTime%Day, DateTime%Year

      CASE('D')      ! Long Date pattern.  6/15/2009 1:45:30 PM -> Monday, June 15, 2009
        WRITE(string,'(a,", ",a,1x,i0,", ",i4)') &
                     TRIM(DateTime_DayOfWeek(DateTime)), &
                     TRIM(DateTime_NameOfMonth(DateTime)), &
                     DateTime%Day, DateTime%Year

      CASE('f')      ! Full Date Short Time pattern.  6/15/2009 1:45:30 PM -> Monday, June 15, 2009 13:45
        WRITE(string,'(a,", ",a,1x,i0,", ",i4,1x,i2.2,":",i2.2)') &
                     TRIM(DateTime_DayOfWeek(DateTime)), &
                     TRIM(DateTime_NameOfMonth(DateTime)), &
                     DateTime%Day, DateTime%Year, &
                     DateTime%Hour, DateTime%Minute

      CASE('F')      ! Full Date Long Time pattern.  6/15/2009 1:45:30 PM -> Monday, June 15, 2009 13:45:30
        WRITE(string,'(a,", ",a,1x,i0,", ",i4,1x,i2.2,":",i2.2,":",i2.2)') &
                     TRIM(DateTime_DayOfWeek(DateTime)), &
                     TRIM(DateTime_NameOfMonth(DateTime)), &
                     DateTime%Day, DateTime%Year, &
                     DateTime%Hour, DateTime%Minute, DateTime%Second

      CASE('g')      ! General Date Short Time pattern.  6/15/2009 1:45:30 PM -> 06/15/2009 13:45
        WRITE(string,'(i2.2,"/",i2.2,"/",i4,1x,i2.2,":",i2.2)') &
                     DateTime%Month, DateTime%Day, DateTime%Year, &
                     DateTime%Hour, DateTime%Minute

      CASE('G')      ! General Date Long Time pattern.  6/15/2009 1:45:30 PM -> 06/15/2009 13:45:30
        WRITE(string,'(i2.2,"/",i2.2,"/",i4,1x,i2.2,":",i2.2,":",i2.2)') &
                     DateTime%Month, DateTime%Day, DateTime%Year, &
                     DateTime%Hour, DateTime%Minute, DateTime%Second

      CASE('m','M')  ! Month pattern.  6/15/2009 1:45:30 PM -> June 15
        WRITE(string,'(a,1x,i0)') &
                     TRIM(DateTime_NameOfMonth(DateTime)), DateTime%Day

      CASE('o','O')  ! Round-trip pattern.  6/15/2009 1:45:30 PM -> 2009-06-15T13:45:30.0900000
        seconds = REAL(DateTime%Second,fp) + &
                  REAL(DateTime%Millisecond,fp)*1.0e-03_fp
        WRITE(string,'(i4,"-",i2.2,"-",i2.2,"T",i2.2,":",i2.2,":",f10.7)') &
                     DateTime%Year, DateTime%Month, DateTime%Day, &
                     DateTime%Hour, DateTime%Minute, seconds

      CASE('r','R')  ! RFC1123 pattern.  6/15/2009 1:45:30 PM -> Mon, 15 Jun 2009 20:45:30 GMT
        string = 'RFC1123 format not yet implemented'

      CASE('s')      ! Sortable pattern.  6/15/2009 1:45:30 PM -> 2009-06-15T13:45:30
        WRITE(string,'(i4,"-",i2.2,"-",i2.2,"T",i2.2,":",i2.2,":",i2.2)') &
                     DateTime%Year, DateTime%Month, DateTime%Day, &
                     DateTime%Hour, DateTime%Minute, DateTime%Second

      CASE('t')      ! Short Time pattern.  6/15/2009 1:45:30 PM -> 13:45
        WRITE(string,'(i2.2,":",i2.2)') &
                     DateTime%Hour, DateTime%Minute

      CASE('T')      ! Long Time pattern.  6/15/2009 1:45:30 PM -> 13:45:30
        WRITE(string,'(i2.2,":",i2.2,":",i2.2)') &
                     DateTime%Hour, DateTime%Minute, DateTime%Second

      CASE('u')      ! Universal Sortable pattern.  6/15/2009 1:45:30 PM -> 2009-06-15 20:45:30Z
        string = 'Universal Sortable format not yet implemented'

      CASE('U')      ! Universal Full pattern.  6/15/2009 1:45:30 PM -> Monday, June 15, 2009 20:45:30
        string = 'Universal Full format not yet implemented'

      CASE('y','Y')  ! Year Month pattern. 6/15/2009 1:45:30 PM -> June, 2009
        WRITE(string,'(a,", ",i4)') &
                     TRIM(DateTime_NameOfMonth(DateTime)), DateTime%Year
      CASE DEFAULT
        string = 'Invalid DateTime string format!'

    END SELECT

  END FUNCTION DateTime_ToString

END MODULE DateTime_Utility
