From ce1f6adb7e2647dc3b56fe7473a469b528afdbd7 Mon Sep 17 00:00:00 2001 From: hachti Date: Sun, 23 Dec 2007 16:32:13 +0000 Subject: [PATCH] *** empty log message *** --- programs/libtest/src/matrix-test.f | 107 +++++++++++++++++++++++++++++ 1 file changed, 107 insertions(+) create mode 100644 programs/libtest/src/matrix-test.f diff --git a/programs/libtest/src/matrix-test.f b/programs/libtest/src/matrix-test.f new file mode 100644 index 0000000..d7ad4a7 --- /dev/null +++ b/programs/libtest/src/matrix-test.f @@ -0,0 +1,107 @@ +C +C +C + COMMON /DDD/Z + + REAL A,B,C,Z + DIMENSION A(4),B(4),C(4) + INTEGER J + DIMENSION J(2) + + A(1)=10.0 + A(2)=1.22 + A(3)=23.0 + A(4)=1.5 + + Z=1.0 + + CALL M$INIT(A) + CALL M$INIT(B) + CALL M$INIT(C) + + 10 FORMAT (9HMATRIX A:) + 11 FORMAT (9HMATRIX B:) + 12 FORMAT (9HMATRIX C:) + +C CALL M$ROT(A,3.141) + WRITE (1,10) + CALL PMAT (A) + PAUSE 4 +C A(1)=1.0 +C A(2)=2.0 +C A(3)=3.0 +C A(4)=4.0 + + B(1)=1.7 + B(4)=1.7 +C B(2)=6.0 +C B(3)=7.0 +C B(4)=-8.0 + + CALL M$MUL(C,A,B) + + WRITE (1,10) + CALL PMAT(A) + WRITE (1,11) + CALL PMAT(B) + WRITE (1,12) + CALL PMAT(C) + + J(1)=4 + J(2)=10 + + 13 FORMAT (8HPOINT J:) + WRITE (1,13) + CALL PPOINT(J) + + CALL M$APLI(C,J) + + 14 FORMAT (30HPOINT J AFTER TRANSFORMATION: ) + WRITE (1,14) + CALL PPOINT(J) + + + 22 FORMAT (20HPROGRAMMENDE ) + + + WRITE (1,22) + + PAUSE 2 + 99 GO TO 99 + END + +CCCCCCCCCCCCCCCCCCCCCCC + + SUBROUTINE PMAT (MATRIX) + + DIMENSION MATRIX(4) + REAL MATRIX + REAL M1,M2,M3,M4 + M1=MATRIX(0) + M2=MATRIX(1) + M3=MATRIX(2) + M4=MATRIX(3) + + WRITE (1,343) MATRIX + WRITE (1,344) + + 343 FORMAT(2H[ ,F17.9,2X,F17.9,2H ]) + 344 FORMAT(X) + + RETURN + END + +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC + + SUBROUTINE PPOINT(POINT) + DIMENSION POINT(2) + INTEGER POINT + + WRITE (1,200) POINT + 200 FORMAT(2H( ,I4,2H, I4,2H )) + RETURN + END + + +CCCCCCCCCCCCCCCCCCC +$0 -- 2.32.0