dccalcreate.f90

Path: dc_utils/dccalcreate.f90
Last Update: Sun Oct 18 21:02:32 +0900 2009

暦の設定

Setting of calendar

Authors:Yasuhiro MORIKAWA
Version:$Id: dccalcreate.f90,v 1.4 2009-10-18 12:02:32 morikawa Exp $
Tag Name:$Name: gtool5-20100924 $
Copyright:Copyright (C) GFD Dennou Club, 2009-. All rights reserved.
License:See COPYRIGHT

このファイルに記載される手続き群は dc_calendar モジュールから提供されます.

Procedures described in this file are provided from "dc_calendar" module.

Required files

Methods

Included Modules

dc_calendar_types dc_calendar_internal dc_message dc_string dc_trace dc_error dc_types

Public Instance methods

Subroutine :
cal_type :character(*), intent(in)
: 既定の暦を指定する文字列.

Strings that specify a previously-defined calendar.

cal :type(DC_CAL), intent(out), optional, target
: 暦情報を収めたオブジェクト.

An object that stores information of calendar.

err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 err が与えられる場合, プログラムは強制終了せず, 代わりに err に .true. が代入されます.

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.

暦の設定を行います.

このサブルーチンは "dc_calendar" モジュールで用意した 既定の暦を設定するものです. 1 ヶ月の日数, 1 日の秒数などを 任意に指定する場合には, 下記の同名のサブルーチンを使用して下さい.

cal_type として以下のものが有効です. これ以外の文字列 を与えた場合にはエラーが発生します. 大文字と小文字は区別しません.

gregorian :グレゴリオ暦
julian :ユリウス暦
noleap :閏年無しの暦
360day :1ヶ月が 30 日の暦
cyclic :ある月の日数を 「30.6 × 月数 − 前月までの総日数」 の小数点以下切捨とする暦

省略可能引数 cal が省略された場合には, dc_calendar 内部で 保持される "dc_calendar_types#DC_CAL" 型の変数に暦が 設定されます. その後の手続きで cal を省略した場合には この暦が使用されます. cal が省略されない場合にはその変数に暦が設定されます. その暦を使用する場合, 手続きにその "dc_calendar_types#DC_CAL" 型の変数 を与えてください.

Set calendar.

This subroutine set previously-defined calendars by "dc_calendar" module. If number of days of a month, number of seconds of a day, etc. want to be specified arbitrarily, use a following homonymous subroutine.

Following strings are valid as cal_type. If any other strings is specified, an error is caused. They are not case-sensitive.

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).

If an optional argument cal is omitted, the calendar setting is stored to a "dc_calendar_types#DC_CAL" variable that is saved in the "dc_calendar". When cal is omitted in subsequent procedures, the internal calendar is used. If cal is not omitted, the settings is stored to the cal. In order to use the calendar setting, use the "dc_calendar_types#DC_CAL" varieble to subsequent procedures.

[Source]

subroutine DCCalCreate1( cal_type, cal, err )
  !
  ! 暦の設定を行います. 
  !
  ! このサブルーチンは "dc_calendar" モジュールで用意した
  ! 既定の暦を設定するものです. 1 ヶ月の日数, 1 日の秒数などを
  ! 任意に指定する場合には, 下記の同名のサブルーチンを使用して下さい. 
  !
  ! *cal_type* として以下のものが有効です. これ以外の文字列
  ! を与えた場合にはエラーが発生します. 大文字と小文字は区別しません. 
  !
  ! gregorian         :: グレゴリオ暦
  ! julian            :: ユリウス暦
  ! noleap            :: 閏年無しの暦
  ! 360day            :: 1ヶ月が 30 日の暦
  ! cyclic            :: ある月の日数を
  !                      「30.6 × 月数 − 前月までの総日数」
  !                      の小数点以下切捨とする暦
  !
  ! 省略可能引数 *cal* が省略された場合には, dc_calendar 内部で
  ! 保持される "dc_calendar_types#DC_CAL" 型の変数に暦が
  ! 設定されます. その後の手続きで *cal* を省略した場合には
  ! この暦が使用されます. 
  ! *cal* が省略されない場合にはその変数に暦が設定されます.
  ! その暦を使用する場合, 手続きにその "dc_calendar_types#DC_CAL" 型の変数
  ! を与えてください. 
  !
  ! Set calendar. 
  !
  ! This subroutine set previously-defined calendars by "dc_calendar" module. 
  ! If number of days of a month, number of seconds of a day, etc. 
  ! want to be specified arbitrarily, use a following homonymous subroutine. 
  ! 
  ! Following strings are valid as *cal_type*. 
  ! If any other strings is specified, an error is caused. 
  ! They are not case-sensitive. 
  !
  ! 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). 
  !
  ! If an optional argument *cal* is omitted, 
  ! the calendar setting is stored to a "dc_calendar_types#DC_CAL" 
  ! variable that is saved in the "dc_calendar". 
  ! When *cal* is omitted in subsequent procedures, the internal calendar
  ! is used. 
  ! If *cal* is not omitted, the settings is stored to the *cal*. 
  ! In order to use the calendar setting, use the "dc_calendar_types#DC_CAL" 
  ! varieble to subsequent procedures. 
  !

  use dc_calendar_types, only: DC_CAL, CAL_CYCLIC, CAL_NOLEAP, CAL_JULIAN, CAL_GREGORIAN, CAL_360DAY
  use dc_calendar_internal, only: default_cal
  use dc_message, only: MessageNotify
  use dc_string, only: LChar
  use dc_trace, only: BeginSub, EndSub
  use dc_error, only: StoreError, DC_NOERR, DC_EALREADYINIT, DC_EBADCALTYPE
  use dc_types, only: STRING, DP
  implicit none
  character(*), intent(in):: cal_type
                              ! 既定の暦を指定する文字列. 
                              ! 
                              ! Strings that specify a previously-defined calendar. 
  type(DC_CAL), intent(out), optional, target:: cal
                              ! 暦情報を収めたオブジェクト. 
                              ! 
                              ! An object that stores information of 
                              ! calendar. 
  logical, intent(out), optional:: err
                              ! 例外処理用フラグ. 
                              ! デフォルトでは, この手続き内でエラーが
                              ! 生じた場合, プログラムは強制終了します. 
                              ! 引数 *err* が与えられる場合, 
                              ! プログラムは強制終了せず, 代わりに
                              ! *err* に .true. が代入されます. 
                              !
                              ! 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. 


  ! 作業変数
  ! Work variables
  !
  type(DC_CAL), pointer:: calp =>null()
  integer:: stat
  character(STRING):: cause_c
  character(*), parameter:: version = '$Name: gtool5-20100924 $' // '$Id: dccalcreate.f90,v 1.4 2009-10-18 12:02:32 morikawa Exp $'
  character(*), parameter:: subname = 'DCCalCreate1'
continue
  call BeginSub( subname, version )
  stat = DC_NOERR
  cause_c = ''

  ! オブジェクトのポインタ割付
  ! Associate pointer of an object
  !
  if ( present( cal ) ) then
    calp => cal
  else
    calp => default_cal
  end if

!!$  ! 初期設定のチェック
!!$  ! Check initialization
!!$  !
!!$  if ( calp % initialized ) then
!!$    stat = DC_EALREADYINIT
!!$    cause_c = 'DC_CAL'
!!$    goto 999
!!$  end if

  ! 暦の種別の正当性のチェック
  ! Validate a kind of calendar
  !
  select case( LChar(trim(cal_type)) )
  case('cyclic')
    calp % cal_type = CAL_CYCLIC
  case('noleap')
    calp % cal_type = CAL_NOLEAP
  case('julian')
    calp % cal_type = CAL_JULIAN
  case('gregorian')
    calp % cal_type = CAL_GREGORIAN
  case('360day')
    calp % cal_type = CAL_360DAY
  case default
    stat = DC_EBADCALTYPE
    call MessageNotify('W', subname, 'cal_type=<%c> is invalid calender type.', c1 = trim(cal_type) )
    goto 999
  end select

  ! 各要素への値の設定
  ! Configure elements
  !
  allocate( calp % day_in_month(1:12) )
  calp % month_in_year = 12
  calp % hour_in_day   = 24
  calp % min_in_hour   = 60
  calp % sec_in_min    = 60.0_DP

  select case( calp % cal_type )
  case(CAL_CYCLIC)
    calp % day_in_month(1:12) = (/ 31, 30, 31, 30, 31, 31, 30, 31, 30, 31, 31, 30 /)
  case(CAL_NOLEAP)
    calp % day_in_month(1:12) = (/ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /)
  case(CAL_JULIAN)
    calp % day_in_month(1:12) = (/ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /)
  case(CAL_GREGORIAN)
    calp % day_in_month(1:12) = (/ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /)
  case(CAL_360DAY)
    calp % day_in_month(1:12) = (/ 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30 /)
  case default
  end select

  ! 終了処理, 例外処理
  ! Termination and Exception handling
  !
  calp % initialized = .true.
999 continue
  nullify( calp )
  call StoreError( stat, subname, err, cause_c )
  call EndSub( subname )
end subroutine DCCalCreate1
Subroutine :
month_in_year :integer, intent(in)
: 1 年の月数. Months in a year.
day_in_month(:) :integer, intent(in)
: 1 ヶ月の日数. Days in months.
hour_in_day :integer, intent(in)
: 1 日の時間数. Hours in a day.
min_in_hour :integer, intent(in)
: 1 時間の分数. Minutes in a hour.
sec_in_min :real(DP), intent(in)
: 1 分の秒数. Seconds in a minute.
cal :type(DC_CAL), intent(out), optional, target
: 暦情報を収めたオブジェクト.

An object that stores information of calendar.

err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 err が与えられる場合, プログラムは強制終了せず, 代わりに err に .true. が代入されます.

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.

暦の設定を行います.

1 ヶ月の日数, 1 日の秒数などを引数に指定して下さい. グレゴリオ暦やユリウス暦などを利用する場合には 上記の同名のサブルーチンを使用して下さい.

省略可能引数 cal が省略された場合には, dc_calendar 内部で 保持される "dc_calendar_types#DC_CAL" 型の変数に暦が 設定されます. その後の手続きで cal を省略した場合には この暦が使用されます. cal が省略されない場合にはその変数に暦が設定されます. その暦を使用する場合, 手続きにその "dc_calendar_types#DC_CAL" 型の変数 を与えてください.

Set calendar.

Specify number of days of a month, number of seconds of a day, etc. to arguments. If Gregorian calendar, Julian calendar are needed, see a foregoing homonymous subroutine.

If an optional argument cal is omitted. The calendar setting is stored to a "dc_calendar_types#DC_CAL" variable that is saved in the "dc_calendar". When cal is omitted in subsequent procedures, the internal calendar is used. If cal is not omitted, the settings is stored to the cal. In order to use the calendar setting, use the "dc_calendar_types#DC_CAL" varieble to subsequent procedures.

[Source]

subroutine DCCalCreate2( month_in_year, day_in_month, hour_in_day, min_in_hour, sec_in_min, cal, err )
  !
  ! 暦の設定を行います. 
  !
  ! 1 ヶ月の日数, 1 日の秒数などを引数に指定して下さい. 
  ! グレゴリオ暦やユリウス暦などを利用する場合には
  ! 上記の同名のサブルーチンを使用して下さい. 
  !
  ! 省略可能引数 *cal* が省略された場合には, dc_calendar 内部で
  ! 保持される "dc_calendar_types#DC_CAL" 型の変数に暦が
  ! 設定されます. その後の手続きで *cal* を省略した場合には
  ! この暦が使用されます. 
  ! *cal* が省略されない場合にはその変数に暦が設定されます.
  ! その暦を使用する場合, 手続きにその "dc_calendar_types#DC_CAL" 型の変数
  ! を与えてください. 
  !
  ! Set calendar. 
  !
  ! Specify number of days of a month, number of seconds of a day, etc. 
  ! to arguments. If Gregorian calendar, Julian calendar are needed, 
  ! see a foregoing homonymous subroutine. 
  ! 
  ! If an optional argument *cal* is omitted. 
  ! The calendar setting is stored to a "dc_calendar_types#DC_CAL" 
  ! variable that is saved in the "dc_calendar". 
  ! When *cal* is omitted in subsequent procedures, the internal calendar
  ! is used. 
  ! If *cal* is not omitted, the settings is stored to the *cal*. 
  ! In order to use the calendar setting, use the "dc_calendar_types#DC_CAL" 
  ! varieble to subsequent procedures. 
  !
  use dc_calendar_types, only: DC_CAL, CAL_USER_DEFINED
  use dc_calendar_internal, only: default_cal
  use dc_message, only: MessageNotify
  use dc_types, only: DP
  use dc_trace, only: BeginSub, EndSub
  use dc_error, only: StoreError, DC_NOERR, DC_EALREADYINIT, DC_EBADCALTYPE
  use dc_types, only: STRING
  implicit none
  integer, intent(in):: month_in_year
                              ! 1 年の月数. 
                              ! Months in a year. 
  integer, intent(in):: day_in_month(:)
                              ! 1 ヶ月の日数. 
                              ! Days in months. 
  integer, intent(in):: hour_in_day
                              ! 1 日の時間数. 
                              ! Hours in a day. 
  integer, intent(in):: min_in_hour
                              ! 1 時間の分数. 
                              ! Minutes in a hour. 
  real(DP), intent(in):: sec_in_min
                              ! 1 分の秒数. 
                              ! Seconds in a minute. 
  type(DC_CAL), intent(out), optional, target:: cal
                              ! 暦情報を収めたオブジェクト. 
                              ! 
                              ! An object that stores information of 
                              ! calendar. 
  logical, intent(out), optional:: err
                              ! 例外処理用フラグ. 
                              ! デフォルトでは, この手続き内でエラーが
                              ! 生じた場合, プログラムは強制終了します. 
                              ! 引数 *err* が与えられる場合, 
                              ! プログラムは強制終了せず, 代わりに
                              ! *err* に .true. が代入されます. 
                              !
                              ! 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. 


  ! 作業変数
  ! Work variables
  !
  type(DC_CAL), pointer:: calp =>null()
  integer:: size_day_in_month
  integer:: stat
  character(STRING):: cause_c
  character(*), parameter:: version = '$Name: gtool5-20100924 $' // '$Id: dccalcreate.f90,v 1.4 2009-10-18 12:02:32 morikawa Exp $'
  character(*), parameter:: subname = 'DCCalCreate2'
continue
  call BeginSub( subname, version )
  stat = DC_NOERR
  cause_c = ''

  ! オブジェクトのポインタ割付
  ! Associate pointer of an object
  !
  if ( present( cal ) ) then
    calp => cal
  else
    calp => default_cal
  end if

!!$  ! 初期設定のチェック
!!$  ! Check initialization
!!$  !
!!$  if ( calp % initialized ) then
!!$    stat = DC_EALREADYINIT
!!$    cause_c = 'DC_CAL'
!!$    goto 999
!!$  end if

  ! 月数の算出
  ! Evaluate number of months
  !
  size_day_in_month = size ( day_in_month ) 

  ! 引数の正当性のチェック
  ! Validate arguments
  !
  if ( .not. month_in_year == size_day_in_month ) then
    stat = DC_EBADCALTYPE
    call MessageNotify('W', subname, 'month_in_year=<%d> is not equal to size of day_in_month=<%d>', i = (/ month_in_year, size_day_in_month /) )
    goto 999
  end if

  if ( month_in_year < 1 ) then
    stat = DC_EBADCALTYPE
    call MessageNotify('W', subname, 'month_in_year=<%d> must be positive', i = (/ month_in_year /) )
    goto 999
  end if

  if ( hour_in_day < 1 ) then
    stat = DC_EBADCALTYPE
    call MessageNotify('W', subname, 'hour_in_day=<%d> must be positive', i = (/ hour_in_day /) )
    goto 999
  end if

  if ( min_in_hour < 1 ) then
    stat = DC_EBADCALTYPE
    call MessageNotify('W', subname, 'min_in_hour=<%d> must be positive', i = (/ min_in_hour /) )
    goto 999
  end if

  if ( .not. sec_in_min > 0.0_DP ) then
    stat = DC_EBADCALTYPE
    call MessageNotify('W', subname, 'sec_in_min=<%f> must be positive', d = (/ sec_in_min /) )
    goto 999
  end if

  ! 各要素への値の設定
  ! Configure elements
  !
  calp % cal_type      = CAL_USER_DEFINED
  calp % month_in_year = month_in_year
  allocate( calp % day_in_month(1:size_day_in_month) )
  calp % day_in_month  = day_in_month 
  calp % hour_in_day   = hour_in_day  
  calp % min_in_hour   = min_in_hour  
  calp % sec_in_min    = sec_in_min   

  ! 終了処理, 例外処理
  ! Termination and Exception handling
  !
  calp % initialized = .true.
999 continue
  nullify( calp )
  call StoreError( stat, subname, err, cause_c )
  call EndSub( subname )
end subroutine DCCalCreate2