print_packed_matrix_int32 Subroutine

private subroutine print_packed_matrix_int32(packed, n_elements, format_type, err)

Print a packed lower triangular matrix of values

n_elements must be n*(n + 1)/2 for some n. If it is not, nothing is printed: err is set to ERROR_VALIDATION when it is present, and the complaint goes to stdout when it is not. Neither path aborts, which is how this routine has always behaved.

Arguments

Type IntentOptional Attributes Name
integer(kind=int32), intent(in) :: packed(:)
integer(kind=default_int), intent(in) :: n_elements
character(len=*), intent(in), optional :: format_type
type(error_t), intent(inout), optional :: err

set to ERROR_VALIDATION when n_elements is not a packed triangle size, or when format_type is not supported

Calls

proc~~print_packed_matrix_int32~~CallsGraph proc~print_packed_matrix_int32 print_packed_matrix_int32 interface~pic_optional pic_optional proc~print_packed_matrix_int32->interface~pic_optional interface~to_char to_char proc~print_packed_matrix_int32->interface~to_char proc~error_raise error_raise proc~print_packed_matrix_int32->proc~error_raise proc~set_brackets set_brackets proc~print_packed_matrix_int32->proc~set_brackets proc~optional_char optional_char interface~pic_optional->proc~optional_char proc~optional_dp optional_dp interface~pic_optional->proc~optional_dp proc~optional_int32 optional_int32 interface~pic_optional->proc~optional_int32 proc~optional_int64 optional_int64 interface~pic_optional->proc~optional_int64 proc~optional_logical optional_logical interface~pic_optional->proc~optional_logical proc~optional_sp optional_sp interface~pic_optional->proc~optional_sp proc~to_char_char to_char_char interface~to_char->proc~to_char_char proc~to_char_dp to_char_dp interface~to_char->proc~to_char_dp proc~to_char_int32 to_char_int32 interface~to_char->proc~to_char_int32 proc~to_char_int64 to_char_int64 interface~to_char->proc~to_char_int64 proc~to_char_logical to_char_logical interface~to_char->proc~to_char_logical proc~to_char_matrix_dp to_char_matrix_dp interface~to_char->proc~to_char_matrix_dp proc~to_char_matrix_int32 to_char_matrix_int32 interface~to_char->proc~to_char_matrix_int32 proc~to_char_matrix_int64 to_char_matrix_int64 interface~to_char->proc~to_char_matrix_int64 proc~to_char_matrix_sp to_char_matrix_sp interface~to_char->proc~to_char_matrix_sp proc~to_char_sp to_char_sp interface~to_char->proc~to_char_sp proc~to_char_vector_dp to_char_vector_dp interface~to_char->proc~to_char_vector_dp proc~to_char_vector_int32 to_char_vector_int32 interface~to_char->proc~to_char_vector_int32 proc~to_char_vector_int64 to_char_vector_int64 interface~to_char->proc~to_char_vector_int64 proc~to_char_vector_sp to_char_vector_sp interface~to_char->proc~to_char_vector_sp proc~error_set error_t%error_set proc~error_raise->proc~error_set proc~set_brackets->proc~error_raise to_upper to_upper proc~set_brackets->to_upper

Called by

proc~~print_packed_matrix_int32~~CalledByGraph proc~print_packed_matrix_int32 print_packed_matrix_int32 interface~pic_print_array pic_print_array interface~pic_print_array->proc~print_packed_matrix_int32 proc~print_3d_tensor_dp print_3d_tensor_dp interface~pic_print_array->proc~print_3d_tensor_dp proc~print_3d_tensor_int32 print_3d_tensor_int32 interface~pic_print_array->proc~print_3d_tensor_int32 proc~print_3d_tensor_int64 print_3d_tensor_int64 interface~pic_print_array->proc~print_3d_tensor_int64 proc~print_3d_tensor_sp print_3d_tensor_sp interface~pic_print_array->proc~print_3d_tensor_sp proc~print_3d_tensor_dp->interface~pic_print_array proc~print_3d_tensor_int32->interface~pic_print_array proc~print_3d_tensor_int64->interface~pic_print_array proc~print_3d_tensor_sp->interface~pic_print_array

Variables

Type Visibility Attributes Name Initial
character(len=1), private :: close_bracket
integer(kind=default_int), private :: i
integer(kind=default_int), private :: idx
integer(kind=default_int), private :: j
integer(kind=default_int), private :: n
real(kind=dp), private :: n_real
character(len=1), private :: open_bracket
character(len=20), private :: print_format

Source Code

   subroutine print_packed_matrix_int32(packed, n_elements, format_type, err)
   !! Print a packed lower triangular matrix of ${T} values
   !!
   !! n_elements must be n*(n + 1)/2 for some n. If it is not, nothing is
   !! printed: err is set to ERROR_VALIDATION when it is present, and the
   !! complaint goes to stdout when it is not. Neither path aborts, which is
   !! how this routine has always behaved.
      integer(int32), intent(in) :: packed(:)
      integer(default_int), intent(in) :: n_elements
      character(len=*), intent(in), optional :: format_type
      type(error_t), intent(inout), optional :: err
         !! set to ERROR_VALIDATION when n_elements is not a packed triangle
         !! size, or when format_type is not supported
      character(len=20) :: print_format
      character(len=1) :: open_bracket, close_bracket
      integer(default_int) :: i, j, idx, n
      real(dp) :: n_real

      ! Determine format
      print_format = pic_optional(format_type, default_format)
      call set_brackets(print_format, open_bracket, close_bracket, err)

      ! Compute n from packed size using proper real arithmetic
      n_real = (-1.0_dp + sqrt(1.0_dp + 8.0_dp*real(n_elements, dp)))/2.0_dp
      n = int(n_real + 0.5_dp, default_int)

      if (n*(n + 1)/2 /= n_elements) then
         if (present(err)) then
            call error_raise(err, ERROR_VALIDATION, "pic_print_array: n_elements does not form a valid packed triangle")
         else
            print *, "Error: n_elements does not form a valid packed triangle"
         end if
         return
      end if

      ! Print lower triangle directly from packed array
      print *, open_bracket
      idx = 0
      do i = 1, n
         write (*, "(A)", advance="no") open_bracket
         do j = 1, i
            idx = idx + 1
            if (j == i) then
               write (*, "(A)", advance="no") to_char(packed(idx))
            else
               write (*, "(A)", advance="no") trim(to_char(packed(idx))//", ")
            end if
         end do
         if (i == n) then
            print *, close_bracket
         else
            print *, close_bracket, ","
         end if
      end do
      print *, close_bracket
   end subroutine print_packed_matrix_int32