dccaldateparsestr.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 Parse strings of date
!> @details
!> Procedures described in this file are provided from "dc_calendar" module.
!> @enden
!>
!> @ja
!> @brief 日時の文字列の解釈
!> @details
!> このファイルに記載される手続き群は dc_calendar モジュールから提供されます.
!> @endja
!>
 
!> @en
!> @brief Parse date string
!> @details
!> Parse strings of date (conformed to gtool4 netCDF Convention
!> "5.5 Expression of date and time") specified as `date_str`,
!> and return `year` -- `zone`.
!>
!> @param[in] date_str Strings that express date and time.
!>                     See gtool4 netCDF Convention 5.5 Expression of date and time for details.
!> @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[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
!> `date_str` で与えられる日時形式
!> (gtool4 netCDF 規約「5.5 日時形式」に準拠) を解釈し,
!> `year` 〜 `zone` に返します.
!>
!> @param[in] date_str 日時情報を表す文字列.
!>                     表示形式については gtool4 netCDF 規約 5.5 日時形式を参照のこと.
!> @param[out] year 年
!> @param[out] month 月
!> @param[out] day 日
!> @param[out] hour 時
!> @param[out] min 分
!> @param[out] sec 秒
!> @param[out] zone UTC からの時差
!> @param[out] err 例外処理用フラグ.
!>                 デフォルトでは, この手続き内でエラーが生じた場合,
!>                 プログラムは強制終了します.
!>                 引数 `err` が与えられる場合, プログラムは強制終了せず,
!>                 代わりに `err` に .true. が代入されます.
!> @endja
subroutine dccaldateparsestr1( date_str, &
  & year, month, day, hour, min, sec, zone, &
  & err )
 
  use dc_regex, only: match
  use dc_message, only: messagenotify
  use dc_string, only: lchar, stoi, stod
  use dc_trace, only: beginsub, endsub, dbgmessage
  use dc_error, only: storeerror, dc_noerr, dc_ebaddate
  use dc_types, only: string, dp, token
  implicit none
  character(*), intent(in):: date_str
  integer, intent(out):: year
  integer, intent(out):: month
  integer, intent(out):: day
  integer, intent(out):: hour
  integer, intent(out):: min
  real(DP), intent(out):: sec
  character(*), intent(out):: zone
  logical, intent(out), optional:: err
 
  ! 作業変数
  ! Work variables
  !
  integer:: start, length
  character(STRING):: str1, str2
  character(TOKEN):: zone_pm, zone_hrs, zone_min
  integer:: stat
  character(STRING):: cause_c
  character(*), parameter:: subname = 'DCCalDateParseStr1'
continue
  call beginsub( subname )
  stat = dc_noerr
  cause_c = ''
 
  ! 与えられた文字列が日時表現として有効かどうかをチェック
  ! Check validation of strings as an expression of date
  !
  call match( '[-]*#d+-#d+-#d+[#w#s]+#d+:#d+:#d+', date_str, & ! (in)
    &         start, length ) ! (out)
 
  if ( length > 0 ) then
    str1 = date_str(start:)
  else
    stat = dc_ebaddate
    call messagenotify('W', subname, &
      & 'date_str=<%c> is invalid expression as date.', &
      & c1 = trim(date_str) )
    goto 999
  end if
 
  ! 年の解釈
  ! Parse year
  !
  call match( '^[-]*#d+-', str1, & ! (in)
    &         start, length ) ! (out)
  str2 = str1(start:start+length-2)
  str1 = str1(start+length:)
  year = stoi(str2)
 
  ! 月の解釈
  ! Parse month
  !
  call match( '^#d+-', str1, & ! (in)
    &         start, length ) ! (out)
  str2 = str1(start:start+length-2)
  str1 = str1(start+length:)
  month = stoi(str2)
 
  ! 日の解釈
  ! Parse day
  !
  call match( '^#d+[#w#s]', str1, & ! (in)
    &         start, length ) ! (out)
  str2 = str1(start:start+length-2)
  str1 = str1(start+length:)
  day = stoi(str2)
 
  ! 時の解釈
  ! Parse hour
  !
  call match( '#d+:', str1, & ! (in)
    &         start, length ) ! (out)
  str2 = str1(start:start+length-2)
  str1 = str1(start+length:)
  hour = stoi(str2)
 
  ! 分の解釈
  ! Parse minute
  !
  call match( '#d+:', str1, & ! (in)
    &         start, length ) ! (out)
  str2 = str1(start:start+length-2)
  str1 = str1(start+length:)
  min = stoi(str2)
 
  ! 秒の解釈
  ! Parse min
  !
  call match( '#d+', str1, & ! (in)
    &         start, length ) ! (out)
  str2 = str1(start:start+length-1)
  str1 = str1(start+length:)
 
  call match( '^#.#d+', str1, & ! (in)
    &         start, length ) ! (out)
 
  if ( length > 0 ) then
    str2 = trim(str2) // str1(start:start+length-1)
    str1 = str1(start+length:)
  end if
  sec = stod(str2)
 
  ! UTC からの時差の解釈
  ! Parse time-zone difference
  !
  call match( '[#+-]#d+:#d+', str1, & ! (in)
    &         start, length ) ! (out)
  if ( length > 0 ) then
    zone_pm = str1(start:start)
    str1 = str1(start+1:start+length-1)
 
    call match( '^#d+:', str1, & ! (in)
      &         start, length ) ! (out)
    zone_hrs = str1(start:start+length-2)
    zone_min = str1(start+length:)
    zone = trim(zone_pm) // trim(zone_hrs) // ':' // trim(zone_min)
  else
    zone = ''
  end if
 
  call dbgmessage('year=<%d> month=<%d> day=<%d> hour=<%d> min=<%d> sec=<%f>' // &
    & ' zone=<%c>', &
    & i = (/year, month, day, hour, min/), d = (/sec/), &
    & c1 = trim(zone) )
 
  ! 終了処理, 例外処理
  ! Termination and Exception handling
  !
999 continue
  call storeerror( stat, subname, err, cause_c )
  call endsub( subname )
end subroutine dccaldateparsestr1