dccaldateinquire.f90

Go to the documentation of this file.

! -*- mode: f90; coding: utf-8 -*-
!-----------------------------------------------------------------------
! Copyright (c) 2000-2026 Gtool Development Group. All rights reserved.
!-----------------------------------------------------------------------
!>
!> @author    Yasuhiro MORIKAWA
!> @copyright Copyright (C) GFD Dennou Club, 2009-2026. All rights reserved. <br/>
!>            License is BSD-2-Clause. see [COPYRIGHT](@ref COPYRIGHT) in detail
!> @en
!> @brief Inquire information of date
!> @details
!> Procedures described in this file are provided from "dc_calendar" module.
!> @enden
!>
!> @ja
!> @brief 日時情報の問い合わせ
!> @details
!> このファイルに記載される手続き群は dc_calendar モジュールから提供されます.
!> @endja
!>
 
!> @en
!> @brief Inquire date information as individual variables
!> @details
!> Inquire information of date.
!>
!> If a string like as "YYYY-MM-DDThh:mm:ss.sTZD"
!> (YYYY is year, MM is month, DD is day, hh is hour, mm is minute,
!> ss.s is second, TZD is time zone) is needed,
!> use a following homonymous subroutine.
!>
!> If an optional argument `date` is omitted,
!> information of date that is stored in the "dc_calendar"
!> is returned,
!> If `date` is not omitted, information of the variable is returned.
!>
!> If an optional argument `cal` is omitted,
!> information of calendar that is stored in the "dc_calendar"
!> is used for conversion of elapsed seconds `elapse_sec` into
!> year-month-day etc.
!> If `cal` is not omitted, information of the variable is used.
!>
!> @param[out] year Year
!> @param[out] month Month
!> @param[out] day Day
!> @param[out] hour Hour
!> @param[out] min Minute
!> @param[out] sec Second
!> @param[out] zone Time-zone (difference from UTC)
!> @param[in] elapse_sec Elapsed seconds from `date`
!> @param[in] date An object that stores information of date and time
!> @param[in] cal An object that stores information of calendar
!> @param[out] err Exception handling flag.
!>                 By default, when error occur in this procedure, the program aborts.
!>                 If this `err` argument is given, .true. is substituted to `err` and
!>                 the program does not abort.
!> @enden
!>
!> @ja
!> @brief 日時情報を個別変数で問い合わせ
!> @details
!> 日時情報の問い合わせを行います.
!>
!> 問い合わせの結果を
!> YYYY-MM-DDThh:mm:ss.sTZD のような文字列
!> (YYYY は年, MM は月, DD は日, hh は時, mm は分, ss.s は秒,
!> TZD はタイムゾーン) で受け取りたい場合には,
!> 下記の同名のサブルーチンを使用して下さい.
!>
!> 省略可能引数 `date` が省略された場合には, dc_calendar 内部で
!> 保持される日時に関する情報が得られます.
!> `date` が省略されない場合にはその変数に設定された日時の情報が得られます.
!>
!> 省略可能引数 `cal` が省略された場合には, 経過秒数 `elapse_sec`
!> の年月日時分への変換に dc_calendar 内部で保持される暦が用いられます.
!> `cal` が省略されない場合にはその変数に設定された暦が用いられます.
!>
!> @param[out] year 年
!> @param[out] month 月
!> @param[out] day 日
!> @param[out] hour 時
!> @param[out] min 分
!> @param[out] sec 秒
!> @param[out] zone UTC からの時差
!> @param[in] elapse_sec `date` からの経過秒数
!> @param[in] date 日時情報を収めたオブジェクト
!> @param[in] cal 暦情報を収めたオブジェクト
!> @param[out] err 例外処理用フラグ.
!>                 デフォルトでは, この手続き内でエラーが生じた場合,
!>                 プログラムは強制終了します.
!>                 引数 `err` が与えられる場合, プログラムは強制終了せず,
!>                 代わりに `err` に .true. が代入されます.
!> @endja
subroutine dccaldateinquire1( year, month, day, hour, min, sec, zone, &
  & elapse_sec, date, cal, err )
 
  use dc_calendar_types, only: dc_cal, dc_cal_date
  use dc_calendar_internal, only: default_cal, default_cal_set, default_date, &
    & dccaldate_normalize
  use dc_calendar_generic, only: dccaldatetochar, dccaltochar
  use dc_message, only: messagenotify
  use dc_string, only: lchar
  use dc_trace, only: beginsub, endsub
  use dc_error, only: storeerror, dc_noerr, dc_enotinit, &
    & dc_einconsistcaldate
  use dc_types, only: string, dp, token
  implicit none
  integer, intent(out), optional:: year
  integer, intent(out), optional:: month
  integer, intent(out), optional:: day
  integer, intent(out), optional:: hour
  integer, intent(out), optional:: min
  real(DP), intent(out), optional:: sec
  character(*), intent(out), optional:: zone
  real(DP), intent(in), optional:: elapse_sec
  type(dc_cal_date), intent(in), optional, target:: date
  type(dc_cal), intent(in), optional, target:: cal
  logical, intent(out), optional:: err
 
  ! 作業変数
  ! Work variables
  !
  integer:: wyear, wmonth, wday, whour, wmin
  real(DP):: wsec
  character(TOKEN):: wzone
  type(dc_cal_date), pointer:: datep =>null()
  type(dc_cal), pointer:: calp =>null()
  character(STRING):: e_date_str, e_cal_str
  integer:: stat
  character(STRING):: cause_c
  character(*), parameter:: subname = 'DCCalInquire1'
continue
  call beginsub( subname )
  stat = dc_noerr
  cause_c = ''
 
  ! オブジェクトのポインタ割付
  ! Associate pointer of an object
  !
  if ( present( date ) ) then
    datep => date
  else
    datep => default_date
  end if
 
  if ( present( cal ) ) then
    calp => cal
  else
    calp => default_cal
    if ( .not. calp % initialized ) call default_cal_set
  end if
 
  ! 初期設定のチェック
  ! Check initialization
  !
  if ( .not. datep % initialized ) then
    stat = dc_enotinit
    cause_c = 'DC_CAL_DATE'
    goto 999
  end if
 
  if ( .not. calp % initialized ) then
    stat = dc_enotinit
    cause_c = 'DC_CAL'
    goto 999
  end if
 
  ! 各要素への値の参照
  ! Refer elements
  !
  wyear  = datep % year
  wmonth = datep % month
  wday   = datep % day
  whour  = datep % hour
  wmin   = datep % min
  wsec   = datep % sec
  wzone  = datep % zone
 
  ! 経過時間(秒)の追加
  ! Add elapsed time (seconds)
  !
  if ( present( elapse_sec ) ) then
!!$    if ( elapse_sec < 0.0_DP ) then
!!$      stat = DC_ENEGATIVE
!!$      cause_c = 'elapse_sec'
!!$      goto 999
!!$    end if
 
    wsec = wsec + elapse_sec
  end if
 
  ! 日時の正規化
  ! Normalize date and time
  !
  stat = dccaldate_normalize( wyear, wmonth, wday, whour, wmin, wsec, & ! (inout)
    &                         calp )                                    ! (in)
  if ( stat == dc_einconsistcaldate ) then
    e_cal_str = dccaltochar( calp )
    e_date_str = dccaldatetochar( wyear, wmonth, wday, whour, wmin, wsec, wzone )
    call messagenotify('W', subname, 'cal=<%c> and date=<%c> are inconsistency', &
      & c1 = trim(e_cal_str), c2 = trim(e_date_str) )
    goto 999
  end if
 
  ! 引数への代入
  ! Substitute arguments
  !
  if ( present(year ) ) year  = wyear
  if ( present(month) ) month = wmonth
  if ( present(day  ) ) day   = wday
  if ( present(hour ) ) hour  = whour
  if ( present(min  ) ) min   = wmin
  if ( present(sec  ) ) sec   = wsec
  if ( present(zone ) ) zone  = wzone
 
  ! 終了処理, 例外処理
  ! Termination and Exception handling
  !
999 continue
  nullify( calp, datep )
  call storeerror( stat, subname, err, cause_c )
  call endsub( subname )
end subroutine dccaldateinquire1
 
!> @en
!> @brief Inquire date information as a string
!> @details
!> Inquire information of date.
!> A result is returned as a string like as
!> YYYY-MM-DDThh:mm:ss.sTZD
!> (YYYY is year, MM is month, DD is day, hh is hour, mm is minute,
!> ss.s is second, TZD is time zone).
!> Format of date is conformed to gtool4 netCDF Convention "5.5 Expression of date and time"
!>
!> If individual variables (year, month, day, hour, minute, second, zone)
!> are needed, use a foregoing homonymous subroutine.
!>
!> If an optional argument `date` is omitted,
!> information of date that is stored in the "dc_calendar"
!> is returned,
!> If `date` is not omitted, information of the variable is returned.
!>
!> If an optional argument `cal` is omitted,
!> information of calendar that is stored in the "dc_calendar"
!> is used for conversion of elapsed seconds `elapse_sec` into
!> year-month-day etc.
!> If `cal` is not omitted, information of the variable is used.
!>
!> @param[out] date_str Strings that express date and time.
!>                      See gtool4 netCDF Convention 5.5 Expression of date and time for details.
!> @param[in] elapse_sec Elapsed seconds from `date`
!> @param[in] date An object that stores information of date and time
!> @param[in] cal An object that stores information of calendar
!> @param[out] err Exception handling flag.
!>                 By default, when error occur in this procedure, the program aborts.
!>                 If this `err` argument is given, .true. is substituted to `err` and
!>                 the program does not abort.
!> @enden
!>
!> @ja
!> @brief 日時情報を文字列で問い合わせ
!> @details
!> 日時情報の問い合わせを行います.
!> 問い合わせ結果は YYYY-MM-DDThh:mm:ss.sTZD のような文字列
!> (YYYY は年, MM は月, DD は日, hh は時, mm は分, ss.s は秒,
!> TZD はタイムゾーン) で返ります.
!> 日時の文字列形式は
!> gtool4 netCDF 規約「5.5 日時形式」に準拠しています.
!>
!> 問い合わせの結果を年月日時分秒で各個変数で受け取りたい場合は
!> 上記の同名のサブルーチンを使用して下さい.
!>
!> 省略可能引数 `date` が省略された場合には, dc_calendar 内部で
!> 保持される日時に関する情報が得られます.
!> `date` が省略されない場合にはその変数に設定された日時の情報が得られます.
!>
!> 省略可能引数 `cal` が省略された場合には, 経過秒数 `elapse_sec`
!> の年月日時分への変換に dc_calendar 内部で保持される暦が用いられます.
!> `cal` が省略されない場合にはその変数に設定された暦が用いられます.
!>
!> @param[out] date_str 日時情報を表す文字列.
!>                      表示形式については gtool4 netCDF 規約 5.5 日時形式を参照のこと.
!> @param[in] elapse_sec `date` からの経過秒数
!> @param[in] date 日時情報を収めたオブジェクト
!> @param[in] cal 暦情報を収めたオブジェクト
!> @param[out] err 例外処理用フラグ.
!>                 デフォルトでは, この手続き内でエラーが生じた場合,
!>                 プログラムは強制終了します.
!>                 引数 `err` が与えられる場合, プログラムは強制終了せず,
!>                 代わりに `err` に .true. が代入されます.
!> @endja
subroutine dccaldateinquire2( date_str, elapse_sec, date, cal, err )
 
  use dc_calendar_generic, only: dccaldatetochar
  use dc_calendar_types, only: dc_cal, dc_cal_date
  use dc_calendar_internal, only: default_cal, default_cal_set, default_date, &
    & dccaldate_normalize
  use dc_calendar_generic, only: dccaldatetochar, dccaltochar
  use dc_message, only: messagenotify
  use dc_string, only: lchar
  use dc_trace, only: beginsub, endsub
  use dc_error, only: storeerror, dc_noerr, dc_enotinit, &
    & dc_einconsistcaldate
  use dc_types, only: string, dp, token
  implicit none
  character(*), intent(out):: date_str
  real(DP), intent(in), optional:: elapse_sec
  type(dc_cal_date), intent(in), optional, target:: date
  type(dc_cal), intent(in), optional, target:: cal
  logical, intent(out), optional:: err
 
  ! 作業変数
  ! Work variables
  !
  integer:: year, month, day, hour, min
  real(DP):: sec
  character(TOKEN):: zone
  type(dc_cal_date), pointer:: datep =>null()
  type(dc_cal), pointer:: calp =>null()
  character(STRING):: e_date_str, e_cal_str
  integer:: stat
  character(STRING):: cause_c
  character(*), parameter:: subname = 'DCCalInquire2'
continue
  call beginsub( subname )
  stat = dc_noerr
  cause_c = ''
 
  ! オブジェクトのポインタ割付
  ! Associate pointer of an object
  !
  if ( present( date ) ) then
    datep => date
  else
    datep => default_date
  end if
 
  if ( present( cal ) ) then
    calp => cal
  else
    calp => default_cal
    if ( .not. calp % initialized ) call default_cal_set
  end if
 
  ! 初期設定のチェック
  ! Check initialization
  !
  if ( .not. datep % initialized ) then
    stat = dc_enotinit
    cause_c = 'DC_CAL_DATE'
    goto 999
  end if
 
  if ( .not. calp % initialized ) then
    stat = dc_enotinit
    cause_c = 'DC_CAL'
    goto 999
  end if
 
  ! 各要素の取得
  ! Get elements
  !
  year  = datep % year
  month = datep % month
  day   = datep % day
  hour  = datep % hour
  min   = datep % min
  sec   = datep % sec
  zone  = datep % zone
 
 
  ! 経過時間(秒)の追加
  ! Add elapsed time (seconds)
  !
  if ( present( elapse_sec ) ) then
!!$    if ( elapse_sec < 0.0_DP ) then
!!$      stat = DC_ENEGATIVE
!!$      cause_c = 'elapse_sec'
!!$      goto 999
!!$    end if
 
    sec = sec + elapse_sec
  end if
 
  ! 日時の正規化
  ! Normalize date and time
  !
  stat = dccaldate_normalize( year, month, day, hour, min, sec, & ! (inout)
    &                         calp )                              ! (in)
  if ( stat == dc_einconsistcaldate ) then
    e_cal_str = dccaltochar( calp )
    e_date_str = dccaldatetochar( year, month, day, hour, min, sec, zone )
    call messagenotify('W', subname, 'cal=<%c> and date=<%c> are inconsistency', &
      & c1 = trim(e_cal_str), c2 = trim(e_date_str) )
    goto 999
  end if
 
  ! 日時表記（gtool4 netCDF 規約 5.5 日時形式）への変換
  ! Convert expression of date (gtool4 netCDF Convention 5.5 Expression of date and time)
  !
  date_str = dccaldatetochar( year, month, day, hour, min, sec, zone )
 
  ! 終了処理, 例外処理
  ! Termination and Exception handling
  !
999 continue
  nullify( calp, datep )
  call storeerror( stat, subname, err, cause_c )
  call endsub( subname )
end subroutine dccaldateinquire2