home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l292 / 1.ddi / MATMATHD.FOR < prev    next >
Encoding:
Text File  |  1989-10-10  |  3.0 KB  |  117 lines
  1.       PROGRAM CalcStats
  2.  
  3.       INCLUDE 'STDHDR.FOR'
  4.       REAL mat1(0: maxr, 0: maxc),mat2(0: maxr, 0: maxc)
  5.       REAL mat3(0: maxr, 0: maxc)
  6.       REAL eigenvalues(0: maxc)
  7.       REAL a(0:maxr,0:maxc), ev(0:maxr, 0:maxc)
  8.       CHARACTER message * 80
  9.       INTEGER n,count
  10.       LOGICAL success
  11.  
  12.       ! matmath demo main
  13.  
  14.       mat1(0, 0) = 13.0
  15.       mat1(0, 1) = -8.0
  16.       mat1(0, 2) = -3.0
  17.       mat1(1, 0) = -8.0
  18.       mat1(1, 1) = 10.0
  19.       mat1(1, 2) = -1.0
  20.       mat1(2, 0) = -3.0
  21.       mat1(2, 1) = -1.0
  22.       mat1(2, 2) = 11.0
  23.  
  24.       mat2(0, 0) = 1.0
  25.       mat2(0, 1) = 5.0
  26.       mat2(0, 2) = 1.0
  27.       mat2(1, 0) = 3.0
  28.       mat2(1, 1) = 6.0
  29.       mat2(1, 2) = 3.0
  30.       mat2(2, 0) = 0.0
  31.       mat2(2, 1) = 1.0
  32.       mat2(2, 2) = -9.0
  33.  
  34.       CALL MatProd(mat1, mat2, 3, 3, 3, mat3)
  35.       message = 'Matrix product mat1 x mat2 = '
  36.       CALL MatPrint(mat3, 3, 3, message)
  37.       WRITE (*,*) 'Press carriage return to advance to next procedure'
  38.       READ (*,*)
  39.  
  40.       vm = 11
  41.       CALL MatScalarProd(mat1, vm, 3, 3, mat3)
  42.       message = 'Matrix scalar product mat1 x 11.000  = '
  43.       CALL MatPrint(mat3, 3, 3, message)
  44.       WRITE(*,*) 'Press carriage return to advance to next procedure'
  45.       READ (*,*)
  46.  
  47.  
  48.       CALL MatAdd(mat1, mat2, 3, 3, mat3)
  49.       message = 'Matrix add mat1 + mat 2 = '
  50.       CALL MatPrint(mat3, 3, 3, message)
  51.       WRITE(*,*) 'Press carriage return to advance to next procedure'
  52.       READ (*,*)
  53.  
  54.  
  55.       CALL MatTranspose(mat1, 3, 3, mat3)
  56.       message = 'Matrix transpose of mat1  = '
  57.       CALL MatPrint(mat3, 3, 3, message)
  58.       WRITE(*,*) 'Press carriage return to advance to next procedure'
  59.       READ (*,*)
  60.  
  61.  
  62.       CALL MatDeter(mat1, 3, det)
  63.       WRITE (*,5) 'Determinant of matrix mat1 = ', det
  64. 5     FORMAT (A28, F7.2)
  65.       WRITE(*,*)
  66.       WRITE(*,*) 'Press carriage return to advance to next procedure'
  67.       READ (*,*)
  68.  
  69.       CALL MatInvert(mat1, 3, det, mat3)
  70.       message = 'Inverse of matrix mat1  = '
  71.       CALL MatPrint(mat3, 3, 3, message)
  72.       WRITE(*,*)'Press carriage return to begin Jacobi Demo '
  73.       READ (*,*)
  74.  
  75.       n = 4
  76.  
  77.        a(0, 0) = 5.0
  78.        a(0, 1) = 4.0
  79.        a(0, 2) = 1.0
  80.        a(0, 3) = 1.0
  81.        a(1, 0) = 4.0
  82.        a(1, 1) = 5.0
  83.        a(1, 2) = 1.0
  84.        a(1, 3) = 1.0
  85.        a(2, 0) = 1.0
  86.        a(2, 1) = 1.0
  87.        a(2, 2) = 4.0
  88.        a(2, 3) = 2.0
  89.        a(3, 0) = 1.0
  90.        a(3, 1) = 1.0
  91.        a(3, 2) = 2.0
  92.        a(3, 3) = 4.0
  93.  
  94.  
  95.       count = 10
  96.       CALL CyclicJacobi(a, n, eigenvalues, ev, count, success)
  97.       CALL NormalizeEigenVectors(ev, n)
  98.       WRITE (*,*) 'Success ', success
  99.       DO i = 0, n - 1
  100.         WRITE(*,7) 'Eigenvalue ', i, ' =  ', eigenvalues(i)
  101.         WRITE(*,8) 'Eigenvector ', i, ' = '
  102.         DO j = 0, n - 1
  103.           WRITE(* ,10)  ev(j, i)
  104.         END DO
  105.         WRITE (*,*)
  106.       END DO
  107.  
  108.       WRITE(*,*) 'count ', count
  109.       READ (*,*)
  110. 7     FORMAT (A12, I2, A3, F7.2)
  111. 8     FORMAT (1X, A12, I2, A3 \)
  112. 10    FORMAT (F11.6\)
  113.  
  114.  
  115.  
  116.       END
  117.