C..  WRITTEN BY BOHDEN K. CMAYLO ... FEB 1982
C..
	DOUBLE PRECISION XOCT,XBIN,XDEC,XHEX
	DIMENSION NBASE(4)
	BYTE KIND(8,4),IBASES(2,4)
	BYTE IN(132),NUM1(132),NUM2(132),NUM3(132),IFACT(4),IOP
	EQUIVALENCE (XOCT,KIND(1,2)),(XDEC,KIND(1,3)),(XBIN,KIND(1,1))
     1 ,(XHEX,KIND(1,4))
	DATA
     1 XOCT,XBIN,XDEC,XHEX/' OCTAL',' BINARY',' DECIMAL',' HEXIDEC'/
C.. BIGGEST BASE IS 16
	DATA MAXLEN,IBASE,INBASE/132,16,4/
	DATA IBASES/'2',0,'8',0,'A',0,'1','0'/
	DATA NBASE/2,8,10,16/
	IQ=ISTXQT(IN)
	IGO=1
	IF(IQ.LE.2) GO TO 1
	IGO=0
	GO TO 111
1	IF(IGO.LE.0) CALL EXIT
	TYPE 2
2	FORMAT(/'  ENTER  n#n OR n#arith#{n} OR <CR> (n=O B D H) =')
	READ(5,3,END=98)IQ,(IN(I),I=1,IQ)
3	FORMAT(Q,132A1)
111	IF(IQ.LE.0) CALL EXIT
C..
C..	CHECK FOR VALID NUMBERS
C..
	KTYPE1=0
	KTYPE2=0
	IARITH=0
	DO 31 KTYPE=1,INBASE
	IF(IN(1).EQ.KIND(2,KTYPE)) KTYPE1=KTYPE
	IF(IN(IQ).EQ.KIND(2,KTYPE)) KTYPE2=KTYPE
31	CONTINUE
	IF(KTYPE1.EQ.0) GO TO 99
C..
C..	CHECK FOR ARITHMETIC OPERATOR
C..
	DO 12 I=2,IQ
	IF(IN(I).EQ.'+'.OR.IN(I).EQ.'-'.OR.IN(I).EQ.'*'.OR.IN(I).EQ.'/'
     1 .OR.IN(I).EQ.'^') GO TO 121
12	CONTINUE
	GO TO 122
C..
C..	FOUND ARITHMETIC OPERATOR
C..
121	KBASE=NBASE(KTYPE1)
	IF(KTYPE2.NE.0) IQ=IQ-1
	IOP=IN(I)
	IN(I)=0
	IN(IQ+1)=0
	IARITH=1
	CALL ARITH(KBASE,IN(2),IN(I+1),IOP,NUM1,NUM2)
	IF(KTYPE2.LE.0) GO TO 1
	CALL STRLEN(NUM1,IQ)
	IQ=IQ+2
	CALL BYTEDO(IN(2),IN(IQ),NUM1)
C..
C..	CHECK FOR VALID LENGTHS
C..
122	IF(KTYPE2.LE.0) GO TO 99
	IF(KTYPE1.EQ.4.AND.KTYPE2.EQ.1.AND.IQ.GT.35) GO TO 97
	IF(KTYPE1.EQ.3.AND.KTYPE2.EQ.1.AND.IQ.GT.46) GO TO 97
	IF(KTYPE1.EQ.2.AND.KTYPE2.EQ.1.AND.IQ.GT.46) GO TO 97
C..
C..	GET CORRECT FACTORS AND KIND OF INPUT NUMBERS
C..
	CALL DOBYTE(IFACT(1),IFACT(4),0)
	IFACT(1)=IBASES(1,KTYPE1)
	IFACT(2)=IBASES(2,KTYPE1)
	TYPE 100,(IN(I-1),I=3,IQ),(KIND(I,KTYPE1),I=1,8)
100	FORMAT(/1X,132A1)
	TYPE 100,'I','S'
C..	CHECK FOR SAME
	IF(KTYPE1.EQ.KTYPE2) GO TO 24
C..	CHECK IF HIGHEST BASE IS INPUT
	IF(KTYPE1.NE.INBASE) GO TO 33
	CALL BYTEDO(NUM1(1),NUM1(IQ-2),IN(2))
	NUM1(IQ-1)=0
	GO TO 34
C..  DECODE INPUT NUMBER FROM BASE TO HIGHEST BASE NUM1 ARRAY
33	NUM1(1)='0'
	NUM1(2)=0
	IQ1=IQ-1
	IF(IQ1.LE.1) GO TO 99
	DO 4 I=2,IQ1
	NUM2(1)=IN(I)
	NUM2(2)=0
	CALL STRMUL(IBASE,NUM1,IFACT,NUM3)
	CALL STRADD(IBASE,NUM3,NUM2,NUM1)
4	CONTINUE
C..	CONVERT HEIGHEST BASE NUM1 TO BASE OUTPUT
34	IF(KTYPE2.EQ.INBASE) GO TO 23
	IFACT(1)=IBASES(1,KTYPE2)
	IFACT(2)=IBASES(2,KTYPE2)
	INY=MAXLEN
	IN(INY)=0
20	CONTINUE
66	FORMAT(' NUM',A1,'= ',I2,':',10O6)
	CALL STRDIV(IBASE,NUM1,IFACT,NUM2,NUM3)
C..    ANSWER IS 0, PLACE REMAINDER + PRINT ANSWER
C**CALL STRLEN(NUM1,L1)
C**CALL STRLEN(NUM2,L2)
C**CALL STRLEN(NUM3,L3)
C**TYPE 66,'1',L1,(NUM1(II),II=1,10)
C**TYPE 66,'2',L2,(NUM2(II),II=1,10)
C**TYPE 66,'3',L3,(NUM3(II),II=1,10)
	IF((NUM2(1).EQ.'0'.AND.NUM2(2).EQ.0).OR.NUM2(1).EQ.0) GO TO 22
	INY=INY-1
C..	SAVE 1 DIGIT REMAINDER
	IN(INY)=NUM3(1)
	CALL BYTEDO(NUM1(1),NUM1(MAXLEN),NUM2(1))
	GO TO 20
C..
C..	COPY OVER INPUT ANSWER
C..
24	CALL BYTEDO(IN(1),IN(IQ-2),IN(2))
	IN(IQ-1)=0
	GO TO 21
C..
C..	TRANSFER OVER HIGHEST BASE TO ANSWER ARRAY
C..
23	CALL BYTEDO(IN(1),IN(MAXLEN),NUM1(1))
	GO TO 21
22	INY=INY-1
	IN(INY)=NUM3(1)
C..
C..	SHIFT OVER ANSWER TO FRONT POSITION
C..
	CALL BYTEDO(IN(1),IN(MAXLEN-INY+1),IN(INY))
C..
C..	GET LENGTH OF STRING ANSWER
C..
21	CALL STRLEN(IN,LENSTR)
	TYPE 100, (IN(I),I=1,LENSTR),(KIND(I,KTYPE2),I=1,8)
	GO TO 1
99	TYPE 199,(IN(I),I=1,IQ)
199	FORMAT('0*** ERROR IN INPUT=',132A1)
	GO TO 1
98	CALL EXIT
97	TYPE 197
197	FORMAT('0*** ERROR *** PARTICULAR COMBINATION REQUIRES'
     1 ,' FEWER NUMBERS.')
	GO TO 1
	END