PROGRAM TESTM2
C
C	  PROGRAM TO TEST THE FOLLOWING ROUTINES ON MATLIB
C	  IDENTD, MADDD, MCLRD, MCOMD, MMOVD, MSCLD, MSUBD
C	  (ALL ARE DOUBLE PRECISON ROUTINES)
	REAL*8 A(4,5),B(4,5),C(4,5),P,Q
	REAL*8 X(3,3),D(3,3),E(3,3)
	DATA P,Q /5.,2./
	DO 10 J=1,5
	DO 5 I=1,4
	K=K+1
	A(I,J) = K
 5	B(I,J) = 2*K
 10	CONTINUE
	TYPE *,' DOUBLE PRECISION MATRIX ROUTINES'
	TYPE 20,((A(I,J),J=1,5),I=1,4),
     1          ((B(I,J),J=1,5),I=1,4),P,Q
20	FORMAT(' A',/,4(5F8.0/),/' B'/,4(5F8.0/),/' P='F8.0,' Q='F8.0)
C
	TYPE *,' PARTIAL MATRIX OPERATIONS'
C
	CALL MPADDD(C,A,B,3,4,4,4,4)
	TYPE *,' MPADDD'
	TYPE 901,((C(I,J),J=1,5),I=1,4)
	CALL MPCLRD(C,3,4,4)
	TYPE *,' MPCLRD'
	TYPE 901,((C(I,J),J=1,5),I=1,4)
	CALL MPCOMD(C,P,A,Q,B,3,4,4,4,4)
        TYPE *,' MPCOMD'
	TYPE 901,((C(I,J),J=1,5),I=1,4)
	CALL MPMOVD(C,A,3,4,4,4)
	TYPE *,' MPMOVD'
	TYPE 901,((C(I,J),J=1,5),I=1,4)
	CALL MPSCLD(C,P,A,3,4,4,4)
	TYPE *,' MPSCLD'
	TYPE 901,((C(I,J),J=1,5),I=1,4)
	CALL MPSUBD(C,A,B,3,4,4,4,4)
	TYPE *,' MSUBD'
	TYPE 901,((C(I,J),J=1,5),I=1,4)
C
	DO 26 J=1,5
	DO 25 I=1,4
 25	C(I,J) = 0.
 26	CONTINUE
C
	TYPE *,'FULL MATRIX OPERATIONS'
C
	CALL MADDD(C,A,B,4,5)
	TYPE *,' MADDD'
	TYPE 901,((C(I,J),J=1,5),I=1,4)
	CALL MCLRD(C,4,5)
	TYPE *,' MCLRD'
	TYPE 901,((C(I,J),J=1,5),I=1,4)
	CALL MCOMD(C,P,A,Q,B,4,5)
	TYPE *,' MCOMD'
	TYPE 901,((C(I,J),J=1,5),I=1,4)
	CALL MMOVD(C,A,4,5)
	TYPE *,' MMOVD'
	TYPE 901,((C(I,J),J=1,5),I=1,4)
	CALL MSCLD(C,P,A,4,5)
	TYPE *,' MSCLD'
	TYPE 901,((C(I,J),J=1,5),I=1,4)
	CALL MSUBD(C,A,B,4,5)
	TYPE *,' MSUBD'
	TYPE 901,((C(I,J),J=1,5),I=1,4)
C
	K=0
	DO 50 J=1,3
	DO 40 I=1,3
	K =K+1
	D(I,J) = K
 40	E(I,J) = 2*K
 50	CONTINUE
C
	TYPE *,' 3X3 MATRIX OPERATIONS'
	TYPE 60,((D(I,J),J=1,3),I=1,3),((E(I,J),J=1,3),I=1,3)
60	FORMAT(' D',/,3(3F8.0/),/,' E',/,3(3F8.0/))
	CALL M3ADDD(X,D,E)
	TYPE *,' M3ADDD'
	TYPE 902,((X(I,J),J=1,3),I=1,3)
	CALL M3CLRD(X)
	TYPE *,' M3CLRD'
	TYPE 902,((X(I,J),J=1,3),I=1,3)
	CALL M3COMD(X,P,D,Q,E)
	TYPE *,' M3COMD'
	TYPE 902,((X(I,J),J=1,3),I=1,3)
	CALL M3MOVD(X,D)
	TYPE *,' M3MOVD'
	TYPE 902,((X(I,J),J=1,3),I=1,3)
	CALL M3SCLD(X,P,D)
	TYPE *,' M3SCLD'
	TYPE 902,((X(I,J),J=1,3),I=1,3)
	CALL M3SUBD(X,D,E)
	TYPE *,' M3SUBD'
	TYPE 902,((X(I,J),J=1,3),I=1,3)
	CALL IDENTD(X,2,3)
	TYPE *,' IDENTD'
	TYPE 902,((X(I,J),J=1,3),I=1,3)
	CALL IDENTD(X,3,3)
	TYPE *,' IDENTD'
	TYPE 902,((X(I,J),J=1,3),I=1,3)
901	FORMAT(4(5F8.0/))
 902	FORMAT(3(3F8.0,/))
	STOP
	END