.TITLE  MABT  MATRIX TRANSPOSE MULTIPLY
	.IDENT  /1.0/					;  08/15/79
;+							     ++EXTSPC>>
;.NAME MABT
;.INDEX M3ABT
;.INDEX MPABT
;.INDEX MABTD
;.INDEX M3ABTD
;.INDEX MPABTD
;.TITLE  SUBROUTINE MABT 
;
;	 CALL MABT   (C,A,B,L,M,N)
;
;	 CALL M3ABT  (C,A,B,N)
;
;	 CALL MPABT  (C,A,B,L,M,N,NRA,NRB,NRC)
;
;	 CALL MABTD  (C,A,B,L,M,N)
;
;	 CALL M3ABTD (C,A,B,N)
;
;	 CALL MPABTD (C,A,B,L,M,N,NRA,NRB,NRC)
;
; VERSION:  VECTOR / MATRIX ROUTINES     SAM MILLER     REL 1.0  
;
; FUNCTION:
;
;	MATRIX TRANSPOSE MULTIPLY - TRANSPOSE RIGHT HAND MATRIX
;
;	C(L,N) = A(L,M) B(N,M)[TRANSPOSE]
;
;
; LANGUAGE:  MACRO-11
;
;
; ARGUMENTS:
;
;       C   = OUTPUT MATRIX (RESULT IS STORED IN UPPER L X N SUBMATRIX)
;       A,B = INPUT  MATRICES  (C = A B[TRANSPOSE])
;       L,M,N = SUBMATRIX MULTIPLY SIZE 
;                 C   =   A     B[T]
;               (LXN) = (LXM) (NXM)
;       NRA = NUMBER OF ROWS IN A
;       NRB = NUMBER OF ROWS IN B
;       NRC = NUMBER OF ROWS IN C
;
;
; COMMONS:
;
;	(NONE)
;
;
; GENERAL DESCRIPTION:
;
;  REAL ARGUMENTS: C,A,B
;  INTEGER ARGUMENTS: L,M,N,NRA,NRB,NRC
;
;
;	THERE ARE 3 CALLING SEQUENCES:
;
;            1.  PARTIAL MATRIX MULTIPLY
;
;                CALL MPABT(C,A,B,L,M,N,NRA,NRB,NRC)
;
;                C(L,N) = A(L,M) B(N,M)T
;
;                WHERE A, B, C ARE MATRICES
;                THE L X M UPPER SUBMATRIX OF A IS MULTIPLIED BY THE 
;                UPPER N X M SUBMATRIX OF B (TRANSPOSE) AND STORED IN
;                THE UPPER L X N SUBMATRIX OF C
;
; 
;            2.  FULL MATRIX MULTIPLY
;
;                CALL MABT(C,A,B,L,M,N)
;
;                C(L,N) = A(L,M) B(N,M)T
;
; 
;            3.  3X3 MATRIX MULTIPLY
;
;                CALL M3ABT(C,A,B,N)
;
;                C(3,N) = A(3,3) B(N,3)T
; 
;
;	NOTE -- SINGLE PRECISION ROUTINE MAINTAINS ACCURACY BY
;	ACCUMULATING INTERMEDIATE QUANTITIES AS DOUBLE PRECISION
;
;
; PERIPHERAL INPUT/OUTPUT:
;
;	(NONE)
;
;
; LOGICAL UNIT USAGE:
;
;	(NONE)
;
;
; EXTERNAL ROUTINES CALLED:
;
;	NAM$
;	$BOMB
;
;-							     --EXTSPC>>
;
; WRITTEN BY:
;
;       DENIS MAHONY AND SAM MILLER     06/01/79
;
;
; MODIFIED BY:
;
;	**********	**DATE**
;		**DETAIL**
;
;-							--EXTSPC>>
	.PAGE
	.GLOBL  MABT,M3ABT,MPABT
	.ENABL  LSB
;
F0=R0				;DEFINE FLOATING REGISTER 0
F1=R1				;DEFINE FLOATING REGISTER 1
F2=R2				;DEFINE FLOATING REGISTER 2
M3ABT:	CMPB	#4,(R5)		;ARE THERE 4 ARGUMENTS?
	BNE	BOMB3		;BOMB IF # OF ARGS. NE 4
	ADD	#8.,R5		;R5=>END OF ARG LIST
	MOV	#12.,R0		;R0=4*NRA=12.
	MOV	#3,R3		;R3=L=3 (TEMPORARY)
	MOV	R3,R2		;R2=M=3
	MOV	@(R5),R1	;R1=N
	MOV	R1,-(SP)	;PLACE N ON STACK
	BR	20$
MPABT:	CMPB	#9.,(R5)	;ARE THERE 9 ARGUMENTS?
	BNE	BOMBP		;BOMB IF # OF ARGS. NE 9
	ADD	#18.,R5		;R5=>END OF ARG LIST
	MOV	@(R5),R4	;NRC
	MOV 	@-(R5),R1	;NRB
	MOV	@-(R5),R0	;NRA
	ASH	#2,R0		;R0=4*NRA
	MOV	@-(R5),-(SP)	;PLACE N ON STACK
	MOV	@-(R5),R2	;R2=M
	MOV	@-(R5),R3	;R3=L (TEMPORARY)
	MOV	R3,-(SP)	;PLACE L ON STACK
	SUB	R3,R4		;NRC-L
	ASH	#2,R4		;4*(NRC-L)
	MOV 	R4,-(SP)	;PLACE 4*(NRC-L) ON STACK
	BR	30$
MABT:	CMPB	#6,(R5)		;ARE THERE 6 ARGUMENTS?
	BNE	BOMB		;BOMB IF # OF ARGS. NE 6
	ADD	#12.,R5		;R5=>END OF ARG LIST
	MOV	@(R5),R1	;R1=N=NRB
	MOV	R1,-(SP)	;PLACE N ON STACK
	MOV	@-(R5),R2	;R2=M
	MOV	@-(R5),R3	;R3=L (TEMPORARY)
	MOV	R3,R0		;R0=NRA=L
	ASH	#2,R0		;R0=4*NRA
20$:	MOV	R3,-(SP)	;PLACE L ON STACK
	MOV	#0,-(SP)	;PLACE 4*(NRC-L) ON STACK
30$:	ASH	#2,R1		;R1=4*NRB
	MOV	-(R5),R3	;R3=>B
	MOV	-(R5),R4	;R4=>A
	MOV	-(R5),R5	;R5=>C
	MOV	R4,-(SP)	;PLACE >A ON STACK
	MOV	R3,-(SP)	;PLACE >B ON STACK
	MOV	R4,-(SP)	;PLACE NEXT >A ON STACK
	ADD	#4.,(SP)	;NEXT >A
	MOV	10(SP),-(SP)	;PLACE L ON STACK
	MOV	R2,-(SP)	;PLACE M ON STACK
	SETD			;SET FLOATING DOUBLE MODE
	CLRD	F2		;F2=0
	BR	50$
40$:	MOV	4(SP),R4	;SET A TO NEXT ROW
45$:	MOV	6(SP),R3	;RESTORE B
	ADD	#4.,4(SP)	;SET NEXT A ON STACK
	MOV	(SP),R2		;RESET M
;MULTIPLICATION LOOP
50$:	LDCFD	(R4),F0		;F0=A
	LDCFD	(R3),F1		;F1=B
	MULD	F0,F1		;A*B
	ADDD	F1,F2		;F2=SUM
	ADD	R0,R4		;NEXT ELEMENT OF A
	ADD	R1,R3		;NEXT ELEMENT OF B
	SOB	R2,50$		;DONE FORMING ELEMENT OF C?
	STCDF	F2,(R5)+	;STORE IN C
	CLRD	F2		;F2=0
	DEC	14(SP)		;GO TO NEXT COLUMN OF C?
	BNE	40$		;NO
	DEC	16(SP)		;DONE?
	BEQ	60$		;YES
	MOV	10(SP),R4	;RESTORE A
	MOV	R4,4(SP)	;NEXT A ON STACK
	ADD	#4.,6(SP)	;NEXT ROW OF B
	ADD	12(SP),R5	;NEXT COLUMN OF C
	MOV	2(SP),14(SP)	;RESET L
	BR	45$
60$:	ADD	#20,SP		;RESTORE STACK
	RTS	PC		;RETURN
BOMBP:	MOV	#7640,-(SP)	;MOVE 2ND HALF OF NAME TO STACK
	MOV	#51701,R4	;MOVE 1ST HALF OF NAME TO R4
	BR	70$
BOMB3:	MOV	#7640,-(SP)	;MOVE 2ND HALF OF NAME TO STACK
	MOV	#53151,R4	;MOVE 1ST HALF OF NAME TO R4
	BR	70$
BOMB:	MOV	#76400,-(SP)	;MOVE 2ND HALF OF NAME TO STACK
	MOV	#50552,R4	;MOVE 1ST HALF OF NAME TO R4
70$:	JSR	R4,NAM$		;SUBR TO PUT NAME IN WALKBACK
	JMP	$BOMB		;ABORT, $BOMB DOES NOT EXIST
	.END