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

(Source file text) 

---

C	MACHK3.FOR - SAMPLE PROGRAM (MATRIX OPERATIONS) USING:
C  MSUB		- SUBTRACTION OF MATRICES
C  MFUN		- TRANSFORM MATRIX BY A FUNCTION
C  SMPY		- MULTIPLY A MATRIX BY A SCALAR
C  RSUM		- SUM ROWS OF MATRIX
C  CSUM		- SUM COLUMNS OF MATRIX
C  RSRT		- SORT ROWS OF MATRIX
C  CCPY		- COPY COLUMN OF MATRIX INTO VECTOR
C    ALSO... MOST OF THESE ROUTINES CALL LOC - LOCATION CALCULATION
	EXTERNAL POSDIF
	DIMENSION SOLD(4,5),ECP(4,5),CUR(4,5),SCR(4,5)
	DIMENSION SS(4),SE(4),RK(4),TOT(1)
C	DATA STATEMENT REPLACES THE NORMAL READ IN
	DATA SOLD/10.,12.,8.,16.,6.,3.,2.,9.,9.,2.,0.,7.,24.,17.,22.,
	1         19.,13.,15.,15.,24./,
	2     ECP/5.,12.,10.,12.,4.,4.,4.,6.,10.,3.,3.,6.,25.,20.,20.,
	3         20.,12.,17.,15.,20./
C
C	OUTPUT CHANNEL = IOUT
	IOUT=2
	WRITE(IOUT,100)
100	FORMAT(//' STORE'10X' GOODS SOLD'9X' EXPECTED TO BE SOLD'/)
	DO 1 I=1,4
1	WRITE(IOUT,101) I,(SOLD(I,J),J=1,5),(ECP(I,J),J=1,5)
101	FORMAT(I4,7X,5F4.0,5X,5F4.0/)
C
C  SEE WHO IS AHEAD OF EXPECTATIONS
	CALL MSUB(SOLD,ECP,CUR,4,5,0,0)
	CALL MFUN(CUR,POSDIF,SCR,4,5,0)
	DO 2 I=1,4
	WRITE(IOUT,102) I
102	FORMAT(/' STORE',I2,':')
	DO 2 J=1,5
	X=SCR(I,J)
	IF(X) 3,2,4
3	STOP
4	WRITE(IOUT,103) X,J
103	FORMAT('   IS AHEAD',F4.0,' UNIT(S) OF PRODUCT',I2)
2	CONTINUE
C
C  SEE WHO IS BEHIND
	CALL SMPY(CUR,-1.,CUR,4,5,0)
	CALL MFUN(CUR,POSDIF,SCR,4,5,0)
	DO 5 I=1,4
	WRITE(IOUT,102) I
	DO 5 J=1,5
	X=SCR(I,J)
	IF(X) 6,5,7
6	STOP
7	WRITE(IOUT,104) X,J
104	FORMAT('   IS BEHIND',F4.0,' UNIT(S) OF PRODUCT',I2)
5	CONTINUE
C
C  GET STATISTICS
	CALL RSUM(SOLD,SS,4,5,0)
	CALL RSUM(ECP,SE,4,5,0)
	CALL CSUM(SS,TOT,4,1,0)
	WRITE(IOUT,105)
105	FORMAT(//' STORE   SOLD/EXP (PER CENT)   TOTAL SALES (ALL STORES)'/)
	DO 8 I=1,4
	X=SS(I)/SE(I)*100.
	XT=SS(I)/TOT(1)*100.
8	WRITE(IOUT,106) I,X,XT
106	FORMAT(I4,11X,F7.2,16X,F7.2)
	CALL SMPY(CUR,-1.,CUR,4,5,0)
C
C  DETERMINE PROGRESS IN SALES
	WRITE(IOUT,107)
107	FORMAT(//' PRODUCT   STORES ACCORDING TO INCREASING SALES'/)
	DO 9 I=1,5
	DO 10 J=1,4
10	RK(J)=FLOAT(J)
	CALL CCPY(SOLD,I,SS,4,5,0)
	CALL RSRT(RK,SS,SCR,4,1,0)
9	WRITE(IOUT,108) I,(SCR(J,1),J=1,4)
108	FORMAT(I5,6X,4F5.0)
	STOP
	END
	FUNCTION POSDIF(X)
	POSDIF=X
	IF(X) 1,2,2
1	POSDIF=0.
2	RETURN
	END

---