fill_symmetric_matrix_int32 Module Subroutine

module subroutine fill_symmetric_matrix_int32(matrix_, upper_lower_)

Fill the upper/lower triangle of a symmetric matrix (integer).

Arguments

Type IntentOptional Attributes Name
integer, intent(inout) :: matrix_(:,:)
character(len=1), intent(in) :: upper_lower_

Calls

proc~~fill_symmetric_matrix_int32~~CallsGraph proc~fill_symmetric_matrix_int32 fill_symmetric_matrix_int32 proc~integer_to_character integer_to_character proc~fill_symmetric_matrix_int32->proc~integer_to_character proc~to_lowercase to_lowercase proc~fill_symmetric_matrix_int32->proc~to_lowercase proc~write_error write_error proc~fill_symmetric_matrix_int32->proc~write_error proc~write_message write_message proc~fill_symmetric_matrix_int32->proc~write_message proc~char_to_lowercase char_to_lowercase proc~to_lowercase->proc~char_to_lowercase proc~write_error->proc~write_message

Contents

Variables

Source Code

fill_symmetric_matrix_int32

Variables

Type Visibility Attributes Name Initial
integer, private :: i_
integer, private :: size_
integer, private :: size_1_
integer, private :: size_2_

Source Code

      module subroutine fill_symmetric_matrix_int32(matrix_, upper_lower_)
          !! Fill the upper/lower triangle of a symmetric matrix (integer).
          integer, intent(inout) :: matrix_(:,:)
          character(len = 1), intent(in) :: upper_lower_
          !--------------------------------------------------------------------!
          integer :: i_, size_1_, size_2_, size_
          !--------------------------------------------------------------------!
          size_1_ = size(matrix_, dim = 1)
          size_2_ = size(matrix_, dim = 2)
          if (size_1_ .eq. size_2_) then
             size_ = size_1_
          else
             call write_message("Error in fill_symmetric_matrix_int: size "    &
               // "in dim = 1 ("//trim(adjustl(integer_to_character(size_1_))) &
               // ") is different than in dim = 2 (" //                        &
               trim(adjustl(integer_to_character(size_2_))) // ")")
             call write_error("Adapt this subroutine to rectangle matrices")
          endif
          !--------------------------------------------------------------------!
          select case(to_lowercase(upper_lower_))
              case('l')
                  do i_ = 1, size_ - 1
                      matrix_(i_ + 1:size_, i_) = matrix_(i_, i_ + 1:size_)
                  enddo
              case('u')
                  do i_ = 1, size_ - 1
                      matrix_(i_, i_ + 1:size_) = matrix_(i_ + 1:size_, i_)
                  enddo
              case default
                  call write_message("Error: Invalid argument in " //          &
                     "fill_symmetric_matrix_int32 subroutine (upper_lower_):"  &
                     // upper_lower_)
                  call write_error("'u' or 'l' expected")
          end select
          !--------------------------------------------------------------------!
      end subroutine fill_symmetric_matrix_int32