判断字符串是何种数值类型
2015-11-26 22:35:33   来源：necrohan供稿   评论：0 点击：

Program www_fcode_cn
  Implicit None
  Character(len=6) :: TYPE(0:4) = ["非数值","整数型","小数型","指数型","双精度"]
  Integer :: IsNum , i
  Character(len=32) :: c
  Do
    read(*,*) c
    if(c=="exit") exit
    i = IsNum( c )
    write(*,*) TYPE(i)
  End Do
End Program www_fcode_cn

Integer Function IsNum(zval)
  ! Verify that a character string represents a numerical value
  ! 确定字符是否是数值类型：
  ! 0-非数值的字符串
  ! 1-整数(integer)
  ! 2-小数(fixed point real)
  ! 3-指数类型实数(exponent type real)
  ! 4-双精度实数指数形式(exponent type double)
  Implicit None
  Character (Len=*), Intent (In) :: zval
  Integer :: num, nmts, nexp, kmts, ifexp, ichr
  Integer, Parameter :: kint = 1 ! integer
  Integer, Parameter :: kfix = 2 ! fixed point real
  Integer, Parameter :: kexp = 3 ! exponent type real
  Integer, Parameter :: kdbl = 4 ! exponent type double
  ! initialise
  num = 0  ! 数字的格式，最后传递给ISNUM返回
  nmts = 0 ! 整数或浮点数的数字个数
  nexp = 0 ! 指数形式的数字个数
  kmts = 0 ! 有+-号为1，否则为0
  ifexp = 0! 似乎没用
  ! loop over characters
  ichr = 0
  Do
    If (ichr>=len(zval)) Then
      ! last check
      If (nmts==0) Exit
      If (num>=kexp .And. nexp==0) Exit
      isnum = num
      Return
    End If
    ichr = ichr + 1
    Select Case (zval(ichr:ichr))
      ! process blanks
    Case (' ')
      Continue
      ! process digits
    Case ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9')
      If (num==0) num = kint
      If (num<kexp) Then
        nmts = nmts + 1
        ! 整数或浮点数+1
      Else
        nexp = nexp + 1
        ! 指数形式+1
      End If
      ! process signs
    Case ('+', '-')
      If (num==0) Then
        If (kmts>0) Exit
        ! 出现2个符号，非数字
        kmts = 1
        num = kint
      Else
        If (num<kexp) Exit
        If (ifexp>0) Exit
        ifexp = 1
      End If
      ! process decimal point
    Case ('.')
      If (num/=kint .And. ichr/=1) Exit
      ! 前面不是整数，小数点也不是第一个字符，则非数字
      num = kfix
      ! process exponent
    Case ('e', 'E')
      If (num>=kexp) Exit
      If (nmts==0) Exit
      num = kexp

    Case ('d', 'D')
      If (num>=kexp) Exit
      If (nmts==0) Exit
      num = kdbl
      ! any other character means the string is non-numeric
    Case Default
      Exit
    End Select
  End Do
  ! if this point is reached, the string is non-numeric
  isnum = 0
  Return
End Function IsNum