File: MACHK2.FT of Tape: Various/ETH/eth11-1

(Source file text) 

---

C	MACHK2.FTN - SAMPLE PROGRAM (MATRICES) USING:
C  XCPY		- SUBMATRIX COPY
C  MCPY		- MATRIX COPY
C  TRPD		- TRANSPOSE PRODUCT
C  MATA		- TRANSPOSE PRODUCT
C  DCPY		- COPY DIAGONAL ELEMENTS
C  DCLA		- SET DIAGONAL ELEMENTS EQUAL TO A CONSTANT
C  CTIE		- ADJOIN MATRICES BY COLUMNS
C  RTIE		- ADJOIN MATRICES BY ROWS
C  CCUT		- PARTITION MATRICES BY COLUMNS
C  RCUT		- PARTITION MATRICES BY ROWS
C	MOST OF THE ROUTINES LISTED HERE CALL LOC - LOCATION CALCULATION
C
	DIMENSION A(4,4),R(3,3),B1(3,2),E(2,3),B2(3,2)
	DIMENSION BB(2,2),C(3),C2(2,2),R1(3)
	EQUIVALENCE (A,BB,R),(E,B1)
	DATA A/-1.,6.,7.,8.,-2.,0.,1.,2.,-3.,3.,4.,5.,-4.,-5.,-6.,-7./
	DATA R1/1.,2.,10./
C
C	OUTPUT CHANNEL = IOUT
	IOUT=2
C
	WRITE(IOUT,100) ((A(I,J),J=1,4),I=1,4)
100	FORMAT(//' ORIGINAL MATRIX'/(4F8.1))
	CALL XCPY(A,B1,2,2,3,2,4,4,0)
	WRITE(IOUT,101) ((B1(I,J),J=1,2),I=1,3)
101	FORMAT(//' 3X2 SUBMATRIX AT ELEMENT (2,3) USING XCPY'/(2F8.1))
	CALL MCPY(B1,B2,3,2,0)
	WRITE(IOUT,102) ((B2(I,J),J=1,2),I=1,3)
102	FORMAT(//' SAME MATRIX COPIED USING MCPY'/(2F8.1))
	CALL TPRD(B1,B2,BB,3,2,0,0,2)
	WRITE(IOUT,103) ((BB(I,J),J=1,2),I=1,2)
103	FORMAT(//' TRANSPOSE OF MATRIX TIMES MATRIX USING TPRD'/
	1 (2F8.1))
	CALL MATA(B1,C2,3,2,0)
	WRITE(IOUT,104) C2(1,1),C2(2,1),C2(2,1),C2(1,2)
104	FORMAT(//' SAME PRODUCT USING MATA'/(2F8.1))
	CALL DCPY(C2,C,2,1)
	WRITE(IOUT,105) C(1),C(2)
105	FORMAT(//' DIAGONAL ELEMENTS USING DCPY'/(F8.1))
	CALL DCLA(BB,2.,2,0)
	WRITE(IOUT,106) ((BB(I,J),J=1,2),I=1,2)
106	FORMAT(//' REPLACING DIAGONAL BY 2.0 USING DCLA'/(2F8.1))
	CALL CTIE(BB,C,E,2,2,0,0,1)
	WRITE(IOUT,107) ((E(I,J),J=1,3),I=1,2)
107	FORMAT(//' ADJOINING THESE TWO MATRICES USING CTIE'/(3F8.1))
	WRITE(IOUT,108) R1
108	FORMAT(//' TAKE THIS ROW VECTOR'/(3F8.1))
	CALL RTIE(E,R1,R,2,3,0,0,1)
	WRITE(IOUT,109)  ((R(I,J),J=1,3),I=1,3)
109	FORMAT(//' ADJOINING THESE TWO MATRICES USING RTIE'/(3F8.1))
	CALL CCUT(R,3,B1,C,3,3,0)
	WRITE(IOUT,110) ((B1(I,J),J=1,2),C(I),I=1,3)
110	FORMAT(//' PARTITIONING BETWEEN COLS. 2 AND 3 USING CCUT'/
	1 (2F8.1,12X,F8.1))
	CALL RCUT(B1,2,R1,C2,3,2,0)
	WRITE(IOUT,111) (R1(I),I=1,2),((C2(I,J),J=1,2),I=1,2)
111	FORMAT(//' PARTITIONING BETWEEN ROWS 1 AND 2 USING RCUT'/
	1 2F8.1//(2F8.1))
	STOP
	END

---