dccalinquire.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 calendar
!> @details
!> Procedures described in this file are provided from "dc_calendar" module.
!> @enden
!>
!> @ja
!> @brief 暦情報の問い合わせ
!> @details
!> このファイルに記載される手続き群は dc_calendar モジュールから提供されます.
!> @endja
!>
 
!> @en
!> @brief Inquire information of calendar
!> @details
!> Inquire information of calendar.
!>
!> Following strings are returned to `cal_type`.
!>
!> | cal_type     | Description                                              |
!> |--------------|----------------------------------------------------------|
!> | gregorian    | Gregorian calendar                                       |
!> | julian       | Julian calendar                                          |
!> | noleap       | A calendar without leap year                             |
!> | 360day       | A calendar in which number of days of a month is 30      |
!> | cyclic       | A calendar in which number of days of a year is "30.6 x (number of months) - (total days until last month)" (truncate fractional part) |
!> | user_defined | User defined calendar                                    |
!>
!> If an optional argument `cal` is omitted,
!> information of a calendar that is stored in the "dc_calendar"
!> is returned.
!> If `cal` is not omitted, information of the variable is returned.
!>
!> @param[out] cal_type          Strings that specify a kind of calendar
!> @param[out] month_in_year     Months in a year
!> @param[out] day_in_month      Days in months (array)
!> @param[out] day_in_month_ptr  Days in months (pointer)
!> @param[out] hour_in_day       Hours in a day
!> @param[out] min_in_hour       Minutes in an hour
!> @param[out] sec_in_min        Seconds in a minute
!> @param[in]  cal               An object that stores information of calendar
!> @param[out] err               Exception handling flag
!> @enden
!>
!> @ja
!> @brief 暦情報の問い合わせ
!> @details
!> 暦情報の問い合わせを行います.
!>
!> `cal_type` には以下の文字列が返ります.
!>
!> | cal_type     | 説明                                                     |
!> |--------------|----------------------------------------------------------|
!> | gregorian    | グレゴリオ暦                                             |
!> | julian       | ユリウス暦                                               |
!> | noleap       | 閏年無しの暦                                             |
!> | 360day       | 1ヶ月が 30 日の暦                                        |
!> | cyclic       | ある月の日数を「30.6 × 月数 − 前月までの総日数」の小数点以下切捨とする暦 |
!> | user_defined | ユーザ定義の暦                                           |
!>
!> 省略可能引数 `cal` が省略された場合には, dc_calendar 内部で
!> 保持される暦に関する情報が得られます.
!> `cal` が省略されない場合にはその変数に設定された暦の情報が得られます.
!>
!> @param[out] cal_type          暦の種類を示す文字列
!> @param[out] month_in_year     1年の月数
!> @param[out] day_in_month      1ヶ月の日数 (配列)
!> @param[out] day_in_month_ptr  1ヶ月の日数 (ポインタ)
!> @param[out] hour_in_day       1日の時間数
!> @param[out] min_in_hour       1時間の分数
!> @param[out] sec_in_min        1分の秒数
!> @param[in]  cal               暦情報を収めたオブジェクト
!> @param[out] err               例外処理用フラグ.
!>                               デフォルトでは, この手続き内でエラーが生じた場合,
!>                               プログラムは強制終了します.
!>                               引数 `err` が与えられる場合, プログラムは強制終了せず,
!>                               代わりに `err` に .true. が代入されます.
!> @endja
subroutine dccalinquire1( cal_type, &
  &                       month_in_year, day_in_month, day_in_month_ptr, &
  &                       hour_in_day, min_in_hour, sec_in_min, &
  &                       cal, err )
 
  use dc_calendar_types, only: dc_cal
  use dc_calendar_internal, only: default_cal, default_cal_set, dccaltype_str
  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
  use dc_types, only: string, dp
  implicit none
  character(*), intent(out), optional:: cal_type
  integer, intent(out), optional:: month_in_year
  integer, intent(out), optional:: day_in_month(:)
  integer, pointer, optional:: day_in_month_ptr(:)
  integer, intent(out), optional:: hour_in_day
  integer, intent(out), optional:: min_in_hour
  real(DP), intent(out), optional:: sec_in_min
  type(dc_cal), intent(in), optional, target:: cal
  logical, intent(out), optional:: err
 
  ! 作業変数
  ! Work variables
  !
  type(dc_cal), pointer:: calp =>null()
  integer:: siz_dm
  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( cal ) ) then
    calp => cal
  else
    calp => default_cal
    if ( .not. calp % initialized ) call default_cal_set
  end if
 
  ! 初期設定のチェック
  ! Check initialization
  !
  if ( .not. calp % initialized ) then
    stat = dc_enotinit
    cause_c = 'DC_CAL'
    goto 999
  end if
 
  ! 各要素への値の参照
  ! Refer elements
  !
  if ( present( cal_type      ) ) then
    cal_type = dccaltype_str( calp % cal_type )
  end if
  if ( present( month_in_year ) ) month_in_year = calp % month_in_year
  if ( present( hour_in_day   ) ) hour_in_day   = calp % hour_in_day
  if ( present( min_in_hour   ) ) min_in_hour   = calp % min_in_hour
  if ( present( sec_in_min    ) ) sec_in_min    = calp % sec_in_min
 
  if ( present( day_in_month     ) ) then
    if ( size( day_in_month ) > 0 ) then
      day_in_month = 0
      siz_dm = min( size( day_in_month ), size( calp % day_in_month ) )
      day_in_month(1:siz_dm) = calp % day_in_month(1:siz_dm)
    end if
  end if
 
  if ( present( day_in_month_ptr ) ) then
    siz_dm = size( calp % day_in_month )
    allocate( day_in_month_ptr(1:siz_dm) )
    day_in_month_ptr(1:siz_dm) = calp % day_in_month(1:siz_dm)
  end if
 
  ! 終了処理, 例外処理
  ! Termination and Exception handling
  !
999 continue
  nullify( calp )
  call storeerror( stat, subname, err, cause_c )
  call endsub( subname )
end subroutine dccalinquire1