Next: G.2.16 ELL_Matrix Class Unit Up: G.2 ELL_Matrix Class Code Previous: G.2.14 Set_Not_Up_to_Date_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