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(len=*), | 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