scale_calendar.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#include "scalelib.h"
module scale_calendar
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_io
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: calendar_setup
  public :: calendar_getdayofyear
  public :: calendar_date2daysec
  public :: calendar_daysec2date
  public :: calendar_ymd2absday
  public :: calendar_hms2abssec
  public :: calendar_adjust_daysec
  public :: calendar_combine_daysec
  public :: calendar_unit2sec
  public :: calendar_sec2unit
  public :: calendar_cfunits2sec
  public :: calendar_date2char
  public :: calendar_get_name
 
  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  integer, public, parameter :: i_year  = 1
  integer, public, parameter :: i_month = 2
  integer, public, parameter :: i_day   = 3
  integer, public, parameter :: i_hour  = 4
  integer, public, parameter :: i_min   = 5
  integer, public, parameter :: i_sec   = 6
 
  real(dp), public :: calendar_doi  = 365.0_dp 
  real(dp), public :: calendar_hour = 24.0_dp  
  real(dp), public :: calendar_min  = 60.0_dp  
  real(dp), public :: calendar_sec  = 60.0_dp  
 
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  private :: calendar_absday2ymd
  private :: calendar_abssec2hms
  private :: calendar_ymdhms2nd
  private :: calendar_ymdhms2mjd
  private :: checkleap
 
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  logical,  private :: calendar_360days = .false.
  logical,  private :: calendar_365days = .false.
  logical,  private :: calendar_user    = .false.
 
  integer,  private, parameter :: i_nonleapyear = 1
  integer,  private, parameter :: i_leapyear    = 2
  integer,  private, parameter :: i_360days     = 3
  integer,  private, parameter :: i_user        = 4
 
  integer,  private            :: dayofmonth(12,4)
  data dayofmonth / 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31, & ! non-leap year
                    31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31, & ! leap year
                    30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, & ! 360 days
                    -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1 /  ! for CALENDAR_USER_DEFINED
 
  integer,  private :: calendar_user_defined(12)
  integer,  private :: calendar_month = 12
  logical,  private :: debug = .false.
 
  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine calendar_setup
    use scale_prc, only: &
       prc_abort
    implicit none
 
    namelist / param_calendar / &
       calendar_360days,        &
       calendar_365days,        &
       calendar_hour,           &
       calendar_min,            &
       calendar_sec,            &
       calendar_user_defined,   &
       debug
 
    integer :: ierr, i
    !---------------------------------------------------------------------------
 
    log_newline
    log_info("CALENDAR_setup",*) 'Setup'
 
    calendar_user_defined(:) = 0
 
    !--- read namelist
    rewind(io_fid_conf)
    read(io_fid_conf,nml=param_calendar,iostat=ierr)
    if( ierr < 0 ) then !--- missing
       log_info("CALENDAR_setup",*) 'Not found namelist. Default used.'
    elseif( ierr > 0 ) then !--- fatal error
       log_error("CALENDAR_setup",*) 'Not appropriate names in namelist PARAM_CALENDAR. Check!'
       call prc_abort
    endif
    log_nml(param_calendar)
 
    log_newline
    log_info("CALENDAR_setup",*) 'Calendar settings'
    if ( maxval(calendar_user_defined) > 0 ) then
       dayofmonth(:,i_user) = calendar_user_defined(:)
       calendar_doi  = sum(calendar_user_defined)
       calendar_user = .true.
       log_info_cont(*) 'DayOfYear = ', int(calendar_doi), ' : user defined calendar'
       do i = 1, 12
          if ( calendar_user_defined(i) > 0 ) then
             log_info_cont(*) 'month #', i, ': ', calendar_user_defined(i), "days"
          else
             calendar_month = i - 1
             exit
          endif
       enddo
    elseif( calendar_360days ) then
       calendar_doi = 360.0_dp
       log_info_cont(*) 'DayOfYear = 360 : ideal setting'
    elseif( calendar_365days ) then
       calendar_doi = 365.0_dp
       log_info_cont(*) 'DayOfYear = 365 : ideal setting'
    else
       log_info_cont(*) 'DayOfYear = 365 or 366 : Gregorian calendar'
    endif
 
    if (int(calendar_sec) /= calendar_sec .or. int(calendar_sec) == 0 ) then
       log_error("CALENDAR_setup",*) 'CALENDAR_SEC must be a natural number!'
       call abort
    elseif (int(calendar_min) /= calendar_min .or. int(calendar_min) == 0 ) then
       log_error("CALENDAR_setup",*) 'CALENDAR_MIN must be a natural number!'
       call abort
    elseif (int(calendar_hour) /= calendar_hour .or. int(calendar_hour) == 0 ) then
       log_error("CALENDAR_setup",*) 'CALENDAR_HOUR must be a natural number!'
       call abort
    endif
 
 
    return
  end subroutine calendar_setup
 
  !-----------------------------------------------------------------------------
  subroutine calendar_getdayofyear( &
       DayOfYear, &
       iyear      )
    implicit none
 
    real(dp), intent(out) :: dayofyear ! # of day of year
    integer,  intent(in)  :: iyear     ! current year
    !---------------------------------------------------------------------------
 
    dayofyear = calendar_doi
    if( checkleap(iyear) ) dayofyear = calendar_doi + 1.0_dp
 
    return
  end subroutine calendar_getdayofyear
 
  !-----------------------------------------------------------------------------
  subroutine calendar_date2daysec( &
       absday,     &
       abssec,     &
       ymdhms,     &
       subsec,     &
       offset_year )
    implicit none
 
    integer,  intent(out) :: absday
    real(dp), intent(out) :: abssec
    integer,  intent(in)  :: ymdhms(6)
    real(dp), intent(in)  :: subsec
    integer,  intent(in)  :: offset_year
    integer               :: ileap
    logical               :: date_error = .false.
    !---------------------------------------------------------------------------
 
    ! check date
    if ( ymdhms(i_month) < 1 .or. calendar_month < ymdhms(i_month) ) then
       log_error("CALENDAR_date2daysec",*) 'Inputted month does not match to the calendar.'
       date_error = .true.
    endif
 
    ileap = i_nonleapyear
    if( checkleap(ymdhms(i_year)+offset_year) ) ileap = i_leapyear
    if( calendar_360days     ) ileap = i_360days
    if( calendar_user        ) ileap = i_user
 
    if ( ymdhms(i_day ) < 1 .or. dayofmonth(ymdhms(i_month),ileap) < ymdhms(i_day) ) then
       log_error("CALENDAR_date2daysec",*) 'Inputted day does not match to the calendar.'
       date_error = .true.
    endif
    if ( ymdhms(i_hour) < 0 .or. (int(calendar_hour)-1) < ymdhms(i_hour) ) then
       log_error("CALENDAR_date2daysec",*) 'Inputted hour does not match to the calendar.'
       date_error = .true.
    endif
    if ( ymdhms(i_min ) < 0 .or. (int(calendar_min )-1) < ymdhms(i_min ) ) then
       log_error("CALENDAR_date2daysec",*) 'Inputted minute does not match to the calendar.'
       date_error = .true.
    endif
    if ( ymdhms(i_sec ) < 0 .or. (int(calendar_sec )-1) < ymdhms(i_sec ) ) then
       log_error("CALENDAR_date2daysec",*) 'Inputted second does not match to the calendar.'
       date_error = .true.
    endif
    if( date_error ) call abort
 
    call calendar_ymd2absday( absday,          & ! [OUT]
                              ymdhms(i_year),  & ! [IN]
                              ymdhms(i_month), & ! [IN]
                              ymdhms(i_day),   & ! [IN]
                              offset_year      ) ! [IN]
 
    call calendar_hms2abssec( abssec,          & ! [OUT]
                              ymdhms(i_hour),  & ! [IN]
                              ymdhms(i_min),   & ! [IN]
                              ymdhms(i_sec),   & ! [IN]
                              subsec           ) ! [IN]
 
    return
  end subroutine calendar_date2daysec
 
  !-----------------------------------------------------------------------------
  subroutine calendar_daysec2date( &
       ymdhms,     &
       subsec,     &
       absday,     &
       abssec,     &
       offset_year )
    implicit none
 
    integer,  intent(out) :: ymdhms(6)
    real(dp), intent(out) :: subsec
    integer,  intent(in)  :: absday
    real(dp), intent(in)  :: abssec
    integer,  intent(in)  :: offset_year
    !---------------------------------------------------------------------------
 
    call calendar_absday2ymd( ymdhms(i_year),  & ! [OUT]
                              ymdhms(i_month), & ! [OUT]
                              ymdhms(i_day),   & ! [OUT]
                              absday,          & ! [IN]
                              offset_year      ) ! [IN]
 
    call calendar_abssec2hms( ymdhms(i_hour),  & ! [OUT]
                              ymdhms(i_min),   & ! [OUT]
                              ymdhms(i_sec),   & ! [OUT]
                              subsec,          & ! [OUT]
                              abssec           ) ! [IN]
 
    return
  end subroutine calendar_daysec2date
 
  !-----------------------------------------------------------------------------
  subroutine calendar_ymd2absday( &
       absday, &
       gyear,  &
       gmonth, &
       gday,   &
       oyear   )
    implicit none
 
    integer, intent(out) :: absday
    integer, intent(in)  :: gyear
    integer, intent(in)  :: gmonth
    integer, intent(in)  :: gday
    integer, intent(in)  :: oyear
 
    integer :: gyear_mod, gmonth_mod
    integer :: yearday, monthday
    integer :: m, ileap
    !---------------------------------------------------------------------------
 
    gmonth_mod = mod( gmonth-1, calendar_month ) + 1
    gyear_mod  = gyear + ( gmonth-gmonth_mod ) / calendar_month
 
    if ( calendar_360days .OR. calendar_365days .or. calendar_user) then
       yearday = int( calendar_doi * ( gyear_mod - oyear ) )
    else
       yearday = int( calendar_doi * ( gyear_mod - oyear ) ) &
               + int( real(gyear_mod-1,kind=dp) /   4.0_dp ) &
               - int( real(gyear_mod-1,kind=dp) / 100.0_dp ) &
               + int( real(gyear_mod-1,kind=dp) / 400.0_dp ) &
               - int( real(oyear    -1,kind=dp) /   4.0_dp ) &
               + int( real(oyear    -1,kind=dp) / 100.0_dp ) &
               - int( real(oyear    -1,kind=dp) / 400.0_dp )
    endif
 
    ileap = i_nonleapyear
    if( checkleap(gyear_mod) ) ileap = i_leapyear
    if( calendar_360days     ) ileap = i_360days
    if( calendar_user        ) ileap = i_user
 
    monthday = 0
    do m = 1, gmonth_mod-1
       monthday = monthday + dayofmonth(m,ileap)
    enddo
 
    absday = yearday + monthday + gday - 1
 
    return
  end subroutine calendar_ymd2absday
 
  !-----------------------------------------------------------------------------
  subroutine calendar_absday2ymd( &
       gyear,  &
       gmonth, &
       gday,   &
       absday, &
       oyear   )
    implicit none
 
    integer, intent(out) :: gyear
    integer, intent(out) :: gmonth
    integer, intent(out) :: gday
    integer, intent(in)  :: absday
    integer, intent(in)  :: oyear
 
    integer :: checkday
    integer :: i, ileap
    !---------------------------------------------------------------------------
 
    gyear = int( real(absday,kind=dp) / (calendar_doi+1.0_dp) ) + oyear ! first guess
 
    do i = 1, 1000
       call calendar_ymd2absday( checkday, gyear+1, 1, 1, oyear )
       if( absday < checkday ) exit
       gyear = gyear + 1
    enddo
 
    ileap = i_nonleapyear
    if( checkleap(gyear) ) ileap = i_leapyear
    if( calendar_360days ) ileap = i_360days
    if( calendar_user    ) ileap = i_user
 
    gmonth = 1
    do i = 1, 1000
       call calendar_ymd2absday( checkday, gyear, gmonth, dayofmonth(gmonth,ileap), oyear )
       if( absday <= checkday ) exit
       gmonth = gmonth + 1
    enddo
 
    call calendar_ymd2absday( checkday, gyear, gmonth, 1, oyear )
    gday = absday - checkday + 1
 
    return
  end subroutine calendar_absday2ymd
 
  !-----------------------------------------------------------------------------
  subroutine calendar_hms2abssec( &
       abssec, &
       hour,   &
       minute, &
       second, &
       subsec  )
    implicit none
 
    real(dp), intent(out) :: abssec
    integer,  intent(in)  :: hour
    integer,  intent(in)  :: minute
    integer,  intent(in)  :: second
    real(dp), intent(in)  :: subsec
    !---------------------------------------------------------------------------
 
    abssec = real(hour,  kind=dp) * calendar_min * calendar_sec &
           + real(minute,kind=dp) * calendar_sec                &
           + real(second,kind=dp)                               &
           + subsec
 
    return
  end subroutine calendar_hms2abssec
 
  !-----------------------------------------------------------------------------
  subroutine calendar_abssec2hms( &
       hour,   &
       minute, &
       second, &
       subsec, &
       abssec  )
    implicit none
 
    integer,  intent(out) :: hour
    integer,  intent(out) :: minute
    integer,  intent(out) :: second
    real(dp), intent(out) :: subsec
    real(dp), intent(in)  :: abssec
 
    real(dp) :: nsec, nmin, nhour, temp
    !---------------------------------------------------------------------------
 
    nsec   = real(int(abssec),kind=dp)
    subsec = abssec - nsec
 
    temp   = mod( nsec, calendar_sec )
    second = int( temp )
    nmin   = ( nsec-temp ) / calendar_sec
 
    temp   = mod( nmin, calendar_min )
    minute = int( temp )
    nhour  = ( nmin-temp ) / calendar_min
 
    temp   = mod( nhour, calendar_hour )
    hour   = int( temp )
 
    return
  end subroutine calendar_abssec2hms
 
  !-----------------------------------------------------------------------------
  subroutine calendar_adjust_daysec( &
       absday, &
       abssec  )
    implicit none
 
    integer,  intent(inout) :: absday
    real(dp), intent(inout) :: abssec
 
    integer :: addday
    !---------------------------------------------------------------------------
 
    addday = int( abssec / ( calendar_hour * calendar_min * calendar_sec ) )
 
    absday = absday + addday
 
    abssec = abssec - real(addday,kind=dp) * calendar_hour * calendar_min * calendar_sec
 
    if ( abssec < 0.0_dp ) then
       absday = absday - 1
       abssec = abssec + calendar_hour * calendar_min * calendar_sec
    endif
 
    return
  end subroutine calendar_adjust_daysec
 
  !-----------------------------------------------------------------------------
  function calendar_combine_daysec( absday, abssec ) result(daysec)
    implicit none
 
    integer,  intent(in) :: absday
    real(dp), intent(in) :: abssec
    real(dp)             :: daysec
    !---------------------------------------------------------------------------
 
    daysec = real(absday,kind=dp) * calendar_sec * calendar_min * calendar_hour &
           + abssec
 
    return
  end function calendar_combine_daysec
 
  !-----------------------------------------------------------------------------
  subroutine calendar_unit2sec( &
       second, &
       value,  &
       unit    )
    use scale_prc, only: &
       prc_abort
    implicit none
 
    real(dp),         intent(out) :: second
    real(dp),         intent(in)  :: value
    character(len=*), intent(in)  :: unit
    !---------------------------------------------------------------------------
 
    select case(unit)
    case('MSEC')
       second = value * 1.e-3_dp
    case('SEC', 'seconds')
       second = value
    case('MIN')
       second = value * calendar_sec
    case('HOUR')
       second = value * calendar_sec * calendar_min
    case('DAY')
       second = value * calendar_sec * calendar_min * calendar_hour
    case default
       log_error("CALENDAR_unit2sec",*) 'Unsupported UNIT: ', trim(unit), ', ', value
       call prc_abort
    endselect
 
    return
  end subroutine calendar_unit2sec
 
  !-----------------------------------------------------------------------------
  subroutine calendar_sec2unit( &
     value,  &
     second, &
     unit    )
    use scale_prc, only: &
       prc_abort
    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 / calendar_sec
    case('HOUR', 'hours', 'hour', 'h')
       value = second / (calendar_sec * calendar_min)
    case('DAY', 'days', 'day')
       value = second / (calendar_sec * calendar_min * calendar_hour)
    case default
       log_error("CALENDAR_sec2unit",*) 'Unsupported UNIT: ', trim(unit), ', ', value
       call prc_abort
    endselect
 
  end subroutine calendar_sec2unit
 
  !-----------------------------------------------------------------------------
  function calendar_cfunits2sec( cftime, cfunits, offset_year, startdaysec ) result( sec )
    use scale_prc, only: &
       prc_abort
    implicit none
 
    real(dp),         intent(in) :: cftime
    character(len=*), intent(in) :: cfunits
    integer,          intent(in) :: offset_year
    real(dp),         intent(in), optional :: startdaysec
    real(dp)                     :: sec
 
    character(len=H_MID) :: tunit
    character(len=H_MID) :: buf
 
    integer  :: date(6)
    integer  :: day
    real(dp) :: sec0
 
    integer :: l
 
    intrinsic index
    !---------------------------------------------------------------------------
 
    l = index( cfunits, " since " )
    if ( l > 1 ) then ! untis is under the CF convension
       tunit = cfunits(1:l-1)
       buf   = cfunits(l+7:)
 
       l = index(buf,"-")
       if ( l /= 5 ) then
          log_error("CALENDAR_CFunits2sec",*) 'units for time is invalid (year)'
          log_error_cont(*) trim(cfunits)
          log_error_cont(*) trim(buf)
          call prc_abort
       end if
       read(buf(1:4),*) date(1) ! year
       buf = buf(6:)
 
       l = index(buf,"-")
       if ( l /= 3 ) then
          log_error("CALENDAR_CFunits2sec",*) 'units for time is invalid (month)'
          log_error_cont(*) trim(cfunits)
          log_error_cont(*) trim(buf)
          call prc_abort
       end if
       read(buf(1:2),*) date(2) ! month
       buf = buf(4:)
 
       l = index(buf," ")
       if ( l /= 3 ) then
          log_error("CALENDAR_CFunits2sec",*) 'units for time is invalid (day)'
          log_error_cont(*) trim(cfunits)
          log_error_cont(*) trim(buf)
          call prc_abort
       end if
       read(buf(1:2),*) date(3) ! day
       buf = buf(4:)
 
       l = index(buf,":")
       if ( l /= 3 ) then
          log_error("CALENDAR_CFunits2sec",*) 'units for time is invalid (hour)'
          log_error_cont(*) trim(cfunits)
          log_error_cont(*) trim(buf)
          call prc_abort
       end if
       read(buf(1:2),*) date(4) ! hour
       buf = buf(4:)
 
       l = index(buf,":")
       if ( l /= 3 ) then
          log_error("CALENDAR_CFunits2sec",*) 'units for time is invalid (min)'
          log_error_cont(*) trim(cfunits)
          log_error_cont(*) trim(buf)
          call prc_abort
       end if
       read(buf(1:2),*) date(5) ! min
       buf = buf(4:)
 
       if ( len_trim(buf) /= 2 ) then
          log_error("CALENDAR_CFunits2sec",*) 'units for time is invalid (sec)'
          log_error_cont(*) trim(cfunits)
          log_error_cont(*) trim(buf)
          log_error_cont(*) len_trim(buf)
          call prc_abort
       end if
       read(buf(1:2),*) date(6) ! sec
 
       call calendar_date2daysec( day,        & ! (out)
                                  sec0,       & ! (out)
                                  date(:),    & ! (in)
                                  0.0_dp,     & ! (in)
                                  offset_year ) ! (in)
 
       sec0 = calendar_combine_daysec( day, sec0 )
    else
       tunit = cfunits
       if ( present(startdaysec) ) then
          sec0 = startdaysec
       else
          sec0 = 0.0_dp
       end if
    end if
 
    call calendar_unit2sec( sec, cftime, tunit )
 
    sec = sec0 + sec
 
    return
  end function calendar_cfunits2sec
 
  !-----------------------------------------------------------------------------
  subroutine calendar_date2char( &
       chardate, &
       ymdhms,   &
       subsec    )
    implicit none
 
    character(len=27), intent(out) :: chardate
    integer,           intent(in)  :: ymdhms(6)
    real(dp),          intent(in)  :: subsec
 
    character(len=4)               :: seclen
    character(len=4)               :: minlen
    character(len=4)               :: hourlen
    character(len=4)               :: daylen
    character(len=4)               :: monthlen
 
 
    !---------------------------------------------------------------------------
    if ( calendar_user) then
       write(daylen, '(A1,I1.1,A1,I1.1)') 'I', int(log10(real(maxval(calendar_user_defined))))+1, &
                                          '.', int(log10(real(maxval(calendar_user_defined))))+1
       if( calendar_month < 10 ) then
          write(monthlen, '(A4)') 'I1.1'
       else
          write(monthlen, '(A4)') 'I2.2'
       endif
    else
       write(daylen,   '(A4)') 'I2.2'
       write(monthlen, '(A4)') 'I2.2'
    endif
 
    write(seclen, '(A1,I1.1,A1,I1.1)') 'I', int(log10(max(calendar_sec -1.0_dp, 1.0_dp)))+1, &
                                       '.', int(log10(max(calendar_sec -1.0_dp, 1.0_dp)))+1
    write(minlen, '(A1,I1.1,A1,I1.1)') 'I', int(log10(max(calendar_min -1.0_dp, 1.0_dp)))+1, &
                                       '.', int(log10(max(calendar_min -1.0_dp, 1.0_dp)))+1
    write(hourlen,'(A1,I1.1,A1,I1.1)') 'I', int(log10(max(calendar_hour-1.0_dp, 1.0_dp)))+1, &
                                       '.', int(log10(max(calendar_hour-1.0_dp, 1.0_dp)))+1
 
!    write(chardate,'(I4.4,A1,I2.2,A1,I2.2,A1,I2.2,A1,I2.2,A1,I2.2,A2,F6.3)')   &
    write(chardate,'(I4.4,A1,'//monthlen//',A1,'//daylen//',A1,'//hourlen//',A1,'//minlen//',A1,'//seclen//',A2,F6.3)') &
                       ymdhms(1),'/',ymdhms(2),'/',ymdhms(3),' ',  &
                       ymdhms(4),':',ymdhms(5),':',ymdhms(6),' +', &
                       subsec
 
    return
  end subroutine calendar_date2char
 
  !-----------------------------------------------------------------------------
  function checkleap( iyear )
    implicit none
 
    integer, intent(in) :: iyear
    logical             :: checkleap
 
    integer :: check4, check100, check400
    !---------------------------------------------------------------------------
 
    check4   = mod(iyear,4  )
    check100 = mod(iyear,100)
    check400 = mod(iyear,400)
 
    checkleap = .false.
    if( check4   == 0 ) checkleap = .true.
    if( check100 == 0 ) checkleap = .false.
    if( check400 == 0 ) checkleap = .true.
 
    if( calendar_360days ) checkleap = .false.
    if( calendar_365days ) checkleap = .false.
    if( calendar_user    ) checkleap = .false.
 
  end function checkleap
 
  !-----------------------------------------------------------------------------
  subroutine calendar_ymdhms2nd( &
       nd,     &
       ymdhms, &
       oyear   )
    implicit none
 
    real(dp), intent(out) :: nd
    integer,  intent(in)  :: ymdhms(6)
    integer,  intent(in)  :: oyear
 
    integer :: absday, absday_jan1
    !---------------------------------------------------------------------------
 
    call calendar_ymd2absday( absday,          & ! [OUT]
                              ymdhms(i_year),  & ! [IN]
                              ymdhms(i_month), & ! [IN]
                              ymdhms(i_day),   & ! [IN]
                              oyear            ) ! [IN]
 
    call calendar_ymd2absday( absday_jan1,     & ! [OUT]
                              ymdhms(i_year),  & ! [IN]
                              1,               & ! [IN]
                              1,               & ! [IN]
                              oyear            ) ! [IN]
 
    nd = absday - absday_jan1 + 1.0_dp
 
    return
  end subroutine calendar_ymdhms2nd
 
  !-----------------------------------------------------------------------------
  subroutine calendar_ymdhms2mjd( &
       mjd,    &
       ymdhms, &
       oyear   )
    implicit none
 
    real(dp), intent(out) :: mjd
    integer,  intent(in)  :: ymdhms(6)
    integer,  intent(in)  :: oyear
 
    integer :: y, m, mjd_day
    !---------------------------------------------------------------------------
 
    if (      ymdhms(i_month) == 1 &
         .OR. ymdhms(i_month) == 2 ) then
       y = ymdhms(i_year)  - 1
       m = ymdhms(i_month) + 2
    else
       y = ymdhms(i_year)
       m = ymdhms(i_month)
    endif
 
    mjd_day = int( 365.25_dp * y )                  & ! year
            + int( y/400.0_dp ) - int( y/100.0_dp ) & ! leap year
            + int( 30.59_dp * m-2 )                 & ! month
            + ymdhms(i_day)                         & ! day
            + 678912                                ! constant
 
    mjd     = real(mjd_day,kind=dp)                                      & ! day
            + ymdhms(i_hour) / (calendar_hour                          ) & ! hour
            + ymdhms(i_min)  / (calendar_hour*calendar_min             ) & ! min
            + ymdhms(i_sec)  / (calendar_hour*calendar_min*calendar_sec)   ! sec
 
    return
  end subroutine calendar_ymdhms2mjd
 
  subroutine calendar_get_name(name)
    character(len=*), intent(out) :: name
 
    if    ( calendar_360days ) then
       name = "360_day"
    elseif( calendar_365days ) then
       name = "365_day"
    elseif( calendar_user    ) then
       name = "USER_DEFINED"
    else
       name = "gregorian"
    endif
 
    return
  end subroutine calendar_get_name
 
end module scale_calendar