[u/mrichter/AliRoot.git] / MINICERN / packlib / kernlib / kerngen / tcgen / ckrack.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1996/02/15 17:49:42  mclareni
* Kernlib
*
*
#include "kerngen/pilot.h"
      SUBROUTINE CKRACK (CHV,JLP,JRP,IFLAGD)
C
C CERN PROGLIB# M432    CKRACK          .VERSION KERNFOR  4.29  910718
C ORIG. 12/06/91, JZ
C
C-    Read the next number from CHV(JL:JR)
C-    formats: (1) bits     - #On octal, or #Bn binary, or #Xn hex
C-             (2) integer  - [+|-]n
C-             (3) floating - [+|-][n][.][f][E][+|-][n]
C-             (4) double   - [+|-][n][.][f]D[+|-][n]
C-
C-    Returns: NDSLAT   number of numeric digits seen
C-             NESLAT   COL(NESLAT) is the terminating character
C-             NFSLAT   mode: -ve bad, 0 blank, 1 B, 2 I, 3 F, 4 D
C-             NGSLAT   = zero if correct termination
C-                      = NESLAT otherwise
C-             NUM(1) or ANUM(1) or DNUM  returns the value

      DIMENSION    JLP(9), JRP(9)
      CHARACTER    CHV(512)*1

      COMMON /SLATE/ NDIGT,NESLAT,MODE,NGSLAT,NUM(2)
     +,              IVALV(6),NEXPV(6), JXOP,JXME,JXFA,JXFE
     +,              JTERM,IPHASE, NEGM,NEGE,NEXPM, NERR, DUMMY(12)

      REAL             ANUM(2)
      DOUBLE PRECISION DNUM, DFRACT
      EQUIVALENCE (ANUM(1),NUM(1))
      EQUIVALENCE (DNUM,NUM(1))

      DIMENSION    ISLATE(40)
      EQUIVALENCE (ISLATE(1),NDIGT)

#include "kerngen/wordsize.inc"
#if !defined(CERNLIB_QISASTD)
#include "kerngen/q_shift.inc"
#endif

      JJ = JLP(1)
      JR = JRP(1)

      DO 12  J=1,28
   12 ISLATE(J) = 0

C----              Look at the first character of the number

   17 IF (JJ.GT.JR)                GO TO 90
      IF (CHV(JJ).EQ.' ')  THEN
          JJ = JJ + 1
          GO TO 17
        ELSEIF (CHV(JJ).EQ.'#')  THEN
          GO TO 71
        ELSEIF (CHV(JJ).EQ.'+')  THEN
          JJ = JJ + 1
        ELSEIF (CHV(JJ).EQ.'-')  THEN
          NEGM = 7
          JJ  = JJ + 1
        ENDIF

C----              Read an integer

   21 JTERM  = 0
      NDIG   = 0
      IVAL   = 0
   22 IF (JJ.GT.JR)          GO TO 27
#if defined(CERNLIB_QASCII)
      K = ICHAR (CHV(JJ))
      K = K - 48
      IF (K.LT.0)            GO TO 26
      IF (K.GE.10)           GO TO 26
#endif
#if defined(CERNLIB_QEBCDIC)
      K = ICHAR (CHV(JJ))
      K = K - 240
      IF (K.LT.0)            GO TO 26
      IF (K.GE.10)           GO TO 26
#endif
#if !defined(CERNLIB_QISASTD)
      IF (ISHFTR(IVAL,NBITPW-5).NE.0)   GO TO 24
#endif
#if defined(CERNLIB_QISASTD)
      IF (ISHFT(IVAL,5-NBITPW).NE.0)    GO TO 24
#endif
   23 JJ   = JJ + 1
      IVAL = 10*IVAL + K
      NDIG = NDIG + 1
      GO TO 22

C--       getting near the integer capacity

   24 IF (IPHASE.NE.0)             GO TO 93
      IF (JXOP.LT.6)  THEN
          JXOP = JXOP + 1
          IVALV(JXOP) = IVAL
          NEXPV(JXOP) = NDIG
        ENDIF
      IVAL = 0
      GO TO 23

   26 JTERM  = INDEX (' .+-EDed', CHV(JJ)) - 1
C-                     01234567

   27 IF (NDIG.NE.0)  THEN
          NDIGT = NDIGT + NDIG
          IF (JXOP.LT.6)  THEN
              JXOP = JXOP + 1
              IVALV(JXOP) = IVAL
              NEXPV(JXOP) = NDIG
            ENDIF
        ENDIF

C--       IPHASE = 0 :  IVAL is the leading integer
C-                 2 :       is the exponent integer

      IF (IPHASE.NE.0)             GO TO 51
      JXME = JXOP
      IF (JTERM.GE.1)              GO TO 31

C--       pure integer

   28 IF (NDIGT.EQ.0)              GO TO 91
      MODE = 2
      NUM(1) = IVALV(1)
      IF (JXME.LT.2)               GO TO 29
      N = NEXPV(2) - NEXPV(1)
      IF (N.GE.2)                  GO TO 92
#if !defined(CERNLIB_QISASTD)
      IVALV(1) = ISHFTL(NUM(1),2) + IVALV(1)
      NUM(1)   = ISHFTL(IVALV(1),1)
#endif
#if defined(CERNLIB_QISASTD)
      IVALV(1) = ISHFT(NUM(1),2) + IVALV(1)
      NUM(1)   = ISHFT(IVALV(1),1)
#endif
      IF (NUM(1).LT.0)             GO TO 92
      NUM(1) = NUM(1) + IVALV(2)
      IF (NUM(1).LT.0)             GO TO 92
   29 IF (NEGM.NE.0) NUM(1) = -NUM(1)
   30 NESLAT = JJ
      IF (JTERM.EQ.0)              RETURN
      NGSLAT = JJ
      RETURN

C----              Read the fraction

   31 IF (JTERM.NE.1)              GO TO 41
      JXFA = JXOP
      MODE = 3
      JJ   = JJ + 1

      JTERM  = 0
      NDIG   = 0
   32 IVAL   = 0
      IVALNT = 0
      NTRAIL = 0
   33 IF (JJ.GT.JR)          GO TO 37
#if defined(CERNLIB_QASCII)
      K = ICHAR (CHV(JJ))
      K = K - 48
      IF (K.LT.0)            GO TO 36
      IF (K.GE.10)           GO TO 36
#endif
#if defined(CERNLIB_QEBCDIC)
      K = ICHAR (CHV(JJ))
      K = K - 240
      IF (K.LT.0)            GO TO 36
      IF (K.GE.10)           GO TO 36
#endif
#if !defined(CERNLIB_QISASTD)
      IF (ISHFTR(IVAL,NBITPW-5).NE.0)   GO TO 34
#endif
#if defined(CERNLIB_QISASTD)
      IF (ISHFT(IVAL,5-NBITPW).NE.0)    GO TO 34
#endif
      JJ   = JJ + 1
      IVAL = 10*IVAL + K
      NDIG = NDIG + 1
      IF (K.EQ.0)  THEN
          NTRAIL = NTRAIL + 1
        ELSE
          NTRAIL = 0
          IVALNT = IVAL
        ENDIF
      GO TO 33

C--       getting near the integer capacity

   34 IF (JXOP.LT.6)  THEN
          JXOP = JXOP + 1
          IVALV(JXOP) = IVALNT
          NEXPV(JXOP) = NTRAIL - NDIG
        ENDIF
      GO TO 32

   36 JTERM  = INDEX (' .+-EDed', CHV(JJ)) - 1
C-                     01234567

   37 NDIGT = NDIGT + NDIG
      IF (IVAL.NE.0)  THEN
          IF (JXOP.LT.6)  THEN
              JXOP = JXOP + 1
              IVALV(JXOP) = IVALNT
              NEXPV(JXOP) = NTRAIL - NDIG
            ENDIF
        ENDIF
      JXFE = JXOP
      IF (JTERM.LT.2)              GO TO 52

C----              Read the exponent

   41 IPHASE = 2
      IF (NDIGT.EQ.0)              GO TO 91
      IF (JTERM.GE.4)              GO TO 44
      IF (JJ.EQ.JR)  THEN
          IF (MODE.EQ.0)           GO TO 28
          GO TO 52
        ENDIF
      MODE = 3
      NEGE = JTERM - 2
      JJ   = JJ + 1
      GO TO 21

   44 IF (JTERM.GE.6)  JTERM = JTERM - 2
      MODE = JTERM - 1
      JJ   = JJ + 1
      IF (JJ.GT.JR)  THEN
          JTERM = 0
          GO TO 52
        ENDIF

      J = INDEX ('+-', CHV(JJ))
      IF (J.EQ.0)                  GO TO 21
      IF (JJ.EQ.JR)                GO TO 52
      NEGE = J - 1
      JJ   = JJ + 1
      GO TO 21

C--                Exponent complete, construct the number

   51 NEXPM = IVAL
      IF (NEGE.NE.0)  NEXPM = -NEXPM
   52 IF (IFLAGD.GE.0)  THEN
          IF (MODE.EQ.4)           GO TO 61
          IF (IFLAGD.NE.0)         GO TO 61
        ENDIF
      ANUM(1) = 0.
      ANUM(2) = 0.
      IF (JXME.EQ.0)               GO TO 56

C--       single precision, integer part

      ANUM(1) = REAL(IVALV(1))
      IF (JXME.GE.2)  THEN
          N = NEXPV(2) - NEXPV(1)
          DO 53  J=1,N
   53     ANUM(1) = 10. * ANUM(1)
          ANUM(1) = ANUM(1) + REAL(IVALV(2))
        ENDIF

      IF (NEXPM.EQ.0)              GO TO 56
      IF (NEXPM.LT.0)              GO TO 55
      IF (NEXPM.GT.9)              GO TO 55
      DO 54  J=1,NEXPM
   54 ANUM(1) = ANUM(1) * 10.
      GO TO 56

   55 ANUM(1) = ANUM(1) * 10.**NEXPM

C--       single precision, fraction

   56 IF (JXFE.LE.JXFA)            GO TO 60
      DO 59  JXOP=JXFA+1,JXFE
      ANUM(2) = REAL(IVALV(JXOP))
      NEXPU   = NEXPV(JXOP) + NEXPM
      IF (NEXPU.EQ.0)              GO TO 59
      IF (NEXPU.LT.0)              GO TO 58
      IF (NEXPU.GT.9)              GO TO 58
      DO 57  J=1,NEXPU
   57 ANUM(2) = ANUM(2) * 10.
      GO TO 59

   58 ANUM(2) = ANUM(2) * 10.**NEXPU
   59 ANUM(1) = ANUM(1) + ANUM(2)
   60 IF (NEGM.NE.0)  ANUM(1) = -ANUM(1)
      GO TO 30

C--       double precision, integer part

   61 MODE = 4
      DNUM = 0.
      IF (JXME.EQ.0)               GO TO 66

      DNUM = DBLE(IVALV(1))
      IF (JXME.GE.2)  THEN
          N = NEXPV(2) - NEXPV(1)
          DO 63  J=1,N
   63     DNUM = DNUM * 10.
          DNUM = DNUM + DBLE(IVALV(2))
        ENDIF

      IF (NEXPM.EQ.0)              GO TO 66
      IF (NEXPM.LT.0)              GO TO 65
      IF (NEXPM.GT.9)              GO TO 65
      DO 64  J=1,NEXPM
   64 DNUM = DNUM * 10.
      GO TO 66

   65 DNUM = DNUM * 10.D0**NEXPM

C--       double precision, fraction

   66 IF (JXFE.LE.JXFA)            GO TO 70
      DO 69  JXOP=JXFA+1,JXFE
      DFRACT = DBLE(IVALV(JXOP))
      NEXPU  = NEXPV(JXOP) + NEXPM
      IF (NEXPU.EQ.0)              GO TO 69
      IF (NEXPU.LT.0)              GO TO 68
      IF (NEXPU.GT.9)              GO TO 68
      DO 67  J=1,NEXPU
   67 DFRACT = DFRACT * 10.
      GO TO 69

   68 DFRACT = DFRACT * 10.D0**NEXPU
   69 DNUM   = DNUM + DFRACT
   70 IF (NEGM.NE.0)  DNUM = -DNUM
      GO TO 30

C--------          Reading octal or binary or hexadecimal

   71 J  = INDEX ('0OoBbXx', CHV(JJ+1))
      IF (J.EQ.0)                  GO TO 94
      JJ = JJ + 2
      IF (J.GE.6)                  GO TO 82
      IF (J.GE.4)                  GO TO 76

C--       octal

   72 IF (JJ.GT.JR)          GO TO 87
#if defined(CERNLIB_QASCII)
      K = ICHAR (CHV(JJ))
      IF (K.EQ.32)           GO TO 87
      K = K - 48
      IF (K.LT.0)            GO TO 86
      IF (K.GE.8)            GO TO 86
#endif
#if defined(CERNLIB_QEBCDIC)
      K = ICHAR (CHV(JJ))
      IF (K.EQ.64)           GO TO 87
      K = K - 240
      IF (K.LT.0)            GO TO 86
      IF (K.GE.8)            GO TO 86
#endif
#if !defined(CERNLIB_QISASTD)
      NUM(1) = ISHFTL(NUM(1),3) + K
#endif
#if defined(CERNLIB_QISASTD)
      NUM(1) = ISHFT(NUM(1),3) + K
#endif
      NDIGT = NDIGT + 1
      JJ    = JJ + 1
      GO TO 72

C--       binary

   76 IF (JJ.GT.JR)          GO TO 87
#if defined(CERNLIB_QASCII)
      K = ICHAR (CHV(JJ))
      IF (K.EQ.32)           GO TO 87
      K = K - 48
      IF (K.LT.0)            GO TO 86
      IF (K.GE.2)            GO TO 86
#endif
#if defined(CERNLIB_QEBCDIC)
      K = ICHAR (CHV(JJ))
      IF (K.EQ.64)           GO TO 87
      K = K - 240
      IF (K.LT.0)            GO TO 86
      IF (K.GE.2)            GO TO 86
#endif
#if !defined(CERNLIB_QISASTD)
      NUM(1) = ISHFTL(NUM(1),1) + K
#endif
#if defined(CERNLIB_QISASTD)
      NUM(1) = ISHFT(NUM(1),1) + K
#endif
      NDIGT = NDIGT + 1
      JJ    = JJ + 1
      GO TO 76

C--       hexadecimal

   82 IF (JJ.GT.JR)          GO TO 87
#if defined(CERNLIB_QASCII)
      K = ICHAR (CHV(JJ))
      IF (K.EQ.32)           GO TO 87
      K = K - 48
      IF (K.LT.0)            GO TO 86
      IF (K.LT.10)           GO TO 84
      K = K - 7
      IF (K.LT.8)            GO TO 86
      IF (K.LT.16)           GO TO 84
      K = K - 32
      IF (K.LT.8)            GO TO 86
      IF (K.GE.16)           GO TO 86
#endif
#if defined(CERNLIB_QEBCDIC)
      K = ICHAR (CHV(JJ))
      IF (K.EQ.64)           GO TO 87
      K = K - 240
      IF (K.GE.10)           GO TO 86
      IF (K.GE.0)            GO TO 84
      K = K + 57
      IF (K.GE.16)           GO TO 86
      IF (K.GE.8)            GO TO 84
      K = K + 64
      IF (K.GE.16)           GO TO 86
      IF (K.LT.8)            GO TO 86
#endif
#if !defined(CERNLIB_QISASTD)
   84 NUM(1) = ISHFTL(NUM(1),4) + K
#endif
#if defined(CERNLIB_QISASTD)
   84 NUM(1) = ISHFT(NUM(1),4) + K
#endif
      NDIGT = NDIGT + 1
      JJ    = JJ + 1
      GO TO 82

   86 JTERM = -1
   87 MODE  = 1
      IF (NDIGT.EQ.0)              GO TO 91
      GO TO 30

C----              Special error exits

   94 NERR = -1
   93 NERR = NERR - 1
   92 NERR = NERR - 1
   91 NERR = NERR - 1
   90 MODE = NERR
      NESLAT = JJ
      NGSLAT = JJ
      RETURN
      END
Commit	Line	Data
fe4da5cc	1	*
	2	* $Id$
	3	*
	4	* $Log$
	5	* Revision 1.1.1.1 1996/02/15 17:49:42 mclareni
	6	* Kernlib
	7	*
	8	*
	9	#include "kerngen/pilot.h"
	10	SUBROUTINE CKRACK (CHV,JLP,JRP,IFLAGD)
	11	C
	12	C CERN PROGLIB# M432 CKRACK .VERSION KERNFOR 4.29 910718
	13	C ORIG. 12/06/91, JZ
	14	C
	15	C- Read the next number from CHV(JL:JR)
	16	C- formats: (1) bits - #On octal, or #Bn binary, or #Xn hex
	17	C- (2) integer - [+\|-]n
	18	C- (3) floating - [+\|-][n][.][f][E][+\|-][n]
	19	C- (4) double - [+\|-][n][.][f]D[+\|-][n]
	20	C-
	21	C- Returns: NDSLAT number of numeric digits seen
	22	C- NESLAT COL(NESLAT) is the terminating character
	23	C- NFSLAT mode: -ve bad, 0 blank, 1 B, 2 I, 3 F, 4 D
	24	C- NGSLAT = zero if correct termination
	25	C- = NESLAT otherwise
	26	C- NUM(1) or ANUM(1) or DNUM returns the value
	27
	28	DIMENSION JLP(9), JRP(9)
	29	CHARACTER CHV(512)*1
	30
	31	COMMON /SLATE/ NDIGT,NESLAT,MODE,NGSLAT,NUM(2)
	32	+, IVALV(6),NEXPV(6), JXOP,JXME,JXFA,JXFE
	33	+, JTERM,IPHASE, NEGM,NEGE,NEXPM, NERR, DUMMY(12)
	34
	35	REAL ANUM(2)
	36	DOUBLE PRECISION DNUM, DFRACT
	37	EQUIVALENCE (ANUM(1),NUM(1))
	38	EQUIVALENCE (DNUM,NUM(1))
	39
	40	DIMENSION ISLATE(40)
	41	EQUIVALENCE (ISLATE(1),NDIGT)
	42
	43	#include "kerngen/wordsize.inc"
	44	#if !defined(CERNLIB_QISASTD)
	45	#include "kerngen/q_shift.inc"
	46	#endif
	47
	48	JJ = JLP(1)
	49	JR = JRP(1)
	50
	51	DO 12 J=1,28
	52	12 ISLATE(J) = 0
	53
	54	C---- Look at the first character of the number
	55
	56	17 IF (JJ.GT.JR) GO TO 90
	57	IF (CHV(JJ).EQ.' ') THEN
	58	JJ = JJ + 1
	59	GO TO 17
	60	ELSEIF (CHV(JJ).EQ.'#') THEN
	61	GO TO 71
	62	ELSEIF (CHV(JJ).EQ.'+') THEN
	63	JJ = JJ + 1
	64	ELSEIF (CHV(JJ).EQ.'-') THEN
65	NEGM = 7
66	JJ = JJ + 1
67	ENDIF
68
69	C---- Read an integer
70
71	21 JTERM = 0
72	NDIG = 0
73	IVAL = 0
74	22 IF (JJ.GT.JR) GO TO 27
75	#if defined(CERNLIB_QASCII)
76	K = ICHAR (CHV(JJ))
77	K = K - 48
78	IF (K.LT.0) GO TO 26
79	IF (K.GE.10) GO TO 26
80	#endif
81	#if defined(CERNLIB_QEBCDIC)
82	K = ICHAR (CHV(JJ))
83	K = K - 240
84	IF (K.LT.0) GO TO 26
85	IF (K.GE.10) GO TO 26
86	#endif
87	#if !defined(CERNLIB_QISASTD)
88	IF (ISHFTR(IVAL,NBITPW-5).NE.0) GO TO 24
89	#endif
90	#if defined(CERNLIB_QISASTD)
91	IF (ISHFT(IVAL,5-NBITPW).NE.0) GO TO 24
92	#endif
93	23 JJ = JJ + 1
94	IVAL = 10*IVAL + K
95	NDIG = NDIG + 1
96	GO TO 22
97
98	C-- getting near the integer capacity
99
100	24 IF (IPHASE.NE.0) GO TO 93
101	IF (JXOP.LT.6) THEN
102	JXOP = JXOP + 1
103	IVALV(JXOP) = IVAL
104	NEXPV(JXOP) = NDIG
105	ENDIF
106	IVAL = 0
107	GO TO 23
108
109	26 JTERM = INDEX (' .+-EDed', CHV(JJ)) - 1
110	C- 01234567
111
112	27 IF (NDIG.NE.0) THEN
113	NDIGT = NDIGT + NDIG
114	IF (JXOP.LT.6) THEN
115	JXOP = JXOP + 1
116	IVALV(JXOP) = IVAL
117	NEXPV(JXOP) = NDIG
118	ENDIF
119	ENDIF
120
121	C-- IPHASE = 0 : IVAL is the leading integer
122	C- 2 : is the exponent integer
123
124	IF (IPHASE.NE.0) GO TO 51
125	JXME = JXOP
126	IF (JTERM.GE.1) GO TO 31
127
128	C-- pure integer
129
130	28 IF (NDIGT.EQ.0) GO TO 91
131	MODE = 2
132	NUM(1) = IVALV(1)
133	IF (JXME.LT.2) GO TO 29
134	N = NEXPV(2) - NEXPV(1)
135	IF (N.GE.2) GO TO 92
136	#if !defined(CERNLIB_QISASTD)
137	IVALV(1) = ISHFTL(NUM(1),2) + IVALV(1)
138	NUM(1) = ISHFTL(IVALV(1),1)
139	#endif
140	#if defined(CERNLIB_QISASTD)
141	IVALV(1) = ISHFT(NUM(1),2) + IVALV(1)
142	NUM(1) = ISHFT(IVALV(1),1)
143	#endif
144	IF (NUM(1).LT.0) GO TO 92
145	NUM(1) = NUM(1) + IVALV(2)
146	IF (NUM(1).LT.0) GO TO 92
147	29 IF (NEGM.NE.0) NUM(1) = -NUM(1)
148	30 NESLAT = JJ
149	IF (JTERM.EQ.0) RETURN
150	NGSLAT = JJ
151	RETURN
152
153	C---- Read the fraction
154
155	31 IF (JTERM.NE.1) GO TO 41
156	JXFA = JXOP
157	MODE = 3
158	JJ = JJ + 1
159
160	JTERM = 0
161	NDIG = 0
162	32 IVAL = 0
163	IVALNT = 0
164	NTRAIL = 0
165	33 IF (JJ.GT.JR) GO TO 37
166	#if defined(CERNLIB_QASCII)
167	K = ICHAR (CHV(JJ))
168	K = K - 48
169	IF (K.LT.0) GO TO 36
170	IF (K.GE.10) GO TO 36
171	#endif
172	#if defined(CERNLIB_QEBCDIC)
173	K = ICHAR (CHV(JJ))
174	K = K - 240
175	IF (K.LT.0) GO TO 36
176	IF (K.GE.10) GO TO 36
177	#endif
178	#if !defined(CERNLIB_QISASTD)
179	IF (ISHFTR(IVAL,NBITPW-5).NE.0) GO TO 34
180	#endif
181	#if defined(CERNLIB_QISASTD)
182	IF (ISHFT(IVAL,5-NBITPW).NE.0) GO TO 34
183	#endif
184	JJ = JJ + 1
185	IVAL = 10*IVAL + K
186	NDIG = NDIG + 1
187	IF (K.EQ.0) THEN
188	NTRAIL = NTRAIL + 1
189	ELSE
190	NTRAIL = 0
191	IVALNT = IVAL
192	ENDIF
193	GO TO 33
194
195	C-- getting near the integer capacity
196
197	34 IF (JXOP.LT.6) THEN
198	JXOP = JXOP + 1
199	IVALV(JXOP) = IVALNT
200	NEXPV(JXOP) = NTRAIL - NDIG
201	ENDIF
202	GO TO 32
203
204	36 JTERM = INDEX (' .+-EDed', CHV(JJ)) - 1
205	C- 01234567
206
207	37 NDIGT = NDIGT + NDIG
208	IF (IVAL.NE.0) THEN
209	IF (JXOP.LT.6) THEN
210	JXOP = JXOP + 1
211	IVALV(JXOP) = IVALNT
212	NEXPV(JXOP) = NTRAIL - NDIG
213	ENDIF
214	ENDIF
215	JXFE = JXOP
216	IF (JTERM.LT.2) GO TO 52
217
218	C---- Read the exponent
219
220	41 IPHASE = 2
221	IF (NDIGT.EQ.0) GO TO 91
222	IF (JTERM.GE.4) GO TO 44
223	IF (JJ.EQ.JR) THEN
224	IF (MODE.EQ.0) GO TO 28
225	GO TO 52
226	ENDIF
227	MODE = 3
228	NEGE = JTERM - 2
229	JJ = JJ + 1
230	GO TO 21
231
232	44 IF (JTERM.GE.6) JTERM = JTERM - 2
233	MODE = JTERM - 1
234	JJ = JJ + 1
235	IF (JJ.GT.JR) THEN
236	JTERM = 0
237	GO TO 52
238	ENDIF
239
240	J = INDEX ('+-', CHV(JJ))
241	IF (J.EQ.0) GO TO 21
242	IF (JJ.EQ.JR) GO TO 52
243	NEGE = J - 1
244	JJ = JJ + 1
245	GO TO 21
246
247	C-- Exponent complete, construct the number
248
249	51 NEXPM = IVAL
250	IF (NEGE.NE.0) NEXPM = -NEXPM
251	52 IF (IFLAGD.GE.0) THEN
252	IF (MODE.EQ.4) GO TO 61
253	IF (IFLAGD.NE.0) GO TO 61
254	ENDIF
255	ANUM(1) = 0.
256	ANUM(2) = 0.
257	IF (JXME.EQ.0) GO TO 56
258
259	C-- single precision, integer part
260
261	ANUM(1) = REAL(IVALV(1))
262	IF (JXME.GE.2) THEN
263	N = NEXPV(2) - NEXPV(1)
264	DO 53 J=1,N
265	53 ANUM(1) = 10. * ANUM(1)
266	ANUM(1) = ANUM(1) + REAL(IVALV(2))
267	ENDIF
268
269	IF (NEXPM.EQ.0) GO TO 56
270	IF (NEXPM.LT.0) GO TO 55
271	IF (NEXPM.GT.9) GO TO 55
272	DO 54 J=1,NEXPM
273	54 ANUM(1) = ANUM(1) * 10.
274	GO TO 56
275
276	55 ANUM(1) = ANUM(1) * 10.**NEXPM
277
278	C-- single precision, fraction
279
280	56 IF (JXFE.LE.JXFA) GO TO 60
281	DO 59 JXOP=JXFA+1,JXFE
282	ANUM(2) = REAL(IVALV(JXOP))
283	NEXPU = NEXPV(JXOP) + NEXPM
284	IF (NEXPU.EQ.0) GO TO 59
285	IF (NEXPU.LT.0) GO TO 58
286	IF (NEXPU.GT.9) GO TO 58
287	DO 57 J=1,NEXPU
288	57 ANUM(2) = ANUM(2) * 10.
289	GO TO 59
290
291	58 ANUM(2) = ANUM(2) * 10.**NEXPU
292	59 ANUM(1) = ANUM(1) + ANUM(2)
293	60 IF (NEGM.NE.0) ANUM(1) = -ANUM(1)
294	GO TO 30
295
296	C-- double precision, integer part
297
298	61 MODE = 4
299	DNUM = 0.
300	IF (JXME.EQ.0) GO TO 66
301
302	DNUM = DBLE(IVALV(1))
303	IF (JXME.GE.2) THEN
304	N = NEXPV(2) - NEXPV(1)
305	DO 63 J=1,N
306	63 DNUM = DNUM * 10.
307	DNUM = DNUM + DBLE(IVALV(2))
308	ENDIF
309
310	IF (NEXPM.EQ.0) GO TO 66
311	IF (NEXPM.LT.0) GO TO 65
312	IF (NEXPM.GT.9) GO TO 65
313	DO 64 J=1,NEXPM
314	64 DNUM = DNUM * 10.
315	GO TO 66
316
317	65 DNUM = DNUM * 10.D0**NEXPM
318
319	C-- double precision, fraction
320
321	66 IF (JXFE.LE.JXFA) GO TO 70
322	DO 69 JXOP=JXFA+1,JXFE
323	DFRACT = DBLE(IVALV(JXOP))
324	NEXPU = NEXPV(JXOP) + NEXPM
325	IF (NEXPU.EQ.0) GO TO 69
326	IF (NEXPU.LT.0) GO TO 68
327	IF (NEXPU.GT.9) GO TO 68
328	DO 67 J=1,NEXPU
329	67 DFRACT = DFRACT * 10.
330	GO TO 69
331
332	68 DFRACT = DFRACT * 10.D0**NEXPU
333	69 DNUM = DNUM + DFRACT
334	70 IF (NEGM.NE.0) DNUM = -DNUM
335	GO TO 30
336
337	C-------- Reading octal or binary or hexadecimal
338
339	71 J = INDEX ('0OoBbXx', CHV(JJ+1))
340	IF (J.EQ.0) GO TO 94
341	JJ = JJ + 2
342	IF (J.GE.6) GO TO 82
343	IF (J.GE.4) GO TO 76
344
345	C-- octal
346
347	72 IF (JJ.GT.JR) GO TO 87
348	#if defined(CERNLIB_QASCII)
349	K = ICHAR (CHV(JJ))
350	IF (K.EQ.32) GO TO 87
351	K = K - 48
352	IF (K.LT.0) GO TO 86
353	IF (K.GE.8) GO TO 86
354	#endif
355	#if defined(CERNLIB_QEBCDIC)
356	K = ICHAR (CHV(JJ))
357	IF (K.EQ.64) GO TO 87
358	K = K - 240
359	IF (K.LT.0) GO TO 86
360	IF (K.GE.8) GO TO 86
361	#endif
362	#if !defined(CERNLIB_QISASTD)
363	NUM(1) = ISHFTL(NUM(1),3) + K
364	#endif
365	#if defined(CERNLIB_QISASTD)
366	NUM(1) = ISHFT(NUM(1),3) + K
367	#endif
368	NDIGT = NDIGT + 1
369	JJ = JJ + 1
370	GO TO 72
371
372	C-- binary
373
374	76 IF (JJ.GT.JR) GO TO 87
375	#if defined(CERNLIB_QASCII)
376	K = ICHAR (CHV(JJ))
377	IF (K.EQ.32) GO TO 87
378	K = K - 48
379	IF (K.LT.0) GO TO 86
380	IF (K.GE.2) GO TO 86
381	#endif
382	#if defined(CERNLIB_QEBCDIC)
383	K = ICHAR (CHV(JJ))
384	IF (K.EQ.64) GO TO 87
385	K = K - 240
386	IF (K.LT.0) GO TO 86
387	IF (K.GE.2) GO TO 86
388	#endif
389	#if !defined(CERNLIB_QISASTD)
390	NUM(1) = ISHFTL(NUM(1),1) + K
391	#endif
392	#if defined(CERNLIB_QISASTD)
393	NUM(1) = ISHFT(NUM(1),1) + K
394	#endif
395	NDIGT = NDIGT + 1
396	JJ = JJ + 1
397	GO TO 76
398
399	C-- hexadecimal
400
401	82 IF (JJ.GT.JR) GO TO 87
402	#if defined(CERNLIB_QASCII)
403	K = ICHAR (CHV(JJ))
404	IF (K.EQ.32) GO TO 87
405	K = K - 48
406	IF (K.LT.0) GO TO 86
407	IF (K.LT.10) GO TO 84
408	K = K - 7
409	IF (K.LT.8) GO TO 86
410	IF (K.LT.16) GO TO 84
411	K = K - 32
412	IF (K.LT.8) GO TO 86
413	IF (K.GE.16) GO TO 86
414	#endif
415	#if defined(CERNLIB_QEBCDIC)
416	K = ICHAR (CHV(JJ))
417	IF (K.EQ.64) GO TO 87
418	K = K - 240
419	IF (K.GE.10) GO TO 86
420	IF (K.GE.0) GO TO 84
421	K = K + 57
422	IF (K.GE.16) GO TO 86
423	IF (K.GE.8) GO TO 84
424	K = K + 64
425	IF (K.GE.16) GO TO 86
426	IF (K.LT.8) GO TO 86
427	#endif
428	#if !defined(CERNLIB_QISASTD)
429	84 NUM(1) = ISHFTL(NUM(1),4) + K
430	#endif
431	#if defined(CERNLIB_QISASTD)
432	84 NUM(1) = ISHFT(NUM(1),4) + K
433	#endif
434	NDIGT = NDIGT + 1
435	JJ = JJ + 1
436	GO TO 82
437
438	86 JTERM = -1
439	87 MODE = 1
440	IF (NDIGT.EQ.0) GO TO 91
441	GO TO 30
442
443	C---- Special error exits
444
445	94 NERR = -1
446	93 NERR = NERR - 1
447	92 NERR = NERR - 1
448	91 NERR = NERR - 1
449	90 MODE = NERR
450	NESLAT = JJ
451	NGSLAT = JJ
452	RETURN
453	END