.TITLE  MTRND  TRANSPOSE A MATRIX (DOUBLE PRECISION)
	.IDENT  /1.0/					;  08/15/79
	.GLOBL  MTRND, M3TRND, MPTRND
	.ENABL	LSB
F0=R0				;DEFINE FLOATING REGISTER 0
;
M3TRND:	CMP	#2,(R5)+	;CHECK FOR 2 ARGUMENTS
	BNE	BOMB3		;BOMB IF # OF ARGS. NE 2
	MOV	#3,R0		;R0=M=3
	MOV 	#3,R1		;R1=N=3
	MOV	#3,-(SP)	;MOVE M ON STACK
	BR	20$
MTRND:	CMP	#4,(R5)+	;CHECK FOR 4 ARGUMENTS
	BNE	BOMB		;BOMB IF # OF ARGS. NE 4
	MOV	@4(R5),R0	;R0=M
	MOV	@6(R5),R1	;R1=N
	MOV 	R0,-(SP)	;MOVE M ON STACK
20$:	MOV	#0,-(SP)	;MOVE NRA-M=0 ON STACK
	MOV	R1,R2		;GET NRC=N
	ASH	#3,R2		;R2=8*NRC
	BR	40$
MPTRND:	CMP	#6,(R5)+	;CHECK NUMBER OF ARGUMENTS
	BNE	BOMBP		;BOMB IF # OF ARGS. NE 6
	MOV	@4(R5),R0	;R0=M
	MOV	@6(R5),R1	;R1=N
	MOV 	R0,-(SP)	;MOVE M ON STACK
	MOV	@10(R5),R2	;GET NRA
	SUB	R0,R2		;NRA-M
	ASH	#3,R2		;8*(NRA-M) - 8 BYTES FOR DOUBLE 
	MOV	R2,-(SP)	;MOVE 8*(NRA-M) ON STACK
	MOV	@12(R5),R2	;GET NRC
	ASH	#3,R2		;R2=8*NRC
40$:	MOV	(R5)+,R3	;R3=ADDRESS OF C
	MOV	(R5),R4		;R4=ADDRESS OF A
	MOV	R3,R5		;R5=ADDRESS OF C
	SETD			;SET FLOATING DOUBLE MODE
	BR	60$
;LOOP TO TRANSPOSE MATRIX
50$:	ADD	#8.,R5		;GO TO START OF NEXT ROW OF C
	MOV	R5,R3		;AND RESET ADDRESS OF C
	ADD	(SP),R4		;GO TO START OF NEXT COLUMN OF A
	MOV	2(SP),R0	;RESET M
60$:	LDD	(R4)+,F0	;F0=TRANSPOSED ELEMENT
	STD	F0,(R3)		;STORE TRANSPOSED ELEMENT
	ADD	R2,R3		;GO TO NEXT COLUMN OF C
	SOB	R0,60$		;DONE WITH THIS COLUMN?
	SOB	R1,50$		;DONE WITH ALL COLUMNS?
	ADD	#4,SP		;RESTORE STACK
	RTS	PC		;RETURN
BOMBP:	MOV	#71264,-(SP)	;  MOVE 2ND HALF OF NAME TO STACK
	MOV	#51724,R4	;  MOVE 1ST HALF OF NAME TO R4
	BR	70$
BOMB3:	MOV	#71264,-(SP)	;  MOVE 2ND HALF OF NAME TO STACK
	MOV	#53174,R4	;  MOVE 1ST HALF OF NAME TO R4
	BR	70$
BOMB:	MOV	#54040,-(SP)	;  MOVE 2ND HALF OF NAME TO STACK
	MOV	#52162,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