!== dcunits_com.f90 - å˜ä½ç³»å‡¦ç†ç”¨ã®ä¸‹ä½ãƒ¢ã‚¸ãƒ¥ãƒ¼ãƒ«
!
! Authors::   Eizi TOYODA, Yasuhiro MORIKAWA
! Version::   $Id: dcunits_com.f90,v 1.2 2009-03-23 22:01:42 morikawa Exp $
! Tag Name::  $Name:  $
! Copyright:: Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved.
! License::   See COPYRIGHT[link:../../COPYRIGHT]
!
! This file provides dcunits_com
!

module dcunits_com !:nodoc:
  !
  !== Overview
  !
  ! dc_units ãƒ¢ã‚¸ãƒ¥ãƒ¼ãƒ«ã§ç”¨ã„ã‚‹ä¸‹ä½ã®å®šæ•°ãŠã‚ˆã³ã‚µãƒ–ãƒ«ãƒ¼ãƒãƒ³ã‚’æä¾›ã—ã¾ã™ã€‚
  !
  ! common private data for dc_units module
  !

  use dc_types, only: DP, STRING
  implicit none
  private
  public:: S_EOF, S_SHIFT, S_TEXT, S_MULTIPLY, S_DIVIDE, S_EXPONENT
  public:: S_OPENPAR, S_CLOSEPAR, S_REAL, S_INTEGER
  public:: DCUnitsSetLine, DCUnitsGetToken

  ! scannter symbols
  integer, parameter:: S_EOF = -128
  integer, parameter:: S_SHIFT = 300
  integer, parameter:: S_TEXT = 301
  integer, parameter:: S_MULTIPLY = 302
  integer, parameter:: S_DIVIDE = 303
  integer, parameter:: S_EXPONENT = 304
  integer, parameter:: S_OPENPAR = 305
  integer, parameter:: S_CLOSEPAR = 306
  integer, parameter:: S_REAL = 307
  integer, parameter:: S_INTEGER = 308

  ! scanner buffer
  character(STRING), private, save:: thisline = ""
  integer, private, save:: i = 1

contains

  subroutine DCUnitsSetLine(line)
    implicit none
    character(*), intent(in):: line
    thisline = line
    i = 1
  end subroutine DCUnitsSetLine

  subroutine DCUnitsGetToken(tokentype, ivalue, dvalue, cvalue)
    use dc_regex, only: match
    implicit none
    integer, intent(out):: tokentype
    integer, intent(out):: ivalue(5)
    real(DP), intent(out):: dvalue
    character(*), intent(out):: cvalue
    integer:: iend, istr, ilen, ios
    ivalue = 0
    dvalue = 0.0_DP
    cvalue = ""
    iend = len_trim(thisline)
    do
      if (i > iend) exit
      ! '#' æ–‡å—ãŒç¾ã‚ã‚Œã‚Œã° EOF ã‚·ãƒ³ãƒœãƒ«ã‚’è¿”ã™
      call match("^##", thisline(i:), istr, ilen)
      if (istr > 0) then
        i = iend + 1
        tokentype = S_EOF
        return
      endif
      ! ç©ºç™½ã‚’ç„¡è¦–
      call match("^#s+", thisline(i:), istr, ilen)
      if (istr > 0) then
        i = i + ilen
        if (i > iend) exit
      endif
      ! ã‚·ãƒ•ãƒˆæ¼”ç®—åãƒã‚§ãƒƒã‚¯
      call match("^@", thisline(i:), istr, ilen)
      if (istr <= 0) call match("^from", thisline(i:), istr, ilen)
      if (istr <= 0) call match("^at", thisline(i:), istr, ilen)
      if (istr > 0) then
        i = i + ilen
        tokentype = S_SHIFT
        cvalue = thisline(i: i+ilen-1)
        return
      endif
      ! åå‰ãƒã‚§ãƒƒã‚¯
      call match("^#a#w*#a", thisline(i:), istr, ilen)
      if (istr <= 0) call match("^[#a'""]", thisline(i:), istr, ilen)
      if (istr > 0) then
        tokentype = S_TEXT
        cvalue = thisline(i: i+ilen-1)
        i = i + ilen
        return
      endif
      ! '*' ã®å‰ã« '**' ã‚’èªçŸ¥ã›ãã°ã€‚
      call match("^#^", thisline(i:), istr, ilen)
      if (istr <= 0) call match("^#*#*", thisline(i:), istr, ilen)
      if (istr > 0) then
        tokentype = S_EXPONENT
        cvalue = thisline(i: i+ilen-1)
        i = i + ilen
        return
      endif
      ! å®Ÿæ•°ã«ãªã‚‰ãªã„å°æ•°ç‚¹ã¯ S_MULTIPLY
      call match("^#.[^#d]", thisline(i:), istr, ilen)
      if (istr <= 0) call match("^#*", thisline(i:), istr, ilen)
      if (istr > 0) then
        tokentype = S_MULTIPLY
        cvalue = thisline(i: i+ilen-1)
        i = i + 1
        return
      endif
      ! å®Ÿæ•°ãƒã‚§ãƒƒã‚¯. å°æ•°ç‚¹ã¯èªžé ã«ã‚ã‚Œã°å¿…ãšæ•°å—ãŒä¼´ã†ã®ã§å®‰å¿ƒã›ã‚ˆ
      call match("^[-+]?#d*#.#d*[EeDd][-+]?#d+", thisline(i:), istr, ilen)
      if (istr <= 0) call match("^[-+]?#d*#.#d*", thisline(i:), istr, ilen)
      if (istr > 0) then
        read(thisline(i: i+ilen-1), fmt=*, &
          & iostat=ios) dvalue
        if (ios /= 0) dvalue = HUGE(dvalue)
        cvalue = thisline(i: i+ilen-1)
        tokentype = S_REAL
        i = i + ilen
        return
      endif
      ! æ•´æ•°ãƒã‚§ãƒƒã‚¯
      call match("^[-+]?#d+", thisline(i:), istr, ilen)
      if (istr > 0) then
        read(thisline(i: i+ilen-1), fmt=*, &
          & iostat=ios) ivalue(1)
        if (ios /= 0) ivalue(1) = HUGE(1)
        cvalue = thisline(i: i+ilen-1)
        tokentype = S_INTEGER
        i = i + ilen
        return
      endif
      ! ã»ã‹ã®ï¼‘å—ãƒˆãƒ¼ã‚¯ãƒ³ãƒã‚§ãƒƒã‚¯
      if (thisline(i:i) == '/') then
        tokentype = S_DIVIDE
        cvalue = thisline(i:i)
        i = i + 1
        return
      endif
      if (thisline(i:i) == '(') then
        tokentype = S_OPENPAR
        cvalue = thisline(i:i)
        i = i + 1
        return
      endif
      if (thisline(i:i) == ')') then
        tokentype = S_CLOSEPAR
        cvalue = thisline(i:i)
        i = i + 1
        return
      endif
      ! ã ã‚ã ã“ã‚Šã‚ƒã€‚ã¯ã„æ¬¡ã„ã£ã¦ã¿ã‚ˆã†
      tokentype = ichar(thisline(i:i))
      cvalue = thisline(i:i)
      i = i + 1
      return
    enddo
    i = iend + 1
    tokentype = S_EOF
    cvalue = ""
  end subroutine DCUnitsGetToken

end module dcunits_com