PROGRAM matrices2
!
! Author:  Br. David Carlson
!
! Date:  April 3, 2010
!
! This program prompts the user for the values to use in 3 by 3 matrix A
! and hard codes the values for a second 3 by 3 matrix C.  It then prints
! A * C.  Next, it prints the matrix product A * b, where b is a hard-coded
! column matrix.  Note that the matrix shortcut A * C in Fortran does NOT
! perform matrix multiplication; rather, it does componentwise multiply.
! Do not use * if you want a matrix product!

IMPLICIT NONE

INTEGER, PARAMETER::n = 3
INTEGER k
REAL, DIMENSION(n, n)::A, Answer
REAL, DIMENSION(n, n):: C = RESHAPE( (/1.0, 2.0, 3.0, -1.0, 0.0, 0.5, 1.5, -2.5, 4.0/), (/3, 3/) )
REAL, DIMENSION(n)::b, x

CALL ReadMatrix(n, A)

! A really simple way to initialize b.  Could be written as b = (/7.0, 4.0, 6.5/)
b(1) = 7.0
b(2) = 4.0
b(3) = 6.5

WRITE (*, *) 'Matrix A contains:'
CALL WriteMatrix(n, A)

WRITE (*, *) 'Matrix C contains:'
CALL WriteMatrix(n, C)

CALL MatrixProduct(n, A, C, Answer)
WRITE (*, *) 'Product of A and C, computed with MatrixProduct, is:'
CALL WriteMatrix(n, Answer)

WRITE (*, *) 'Column vector b contains'
CALL WriteVector(n, b)
CALL MatrixTimesColumn(n, A, b, x)

WRITE (*, *) 'The product Ab, computed with MatrixTimesColumn, yields the column matrix'
CALL WriteVector(n, x)

END PROGRAM


! Given:  n    Number of entries in column vector col.
!         b    Column vector with n entries.
! Task:   To print the column vector b.
! Return: Nothing
SUBROUTINE WriteVector(n, b)

IMPLICIT NONE

INTEGER, INTENT(IN)::n
REAL, DIMENSION(n), INTENT(IN)::b

INTEGER::k

DO k = 1, n
   WRITE (*, *) b(k)
END DO

END SUBROUTINE


! Given:  n    Number of rows (and columns) in matrix A.
!         A    n by n matrix with real coefficients
!         b    Column vector with n real coefficients
! Task:   To find the product A * b.
! Return: x    The product A * b.
SUBROUTINE MatrixTimesColumn(n, A, b, x)

IMPLICIT NONE

INTEGER, INTENT(IN)::n
REAL, DIMENSION(n, n), INTENT(IN)::A
REAL, DIMENSION(n), INTENT(IN)::b
REAL, DIMENSION(n), INTENT(OUT)::x

INTEGER::row, col
REAL::DotProduct

DO row = 1, n
   DotProduct = 0.0
   DO col = 1, n
      DotProduct = DotProduct + A(row, col) * b(col)
   END DO
   x(row) = DotProduct
END DO

END SUBROUTINE


! Given:  n    Number of rows (and columns) in matrix A.
!         A    n by n matrix of reals
! Task:   To prompt the user to input the values to place in matrix A.
! Return: A    The matrix A holding these values just entered.
SUBROUTINE ReadMatrix(n, A)

IMPLICIT NONE

INTEGER, INTENT(IN)::n
REAL, DIMENSION(n, n), INTENT(INOUT)::A

INTEGER::row, col

DO row = 1, n
   DO col = 1, n
      WRITE (*, *) 'Enter the value for matrix A, row ', row, ' column ', col
      READ (*, *) A(row, col)   ! Always put row index first, then column index.
   END DO
END DO

END SUBROUTINE


! Given:  n    Number of rows (and columns) in matrix M.
!         M    n by n matrix of reals
! Task:   To print the values of M in typical grid fashion.
! Return: Nothing
SUBROUTINE WriteMatrix(n, M)

IMPLICIT NONE

INTEGER, INTENT(IN)::n
REAL, DIMENSION(n, n), INTENT(IN)::M

INTEGER::row, col

DO row = 1, n
   WRITE (*, *) (M(row, col), col = 1, n)
   ! Implied DO loop prints items on the same line.
   ! Whereas each new WRITE prints on a new line.
END DO

END SUBROUTINE


! Given:  n    Number of rows (and columns) in matrices A and C
!         A    n by n matrix with real coefficients
!         C    n by n matrix with real coefficients
! Task:   To find the product A * C
! Return: Answer    The product A * C.
SUBROUTINE MatrixProduct(n, A, C, Answer)

IMPLICIT NONE

INTEGER, INTENT(IN)::n
REAL, DIMENSION(n, n), INTENT(IN)::A, C
REAL, DIMENSION(n, n), INTENT(OUT)::Answer

INTEGER::row, col, k
REAL::DotProduct

DO row = 1, n
   DO col = 1, n
      DotProduct = 0.0
      DO k = 1, n
         DotProduct = DotProduct + A(row, k) * C(k, col)
      END DO
      Answer(row, col) = DotProduct
   END DO
END DO

END SUBROUTINE