      SUBROUTINE NUMB(MODE)
C 
C     THIS ROUTINE CONVERTS A NUMERIC CONSTANT TO BINARY
C 
C     ENTRY PARAMETERS
C        NBASE - BASE OF NUMBERS WITHOUT BASE SPECIFICATIONS
C        ICOL - COLUMN THAT SCAN STARTS IN
C        MODE - CONTROL PARAMETER 
C           0 = DON"T SCAN CONSTANT MODIFIERS 
C           1 = SCAN CONSTANT MODIFIERS 
C        NFLAG = FLAG THAT ALLOWS CONSTANTS OF THE TYPE 025H TO BE READ 
C     EXIT PARAMETERS 
C        IERR - ERROR INDICATOR 
C           1 = NO ERROR, NUMERIC FORM
C           2 = NOT A NUMERIC FORM
C           3 = NUMERIC CONSTANT ERROR
C           4 = NUMERIC CONSTANT TOO LARGE
C           5 = IMPLICIT AND EXPLICIT LENGTH CONFLICT 
C        CVAL - CONTAINS CONSTANT VALUE 
C        ICOL - POINTS TO CHARACTER AFTER CONSTANT
C        KLEN - IMPLICIT LENGTH OF NUMERIC CONSTANT 
C        LLEN - EXPLICIT LENGTH OF NUMERIC CONSTANT 
C 
      REAL IVAL1,IVAL2
      DIMENSION JSYM(15),JCTYP(4),JCVAL(4),JCLEN(4)
      DIMENSION NUMS(16)
      INTEGER FTYPE
      REAL ITABV(249)
      COMMON ICRD,IPRT,MCFLE,IDFLE,MCREC,IDREC,IFORM,ITRUN,ILOUT,IXCOL
      COMMON MLAB,MOPC,IBIT,ICCNT,IWORD,IERRL,IERRI,IEND,IFRMC
      COMMON LSOR,LIF,LSYM,LREF,LDEF,LOCT,ITRMI,ITRMO
      COMMON ILEN,KLEN,LLEN,KWORD,IFLD(2400),IYFLD,IZFLD
      COMMON IFBIT,ZVAL,CVAL,JREAD,IN(80),INB(80),LINE,IPAGE,LISN
      COMMON IALPH(37),IAST,IDOLR,ISHRP 
      COMMON ICOLN,IBLNK,ICTAB,ISEMI,ICOMM,IPLUS,IMIN,IMULT,IDIV
      COMMON IRPAR,ILPAR,IATT(9),JATT(5),LATT(9),IFPAR(16),NBASE,JBASE
      COMMON ICOL,IFCOL,MCOL,MLCOL,IOLIN,ICNT,LTITL(50),IADDR(4,12) 
      COMMON ITYPE,JTYPE,FTYPE,IERR,IERRS,IOPVA,JCOL,IBUG 
      COMMON ITAB(4,249),ITABS(249),ITABV,NAME(4),INDEX,INDET,ISYM,LTAB 
      COMMON IXTAB(256),MXREF,IXT,IXPNT,IXCNT,IXPAG,MCORE(128) 
C INCLUDE(:F1:METAD.COM)
      EQUIVALENCE (NUMS(1),IALPH(1))
      EQUIVALENCE (JSYM(1),IBLNK)
      EQUIVALENCE(IATT(6),JCTYP(1))
      EQUIVALENCE (ICHR0,IALPH(1)),(ICHR9,IALPH(10))
      DATA JCVAL(1),JCVAL(2),JCVAL(3),JCVAL(4) /2,8,16,10/
      DATA JCLEN(1),JCLEN(2),JCLEN(3),JCLEN(4) /1,3,4,0/
C 
      CVAL = 0. 
      IFLG = 0
      NFLAG = 0 
C     SET DEFAULT BASE VALUE AND DIGIT LENGTH 
      NBASE = JCVAL(JBASE)
      LBASE = JCLEN(JBASE)
C     INITIALIZE CONSTANT"S EXPLICIT LENGTH 
      LLEN = 0
      KKEN = 0
C     INITIALIZE CONSTANT"S IMPLICIT LENGTH 
      KLEN = 0
      IF(IN(ICOL) .GT. ICHR9) GO TO 100
      IF(IN(ICOL) .GE. ICHR0) GO TO 120
100   CONTINUE
C     CHECK FOR A SHARP SIGN INDICATING A CONSTANT TYPE 
      ICOL1 = ICOL+1
      IF(IN(ICOL1)-ISHRP) 910,205,910 
C     CHECK FOR LENGTH SPECIFIED ON CONSTANT, 
C     FIND FIRST NON-DECIMAL NUMBER 
120   N1 = ICOL 
125   DO 140 I=1,10 
      IF(IN(ICOL)-NUMS(I)) 140,150,140
140   CONTINUE
      GO TO 160 
150   KKEN = KKEN*10+I-1
      ICOL = ICOL+1 
      IF(ICOL-MCOL) 125,125,910 
C     CHECK FOR FIELD DESCRIPTOR
160   DO 170 I=1,4
      IF(IN(ICOL)-JCTYP(I)) 170,180,170 
170   CONTINUE
C     NO FIELD DESCRIPTOR FOUND, NUMBER ASSUMED TO BE HEXIDECIMAL 
      GO TO 211 
C     IF NEXT CHARACTER IS A SHARP, THEN NUMBER JUST SCANNED
C     SPECIFIES EXPLICIT FIELD LENGTH 
180   ICOL1 = ICOL+1
      IF(IN(ICOL1)-ISHRP) 211,185,211 
185   LLEN = KKEN 
205   IFLG = 1
      NCHAR = IN(ICOL)
      ICOL = ICOL1+1
C     SKIP OVER BLANKS
207   IF(IN(ICOL)-IBLNK) 210,208,210
208   ICOL = ICOL+1 
      IF(ICOL-MCOL) 207,207,920
C     SET STARTING COLUMN NUMBER OF CONSTANT
210   N1 = ICOL 
211   IF(ICOL-MCOL) 212,212,920 
C     CHECK FOR NUMERIC TERMINATOR
212   DO 214 I=1,15 
      IF(JSYM(I)-IN(ICOL)) 214,220,214
214   CONTINUE
      ICOL = ICOL+1 
      GO TO 211 
C     SET ENDING COLUMN NUMBER OF CONSTANT
220   ICOL1 = ICOL-1
C     IF CONSTANT TYPE NOT SPECIFIED, SET BASE TO DEFAULT 
      IF(IFLG) 300,225,300
225   IF(NFLAG) 235,230,235 
230   IFACT = NBASE 
      JFACT = LBASE 
      GO TO 335 
235   NCHAR = IN(ICOL1) 
      ICOL1 = ICOL1-1 
      GO TO 335 
C     CHECK FOR CONSTANT TYPE 
300   DO 310 I=1,4
      IFACT = JCVAL(I)
      JFACT = JCLEN(I)
      IF(JCTYP(I)-NCHAR) 310,335,310
310   CONTINUE
C 
C     CONVERT HOLLERITH CODED NUMBER TO BINARY
C   
335   IF(ICOL1-N1) 920,338,338
338   DO 350 LL=N1,ICOL1
      DO 340 I=1,IFACT
      IF(IN(LL)-NUMS(I)) 340,345,340
340   CONTINUE
      GO TO 920 
345   IVAL1 = IFACT 
      IVAL2 = I-1 
      CVAL = CVAL*IVAL1+IVAL2 
      KLEN = KLEN+JFACT 
      IF(CVAL-ZVAL) 350,350,930 
350   CONTINUE
800   IF(IFACT-10) 870,850,870
C     SET CONSTANT LENGTH FOR DECIMAL NUMBER
850   DO 860 I=1,IFBIT
C     FORM 2.**IFBIT-I
      J = IFBIT-I
      REAL = 1. 
      IF(J) 855,857,855 
855   DO 856 K=1,J
      REAL = REAL+REAL
856   CONTINUE
857   K = CVAL/REAL
      IF(K) 865,860,865 
860   CONTINUE
      J = -1
865   KLEN = J+1
C     IF AN EXPLICIT LENGTH IS SPECIFIED, THEN CHECK IMPLICIT LENGTH
870   IF(LLEN) 880,900,880
880   IF(LLEN-KLEN) 940,900,940 
C     FINISHED, NO ERROR
900   IERR = 1
      GO TO 990 
C     NOT A NUMERIC CONSTANT
910   IERR = 2
      GO TO 990
C     NUMERIC CONSTANT ERROR
920   IERR = 3
      GO TO 990
C     NUMERIC CONSTANT TOO LARGE
930   IERR = 4
      GO TO 990
C     EXPLICIT - IMPLICIT LENGTH CONFLICT
940   IERR = 5
990   RETURN
      END
END
