printmat_s Subroutine

private subroutine printmat_s(matrix, rows, cols, iunit, title, tr)

Prints the elements of a matrix.

Arguments

Type IntentOptional 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


Source Code

   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