dcunits_com Module Reference

Functions/Subroutines
subroutine, public	dcunitssetline (line)
subroutine, public	dcunitsgettoken (tokentype, ivalue, dvalue, cvalue)

Variables
integer, parameter, public	s_eof = -128
integer, parameter, public	s_shift = 300
integer, parameter, public	s_text = 301
integer, parameter, public	s_multiply = 302
integer, parameter, public	s_divide = 303
integer, parameter, public	s_exponent = 304
integer, parameter, public	s_openpar = 305
integer, parameter, public	s_closepar = 306
integer, parameter, public	s_real = 307
integer, parameter, public	s_integer = 308

Function/Subroutine Documentation

dcunitsgettoken()

subroutine, public dcunits_com::dcunitsgettoken	(	integer, intent(out)	tokentype,
		integer, dimension(5), intent(out)	ivalue,
		real(dp), intent(out)	dvalue,
		character(*), intent(out)	cvalue
	)

Definition at line 54 of file dcunits_com.f90.

References dc_regex::match(), s_closepar, s_divide, s_eof, s_exponent, s_integer, s_multiply, s_openpar, s_real, s_shift, and s_text.

    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 = ""

Here is the call graph for this function:

dcunitssetline()

subroutine, public dcunits_com::dcunitssetline

(

character(*), intent(in)

line

)

Definition at line 47 of file dcunits_com.f90.

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

Variable Documentation

s_closepar

integer, parameter, public dcunits_com::s_closepar = 306

Definition at line 36 of file dcunits_com.f90.

  integer, parameter:: s_closepar = 306

s_divide

integer, parameter, public dcunits_com::s_divide = 303

Definition at line 33 of file dcunits_com.f90.

  integer, parameter:: s_divide = 303

s_eof

integer, parameter, public dcunits_com::s_eof = -128

Definition at line 29 of file dcunits_com.f90.

  integer, parameter:: s_eof = -128

s_exponent

integer, parameter, public dcunits_com::s_exponent = 304

Definition at line 34 of file dcunits_com.f90.

  integer, parameter:: s_exponent = 304

s_integer

integer, parameter, public dcunits_com::s_integer = 308

Definition at line 38 of file dcunits_com.f90.

  integer, parameter:: s_integer = 308

s_multiply

integer, parameter, public dcunits_com::s_multiply = 302

Definition at line 32 of file dcunits_com.f90.

  integer, parameter:: s_multiply = 302

s_openpar

integer, parameter, public dcunits_com::s_openpar = 305

Definition at line 35 of file dcunits_com.f90.

  integer, parameter:: s_openpar = 305

s_real

integer, parameter, public dcunits_com::s_real = 307

Definition at line 37 of file dcunits_com.f90.

  integer, parameter:: s_real = 307

s_shift

integer, parameter, public dcunits_com::s_shift = 300

Definition at line 30 of file dcunits_com.f90.

  integer, parameter:: s_shift = 300

s_text

integer, parameter, public dcunits_com::s_text = 301

Definition at line 31 of file dcunits_com.f90.

  integer, parameter:: s_text = 301