programs/libtest/src/matrix-test.f

   1 C
   2 C
   3 C
   4       COMMON /DDD/Z
   5
   6       REAL A,B,C,Z
   7       DIMENSION A(4),B(4),C(4)
   8       INTEGER J
   9       DIMENSION J(2)
  10
  11       A(1)=10.0
  12       A(2)=1.22
  13       A(3)=23.0
  14       A(4)=1.5
  15
  16       Z=1.0
  17
  18       CALL M$INIT(A)
  19       CALL M$INIT(B)
  20       CALL M$INIT(C)
  21
  22  10   FORMAT (9HMATRIX A:)
  23  11   FORMAT (9HMATRIX B:)
  24  12   FORMAT (9HMATRIX C:)
  25
  26 C      CALL M$ROT(A,3.141)
  27       WRITE (1,10)
  28       CALL PMAT (A)
  29       PAUSE 4
  30 C      A(1)=1.0
  31 C      A(2)=2.0
  32 C      A(3)=3.0
  33 C      A(4)=4.0
  34
  35       B(1)=1.7
  36       B(4)=1.7
  37 C      B(2)=6.0
  38 C      B(3)=7.0
  39 C      B(4)=-8.0
  40
  41       CALL M$MUL(C,A,B)
  42
  43       WRITE (1,10)
  44       CALL PMAT(A)
  45       WRITE (1,11)
  46       CALL PMAT(B)
  47       WRITE (1,12)
  48       CALL PMAT(C)
  49
  50       J(1)=4
  51       J(2)=10
  52
  53  13   FORMAT (8HPOINT J:)
  54       WRITE (1,13)
  55       CALL PPOINT(J)
  56
  57       CALL M$APLI(C,J)
  58
  59  14   FORMAT (30HPOINT J AFTER TRANSFORMATION:   )
  60       WRITE (1,14)
  61       CALL PPOINT(J)
  62
  63
  64  22   FORMAT (20HPROGRAMMENDE            )
  65
  66
  67       WRITE (1,22)
  68
  69       PAUSE 2
  70  99   GO TO 99
  71       END
  72
  73 CCCCCCCCCCCCCCCCCCCCCCC
  74
  75       SUBROUTINE PMAT (MATRIX)
  76
  77       DIMENSION MATRIX(4)
  78       REAL MATRIX
  79       REAL M1,M2,M3,M4
  80       M1=MATRIX(0)
  81       M2=MATRIX(1)
  82       M3=MATRIX(2)
  83       M4=MATRIX(3)
  84
  85       WRITE (1,343) MATRIX
  86       WRITE (1,344)
  87
  88  343  FORMAT(2H[ ,F17.9,2X,F17.9,2H ])
  89  344  FORMAT(X)
  90
  91       RETURN
  92       END
  93
  94 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  95
  96       SUBROUTINE PPOINT(POINT)
  97       DIMENSION POINT(2)
  98       INTEGER POINT
  99
 100       WRITE (1,200) POINT
 101  200  FORMAT(2H( ,I4,2H, I4,2H ))
 102       RETURN
 103       END
 104
 105
 106 CCCCCCCCCCCCCCCCCCC
 107 $0