Prints the elements of a matrix.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
real(kind=real_4), | intent(in), | DIMENSION(:) | :: | matrix | ||
integer, | intent(in) | :: | rows |
the logical (possibly detransposed) matrix size, not the stored size the logical (possibly detransposed) matrix size, not the stored size |
||
integer, | intent(in) | :: | cols |
the logical (possibly detransposed) matrix size, not the stored size the logical (possibly detransposed) matrix size, not the stored size |
||
integer, | intent(in) | :: | iunit |
the logical (possibly detransposed) matrix size, not the stored size the logical (possibly detransposed) matrix size, not the stored size |
||
character, | intent(in), | optional | :: | title | ||
logical, | intent(in), | optional | :: | tr |
specifies whether the elements are stored transposed |
SUBROUTINE printmat_s(matrix, rows, cols, iunit, title, tr)
!! Prints the elements of a matrix.
REAL(KIND=real_4), DIMENSION(:), INTENT(IN) :: matrix
INTEGER, INTENT(IN) :: rows, cols, iunit
!! the logical (possibly detransposed) matrix size, not the stored size
!! the logical (possibly detransposed) matrix size, not the stored size
CHARACTER(*), INTENT(IN), OPTIONAL :: title
LOGICAL, INTENT(IN), OPTIONAL :: tr
!! specifies whether the elements are stored transposed
CHARACTER(30) :: f
INTEGER :: m, n, r
LOGICAL :: t
REAL(KIND=dp) :: bit_bucket
! ---------------------------------------------------------------------------
m = rows
n = cols
t = .FALSE.
IF (PRESENT(title)) WRITE (iunit, *) title
IF (PRESENT(tr)) THEN
IF (tr) THEN
t = .TRUE.
m = cols
n = rows
END IF
END IF
DO r = LBOUND(matrix, 1), UBOUND(matrix, 1)
bit_bucket = matrix(r)
END DO
bit_bucket = 0.0_dp
DO r = LBOUND(matrix, 1), UBOUND(matrix, 1)
bit_bucket = bit_bucket + matrix(r)
END DO
IF (m .GT. 10000) m = 0
IF (n .GT. 10000) n = 0
IF (m*n .LT. 1 .OR. m*n .GT. SIZE(matrix)) RETURN
WRITE (f, FMT="('(',I4,'(F9.4))')") cols
DO r = 1, rows
IF (.NOT. t) THEN
WRITE (iunit, FMT=f) matrix(r:r + (cols - 1)*rows:rows)
ELSE
WRITE (iunit, FMT=f) matrix((r - 1)*cols + 1:r*cols)
END IF
END DO
END SUBROUTINE printmat_s