dc_calendar.f90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!  Warning: This file was generated from dc_calendar.f90.erb.
!           Do not edit this file.
!-------------------------------------------------------------------------------
module dc_calendar
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use dc_log, only: &
     log_lmsg, &
     log
  use dc_types, only: &
     sp, &
     dp
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: calendarinit
  public :: calendarymdhms2sec
  public :: calendarsec2ymdhms

  interface calendarymdhms2sec
     module procedure calendarymdhms2secsp
     module procedure calendarymdhms2secdp
  end interface calendarymdhms2sec

  interface calendarsec2ymdhms
     module procedure calendarsec2ymdhmssp
     module procedure calendarsec2ymdhmsdp
  end interface calendarsec2ymdhms

  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  real(DP), private, parameter :: time_hour    =  24.d0
  real(DP), private, parameter :: time_min     =  60.d0
  real(DP), private, parameter :: time_sec     =  60.d0

  character(len=LOG_LMSG), private :: message
  !-----------------------------------------------------------------------------
contains

  !-----------------------------------------------------------------------------
  !-----------------------------------------------------------------------------
  subroutine calendarinit
    implicit none

    return
  end subroutine calendarinit

  !-----------------------------------------------------------------------------
  ! interface CalendarYmdhms2sec
  !-----------------------------------------------------------------------------
  !@todo fit to gregorian calendar
  !-----------------------------------------------------------------------------
  subroutine calendarymdhms2secsp( &
     second, &
     value,  &
     unit    )
    implicit none

    real(SP),         intent(out) :: second
    real(SP),         intent( in) :: value
    character(len=*), intent( in) :: unit
    !---------------------------------------------------------------------------

    select case(trim(unit))
    case('MSEC','msec')
       second = value * 1.0e-3_sp
    case('SEC','sec','s')
       second = value
    case('MIN','min')
       second = value * time_sec
    case('HOUR','hour','h')
       second = value * time_sec * time_min
    case('DAY','day')
       second = value * time_sec * time_min * time_hour
    case default
       write(message,*) ' xxx Unsupported UNIT:', trim(unit), value
       call log('E', message)
    endselect

    return
  end subroutine calendarymdhms2secsp
  subroutine calendarymdhms2secdp( &
     second, &
     value,  &
     unit    )
    implicit none

    real(DP),         intent(out) :: second
    real(DP),         intent( in) :: value
    character(len=*), intent( in) :: unit
    !---------------------------------------------------------------------------

    select case(trim(unit))
    case('MSEC','msec')
       second = value * 1.0e-3_dp
    case('SEC','sec','s')
       second = value
    case('MIN','min')
       second = value * time_sec
    case('HOUR','hour','h')
       second = value * time_sec * time_min
    case('DAY','day')
       second = value * time_sec * time_min * time_hour
    case default
       write(message,*) ' xxx Unsupported UNIT:', trim(unit), value
       call log('E', message)
    endselect

    return
  end subroutine calendarymdhms2secdp

  !-----------------------------------------------------------------------------
  ! interface CalendarSec2ymdhms
  !-----------------------------------------------------------------------------
  !@todo fit to gregorian calendar
  !-----------------------------------------------------------------------------
  subroutine calendarsec2ymdhmssp( &
     value,  &
     second, &
     unit    )
    implicit none

    real(SP),         intent(out) :: value
    real(SP),         intent( in) :: second
    character(len=*), intent( in) :: unit
    !---------------------------------------------------------------------------

    select case(trim(unit))
    case('MSEC', 'msec')
       value = second / 1.0e-3_sp
    case('SEC', 'seconds', 'sec', 's')
       value = second
    case('MIN', 'mins', 'min')
       value = second / time_sec
    case('HOUR', 'hours', 'hour', 'h')
       value = second / (time_sec * time_min)
    case('DAY', 'days', 'day')
       value = second / (time_sec * time_min * time_hour)
    case default
       write(message,*) ' xxx Unsupported UNIT:', trim(unit), value
       call log('E', message)
    endselect

    return
  end subroutine calendarsec2ymdhmssp
  subroutine calendarsec2ymdhmsdp( &
     value,  &
     second, &
     unit    )
    implicit none

    real(DP),         intent(out) :: value
    real(DP),         intent( in) :: second
    character(len=*), intent( in) :: unit
    !---------------------------------------------------------------------------

    select case(trim(unit))
    case('MSEC', 'msec')
       value = second / 1.0e-3_dp
    case('SEC', 'seconds', 'sec', 's')
       value = second
    case('MIN', 'mins', 'min')
       value = second / time_sec
    case('HOUR', 'hours', 'hour', 'h')
       value = second / (time_sec * time_min)
    case('DAY', 'days', 'day')
       value = second / (time_sec * time_min * time_hour)
    case default
       write(message,*) ' xxx Unsupported UNIT:', trim(unit), value
       call log('E', message)
    endselect

    return
  end subroutine calendarsec2ymdhmsdp

  !-----------------------------------------------------------------------------
end module dc_calendar
!-------------------------------------------------------------------------------


!--
! vi:set readonly sw=4 ts=8
!
!Local Variables:
!mode: f90
!buffer-read-only: t
!End:
!
!++