fill_symmetric_matrix_sp Module Subroutine

module subroutine fill_symmetric_matrix_sp(matrix_, upper_lower_)

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

Arguments

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

Calls

proc~~fill_symmetric_matrix_sp~~CallsGraph proc~fill_symmetric_matrix_sp fill_symmetric_matrix_sp proc~integer_to_character integer_to_character proc~fill_symmetric_matrix_sp->proc~integer_to_character proc~to_lowercase to_lowercase proc~fill_symmetric_matrix_sp->proc~to_lowercase proc~write_error write_error proc~fill_symmetric_matrix_sp->proc~write_error proc~write_message write_message proc~fill_symmetric_matrix_sp->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_sp

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_sp(matrix_, upper_lower_)
         !! Fill the upper/lower triangle of a symmetric matrix
         !! (single precision).
         real(sp), 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_sp: 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_sp