!= æš¦ã®è¨å®š
!= Setting of calendar
!
! Authors::   Yasuhiro MORIKAWA
! Version::   $Id: dccalcreate.f90,v 1.4 2009-10-18 12:02:32 morikawa Exp $
! Tag Name::  $Name:  $
! Copyright:: Copyright (C) GFD Dennou Club, 2009-. All rights reserved.
! License::   See COPYRIGHT[link:../../COPYRIGHT]
!
! ã“ã®ãƒ•ã‚¡ã‚¤ãƒ«ã«è¨˜è¼‰ã•ã‚Œã‚‹æ‰‹ç¶šãç¾¤ã¯ dc_calendar ãƒ¢ã‚¸ãƒ¥ãƒ¼ãƒ«ã‹ã‚‰æä¾›ã•ã‚Œã¾ã™.
!
! Procedures described in this file are provided from "dc_calendar" module.
!

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:  $' // &
    & '$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 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:  $' // &
    & '$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