home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l291 / 6.ddi / MTRX.FO$ / MTRX.bin
Encoding:
Text File  |  1991-01-08  |  2.8 KB  |  114 lines
  1.       PROGRAM MATRIX
  2. C
  3. C  This program calculates the product of two matrices. The product
  4. C  matrix has
  5. C
  6. C    - the same number of rows as the first matrix
  7. C    - the same number of columns as the second matrix
  8. C
  9. C  The number of rows in the second matrix must equal the number of
  10. C  columns in the first matrix. This is the number of products that are
  11. C  summed for each element in the product matrix.
  12. C
  13.  
  14.       REAL*8 a[ALLOCATABLE] (:,:), b[ALLOCATABLE] (:,:),
  15.      +       c[ALLOCATABLE] (:,:)
  16.       INTEGER*2 rows, cols, prods
  17. C
  18. C  Get dimensions of matrices
  19. C
  20.       WRITE (*, '(A)'  ) ' This program multiplies two matrices.'
  21.       WRITE (*, '(A \)')
  22.      +      ' Enter dimensions of first matrix (rows, columns): '
  23.       READ  (*, *) rows, prods
  24.  
  25.       WRITE (*, '(A, I2, A)') ' Second matrix has ', prods, ' rows.'
  26.       WRITE (*, '(A \)') ' Enter number of columns: '
  27.       READ (*, *) cols
  28. C
  29. C  Allocate matrices
  30. C
  31.       ALLOCATE (a(rows,  prods))
  32.       ALLOCATE (b(prods, cols ))
  33.       ALLOCATE (c(rows,  cols ))
  34. C
  35. C  Get matrix elements
  36. C
  37.       WRITE (*, *) 'Enter first  matrix'
  38.       CALL GetMatrix (rows, prods, a)
  39.  
  40.       WRITE (*, *) 'Enter second matrix'
  41.       CALL GetMatrix (prods, cols, b)
  42. C
  43. C  Multiply them
  44. C
  45.       CALL MultMatrices(rows, prods, cols, a, b, c )
  46. C
  47. C  Show results
  48. C
  49.       WRITE (*, *) 'First  matrix:'
  50.       CALL ShowMatrix (rows, prods, a)
  51.  
  52.       WRITE (*, *) 'Second matrix:'
  53.       CALL ShowMatrix (prods, cols, b)
  54.  
  55.       WRITE (*, *) 'Product matrix: '
  56.       CALL ShowMatrix (rows, cols,  c)
  57.       END
  58.  
  59. C
  60. C Begin subroutines
  61. C
  62.  
  63. C
  64. C Get a matrix from the user
  65. C
  66.       SUBROUTINE GetMatrix(rows, cols, mtrx [REFERENCE])
  67.       INTEGER*2 rows, cols, i, j
  68.       REAL*8 mtrx (rows, cols)
  69.  
  70.       DO 1000, i = 1, rows
  71.  
  72.           WRITE (*, '(A \, I2 \, A \, I2 \, A \)')
  73.      +          '       Row ', i, '   (', cols, ' values): '
  74.           READ (*, *) (mtrx(i,j), j = 1, cols)
  75.  1000 CONTINUE
  76.       RETURN
  77.       END
  78.  
  79. C
  80. C Display the matrix
  81. C
  82.       SUBROUTINE ShowMatrix (rows, cols, mtrx)
  83.       INTEGER*2 rows, cols, i, j
  84.       REAL*8 mtrx (rows,cols)
  85.  
  86.       DO 2000, i = 1, rows
  87.           WRITE (*, '(A\)') '    '
  88.           DO 2100, j = 1, cols
  89.               WRITE (*, '(A \, F6.1\)') '  ', mtrx (i, j)
  90.  2100     CONTINUE
  91.           WRITE (*, *) ' '
  92.  2000 CONTINUE
  93.       RETURN
  94.       END
  95. C
  96. C Multiply the matrices
  97. C
  98.  
  99.       SUBROUTINE MultMatrices( rows, prods, cols, a, b, c [REFERENCE])
  100.  
  101.       INTEGER*2 i, j, k, rows, prods, cols
  102.       REAL*8 a(rows, prods), b(prods, cols), c(rows, cols)
  103.  
  104.       DO 3000, j = 1, cols
  105.           DO 3100, i = 1, rows
  106.               c(i, j) = 0.0
  107.               DO 3200, k = 1, prods
  108.                   c(i, j) = c(i, j) + (a(i, k) * b(k, j))
  109.  3200         CONTINUE
  110.  3100     CONTINUE
  111.  3000 CONTINUE
  112.       RETURN
  113.       END
  114.