01 | Program www_fcode_cn |
02 | Implicit None |
03 | Character(len=6) :: TYPE(0:4) = ["非数值","整数型","小数型","指数型","双精度"] |
04 | Integer :: IsNum , i |
05 | Character(len=32) :: c |
06 | Do |
07 | read(*,*) c |
08 | if(c=="exit") exit |
09 | i = IsNum( c ) |
10 | write(*,*) TYPE(i) |
11 | End Do |
12 | End Program www_fcode_cn |
13 |
14 | Integer Function IsNum(zval) |
15 | ! Verify that a character string represents a numerical value |
16 | ! 确定字符是否是数值类型： |
17 | ! 0-非数值的字符串 |
18 | ! 1-整数(integer) |
19 | ! 2-小数(fixed point real) |
20 | ! 3-指数类型实数(exponent type real) |
21 | ! 4-双精度实数指数形式(exponent type double) |
22 | Implicit None |
23 | Character (Len=*), Intent (In) :: zval |
24 | Integer :: num, nmts, nexp, kmts, ifexp, ichr |
25 | Integer, Parameter :: kint = 1 ! integer |
26 | Integer, Parameter :: kfix = 2 ! fixed point real |
27 | Integer, Parameter :: kexp = 3 ! exponent type real |
28 | Integer, Parameter :: kdbl = 4 ! exponent type double |
29 | ! initialise |
30 | num = 0 ! 数字的格式，最后传递给ISNUM返回 |
31 | nmts = 0 ! 整数或浮点数的数字个数 |
32 | nexp = 0 ! 指数形式的数字个数 |
33 | kmts = 0 ! 有+-号为1，否则为0 |
34 | ifexp = 0! 似乎没用 |
35 | ! loop over characters |
36 | ichr = 0 |
37 | Do |
38 | If (ichr>=len(zval)) Then |
39 | ! last check |
40 | If (nmts==0) Exit |
41 | If (num>=kexp .And. nexp==0) Exit |
42 | isnum = num |
43 | Return |
44 | End If |
45 | ichr = ichr + 1 |
46 | Select Case (zval(ichr:ichr)) |
47 | ! process blanks |
48 | Case (' ') |
49 | Continue |
50 | ! process digits |
51 | Case ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9') |
52 | If (num==0) num = kint |
53 | If (num<kexp) Then |
54 | nmts = nmts + 1 |
55 | ! 整数或浮点数+1 |
56 | Else |
57 | nexp = nexp + 1 |
58 | ! 指数形式+1 |
59 | End If |
60 | ! process signs |
61 | Case ('+', '-') |
62 | If (num==0) Then |
63 | If (kmts>0) Exit |
64 | ! 出现2个符号，非数字 |
65 | kmts = 1 |
66 | num = kint |
67 | Else |
68 | If (num<kexp) Exit |
69 | If (ifexp>0) Exit |
70 | ifexp = 1 |
71 | End If |
72 | ! process decimal point |
73 | Case ('.') |
74 | If (num/=kint .And. ichr/=1) Exit |
75 | ! 前面不是整数，小数点也不是第一个字符，则非数字 |
76 | num = kfix |
77 | ! process exponent |
78 | Case ('e', 'E') |
79 | If (num>=kexp) Exit |
80 | If (nmts==0) Exit |
81 | num = kexp |
82 |
83 | Case ('d', 'D') |
84 | If (num>=kexp) Exit |
85 | If (nmts==0) Exit |
86 | num = kdbl |
87 | ! any other character means the string is non-numeric |
88 | Case Default |
89 | Exit |
90 | End Select |
91 | End Do |
92 | ! if this point is reached, the string is non-numeric |
93 | isnum = 0 |
94 | Return |
95 | End Function IsNum |
