	SUBROUTINE MULADD (PT1,PT2,RETCD,ENTRY)
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 MULADD (PT1,PT2,RETCD,ENTRY)    *
C *                                                *
C **************************************************
C
C
C MULTIPLE PRECISION ADDITION AND SUBTRACTION ROUTINE.
C
C
C
C   ENTRY #  ACTION
C     1       M10ADD	ARGUMENT LIST IS (PT1,PT2,RETCD,ENTRY)
C     2       M8ADD	WHERE THE OPERATION OPR IS PERFORMED
C     3       M16ADD	AS FOLLOWS:
C     4       M10SUB
C     5       M8SUB	STACK1( ,PT1) GETS VALUE
C     6       M16SUB	STACK1( ,PT1) OPR STACK2 ( ,PT2)
C
C  NOTE:  STACK2 IS NOT CLEANED UP BY THE OPERATION
C
C  RETCD = 1	NORMAL
C	   2	ERROR
C
C
C
C  MODIFICATION CLASSES: M3, M10
C
C
C
C
C
C
C MULADD CALLS ERRMSG TO PRINT ERROR MESSAGES.
C
C
C
C MULADD IS CALLED BY CALBIN
C
C
C
C
C     VARIABLE     USE
C
C    BASE      BASE OF NUMBERS BEING ADDED.
C    CARRY     HOLDS CARRY AS OPERATION IS PERFORMED.
C    ENTRY     CODED SPECIFICATION OF BASE AND OPERATION (ADD OR SUBTRACT)
C    I,K       TEMPORARY VALUES.
C    PT1       POINTER TO OPERAND 1 (IN STACK 1)
C    PT2       POINTER TO OPERAND 2 (IN STACK 2)
C    RETCD     RETURN CODE: 1=O.K., 2=ERROR
C    SW        SWITCH: 1=NEGATIVE, 0=POSITIVE.
C    TEMP      HOLDS TEMPORARY VALUES.
C
C
C
C
C
C	SUBROUTINE MULADD (PT1,PT2,RETCD,ENTRY)
C
C
	InTEgeR*4 ST1TYP(40),ST2TYP(40)
	InTEgeR*4 RETCD,ENTRY
	InTEgeR*4 PT1,PT2
	InTEgeR*4 ST1PT,ST2PT,ST1LIM,ST2LIM
	InTEgeR*4 BASE,CARRY,TEMP,SW
	InTEgeR*4 I,K
C
	LOGICAL*1 STACK1(20,40),STACK2(20,40)
C
	COMMON /STACK/STACK1,STACK2,ST1PT,ST2PT,ST1TYP,ST2TYP,
     ;         ST1LIM,ST2LIM
C
C
	GO TO (10,20,30,40,60,70),ENTRY
	STOP 10
C
C ADD BASE 10
10	BASE=10
	GOTO 100
C
C ADD BASE 8
20	BASE=8
	GOTO 100
C
C ADD BASE 16
30	BASE=16
	GOTO 100
C
C SUBTRACT BASE 10
40	BASE=10
C
C CONVERT A - B TO A + (-B)
50	STACK2(20,PT2)=1-STACK2(20,PT2)
	GOTO 100
C
C SUBTRACT BASE 8
60	BASE=8
	GOTO 50
C
C SUBTRACT BASE 16
70	BASE=16
	GOTO 50
C
C
C  SET UP RETURN CODE DEFAULT VALUE
100	RETCD=1
C
C
C  GO ELSEWHERE IF SIGNS ARE NOT THE SAME
	IF (STACK1(20,PT1).NE.STACK2(20,PT2)) GOTO 10000
C
C
C
C **************************************************
C ****** ADD 2 POSITIVE OR 2 NEGATIVE NUMBERS ******
C **************************************************
	CARRY=0
	DO 110 I=1,19
	TEMP=STACK1(I,PT1)+STACK2(I,PT2)+CARRY
	CARRY=TEMP/BASE
110	STACK1(I,PT1)=TEMP-CARRY*BASE
C
C
C
120	IF (CARRY.EQ.0) RETURN
C
C
C
C ***** ERROR ******  OVERFLOW
	RETCD=2
	CALL ERRMSG (22)
	RETURN
C
C
C
C
C
C ***************************************************************
C ***** SUBTRACTION REQUIRED BECAUSE THE SIGNS ARE OPPOSITE *****
C ***************************************************************
10000	SW=STACK1(20,PT1)
C
C SUBTRACT ACCORDING TO VALUE OF SW (A-B OR B-A)
	DO 10100 I=1,19
	IF (SW.EQ.1) GOTO 10010
	STACK1(I,PT1)=STACK1(I,PT1)-STACK2(I,PT2)
	GOTO 10100
10010	STACK1(I,PT1)=STACK2(I,PT2)-STACK1(I,PT1)
C
C
C DETERMINE IF SUM RESULTED IN ANY 'NEGATIVE DIGITS'
10100	CONTINUE
	DO 10200 I=1,19
	K=20-I
	IF (STACK1(K,PT1).NE.0) GOTO 10250
10200	CONTINUE
	STACK1(20,PT1)=0
	RETURN
C
C
C
C
C WHEN CORRESPONDING DIGITS WHERE ADDED (OR SUBTRACTED) THE RESULT
C WAS NEGATIVE. FIRST WE SET SW TO THE SIGN OF THE RESULT (THE SIGN
C OF THE MOST SIGNIFICANT DIGIT).
10250	SW=0
	IF (STACK1(K,PT1).LT.0) SW=1
	CARRY=0
	DO 10300 I=1,K
	IF (SW.EQ.0) GOTO 10280
C
C
C ********************************
C ****** RESULT IS NEGATIVE ******
C ********************************
C
C GO THROUGHT EACH DIGIT, MAKE EACH ONE POSITIVE SINCE
C STACK1(20,PT1) WILL INDICATE THAT THE NUMBER IS NEGATIVE.
	TEMP=STACK1(I,PT1)+CARRY
	IF (TEMP.LE.0) GOTO 10270
C
C IF DIGIT IS POSITIVE, "BORROW" FROM NEXT HIGHEST DIGIT.
	STACK1(I,PT1)=BASE-TEMP
C
C SET BORROW INDICATOR.
	CARRY=1
	GOTO 10300
C
C DIGIT IS NEGATIVE SO CHANGE SIGN, CLEAR "BORROW" INDICATOR.
10270	STACK1(I,PT1)=-TEMP
	CARRY=0
	GOTO 10300
C
C
C
C
C ********************************
C ****** RESULT IS POSITIVE ******
C ********************************
10280	TEMP=STACK1(I,PT1)-CARRY
	IF (TEMP.GE.0) GOTO 10290
C
C IF DIGIT IS NEGATIVE, "BORROW" FROM NEXT HIGHEST DIGIT.
	STACK1(I,PT1)=TEMP+BASE
C
C SET "BORROW" INDICATOR
	CARRY=1
	GOTO 10300
C
C
C DIGIT IS POSITIVE SO RETAIN VALUE AND CLEAR CARRY INDICATOR
10290	STACK1(I,PT1)=TEMP
	CARRY=0
10300	CONTINUE
C
C
C
C SET SIGN OF RESULT, GO TO 120 TO CHECK FOR OVERFLOW.
	STACK1(20,PT1)=SW
	GOTO 120
	END
