1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
|
DOUBLE PRECISION FUNCTION READA(STRING,ISTART)
C FORTRAN FUNCTION TO EXTRACT NUMBER FROM STRING
C
CHARACTER STRING*(*)
DOUBLE PRECISION DIGIT
LOGICAL EXPNNT
C
C DEFINE ASCII VALUES OF NUMERIC FIELD CHARACTERS
I0=ICHAR('0')
I9=ICHAR('9')
IDOT=ICHAR('.')
INEG=ICHAR('-')
IPOS=ICHAR('+')
ICAPD=ICHAR('D')
ICAPE=ICHAR('E')
ISMLD=ICHAR('d')
ISMLE=ICHAR('e')
C
L=LEN(STRING)
C
C FIND THE START OF THE NUMERIC FIELD
DO 10 I=ISTART,L
IADD=0
N=ICHAR(STRING(I:I))
C
C SIGNAL START OF NUMERIC FIELD IF DIGIT FOUND
IF(N.GE.I0.AND.N.LE.I9)GOTO 20
C
C ACCOUNT FOR CONSECUTIVE SIGNS [- AND(OR) +]
IF(N.EQ.INEG.OR.N.EQ.IPOS)THEN
IADD=IADD+1
IF(I+IADD.GT.L)GOTO 50
N=ICHAR(STRING(I+IADD:I+IADD))
IF(N.GE.I0.AND.N.LE.I9)GOTO 20
ENDIF
C
C ACCOUNT FOR CONSECUTIVE DECIMAL POINTS (.)
IF(N.EQ.IDOT)THEN
IADD=IADD+1
IF(I+IADD.GT.L)GOTO 50
N=ICHAR(STRING(I+IADD:I+IADD))
IF(N.GE.I0.AND.N.LE.I9)GOTO 20
ENDIF
10 CONTINUE
GOTO 50
C
C FIND THE END OF THE NUMERIC FIELD
20 EXPNNT=.FALSE.
DO 30 J=I+1,L
IADD=0
N=ICHAR(STRING(J:J))
C
C CONTINUE SEARCH FOR END IF DIGIT FOUND
IF(N.GE.I0.AND.N.LE.I9)GOTO 30
C
C CONTINUE SEARCH FOR END IF SIGN FOUND AND EXPNNT TRUE
IF(N.EQ.INEG.OR.N.EQ.IPOS)THEN
IF(.NOT.EXPNNT)GOTO 40
IADD=IADD+1
IF(J+IADD.GT.L)GOTO 40
N=ICHAR(STRING(J+IADD:J+IADD))
IF(N.GE.I0.AND.N.LE.I9)GOTO 30
ENDIF
IF(N.EQ.IDOT)THEN
IADD=IADD+1
IF(J+IADD.GT.L)GOTO 40
N=ICHAR(STRING(J+IADD:J+IADD))
IF(N.GE.I0.AND.N.LE.I9)GOTO 30
IF(N.EQ.ICAPE.OR.N.EQ.ISMLE.OR.N.EQ.ICAPD.OR.N.EQ.ISMLD)
1 GOTO 30
ENDIF
IF(N.EQ.ICAPE.OR.N.EQ.ISMLE.OR.N.EQ.ICAPD.OR.N.EQ.ISMLD)THEN
IF(EXPNNT)GOTO 40
EXPNNT=.TRUE.
GOTO 30
ENDIF
GOTO 40
30 CONTINUE
J=L+1
40 N=ICHAR(STRING(J-1:J-1))
IF(N.EQ.ICAPE.OR.N.EQ.ISMLE.OR.N.EQ.ICAPD.OR.N.EQ.ISMLD)J=J-1
C
C FOUND THE END OF THE NUMERIC FIELD (IT RUNS 'I' THRU 'J-1')
N=0
N=N+INDEX(STRING(I:J-1),'e')
N=N+INDEX(STRING(I:J-1),'E')
N=N+INDEX(STRING(I:J-1),'d')
N=N+INDEX(STRING(I:J-1),'D')
IF(N.EQ.0)THEN
READA=DIGIT(STRING(I:J-1),1)
ELSE
READA=DIGIT(STRING(:I+N-2),I)*1.D1**DIGIT(STRING(:J-1),I+N)
ENDIF
RETURN
C
C DEFAULT VALUE RETURNED BECAUSE NO NUMERIC FIELD FOUND
50 READA=0.D0
RETURN
END
C ******************************************************************
DOUBLE PRECISION FUNCTION DIGIT(STRING,ISTART)
C FORTRAN FUNCTION TO CONVERT NUMERIC FIELD TO DOUBLE PRECISION
C NUMBER. THE STRING IS ASSUMED TO BE CLEAN (NO INVALID DIGIT
C OR CHARACTER COMBINATIONS FROM ISTART TO THE FIRST NONSPACE,
C NONDIGIT, NONSIGN, AND NONDECIMAL POINT CHARACTER).
C
CHARACTER STRING*(*)
DOUBLE PRECISION C1,C2,DECIML
LOGICAL SIGN
C
C DEFINE ASCII VALUES OF NUMERIC FIELD CHARACTERS
I0=ICHAR('0')
I9=ICHAR('9')
INEG=ICHAR('-')
IPOS=ICHAR('+')
IDOT=ICHAR('.')
ISPC=ICHAR(' ')
C
C1=0.D0
C2=0.D0
SIGN=.TRUE.
L=LEN(STRING)
C
C DETERMINE THE CONTRIBUTION TO THE NUMBER GREATER THAN ONE
IDIG=0
DO 10 I=ISTART,L
N=ICHAR(STRING(I:I))
IF(N.GE.I0.AND.N.LE.I9)THEN
IDIG=IDIG+1
C1=C1*1.D1+N-I0
ELSEIF(N.EQ.INEG.OR.N.EQ.IPOS.OR.N.EQ.ISPC)THEN
IF(N.EQ.INEG)SIGN=.FALSE.
ELSEIF(N.EQ.IDOT)THEN
GOTO 20
ELSE
GOTO 40
ENDIF
10 CONTINUE
C
C DETERMINE THE CONTRIBUTION TO THE NUMBER LESS THAN THAN ONE
20 DECIML=1.D0
DO 30 J=I+1,L
N=ICHAR(STRING(J:J))
IF(N.GE.I0.AND.N.LE.I9)THEN
DECIML=DECIML/1.D1
C2=C2+(N-I0)*DECIML
ELSEIF(N.NE.ISPC)THEN
GOTO 40
ENDIF
30 CONTINUE
C
C PUT THE PIECES TOGETHER
40 DIGIT=C1+C2
IF(.NOT.SIGN)DIGIT=-DIGIT
RETURN
END
|
