G.2.15 Set_Values_ELL_Matrix Procedure

The main documentation of the Set_Values_ELL_Matrix Procedure contains additional explanation of this code listing.

  subroutine Set_Values_ELL_Matrix_0 (ELLM, Value, Row, Column, Global)

    ! Note: this routine is very similar to Add_Values_ELL_Matrix_0.

    ! Input variables.
  
    type(real), intent(in) :: Value               ! Value scalar.
    type(integer), intent(in) :: Row              ! Row integer scalar.
    type(integer), intent(in) :: Column           ! Column integer scalar.
    type(logical), intent(in), optional :: Global ! Global/local index toggle.

    ! Input/Output variable.
    
    type(ELL_Matrix_type), intent(inout) :: ELLM  ! Variable to be set.

    ! Internal variables.

    type(logical) :: A_Global        ! Actual global/local toggle.
    type(integer) :: Column_Location ! Location in Columns array for the entry.
    type(integer) :: location        ! Loop index.
    type(integer) :: shift           ! Index shift.

    !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  
    ! Verify requirements.
  
    VERIFY(Valid_State(ELLM),5)                       ! ELLM is valid.
    VERIFY(Valid_State(Value),5)                      ! Value is valid.
    VERIFY(Valid_State(Row),5)                        ! Row is valid.
    VERIFY(Valid_State(Column),5)                     ! Column is valid.

    ! Global/Local toggle.

    if (PRESENT(Global)) then
      A_Global = Global
    else
      A_Global = .true.
    end if
    if (A_Global) then
      shift = -First_PE(ELLM%Row_Structure) + 1
    else
      shift = 0
    end if

    ! Another requirement check -- require that Row be in the correct range.

    VERIFY(Row + shift .InInterval. (/1, Length_PE(ELLM%Row_Structure)/),5)

    ! Set the value.

    if (Row /= 0) then

      ! Find a column location to store the entry.

      Column_Location = 0
      do location = 1, ELLM%Max_Nonzeros
        if (ELLM%Columns(Row + shift, location) == 0 .or. &
            ELLM%Columns(Row + shift, location) == Column) then
          Column_Location = location
          exit
        end if
      end do

      ! Store the entry.

      ELLM%Values(Row + shift, Column_Location) = Value
      ELLM%Columns(Row + shift, Column_Location) = Column

    else

      ! Make sure Column_Location has a non-zero value if Row=0,
      ! so the check below executes correctly.
      Column_Location = -1

    end if

    ! Make sure Max_Nonzeros is not exceeded (that is, that we
    ! found a spot to put the entry).

    VERIFY(Column_Location /= 0,1)

    ! Unset the updated? variables.

    call Set_Not_Up_to_Date (ELLM)

    ! Verify guarantees.

    VERIFY(Valid_State(ELLM),5)                    ! ELLM is still valid.

    return
  end subroutine Set_Values_ELL_Matrix_0

  subroutine Set_Values_ELL_Matrix_1 (ELLM, Values, Rows, Columns, Global)

    ! Note: this routine is very similar to Add_Values_ELL_Matrix_1.

    ! Input variables.
  
    type(real,1,np), intent(in) :: Values          ! Values bare naked array.
    type(integer,1,np), intent(in) :: Rows         ! Rows integer vector.
    type(integer,1,np), intent(in) :: Columns      ! Columns integer vector.
    type(logical), intent(in), optional :: Global  ! Global/local index toggle.

    ! Input/Output variable.
    
    type(ELL_Matrix_type), intent(inout) :: ELLM ! Variable to be set.

    ! Internal variables.

    type(logical) :: A_Global                   ! Actual global/local toggle.
    type(integer) :: Column_Location            ! Location in Columns array 
                                                !   for the entry.
    type(integer) :: i                          ! Loop parameter.
    type(integer) :: location                   ! Loop index.
    type(logical) :: Max_Nonzeros_Not_Exceeded  ! Toggle for error check.
    type(integer) :: shift                      ! Index shift.
    define([rows_are_set_twice_check], [9])
    ifelse(ARCHITECTURE, Sun, [], [
      ifelse(m4_eval(DEBUG_LEVEL >= rows_are_set_twice_check), 1, [
        type(integer) :: j                      ! Verify loop parameter.
      ])
    ])

    !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  
    ! Verify requirements.
  
    VERIFY(Valid_State(ELLM),5)                         ! ELLM is valid.
    VERIFY(Valid_State_NP(Values),5)                    ! Values is valid.
    VERIFY(Valid_State_NP(Rows),5)                      ! Rows is valid.
    VERIFY(Valid_State_NP(Columns),5)                   ! Columns is valid.
    ! Values, Rows & Columns size checks.
    VERIFY(SIZE(Values,1) <= Length_PE(ELLM%Row_Structure),5) 
    VERIFY(SIZE(Rows) <= Length_PE(ELLM%Row_Structure),5)
    VERIFY(SIZE(Rows) == SIZE(Values,1),5)
    VERIFY(SIZE(Values) == SIZE(Columns),5)

    ! Global/Local toggle.

    if (PRESENT(Global)) then
      A_Global = Global
    else
      A_Global = .true.
    end if
    if (A_Global) then
      shift = -First_PE(ELLM%Row_Structure) + 1
    else
      shift = 0
    end if

    ! More requirement checks -- require that Rows entries are in the 
    ! correct range.

    VERIFY(Rows + shift .InInterval. (/1, Length_PE(ELLM%Row_Structure)/),5)

    ! Set the values.

    Max_Nonzeros_Not_Exceeded = .true.
    do i = 1, SIZE(Rows)
      if (Rows(i) /= 0) then

        ! Find a column location to store the entry.
    
        Column_Location = 0
        do location = 1, ELLM%Max_Nonzeros
          if (ELLM%Columns(Rows(i) + shift, location) == 0 .or. &
              ELLM%Columns(Rows(i) + shift, location) == Columns(i)) then
            Column_Location = location
            exit
          end if
        end do
    
        ! Make sure Max_Nonzeros is not exceeded (that is, that we
        ! found a spot to put the entry).

        Max_Nonzeros_Not_Exceeded = &
          Max_Nonzeros_Not_Exceeded .and. Column_Location /= 0
    
        ! Store the entry.
    
        ELLM%Values(Rows(i) + shift, Column_Location) = Values(i)
        ELLM%Columns(Rows(i) + shift, Column_Location) = Columns(i)

      end if
    end do

    ! Make sure Max_Nonzeros is not exceeded (that is, that we
    ! found a spot to put all of the entries).

    VERIFY(Max_Nonzeros_Not_Exceeded,1)

    ! Make sure no rows are set twice. 

    ! This check bombed on Suns for NPES=16 or 32, 
    ! so it has been removed there.
    ifelse(ARCHITECTURE, Sun, [], [
      VERIFY((/(((Rows(i)/=Rows(j) .and. Rows(i)/=0), dnl
        j=i+1,SIZE(Rows)), i=1,SIZE(Rows))/),rows_are_set_twice_check)
    ])

    ! Unset the updated? variables.

    call Set_Not_Up_to_Date (ELLM)

    ! Verify guarantees.

    VERIFY(Valid_State(ELLM),5)                    ! ELLM is still valid.

    return
  end subroutine Set_Values_ELL_Matrix_1

  subroutine Set_Values_ELL_Matrix_2 (ELLM, Values, Rows, Columns, Global)

    ! Note: this routine is very similar to Add_Values_ELL_Matrix_2.

    ! Input variables.
  
    type(real,2,np), intent(in) :: Values          ! Values bare naked array.
    type(integer,1,np), intent(in) :: Rows         ! Rows integer vector.
    type(integer,2,np), intent(in) :: Columns      ! Columns integer array.
    type(logical), intent(in), optional :: Global  ! Global/local index toggle.

    ! Input/Output variable.
    
    type(ELL_Matrix_type), intent(inout) :: ELLM ! Variable to be set.

    ! Internal variables.

    type(logical) :: A_Global                   ! Actual global/local toggle.
    type(integer) :: Column_Location            ! Location in Columns array 
                                                !   for the entry.
    type(integer) :: i, j                       ! Loop parameters.
    type(integer) :: location                   ! Loop index.
    type(logical) :: Max_Nonzeros_Not_Exceeded  ! Toggle for error check.
    type(integer) :: shift                      ! Index shift.

    !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  
    ! Verify requirements.
  
    VERIFY(Valid_State(ELLM),5)                         ! ELLM is valid.
    VERIFY(Valid_State_NP(Values),5)                    ! Values is valid.
    VERIFY(Valid_State_NP(Rows),5)                      ! Rows is valid.
    VERIFY(Valid_State_NP(Columns),5)                   ! Columns is valid.
    ! Values, Rows & Columns size checks.
    VERIFY(SIZE(Values,1) <= Length_PE(ELLM%Row_Structure),5) 
    VERIFY(SIZE(Values,2) == ELLM%Max_Nonzeros,5)
    VERIFY(SIZE(Rows) <= Length_PE(ELLM%Row_Structure),5)
    VERIFY(SIZE(Rows) == SIZE(Values,1),5)
    VERIFY(SIZE(Values) == SIZE(Columns),5)

    ! Global/Local toggle.

    if (PRESENT(Global)) then
      A_Global = Global
    else
      A_Global = .true.
    end if
    if (A_Global) then
      shift = -First_PE(ELLM%Row_Structure) + 1
    else
      shift = 0
    end if

    ! More requirement checks -- require that Rows entries are in the 
    ! correct range.

    VERIFY(Rows + shift .InInterval. (/1, Length_PE(ELLM%Row_Structure)/),5)

    ! Set the values.

    Max_Nonzeros_Not_Exceeded = .true.
    do i = 1, SIZE(Rows)
      if (Rows(i) /= 0) then
        do j = 1, SIZE(Values,2)

          ! Find a column location to store the entry.
    
          Column_Location = 0
          do location = 1, ELLM%Max_Nonzeros
            if (ELLM%Columns(Rows(i) + shift, location) == 0 .or. &
                ELLM%Columns(Rows(i) + shift, location) == Columns(i,j)) then
              Column_Location = location
              exit
            end if
          end do
    
          ! Make sure Max_Nonzeros is not exceeded (that is, that we
          ! found a spot to put the entry).

          Max_Nonzeros_Not_Exceeded = &
            Max_Nonzeros_Not_Exceeded .and. Column_Location /= 0
    
          ! Store the entry.
    
          ELLM%Values(Rows(i) + shift, Column_Location) = Values(i,j)
          ELLM%Columns(Rows(i) + shift, Column_Location) = Columns(i,j)

        end do
      end if
    end do

    ! Make sure Max_Nonzeros is not exceeded (that is, that we
    ! found a spot to put all of the entries).

    VERIFY(Max_Nonzeros_Not_Exceeded,1)

    ! Make sure no rows are set twice. 

    ! This check bombed on Suns for NPES=16 or 32, 
    ! so it has been removed there.
    ifelse(ARCHITECTURE, Sun, [], [
      VERIFY((/(((Rows(i)/=Rows(j) .and. Rows(i)/=0), dnl
        j=i+1,SIZE(Rows)), i=1,SIZE(Rows))/),9)
    ])

    ! Make sure no columns are set twice.

    ! Next line was too long for the Absoft compiler, 
    ! even with all spaces removed.

    !VERIFY((/((((Columns(i,j)/=Columns(i,k) .and. Columns(i,j)/=0), dnl
    !  k=j+1,SIZE(Columns,2)), j=1,SIZE(Columns,2)), i=1,SIZE(Columns,1))/),9)

    ! Unset the updated? variables.

    call Set_Not_Up_to_Date (ELLM)

    ! Verify guarantees.

    VERIFY(Valid_State(ELLM),5)                    ! ELLM is still valid.

    return
  end subroutine Set_Values_ELL_Matrix_2

  subroutine Set_Values_ELL_Matrix_All (ELLM, Values, Columns)

    ! Input variables.
  
    type(real,2,np), intent(in) :: Values         ! Values bare naked array.
    type(integer,2,np), intent(in) :: Columns     ! Columns bare naked array.

    ! Input/Output variable.
    
    type(ELL_Matrix_type), intent(inout) :: ELLM ! Variable to be set.
  
    !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  
    ! Verify requirements.
  
    VERIFY(Valid_State(ELLM),5)                          ! ELLM is valid.
    VERIFY(Valid_State_NP(Values),5)                     ! Values is valid.
    VERIFY(Valid_State_NP(Columns),5)                    ! Columns is valid.
    ! Values and Columns size checks.
    VERIFY(SIZE(Values,1) == Length_PE(ELLM%Row_Structure),5)
    VERIFY(SIZE(Values,2) == ELLM%Max_Nonzeros,5)
    VERIFY(SIZE(Values) == SIZE(Columns),5)

    ! Set the values.
  
    ELLM%Values = Values
    ELLM%Columns = Columns

    ! Unset the updated? variables.

    call Set_Not_Up_to_Date (ELLM)

    ! Verify guarantees.

    VERIFY(Valid_State(ELLM),5)                          ! ELLM is still valid.

    return
  end subroutine Set_Values_ELL_Matrix_All

  subroutine Set_Value_ELL_Matrix_All (ELLM, Value)

    ! Input variables.
  
    type(real), intent(in) :: Value              ! Value scalar.

    ! Input/Output variable.
    
    type(ELL_Matrix_type), intent(inout) :: ELLM ! Variable to be set.
  
    !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  
    ! Verify requirements.
  
    VERIFY(Valid_State(ELLM),5)                          ! ELLM is valid.
    VERIFY(Valid_State(Value),5)                         ! Value is valid.

    ! Set all the values which have nonzero 
    ! column indices to the input scalar.

    where (ELLM%Columns /= 0)
      ELLM%Values = Value
    end where

    ! Unset the updated? variables.

    call Set_Not_Up_to_Date (ELLM)

    ! Verify guarantees.

    VERIFY(Valid_State(ELLM),5)                          ! ELLM is still valid.

    return
  end subroutine Set_Value_ELL_Matrix_All



Michael L. Hall