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

(Source file text) 

---

C	MACHK4.FTN - SAMPLE PROGRAM (MATRIX OPERATIONS)
C  RCPY	- COPY ROW INTO VECTOR
C  MSTR	- CONVERT STORAGE MODE
C  MPRD	- MULTIPLY TWO MATRICES
C  SADD	- ADD SCALAR TO MATRIX
C  SSUB	- SUBTRACT SCALAR FROM MATRIX
C  SDIV	- DIVIDE MATRIX BY SCALAR
C  SCLA	- SET MATRIX ELEMENTS EQUAL TO A SCALAR
C  RADD	- ADD ROW TO ROW OF ANOTHER MATRIX
C  CADD	- ADD COL. TO COL. OF ANOTHER MATRIX
C  RTAB	- TABULATE ROWS OF A MATRIX
C  CTAB	- TABULATE COLS. OF A MATRIX
C  CSRT	- SORT COLUMNS
C  RECP	- RECIPROCAL FUNCTION FOR MFUN
C    ALSO	- MFUN, CCPY, LOC
C
	EXTERNAL RECP
	DIMENSION A(3,3),B(3,3),C(3,3),R(3),U(4),S(4),T(3)
	EQUIVALENCE (R,U), (S,T)
	DATA A/1.,1.,-1.,2.,0.,3.,3.,-1.,2./,R/1.,2.,3./
C  OUTPUT CHANNEL = IOUT
	IOUT=2
	WRITE(IOUT,100) ((A(I,J),J=1,3),I=1,3)
100	FORMAT(//' ORIGINAL MATRIX:'/(3F10.2))
C  SET B = ALL ONES
	CALL SCLA(B,1.0,3,3,0)
	CALL SADD(A,1.0,C,3,3,0)
	WRITE(IOUT,101) ((B(I,J),J=1,3),I=1,3)
101	FORMAT(//' MATRIX OF ONES BY SCLA:'/(3F10.2))
	WRITE(IOUT,102)  ((C(I,J),J=1,3),I=1,3)
102	FORMAT(//' SIMULATE ADDITION BY SADD:'/(3F10.2))
C  CONVERT DIAGONAL R TO GENERAL A
	CALL MSTR(R,A,3,2,0)
	WRITE(IOUT,103) R,((A(I,J),J=1,3),I=1,3)
103	FORMAT(//' EXPAND DIAGONAL TO GENERAL BY MSTR:'/3F10.2//(3F10.2))
C  MULTIPLY MATRICES
	CALL MPRD(A,C,B,3,3,0,0,3)
	WRITE(IOUT,104) ((B(I,J),J=1,3),I=1,3)
104	FORMAT(//' PRODUCT OF MATRICES USING MPRD:'/(3F10.2))
C  GET THE FIRST COLUMN
	CALL CADD(C,1,B,1,3,3,0,3)
	WRITE(IOUT,105) ((B(I,J),J=1,3),I=1,3)
105	FORMAT(//' ADDING (2,2,0) TO THE FIRST COL. BY CADD:'/(3F10.2))
C  GET A ROW
	CALL RCPY(B,1,R,3,3,0)
	WRITE(IOUT,106) R
106	FORMAT(//' FIRST ROW BY RCPY:'/3F10.2)
	CALL SDIV(B,2.,B,3,3,0)
	CALL SSUB(R,1.9,R,3,1,0)
	WRITE(IOUT,107)  ((B(I,J),J=1,3),R(I),I=1,3)
107	FORMAT(//' DIVIDING 3X3 MATRIX BY 2. AND      SUBTRACTING
	1 1.9 FROM ROW VECTOR:'/(3F10.2,10X,F10.2))
	CALL CTAB(B,R,A,S,3,3,0,3)
	WRITE(IOUT,108)  ((A(I,J),J=1,3),I=1,3),S
108	FORMAT(//' TABULATING THE COLUMNS BY CTAB:'/3(3F10.2/)/
	1'   NUMBER OF OLD COLUMNS USED IN NEW COLUMNS:'/4F10.2)
	CALL CSRT(A,T,B,3,3,0)
	WRITE(IOUT,109)  ((B(I,J),J=1,3),I=1,3)
109	FORMAT(//' COLUMNS ALIGNED BY NUMBER OF OLD COLS.'/
	1'   IN THEM VIA CSRT:'/(3F10.2))
	CALL RTAB(B,T,A,U,3,3,0,3)
	WRITE(IOUT,110)  ((A(I,J),J=1,3),I=1,3),U
110	FORMAT(//' TABULATING THE ROWS BY RTAB:'/3(3F10.2/)/
	1'   NUMBER OF OLD ROWS USED IN NEW ROWS:'/4F10.2)
	CALL SADD(A,1.5,B,3,3,0)
	CALL MFUN(B,RECP,A,3,3,0)
	WRITE(IOUT,111)  ((A(I,J),J=1,3),I=1,3)
111	FORMAT(//' ADDING 1.5 TO EACH ELEMENT AND TAKING THE RECIPROCAL:'
	1/(3F10.2))
	STOP
	END

---