dcdatetimeeval.f90

Go to the documentation of this file.

!-----------------------------------------------------------------------
! Copyright (c) 2000-2026 Gtool Development Group. All rights reserved.
!-----------------------------------------------------------------------
 
subroutine dcdatetimeeval1(time, year, mon, day, hour, min, &
  & sec, caltype, zone, sclyear, sclmon, sclday, sclsec)
  use dc_types, only: dp
  use dc_date_types, only: dc_datetime, &
    & cyclic_mdays, cal_noleap, cal_julian, cal_cyclic, &
    & year_months, year_days, four_years, four_century, &
    & hour_seconds, min_seconds
  use dc_scaledsec, only:  dc_scaled_sec, &
    & assignment(=), dcscaledsecputline, &
    & operator(==), operator(>), operator(<), operator(>=), operator(<=), &
    & operator(+), operator(-), operator(*), operator(/), mod, modulo, &
    & abs, int, floor, ceiling
  use dc_trace, only: beginsub, endsub
  implicit none
  type(dc_datetime), intent(in):: time
  integer, intent(out), optional:: year ! 年
  integer, intent(out), optional:: mon  ! 月
  integer, intent(out), optional:: day  ! 日
  integer, intent(out), optional:: hour ! 時
  integer, intent(out), optional:: min  ! 分
  real(DP),intent(out), optional:: sec  ! 秒
  integer, intent(out), optional:: caltype ! 暦法
  character(*), intent(out), optional:: zone ! タイムゾーン (UTC からの時差)
  type(dc_scaled_sec), intent(out), optional:: sclyear ! 年 (DC_SCALED_SEC 型)
  type(dc_scaled_sec), intent(out), optional:: sclmon  ! 月 (DC_SCALED_SEC 型)
  type(dc_scaled_sec), intent(out), optional:: sclday  ! 日 (DC_SCALED_SEC 型)
  type(dc_scaled_sec), intent(out), optional:: sclsec  ! 秒 (DC_SCALED_SEC 型)
 
  type(dc_scaled_sec):: iyear, month, iday, imon, isec
  !character(*), parameter :: subname = 'DCDateTimeEval1'
continue
  !call BeginSub(subname)
  if (present(zone)) then
    zone = time % zone
  end if
  if (present(caltype)) then
    caltype = time % caltype
  end if
  isec = time % sec
  if (present(hour)) then
    hour = floor(isec / hour_seconds)
    isec = modulo(isec, hour_seconds)
  end if
  if (present(min)) then
    min = floor(isec / min_seconds)
    isec = modulo(isec, min_seconds)
  end if
  if (present(sec)) then
    sec = isec
  end if
  if (present(sclsec)) then
    sclsec = isec
  end if
 
  if (time % caltype == cal_cyclic) then
    iday = time % day
    if (present(year)) year = 0
    if (present(sclyear)) sclyear = 0
    if (present(sclmon)) then
      sclmon = floor(iday / cyclic_mdays)
      iday = ceiling( modulo(iday, cyclic_mdays) )
    elseif (present(mon)) then
      mon = floor(iday / cyclic_mdays)
      iday = ceiling( modulo(iday, cyclic_mdays) )
    end if
    if (present(day)) day = iday
    if (present(sclday)) sclday = iday
    goto 999
  endif
  if (time % caltype == cal_noleap) then
    iday = int( modulo(time%day - 91, year_days) )
    iyear = int( (time%day - 91 - iday) / year_days )
  else
    if (time % caltype == cal_julian) then
      iday = int( modulo(time%day - 92, four_years) )
      iyear = int( (time%day - 92 - iday) / four_years ) * 4
    elseif (time%day < 640196) then
      iday = int( modulo(time%day - 92, four_years) )
      iyear = int( (time%day - 92 - iday) / four_years ) * 4
    else
      iday = int( modulo(time%day - 94, four_century) )
      iyear = int( (time%day - 94 - iday) / four_century ) * 400
      if (iday == four_century - 1) then
        iyear = iyear + 300
        iday = 36525
      else
        iyear = iyear + int( iday / 36524 ) * 100
        iday = int( modulo(iday, 36524) )
      endif
      iyear = iyear + int( iday / four_years ) * 4
      iday = int( modulo(iday, four_years) )
    endif
    if (iday == four_years - 1) then
      iyear = iyear + 3
      iday = year_days
    else
      iyear = iyear + int( iday / year_days )
      iday = int( modulo(iday, year_days) )
    endif
  endif
 
  iday = iday * 10 + 922
  month = int( iday / 306 )
 
  if (present(sclyear)) then
    imon = mod(month - 1, year_months) + 1
    sclyear = iyear + int( (month - imon) / year_months )
  elseif (present(year)) then
    imon = mod(month - 1, year_months) + 1
    year = iyear + int( (month - imon) / year_months )
  else
    imon = month
  end if
  if (present(sclmon)) then
    iday = int( mod(iday, 306) / 10 ) + 1
    sclmon = imon
  elseif (present(mon)) then
    iday = int( mod(iday, 306) / 10 ) + 1
    mon = imon
  else
    iday = int( iday / 10 )  + 1
  end if
 
  if (present(day)) day = iday
  if (present(sclday)) sclday = iday
 
999 continue
  !call EndSub(subname)
end subroutine dcdatetimeeval1
 
 
subroutine dcdifftimeeval1(diff, &
  & year, mon, day, hour, min, sec, nondim, &
  & sclyear, sclmon, sclday, sclsec, sclnondim, err)
  use dc_types, only: dp
  use dc_trace, only: beginsub, endsub
  use dc_error, only: storeerror, dc_noerr, dc_enodimtime, dc_edimtime
  use dc_date_types, only: dc_difftime, &
    & min_seconds, hour_seconds, year_months
  use dc_scaledsec, only:  dc_scaled_sec, &
    & assignment(=), dcscaledsecputline, &
    & operator(==), operator(>), operator(<), operator(>=), operator(<=), &
    & operator(+), operator(-), operator(*), operator(/), mod, modulo, &
    & abs, int, floor, ceiling
  implicit none
  type(dc_difftime), intent(in):: diff
  integer, intent(out), optional:: year ! 年
  integer, intent(out), optional:: mon  ! 月
  integer, intent(out), optional:: day  ! 日
  integer, intent(out), optional:: hour ! 時
  integer, intent(out), optional:: min  ! 分
  real(DP),intent(out), optional:: sec  ! 秒
  real(DP),intent(out), optional:: nondim  ! 無次元時間. Nondimensional time
  type(dc_scaled_sec), intent(out), optional:: sclyear ! 年 (DC_SCALED_SEC 型)
  type(dc_scaled_sec), intent(out), optional:: sclmon  ! 月 (DC_SCALED_SEC 型)
  type(dc_scaled_sec), intent(out), optional:: sclday  ! 日 (DC_SCALED_SEC 型)
  type(dc_scaled_sec), intent(out), optional:: sclsec  ! 秒 (DC_SCALED_SEC 型)
  type(dc_scaled_sec), intent(out), optional:: sclnondim  ! 無次元時間 (DC_SCALED_SEC 型)
  logical, intent(out), optional :: err
  type(dc_scaled_sec):: imon, isec
  integer:: stat
  character(*), parameter :: subname = 'DCDiffTimeEval1'
continue
  !call BeginSub(subname)
  stat = dc_noerr
  if ( present(sclnondim) ) then
    if ( .not. diff % nondim_flag ) then
      stat = dc_edimtime
      goto 999
    end if
    sclnondim = diff % sec
  elseif ( present(nondim) ) then
    if ( .not. diff % nondim_flag ) then
      stat = dc_edimtime
      goto 999
    end if
    nondim = diff % sec
  else
    if ( diff % nondim_flag ) then
      stat = dc_enodimtime
      goto 999
    end if
  end if
 
  imon = diff % mon
  isec = diff % sec
  if (present(sclyear)) then
    sclyear = int( imon / year_months )
    imon = mod(imon, year_months)
  elseif (present(year)) then
    year = int( imon / year_months )
    imon = mod(imon, year_months)
  endif
 
  if (present(sclmon)) then
    sclmon = imon
  elseif (present(mon)) then
    mon = imon
  endif
 
  if (present(sclday)) then
    sclday = diff % day
  elseif (present(day)) then
    day = diff % day
  else
    isec = isec + diff % day * diff % day_seconds
  endif
 
  if (present(hour)) then
    hour = int(isec / hour_seconds)
    isec = mod(isec, hour_seconds)
  endif
  if (present(min)) then
    min = int(isec / min_seconds)
    isec = mod(isec, min_seconds)
  endif
 
  if (present(sec)) then
    sec = isec
  endif
  if (present(sclsec)) then
    sclsec = isec
  endif
999 continue
  call storeerror(stat, subname, err)
  !call EndSub(subname)
end subroutine dcdifftimeeval1
 
 
function dcdatetimeevalday(time) result(result)
  use dc_types, only: dp
  use dc_date_generic, only: eval
  use dc_date_types, only: dc_datetime
  use dc_scaledsec, only: dc_scaled_sec, assignment(=), operator(/), operator(+)
  implicit none
  real(dp):: result
  type(dc_datetime), intent(in):: time
  type(dc_scaled_sec):: day, sec
continue
  call eval(time, sclday = day, sclsec = sec)
  result = day + sec / time % day_seconds
end function dcdatetimeevalday
 
function dcdifftimeevalday(diff) result(result)
  use dc_types, only: dp
  use dc_date_generic, only: eval
  use dc_date_types, only: dc_difftime, cyclic_mdays
  use dc_scaledsec, only: dc_scaled_sec, assignment(=), operator(/), &
    & operator(+), operator(*), int
  implicit none
  real(dp):: result
  type(dc_difftime), intent(in):: diff
  type(dc_scaled_sec):: day, mon, sec
continue
  call eval(diff, sclmon = mon, sclday = day, sclsec = sec)
  result = int(mon * cyclic_mdays) + day + sec / diff % day_seconds
end function dcdifftimeevalday
 
 
function dcdatetimeevalhour(time) result(result)
  use dc_types, only: dp
  use dc_date_generic, only: eval
  use dc_date_types, only: dc_datetime, hour_seconds
  use dc_scaledsec, only: dc_scaled_sec, assignment(=), operator(/), &
    & operator(+), operator(*), int
  implicit none
  real(dp):: result
  type(dc_datetime), intent(in):: time
  type(dc_scaled_sec):: day, sec
continue
  call eval(time, sclday = day, sclsec = sec)
  result = (day * time % day_seconds + sec) / hour_seconds
end function dcdatetimeevalhour
 
function dcdifftimeevalhour(diff) result(result)
  use dc_types, only: dp
  use dc_date_generic, only: eval
  use dc_date_types, only: dc_difftime, hour_seconds, cyclic_mdays
  use dc_scaledsec, only: dc_scaled_sec, assignment(=), operator(/), &
    & operator(+), operator(*), int
  implicit none
  real(dp):: result
  type(dc_difftime), intent(in):: diff
  type(dc_scaled_sec):: mon, day, sec
continue
  call eval(diff, sclmon = mon, sclday = day, sclsec = sec)
  result = ( int(mon * cyclic_mdays) + day &
    &         * diff % day_seconds + sec) / hour_seconds
end function dcdifftimeevalhour
 
 
function dcdatetimeevalmin(time) result(result)
  use dc_types, only: dp
  use dc_date_generic, only: eval
  use dc_date_types, only: dc_datetime, min_seconds
  use dc_scaledsec, only: dc_scaled_sec, assignment(=), operator(/), &
    & operator(+), operator(*), int
  implicit none
  real(dp):: result
  type(dc_datetime), intent(in):: time
  type(dc_scaled_sec):: day, sec
continue
  call eval(time, sclday = day, sclsec = sec)
  result = (day * time % day_seconds + sec) / min_seconds
end function dcdatetimeevalmin
 
function dcdifftimeevalmin(diff) result(result)
  use dc_types, only: dp
  use dc_date_generic, only: eval
  use dc_date_types, only: dc_difftime, min_seconds, cyclic_mdays
  use dc_scaledsec, only: dc_scaled_sec, assignment(=), operator(/), &
    & operator(+), operator(*), int
  implicit none
  real(dp):: result
  type(dc_difftime), intent(in):: diff
  type(dc_scaled_sec):: mon, day, sec
continue
  call eval(diff, sclmon = mon, sclday = day, sclsec = sec)
  result = ( int(mon * cyclic_mdays) + day &
    &         * diff % day_seconds + sec) / min_seconds
end function dcdifftimeevalmin
 
 
function dcdatetimeevalsec(time) result(result)
  use dc_types, only: dp
  use dc_date_generic, only: eval
  use dc_date_types, only: dc_datetime
  use dc_scaledsec, only: assignment(=)
  implicit none
  real(dp):: result
  type(dc_datetime), intent(in):: time
  integer:: day
  real(dp):: sec, day_seconds
continue
  call eval(time, day = day, sec = sec)
  day_seconds = time % day_seconds
  result = day * day_seconds + sec
end function dcdatetimeevalsec
 
function dcdifftimeevalsec(diff) result(result)
  use dc_types, only: dp
  use dc_date_generic, only: eval
  use dc_date_types, only: dc_difftime, cyclic_mdays
  use dc_scaledsec, only: assignment(=)
  implicit none
  real(dp):: result
  type(dc_difftime), intent(in):: diff
  integer:: mon, day
  real(dp):: sec, day_seconds
continue
  if ( .not. diff % nondim_flag ) then
    call eval(diff, mon = mon, day = day, sec = sec)
    day_seconds = diff % day_seconds
    result = int(mon * cyclic_mdays) + day * day_seconds + sec
  else
    call eval(diff, nondim = result)
  end if
end function dcdifftimeevalsec
 
function dcdifftimeevalnondim(diff) result(result)
  use dc_types, only: dp
  use dc_date_generic, only: eval
  use dc_date_types, only: dc_difftime
  implicit none
  real(dp):: result
  type(dc_difftime), intent(in):: diff
  real(dp):: nondim
continue
  call eval(diff, nondim=nondim)
  result = nondim
end function dcdifftimeevalnondim
 
function dcdatetimeevalsclsec(time) result(result)
  use dc_date_generic, only: eval
  use dc_date_types, only: dc_datetime
  use dc_scaledsec, only: dc_scaled_sec, operator(/), &
    & operator(+), operator(*), int
  implicit none
  type(dc_scaled_sec):: result
  type(dc_datetime), intent(in):: time
  type(dc_scaled_sec):: day, sec
continue
  call eval(time, sclday = day, sclsec = sec)
  result = day * time % day_seconds + sec
end function dcdatetimeevalsclsec
 
function dcdifftimeevalsclsec(diff) result(result)
  use dc_date_generic, only: eval
  use dc_date_types, only: dc_difftime, cyclic_mdays
  use dc_scaledsec, only: dc_scaled_sec, operator(/), &
    & operator(==), operator(+), operator(*), int
  implicit none
  type(dc_scaled_sec):: result
  type(dc_difftime), intent(in):: diff
  type(dc_scaled_sec):: mon, day, sec
  type(dc_scaled_sec):: zero_sec
continue
  if ( .not. diff % nondim_flag ) then
    call eval(diff, sclmon = mon, sclday = day, sclsec = sec)
    if ( mon == zero_sec ) then
      result = day * diff % day_seconds + sec
    else
      result = ( int(mon * cyclic_mdays) + day ) * diff % day_seconds + sec
    end if
  else
    call eval(diff, sclnondim = sec)
    result = sec
  end if
end function dcdifftimeevalsclsec
 
function dcdatetimeevalbyunit(time, unit, unit_symbol) result(result)
  use dc_types, only: dp
  use dc_date_generic, only: evalsec, evalmin, evalhour, evalday, parsetimeunits
  use dc_date_types, only: dc_datetime, &
    & unit_symbol_day, unit_symbol_hour, unit_symbol_min, unit_symbol_sec, &
    & unit_symbol_err
  implicit none
  real(dp):: result
  type(dc_datetime), intent(in):: time
  character(*), intent(in):: unit
  integer, intent(in), optional:: unit_symbol
  integer:: symbol
continue
  symbol = unit_symbol_err
  if ( present(unit_symbol) ) then
    symbol = unit_symbol
  else
    symbol = parsetimeunits(unit)
  end if
 
  if ( symbol == unit_symbol_sec ) then
    result = evalsec(time)
  elseif ( symbol == unit_symbol_min ) then
    result = evalmin(time)
  elseif ( symbol == unit_symbol_hour ) then
    result = evalhour(time)
  elseif ( symbol == unit_symbol_day ) then
    result = evalday(time)
  else
    result = 0.0_dp
  end if
end function dcdatetimeevalbyunit
 
 
function dcdifftimeevalbyunit(diff, unit, unit_symbol) result(result)
  use dc_types, only: dp
  use dc_date_generic, only: evalnondim, evalsec, evalmin, evalhour, evalday, &
    & parsetimeunits
  use dc_date_types, only: dc_difftime, &
    & unit_symbol_day, unit_symbol_hour, unit_symbol_min, &
    & unit_symbol_sec, unit_symbol_nondim, unit_symbol_err
  implicit none
  real(dp):: result
  type(dc_difftime), intent(in):: diff
  character(*), intent(in):: unit
  integer, intent(in), optional:: unit_symbol
  integer:: symbol
continue
  symbol = unit_symbol_err
  if ( present(unit_symbol) ) then
    symbol = unit_symbol
  else
    symbol = parsetimeunits(unit)
  end if
 
  if ( symbol == unit_symbol_nondim ) then
    result = evalnondim(diff)
  elseif ( symbol == unit_symbol_sec ) then
    result = evalsec(diff)
  elseif ( symbol == unit_symbol_min ) then
    result = evalmin(diff)
  elseif ( symbol == unit_symbol_hour ) then
    result = evalhour(diff)
  elseif ( symbol == unit_symbol_day ) then
    result = evalday(diff)
  else
    result = 0.0_dp
  end if
end function dcdifftimeevalbyunit
 
 
 
!!$subroutine DCDateTimeEval0(time, mon, day, sec)
!!$  !
!!$  ! dc_date_types#DC_DATETIME 型変数の *time* を
!!$  ! 月 *mon*, 日 *day*, 秒 *sec* に変換して返す.
!!$  !
!!$  use dc_types, only: DP
!!$  use dc_date_types, only: DC_DATETIME, &
!!$    & CYCLIC_MDAYS, CAL_NOLEAP, CAL_JULIAN, CAL_CYCLIC, &
!!$    & FOUR_YEARS, FOUR_CENTURY
!!$  use dc_trace, only: BeginSub, EndSub
!!$  implicit none
!!$  type(DC_DATETIME), intent(in):: time
!!$  integer, intent(out):: mon, day
!!$  real(DP), intent(out):: sec
!!$  integer:: year, month
!!$  character(*), parameter :: subname = 'DCDateTimeEval0'
!!$continue
!!$  call BeginSub(subname)
!!$  sec = time%sec
!!$  if (time % caltype == CAL_CYCLIC) then
!!$    day = modulo(dble(time%day - 1), CYCLIC_MDAYS) + 1
!!$    mon = (time%day - 1) / CYCLIC_MDAYS
!!$    goto 999
!!$  endif
!!$  if (time % caltype == CAL_NOLEAP) then
!!$    day = modulo(time%day - 91, 365)
!!$    year = (time%day - 91 - day) / 365
!!$  else
!!$    if (time % caltype == CAL_JULIAN .or. time%day < 640196) then
!!$      day = modulo(time%day - 92, FOUR_YEARS)
!!$      year = (time%day - 92 - day) / FOUR_YEARS * 4
!!$    else
!!$      day = modulo(time%day - 94, FOUR_CENTURY)
!!$      year = (time%day - 94 - day) / FOUR_CENTURY * 400
!!$      if (day == FOUR_CENTURY - 1) then
!!$        year = year + 300
!!$        day = 36525
!!$      else
!!$        year = year + day / 36524 * 100
!!$        day = modulo(day, 36524)
!!$      endif
!!$      year = year + day / FOUR_YEARS * 4
!!$      day = modulo(day, FOUR_YEARS)
!!$    endif
!!$    if (day == FOUR_YEARS - 1) then
!!$      year = year + 3
!!$      day = 365
!!$    else
!!$      year = year + day / 365
!!$      day = modulo(day, 365)
!!$    endif
!!$  endif
!!$  day = day * 10 + 922
!!$  month = day / 306
!!$  mon = mod(month - 1, 12) + 1
!!$  year = year + (month - mon) / 12
!!$  day = mod(day, 306) / 10  + 1
!!$999 continue
!!$  call EndSub(subname, 'mon=<%d>, day=<%d>, sec=<%f>',&
!!$    & i=(/mon, day/), d=(/sec/))
!!$end subroutine DCDateTimeEval0