SUBROUTINE MULCON (STACK,INDEX,OLDA,NEWA,RETCD)
	INCLUDE 'VKLUGPRM.FTN'
C	PARAMETER RRW = 32
C	PARAMETER RCL = 32
C RRW=MAX REAL ROWS
C RCL=MAX REAL COLS
C RRW MUST BE 1 LARGER TO HANDLE 1ST 27 VARIABLES IN AVBLS
C VBLS AND TYPE DIMENSIONED RRW,RCL
C ***************************************************
C **                                                 *
C * SUBROUTINE  MULCON (STACK,INDEX,OLDA,NEWA,RETCD) *
C *                                                  *
C ****************************************************
C
C
C
C  WHICH CONVERTS MULTIPLE PRECISION NUMBER IN STACK ( ,INDEX) FROM
C  BASE "OLD" TO BASE "NEW".
C
C  ERROR RETURN:	RETCD VALUE	MEANING
C                           1             O.K.
C                           2             ERROR
C 
C  LEGAL VALUE FOR OLDA AND NEWA: 5 (BASE 8),  6 (BASE 10),  7 (BASE 16)
C
C
C
C MODIFY CODES: M3, M10
C
C
C
C MULCON IS CALLED BY CONTYP
C
C
C
C
C
C
C    VARIABLE    USE
C
C    ANSWER(100)  HOLDS ANSWER.
C    APT          POINTER FOR VECTOR ANS (WHICH HOLDS ANSWER).
C    BCON         VECTOR OF LEGAL BASES (8, 10, AND 16).
C    CARRY        USED TO "BORROW" WHEN SUBTRACTING OFF DIVISOR.
C    DIVPT        POINTER FOR THE DIVISOR (A VECTOR)
C    I,M,K,L      TEMPORARY VALUES.
C    INDEX        POINTER TO NUMBER (IN STACK) TO BE CONVERTED.
C    ISW          SWITCH: 0=ONLY DIGITS 0 FOUND,  1=NON-ZERO FOUND.
C    NEW          NEW BASE: 8, 10, OR 16.
C    NEWA         NEW BASE CODE: 5,6 OR 7
C    NPT          POINTER TO HIGH ORDER DIGIT OF NUMBER AS IT IS SUCCESSIVELY
C                 REDUCED BY DIVISION.
C    NPTH         HOLDS OLD NPT VALUE.
C    OLD          OLD BASE: 8, 10, OR 16
C    OLDA         OLD BASE CODE: 5,6, OR 7
C    QUOT(100)    HOLDS QUOTIENT FOR SUCCESSIVE DIVIDES.
C    RETCD        RETURN CODE: 1=O.K., 2=ERROR.
C    STACK(,INDEX) HOLDS MULTIPLE PRECISION NUMBER TO BE CONVERTED.
C
C
C
C
C
C
C	SUBROUTINE MULCON (STACK,INDEX,OLDA,NEWA,RETCD)
C
	INTEGER*2 INDEX
	INTEGER*2 OLD,NEW,RETCD,DIVPT,NPT,APT,BCON(3)
	INTEGER*2 CARRY,NPTH,NEWA,OLDA
	INTEGER*2 I,M,K,L
C
C
	LOGICAL*1 STACK(100,40),QUOT(100),ANSWER(100),DIV(2)
C
C
	DATA BCON/10,8,16/
C
	RETCD=1
	IF (OLDA.EQ.NEWA) RETURN
	OLD=BCON(OLDA-4)
	NEW=BCON(NEWA-4)
	IF (OLD.NE.16) GOTO 100
C
C
C
C
C
C ***********************************************************
C ******** SET UP DIVISOR (DIV(1), DIV(2)) ACCORDING ********
C ******** TO OLD AND NEW BASES.                     ********
C ***********************************************************
C  OLD IS BASE 16, NEW CAN BE ANYTHING
C  ALSO ENTER HERE IF OLD IS BASE 10 AND NEW BASE IS 8
90	DIV(1)=NEW
	DIV(2)=0
	GOTO 1000
100	IF (OLD.NE.10) GOTO 200
C
C
C  OLD IS BASE 10
	IF (NEW.EQ.8) GOTO 90
C
C
C  OLD IS BASE 10, NEW IS BASE 16
	DIV(1)=6
	DIV(2)=1
	GOTO 1000
C
C
C  OLD IS BASE 8
200	IF (OLD.NE.8) STOP 200
	IF (NEW.EQ.10) GOTO 250
C
C
C  NEW IS BASE 16, OLD IS BASE 8
	DIV(1)=0
	DIV(2)=2
	GOTO 1000
C
C
C  NEW IS BASE 10, OLD IS BASE 8
250	DIV(1)=2
	DIV(2)=1
C
C
C
C
C
C
C
C 
C **********************************************************
C ****** CONVERT TO NEW BASE BY SUCCESSIVELY DIVIDING ******
C ****** BY THE NEW BASE (AS EXPRESSED IN THE OLD     ******
C ****** BASE) TO GET REMAINDERS.                     ******
C **********************************************************
1000	CONTINUE
	APT=1
C
C
C  ZERO OUT ANSWER AND QUOTIENT
	DO 1010 I=1,99
	QUOT(I)=0
1010	ANSWER(I)=0
C
C
C  FIND HIGH ORDER NON-ZERO DIGIT OF DIVISOR
	DIVPT=1
	IF (DIV(2).NE.0) DIVPT=2
C
C
C  FIND HIGH ORDER NON-ZERO DIGIT OF NUMBER TO BE CONVERTED
	DO 1100 I=1,99
	NPTH=100-I
	IF (STACK(NPTH,INDEX).NE.0) GOTO 1195
1100	CONTINUE
C
C
C  NUMBER IS 0 SO SIMPLY RETURN
	RETURN
C
C
C
C
C
C
C ***********************************
C ******  CALCULATE REMAINDERS ******
C ***********************************
C
C FIRST DETERMINE WHERE TO SUBTRACT
1195	NPT=NPTH
1200	CONTINUE
C
C IF DIVISOR IS LESS THAN DIVIDEND, THE REMAINDER IS THE DIVIDEND
C SO GO TO  10000
	IF (NPT.LT.DIVPT) GOTO 10000
C
C M POINTS TO THE DIGIT OF THE DIVIDEND ALIGNED BY THE LOW ORDER
C DIGIT OF THE DIVISOR WHEN DIVIDEND AND DIVISOR HAVE THEIR HIGH
C ORDER DIGITS ALIGNED.
	M=NPT-DIVPT+1
C
C K INDEXES DIGITS OF DIVIDEND FROM HIGH ORDER END.
	K=NPT
C
C L INDEXES DIGITS OF DIVISOR FROM HIGH ORDER END.
	L=DIVPT
	DO 1250 I=1,DIVPT
	IF (DIV(L).EQ.STACK(K,INDEX)) GOTO 1240
C
C IF DIGIT OF DIVISOR IS LESS THAN CORRESPONDING DIGIT OF DIVIDEND
C WE CAN SUBTRACT OFF THE DIVISOR FROM THE APPROPRIATE DIGITS OF
C DIVIDEND.
	IF (DIV(L).LT.STACK(K,INDEX)) GOTO 1300
C
C IF DIVISOR AND DIVIDEND HAVE THE SAME NUMBER OF DIGITS AND AS
C THE DIGITS ARE COMPARED FROM THE HIGH ORDER END, DIGITS ARE 
C EQUAL UNTIL A DIGIT OF DIVISOR IS GREATER, THEN THE DIVISOR
C IS GREATER THAN THE DIVIDEND SO REMAINDER IS JUST THE DIVIDEND
C AND WE GO TO 10000.
	IF (NPT.LT.DIVPT+1) GOTO 10000
C
C THE SIZE OF THE HIGH ORDER DIGITS OF THE DIVIDEND ARE SUCH THAT WE WILL
C BE SUBTRACTING THE DIVISOR AFTER SHIFTING ALIGNMENT ONE PLACE TO THE
C RIGHT (WHEN HIGH ORDER DIGITS WERE ALIGNED, THE CORRESPONDING DIGITS
C OF THE DIVIDEND FORMED A NUMBER THAT WAS TOO SMALL).
	M=M-1
	GOTO 1300
C
C
C K IS DIVIDEND POINTER
C L IS DIVISOR POINTER
1240	K=K-1
	L=L-1
1250	CONTINUE
C
C
C
C
C **********************************************************
C ****** DIVISION PERFORMED BY SUCCESSIVE SUBTRACTION ******
C **********************************************************
1300	CONTINUE
	K=M-1
	CARRY=0
	DO 1350 I=1,DIVPT
	K=K+1
	L=STACK(K,INDEX)-DIV(I)-CARRY
	IF (L.GE.0) GOTO 1325
	CARRY=1
	L=OLD+L
	GOTO 1340
1325	CARRY=0
1340	STACK(K,INDEX)=L
1350	CONTINUE
	IF(CARRY.EQ.1) STACK(K+1,INDEX)=STACK(K+1,INDEX)-1
C
C THE QUOTIENT IS JUST HOW MANY SUBTRACTIONS WHERE MADE
	QUOT(M)=QUOT(M)+1
C
C NPT IS ADJUSTED (IF NECESSARY) TO POINT TO HIGHEST NON-ZERO
C DIGIT OF DIVIDEND.
1370	IF (STACK(NPT,INDEX).NE.0) GOTO 1200
	NPT=NPT-1
	IF (NPT.EQ.0) GOTO 10000
	GOTO 1370
C
C DIGIT OF ANSWER IS JUST THE REMAINDER. NOTE THAT THIS DIGIT IS LESS
C THAN THE BASE.
10000	ANSWER(APT)=OLD*STACK(2,INDEX)+STACK(1,INDEX)
C
C
C ADJUST ANSWER POINTER.
	APT=APT+1
C
C
C
C
C *******************************************************
C ****** COPY QUOTIENT BACK INTO STACK TO FORM NEW ******
C ****** DIVIDEND AND ZERO OUT QUOTIENT VECTOR.    ******
C *******************************************************
	ISW=0
	DO 10100 I=1,99
	K=QUOT(I)
	IF (K.NE.0) ISW=1
	QUOT(I)=0
10100	STACK(I,INDEX)=K
C
C
C
C CALCULATE NEW VALUE FOR NPTH (POINTER TO HIGHEST NON-ZERO DIGIT
C OF DIVIDEND.
	IF (ISW.EQ.0) GOTO 10500
10150	IF (STACK(NPTH,INDEX).NE.0) GOTO 1195
	NPTH=NPTH-1
	GOTO 10150
C
C
C
C REPLACE OLD NUMBER WITH THE VALUE AS EXPRESSED IN NEW BASE.
10500	DO 10550 I=1,99
10550	STACK(I,INDEX)=ANSWER(I)
C
C
	RETURN
	END