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
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
|
SUBROUTINE sla_INTIN (STRING, NSTRT, IRESLT, JFLAG)
*+
* - - - - - -
* I N T I N
* - - - - - -
*
* Convert free-format input into an integer
*
* Given:
* STRING c string containing number to be decoded
* NSTRT i pointer to where decoding is to start
* IRESLT i current value of result
*
* Returned:
* NSTRT i advanced to next number
* IRESLT i result
* JFLAG i status: -1 = -OK, 0 = +OK, 1 = null, 2 = error
*
* Called: sla__IDCHI
*
* Notes:
*
* 1 The reason INTIN has separate OK status values for +
* and - is to enable minus zero to be detected. This is
* of crucial importance when decoding mixed-radix numbers.
* For example, an angle expressed as deg, arcmin, arcsec
* may have a leading minus sign but a zero degrees field.
*
* 2 A TAB is interpreted as a space.
*
* 3 The basic format is the sequence of fields #^, where
* # is a sign character + or -, and ^ means a string of
* decimal digits.
*
* 4 Spaces:
*
* . Leading spaces are ignored.
*
* . Spaces between the sign and the number are allowed.
*
* . Trailing spaces are ignored; the first signifies
* end of decoding and subsequent ones are skipped.
*
* 5 Delimiters:
*
* . Any character other than +,-,0-9 or space may be
* used to signal the end of the number and terminate
* decoding.
*
* . Comma is recognized by INTIN as a special case; it
* is skipped, leaving the pointer on the next character.
* See 9, below.
*
* 6 The sign is optional. The default is +.
*
* 7 A "null result" occurs when the string of characters being
* decoded does not begin with +,- or 0-9, or consists
* entirely of spaces. When this condition is detected, JFLAG
* is set to 1 and IRESLT is left untouched.
*
* 8 NSTRT = 1 for the first character in the string.
*
* 9 On return from INTIN, NSTRT is set ready for the next
* decode - following trailing blanks and any comma. If a
* delimiter other than comma is being used, NSTRT must be
* incremented before the next call to INTIN, otherwise
* all subsequent calls will return a null result.
*
* 10 Errors (JFLAG=2) occur when:
*
* . there is a + or - but no number; or
*
* . the number is greater than BIG (defined below).
*
* 11 When an error has been detected, NSTRT is left
* pointing to the character following the last
* one used before the error came to light.
*
* 12 See also FLOTIN and DFLTIN.
*
* P.T.Wallace Starlink 27 April 1998
*
* Copyright (C) 1998 Rutherford Appleton Laboratory
*-
IMPLICIT NONE
CHARACTER*(*) STRING
INTEGER NSTRT,IRESLT,JFLAG
* Maximum allowed value
DOUBLE PRECISION BIG
PARAMETER (BIG=2147483647D0)
INTEGER JPTR,MSIGN,NVEC,J
DOUBLE PRECISION DRES,DIGIT
* Current character
JPTR=NSTRT
* Set defaults
DRES=0D0
MSIGN=1
* Look for sign
100 CONTINUE
CALL sla__IDCHI(STRING,JPTR,NVEC,DIGIT)
GO TO ( 400, 100, 300, 200, 9110, 9100, 9110),NVEC
* 0-9 SP + - , ELSE END
* Negative
200 CONTINUE
MSIGN=-1
* Look for first decimal
300 CONTINUE
CALL sla__IDCHI(STRING,JPTR,NVEC,DIGIT)
GO TO ( 400, 300, 9200, 9200, 9200, 9200, 9210),NVEC
* 0-9 SP + - , ELSE END
* Accept decimals
400 CONTINUE
DRES=DRES*1D1+DIGIT
* Test for overflow
IF (DRES.GT.BIG) GO TO 9200
* Look for subsequent decimals
CALL sla__IDCHI(STRING,JPTR,NVEC,DIGIT)
GO TO ( 400, 1610, 1600, 1600, 1600, 1600, 1610),NVEC
* 0-9 SP + - , ELSE END
* Get result & status
1600 CONTINUE
JPTR=JPTR-1
1610 CONTINUE
J=0
IF (MSIGN.EQ.1) GO TO 1620
J=-1
DRES=-DRES
1620 CONTINUE
IRESLT=NINT(DRES)
* Skip to end of field
1630 CONTINUE
CALL sla__IDCHI(STRING,JPTR,NVEC,DIGIT)
GO TO (1720, 1630, 1720, 1720, 9900, 1720, 9900),NVEC
* 0-9 SP + - , ELSE END
1720 CONTINUE
JPTR=JPTR-1
GO TO 9900
* Exits
* Null field
9100 CONTINUE
JPTR=JPTR-1
9110 CONTINUE
J=1
GO TO 9900
* Errors
9200 CONTINUE
JPTR=JPTR-1
9210 CONTINUE
J=2
* Return
9900 CONTINUE
NSTRT=JPTR
JFLAG=J
END
|
