dcdatetimecreate.f90

subroutine DCDateTimeCreate1(time, year, mon, day, hour, min, sec, zone, caltype, day_seconds, err)
  !
  ! dc_date_types#DC_DATETIME 型変数の生成を行います.
  ! 引数 *year*, *mon*, *day*, *hour*, *min*, *sec* の全てを与えない場合,
  ! このサブルーチンが呼ばれた際の時刻が使用されます.
  !
  ! 引数 *caltype* には暦法を設定します.
  ! dc_date_types#CAL_CYCLIC, dc_date_types#CAL_NOLEAP, 
  ! dc_date_types#CAL_JULIAN, dc_date_types#CAL_GREGORIAN
  ! のいづれかを与えてください. 引数 *caltype* を指定しない場合, 暦法は
  ! dc_date_types#CAL_GREGORIAN に設定されます.
  !
  ! 引数 *zone* には UTC からの時差を設定します.
  ! '+09:00' や '-13:00' のように時差を 6 文字で指定してください.
  ! 引数 *zone* を指定しない場合, date_and_time 組み込みサブルーチン
  ! によって得られる時差を設定します.
  !
  ! 引数 *day_seconds* には 1 日何秒かを設定します. この引数を
  ! 指定しない場合, dc_date_types#day_seconds の値が用いられます.
  ! dc_date_types#day_seconds は SetSecOfDay で変更可能です.
  !
  ! 引数 *caltype* および, *zone* に不適切な値が与えられた場合,
  ! エラーを発生させます.
  ! 引数 *err* を与えている場合には *err* に .true. が返り,
  ! プログラムは続行します.
  !

  use dc_types,      only: DP, STRING
  use dc_date_types, only: DC_DATETIME, caltype_default => caltype, day_seconds_default => day_seconds, CYCLIC_MDAYS, CAL_NOLEAP, CAL_JULIAN, CAL_CYCLIC, MIN_SECONDS, HOUR_SECONDS, FOUR_YEARS, YEAR_MONTHS
  use dc_error, only: StoreError, DC_EBADCALTYPE, DC_EBADTIMEZONE, DC_NOERR
  use dc_message, only: MessageNotify
  use dc_trace, only: BeginSub, EndSub
  use dc_date, only: ValidCaltype, ValidZone
  use dc_present, only: present_select
  implicit none
  type(DC_DATETIME), intent(out) :: time
  integer, intent(in), optional:: year ! 年
  integer, intent(in), optional:: mon  ! 月
  integer, intent(in), optional:: day  ! 日
  integer, intent(in), optional:: hour ! 時
  integer, intent(in), optional:: min  ! 分
  real(DP),intent(in), optional:: sec  ! 秒
  character(*), intent(in), optional :: zone ! UTC からの時差
  integer, intent(in), optional:: caltype ! 暦法
  real(DP),intent(in), optional:: day_seconds  ! 1 日の秒数
  logical, intent(out), optional:: err

  real(DP):: isec
  integer :: iday, imon, month, iyear, century
  character(6) :: izone
  integer, parameter :: year_default = 0, mon_default = 1
  integer, parameter :: day_default = 1
  real(DP), parameter:: sec_default = 0.0_DP
  logical :: current_time_used
  integer :: stat, cause_i
  character(STRING) :: cause_c
  character(*), parameter :: subname = 'DCDateTimeCreate1'
continue
  current_time_used = .not. present(year) .and. .not. present(mon) .and. .not. present(day) .and. .not. present(hour) .and. .not. present(min) .and. .not. present(sec)
  call BeginSub(subname, 'current_time_used=<%y>', l=(/current_time_used/))
  stat = DC_NOERR
  cause_i = DC_NOERR
  cause_c = ''

  time % day_seconds = present_select(.false., day_seconds_default, day_seconds)

  call get_current_time(iyear, imon, iday, isec, izone)

  if (.not. current_time_used) then
    if (present(zone)) then
      if (ValidZone(zone)) then
        izone = zone
      else
        stat = DC_EBADTIMEZONE
        cause_c = zone
        if (present(err)) then
          call MessageNotify('W', subname, 'zone=<%c> is invalid.', c1=trim(zone))
        else
          goto 999
        end if
      end if
    end if
    isec = present_select(.false., sec_default, sec)
    if (present(min)) then
      isec = isec + real(min, DP) * MIN_SECONDS
    end if
    if (present(hour)) then
      isec = isec + real(hour, DP) * HOUR_SECONDS
    end if
    iday = present_select(.false., day_default, day)
    iday = iday + floor(isec / time % day_seconds)
    imon = present_select(.false., mon_default, mon)
    iyear = present_select(.false., year_default, year)
  end if

  time % zone = izone
  time % sec = modulo(isec, time % day_seconds)
  time % caltype = caltype_default
  if (present(caltype)) then
    if (ValidCaltype(caltype)) then
      time % caltype = caltype
    else
      stat = DC_EBADCALTYPE
      cause_i = caltype
      if (present(err)) then
        call MessageNotify('W', subname, 'caltype=<%d> is invalid calender type.', i=(/caltype/))
      else
        goto 999
      end if
    end if
  end if
  if (time % caltype == CAL_CYCLIC) then
    time % day = iday + imon * CYCLIC_MDAYS
    goto 999
  endif
  month = modulo(imon - 3, YEAR_MONTHS) + 3
  iyear = iyear + (imon - month) / YEAR_MONTHS
  iday = iday + (month * 306 - 914) / 10
  if (time % caltype == CAL_NOLEAP) then
    time % day = iday + iyear * 365 + 90
  else
    iday = iday + (iyear * FOUR_YEARS - modulo(iyear * FOUR_YEARS, 4)) / 4
    if (time % caltype == CAL_JULIAN .or. iday < 640116) then
      time % day = iday + 91
    else
      century = (iyear - modulo(iyear, 100)) / 100 + 1
      time % day = iday - (century * 3 - modulo(century * 3, 4)) / 4 + 93
    endif
  endif
999 continue
  call StoreError(stat, subname, err, cause_c, cause_i)
  call EndSub(subname, 'time (caltype=%d, day=%d, sec=%f, zone=%c, day_seconds=%f)', i=(/time % caltype, time % day/), d=(/time % sec, time % day_seconds/), c1=trim(time % zone))

  contains
    subroutine get_current_time(jyear, jmon, jday, jsec, jzone)
      !
      ! date_and_time 組み込みサブルーチンを用いて, 現在
      ! 時刻と UTC からの時差を返します.
      !
      use dc_types, only: DP
      use dc_string, only: StoD
      implicit none
      integer, intent(out) :: jyear, jmon, jday
      real(DP), intent(out) :: jsec
      character(*), intent(out) :: jzone

      integer :: date_time_values(1:8)
      character(5)  :: zone_raw
    continue

      call date_and_time(zone=zone_raw, values=date_time_values)

      jzone = zone_raw(1:3) // ":" // zone_raw(4:5)

      jyear = date_time_values(1)
      jmon  = date_time_values(2)
      jday  = date_time_values(3)
      jsec  = real(date_time_values(5), DP) * HOUR_SECONDS + real(date_time_values(6), DP) * MIN_SECONDS + real(date_time_values(7), DP)

    end subroutine get_current_time

end subroutine DCDateTimeCreate1

subroutine DCDateTimeCreateD(time, sec)
  use dc_types, only: DP
  use dc_date_types, only: DC_DATETIME
  use dc_date, only: Create
  implicit none
  type(DC_DATETIME), intent(out):: time
  real(DP), intent(in):: sec
continue
  call Create(time, sec=sec)
end subroutine DCDateTimeCreateD

subroutine DCDateTimeCreateR(time, sec)
  !
  ! dc_date_types#DC_DATETIME 型変数の生成を行います.
  ! 引数 sec には秒数を与えてください. 年月日, 時分を使って
  ! 指定を行いたい場合は Create を利用してください.
  !
  use dc_types, only: DP
  use dc_date_types, only: DC_DATETIME
  use dc_date, only: Create
  implicit none
  type(DC_DATETIME), intent(out):: time
  real, intent(in):: sec
continue
  call Create(time, sec=real(sec, DP))
end subroutine DCDateTimeCreateR

subroutine DCDiffTimeCreate1(diff, year, mon, day, hour, min, sec, day_seconds)
  !
  ! dc_date_types#DC_DIFFTIME 型変数の生成を行います.
  ! 引数 year, mon, day, hour, min, sec を与えない場合,
  ! 0 が与えられたことになります.
  !
  ! 引数 *day_seconds* には 1 日何秒かを設定します. この引数を
  ! 指定しない場合, dc_date_types#day_seconds の値が用いられます.
  ! dc_date_types#day_seconds は SetSecOfDay で変更可能です.
  !
  use dc_types,      only: DP
  use dc_date_types, only: DC_DIFFTIME, day_seconds_default => day_seconds, MIN_SECONDS, HOUR_SECONDS, YEAR_MONTHS
  use dc_message, only: MessageNotify
  use dc_trace, only: BeginSub, EndSub
  use dc_date, only: ValidCaltype, dcdate_normalize
  use dc_present, only: present_select
  implicit none
  type(DC_DIFFTIME), intent(out) :: diff
  integer, intent(in), optional:: year ! 年
  integer, intent(in), optional:: mon  ! 月
  integer, intent(in), optional:: day  ! 日
  integer, intent(in), optional:: hour ! 時
  integer, intent(in), optional:: min  ! 分
  real(DP),intent(in), optional:: sec  ! 秒
  real(DP),intent(in), optional:: day_seconds  ! 1 日の秒数

  integer :: iyear, imon, iday, ihour, imin
  real(DP):: isec
  integer, parameter :: year_default = 0, mon_default = 0
  integer, parameter :: day_default = 0, hour_default = 0, min_default = 0
  real(DP), parameter:: sec_default = 0.0_DP
  character(*), parameter :: subname = 'DCDiffTimeCreate1'
continue
  call BeginSub(subname)

  iyear = present_select(.false., year_default, year)
  imon  = present_select(.false., mon_default, mon)
  iday  = present_select(.false., day_default, day)
  ihour = present_select(.false., hour_default, hour)
  imin  = present_select(.false., min_default, min)
  isec  = present_select(.false., sec_default, sec)

  diff % mon = iyear * YEAR_MONTHS + imon
  diff % day = iday
  diff % sec = real(ihour, DP) * HOUR_SECONDS + real(imin, DP) * MIN_SECONDS + isec

  diff % day_seconds = present_select(.false., day_seconds_default, day_seconds)

  call dcdate_normalize(diff % day, diff % sec, diff % day_seconds)

999 continue
  call EndSub(subname, 'diff (mon=%d, day=%d, sec=%f, day_seconds=%f)', i=(/diff % mon, diff % day/), d=(/diff % sec, diff % day_seconds/))
end subroutine DCDiffTimeCreate1

subroutine DCDiffTimeCreate2(diff, value, unit, err)
  !
  ! dc_date_types#DC_DIFFTIME 型変数の生成を行います.
  ! 引数 *value* に数値を, *unit* に単位を表す文字列を与えてください.
  ! unit に指定できるのは以下の文字列です. (大文字小文字は区別しません).
  !
  ! 年 :: dc_date_types#UNIT_YEAR
  ! 月 :: dc_date_types#UNIT_MONTH
  ! 日 :: dc_date_types#UNIT_DAY
  ! 時 :: dc_date_types#UNIT_HOUR
  ! 分 :: dc_date_types#UNIT_MIN
  ! 秒 :: dc_date_types#UNIT_SEC
  !
  ! これらに該当しない文字列を *unit* に与えた場合, エラーを発生させます.
  ! 引数 *err* を与えている場合には *err* に .true. が返り,
  ! プログラムは続行します.
  !
  use dc_types, only: DP, STRING
  use dc_trace, only: BeginSub, EndSub
  use dc_error, only: StoreError, DC_EBADUNIT, DC_NOERR
  use dc_string, only: StriEq
  use dc_date, only: Create, dcdate_parse_unit
  use dc_date_types, only: DC_DIFFTIME, UNIT_YEAR, UNIT_MONTH, UNIT_DAY, UNIT_HOUR, UNIT_MIN, UNIT_SEC, MIN_SECONDS, HOUR_SECONDS, day_seconds, CYCLIC_MDAYS, YEAR_MONTHS
  implicit none
  type(DC_DIFFTIME), intent(out) :: diff
  real(DP), intent(in) :: value
  character(*), intent(in) :: unit
  logical, intent(out), optional :: err

  integer :: stat, val_int
  real(DP):: val_dec
  character(STRING) :: cause_c, unitl

  character(*), parameter :: subname = 'DCDiffTimeCreate2'
continue
  call BeginSub(subname, 'value=%f unit=%c', d=(/value/), c1=trim(unit))
  stat = DC_NOERR
  cause_c = ''
  unitl = dcdate_parse_unit(unit)
  if (trim(unitl) == trim(UNIT_SEC(1))) then
    call Create(diff, sec=value)
    goto 999
  end if

  val_int = int(value)
  val_dec = value - int(value)

  if (trim(unitl) == trim(UNIT_MIN(1))) then
    call Create(diff, min = val_int, sec = val_dec * MIN_SECONDS)
  elseif (trim(unitl) == trim(UNIT_HOUR(1))) then
    call Create(diff, hour = val_int, sec = val_dec * HOUR_SECONDS)
  elseif (trim(unitl) == trim(UNIT_DAY(1))) then
    call Create(diff, day = val_int, sec = val_dec * day_seconds)
  elseif (trim(unitl) == trim(UNIT_MONTH(1))) then
    call Create(diff, mon = val_int, sec = int(val_dec * CYCLIC_MDAYS) * day_seconds)
  elseif (trim(unitl) == trim(UNIT_YEAR(1))) then
    call Create(diff, year = val_int, sec = int(val_dec * CYCLIC_MDAYS * YEAR_MONTHS) * day_seconds)
  else
    stat = DC_EBADUNIT
    cause_c = unitl
  end if

999 continue
  call StoreError(stat, subname, err, cause_c)
  call EndSub(subname, 'diff (mon=%d, day=%d, sec=%f)', i=(/diff % mon, diff % day/), d=(/diff % sec/))
end subroutine DCDiffTimeCreate2

subroutine DCDiffTimeCreateD(diff, sec)
  use dc_types, only: DP
  use dc_date_types, only: DC_DIFFTIME
  use dc_date, only: Create
  implicit none
  type(DC_DIFFTIME), intent(out):: diff
  real(DP), intent(in):: sec
continue
  call Create(diff, sec=sec)
end subroutine DCDiffTimeCreateD

subroutine DCDiffTimeCreateR(diff, sec)
  !
  ! dc_date_types#DC_DIFFTIME 型変数の生成を行います.
  ! 引数 sec には秒数を与えてください. 年月日, 時分を使って
  ! 指定を行いたい場合は Create を利用してください.
  !
  use dc_types, only: DP
  use dc_date_types, only: DC_DIFFTIME
  use dc_date, only: Create
  implicit none
  type(DC_DIFFTIME), intent(out):: diff
  real, intent(in):: sec
continue
  call Create(diff, sec=real(sec, DP))
end subroutine DCDiffTimeCreateR

    subroutine get_current_time(jyear, jmon, jday, jsec, jzone)
      !
      ! date_and_time 組み込みサブルーチンを用いて, 現在
      ! 時刻と UTC からの時差を返します.
      !
      use dc_types, only: DP
      use dc_string, only: StoD
      implicit none
      integer, intent(out) :: jyear, jmon, jday
      real(DP), intent(out) :: jsec
      character(*), intent(out) :: jzone

      integer :: date_time_values(1:8)
      character(5)  :: zone_raw
    continue

      call date_and_time(zone=zone_raw, values=date_time_values)

      jzone = zone_raw(1:3) // ":" // zone_raw(4:5)

      jyear = date_time_values(1)
      jmon  = date_time_values(2)
      jday  = date_time_values(3)
      jsec  = real(date_time_values(5), DP) * HOUR_SECONDS + real(date_time_values(6), DP) * MIN_SECONDS + real(date_time_values(7), DP)

    end subroutine get_current_time