	SUBROUTINE MULDIV (PT1,PT2,RETCD,BASE)
C COPYRIGHT (C) 1983 GLENN EVERHART
C PERMISSION IS GIVEN TO ANYONE TO USE, DISTRIBUTE, OR COPY THIS
C PROGRAM FREELY BUT NOT TO SELL IT COMMERICALLY.
	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  MULDIV (PT1,PT2,RETCD,BASE)     *
C *                                                *
C **************************************************
C
C
C  SUBROUTINE MULDIV PERFORMS MULTIPLE PRECISION DIVISION
C
C
C
C  ARGUMENTS: (PT1,PT2,RETCD)
C
C  PLACES STACK1( ,PT1)/STACK2( ,PT2) INTO STACK1( ,PT1)
C
C  STACK 2 IS NOT CLEANED UP BY THIS ROUTINE
C
C  ERROR RETURN		1 = NORMAL
C			2 = ERROR
C
C
C
C ENTRY INDICATES THE BASE: 8, 10, OR 16
C
C
C
C
C  MODIFY CODES: M3, M10
C
C
C
C
C MULDIV CALLS ERRMSG TO PRINT ERROR MESSAGES.
C
C
C
C
C MULDIV IS CALLED BY CALBIN
C
C
C
C
C  VARIABLE    USE
C
C    ANSWER    HOLDS QUOTIENT
C    BASE      HOLDS THE BASE: 8, 10, OR 16
C    CARRY     USED TO "BORROW" WHEN SUBTRACTING
C    DIVPT     POINTS TO HIGHEST (NON-ZERO) DIGIT OF DIVISOR.
C    I,M,K,L   TEMPORARY VALUES.
C    NPT       HOLDS POSITION OF HIGHEST (NON-ZERO) DIGIT OF DIVIDEND.
C    PT1       POINTER TO STACK1 ELEMENT (DIVIDEND)
C    PT2       POINTER TO STACK2 ELEMENT (DIVISOR)
C    RETCD     RETURN CODE: 1=O.K., 2=ERROR.
C
C
C
C
C
C
C	SUBROUTINE MULDIV (PT1,PT2,RETCD,BASE)
	InTEgeR*4 RETCD,BASE,DIVPT,NPT,CARRY
	InTEgeR*4 ST1PT,ST2PT,ST1LIM,ST2LIM,PT1,PT2
	InTEgeR*4 ST1TYP(40),ST2TYP(40)
	InTEgeR*4 I,M,K,L
C
	LOGICAL*1 ANSWER(20)
	LOGICAL*1 STACK1(20,40),STACK2(20,40)
C
	COMMON /STACK/STACK1,STACK2,ST1PT,ST2PT,ST1TYP,ST2TYP,
     ;          ST1LIM,ST2LIM
C
C
C
C
C
C  SET DEFAULT RETURN CODE AND ZERO ANSWER
	RETCD=1
	DO 110 I=1,20
110	ANSWER(I)=0
C
C
C  DETERMINE SIGN OF ANSWER
	IF (STACK1(20,PT1)+STACK2(20,PT2).EQ.1)ANSWER(20)=1
C
C
C  FIND HIGH ORDER NON-ZERO DIGIT OF DIVISOR (HELD BY DIVPT)
	DO 140 I=1,19
	DIVPT=20-I
	IF (STACK2(DIVPT,PT2).NE.0) GOTO 150
140	CONTINUE
C
C
C  DIVISOR IS ZERO, PRINT OUT APPROPRIATE ERROR MESSAGE
	RETCD=2
	CALL ERRMSG (23)
	RETURN
C
C
C  FIND STARTING NON-ZERO DIGIT OF DIVIDEND (HELD BY NPT)
150	DO 170 I=1,19
	NPT=20-I
	IF (STACK1(NPT,PT1).NE.0) GOTO 200
170	CONTINUE
C
C
C  ANSWER IS ZERO
	GOTO 10000
C
C
C
C
C
C ************************************************
C ****** FIND OUT WHERE TO SUBTRACT DIVISOR ******
C ************************************************
C (NEXT LINE WAS $200	IF ...)
 200	IF (NPT.LT.DIVPT) GOTO 10000
C
C M POINTS TO A DIGIT OF DIVIDEND ALIGNED WITH THE LOW ORDER DIGIT OF
C DIVISOR.
	M=NPT-DIVPT+1
C
C K INDEXES DIVIDEND FROM HIGH ORDER END.
	K=NPT
C
C L INDEXES DIVISOR FROM HIGH ORDER END.
	L=DIVPT
	DO 250 I=1,DIVPT
	IF (STACK2(L,PT2).EQ.STACK1(K,PT1)) GOTO 240
C
C WHEN COMPARING DIGITS OF DIVISOR AND DIVIDEND, IF THE DIVISOR'S
C DIGIT IS SMALLER AND ALL PREVIOUS WERE EQUAL,
C THEN WE GO TO 300 TO SUBTRACT OFF THE DIVISOR.
	IF (STACK2(L,PT2).LT.STACK1(K,PT1)) GOTO 300
C
C OTHERWISE THOSE DIGITS OF THE DIVIDEND REPRESENT A LARGER
C NUMBER. IF THE NUMBER OF DIGITS OF THE DIVISOR IS GREATER
C THAN OR EQUAL TO DIVIDEND THEN THE QUOTIENT IS 0 AND THE
C REMAINDER IS THE DIVIDEND. (GO TO 10000)
	IF (NPT.LT.DIVPT+1) GOTO 10000
C
C OTHERWISE SHIFT THE POSITION OF THE DIVISOR BY 1.
	M=M-1
	GOTO 300
C
C
C K INDEXES DIVIDEND
C L INDEXES DIVISOR
240	K=K-1
	L=L-1
250	CONTINUE
C
C
C
C
C **************************************
C ****** SUBTRACT OFF THE DIVISOR ******
C **************************************
300	CONTINUE
C
C K POINTS TO LOW ORDER DIGIT WHERE SUBTRACTION TAKES PLACE,
C CARRY TAKES CARE OF "BORROWS"
	K=M-1
	CARRY=0
	DO 350 I=1,DIVPT
	K=K+1
	L=STACK1(K,PT1)-STACK2(I,PT2)-CARRY
	IF (L.GE.0) GOTO 325
C
C IF SUBTRACTION RESULTS IN A "NEGATIVE DIGIT", ADD BASE AND SET CARRY
C INDICATOR.
	CARRY=1
	L=BASE+L
	GOTO 340
C
C RESULT OF SUBTRACTION IS A POSITIVE NUMBER, SO
C CLEAR CARRY INDICATOR.
325	CARRY=0
340	STACK1(K,PT1)=L
350	CONTINUE
	IF(CARRY.EQ.1) STACK1(K+1,PT1)=STACK1(K+1,PT1)-1
C
C
C THE QUOTIENT (ANSWER(M)) COUNTS THE NUMBER OF SUBTRACTIONS.
	ANSWER(M)=ANSWER(M)+1
C
C
C RESET THE POINTER TO THE HIGH ORDER NON-ZERO DIGIT OF THE
C DIVIDEND IF NECESSARY.
370	IF (STACK1(NPT,PT1).NE.0) GOTO 200
	NPT=NPT-1
	IF (NPT.EQ.0) GOTO 10000
	GOTO 370
C
C
C
C
C ***************************
C ******  COPY ANSWER  ******
C ***************************
10000	DO 10010 I=1,20
10010	STACK1(I,PT1)=ANSWER(I)
	RETURN
	END
