Next: D.4.2 Finalize_Data_Index Procedure Up: D.4 Data_Index Class Code Previous: D.4 Data_Index Class Code
The main documentation of the Initialize_Data_Index Procedure contains additional explanation of this code listing.
subroutine Initialize_Data_Index (Index, Many_Structure, One_Structure, &
Many_of_One_Vector, Many_of_One_Array, &
! Many_of_One_Ragged, &
status)
! Use associations.
use Caesar_Flags_Module, only: initialized_flag
! Input variables.
type(Base_Structure_type), target :: Many_Structure ! Column base structure.
type(Base_Structure_type), target :: One_Structure ! Row base structure.
type(integer,1), optional :: Many_of_One_Vector ! Vector indices.
type(integer,2), optional :: Many_of_One_Array ! Array indices.
!type(Ragged_Integer_type), optional :: Many_of_One_Ragged ! Ragged indices.
! Output variables.
! Data_Index to be initialized.
type(Data_Index_type), intent(out) :: Index
type(Status_type), intent(out), optional :: status ! Exit status.
! Internal variables.
type(Status_type), dimension(6) :: allocate_status ! Allocation Status.
type(Status_type) :: consolidated_status ! Consolidated Status.
type(integer,1) :: Off_PE_Index_Temp ! Off_PE_Index temporary.
type(integer) :: entry, i, j ! Loop indices.
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! Verify requirements.
VERIFY(Valid_State(Many_Structure),5) ! Many_Structure is valid.
VERIFY(Valid_State(One_Structure),5) ! One_Structure is valid.
! Set allocation status.
call Initialize (allocate_status)
call Initialize (consolidated_status)
! Set up trace.
if (PRESENT(Many_of_One_Vector)) then
call Initialize (Index%Trace, Many_of_One_Vector, &
Length_PE(Many_Structure), allocate_status(1))
else if (PRESENT(Many_of_One_Array)) then
call Initialize (Index%Trace, Many_of_One_Array, &
Length_PE(Many_Structure), allocate_status(1))
end if
! Initialize temporary to store off-PE indices.
!
! Note that the size that this variable needs to be is unknown. Assuming
! that the number of off-PE indices is less than the number of on-PE
! indices gives a size of Length_PE(One_Structure). This assumption
! means that the number of "boundary" values needed is less than
! the number of on-processor values, which will often be a reasonable
! assumption. However, one can imagine an almost worst-case scenario (not
! counting an extremely bad poly-connected structure, like a polyhedral
! mesh) consisting of a contiguous line of items connected like a
! 3-D structured hex mesh. Each item would connect to 8 off-PE items
! perpindicularly, and some others that are overlapped. The "end-caps"
! would not overlap, so would have an additional 9 items each. This
! gives rise to the following formula for the maximum:
!
! Max size = 8 * Length_PE(One_Structure) + 18
!
! This size is used for a temporary -- the actual variable is then sized
! to be exactly the needed size.
call Initialize (Off_PE_Index_Temp, 8*Length_PE(One_Structure) + 18, &
allocate_status(2))
! Set up structure pointers.
Index%Many_Structure => Many_Structure
Index%One_Structure => One_Structure
! Set up for a Vector Index.
if (PRESENT(Many_of_One_Vector)) then
! Verifications for a Vector.
VERIFY(.not.PRESENT(Many_of_One_Array),7)
VERIFY(.not.PRESENT(Many_of_One_Ragged),1000) ! Activate this later.
VERIFY(Length_PE(One_Structure) == SIZE(Many_of_One_Vector), 5)
! Initialize Index1.
Index%Dimensionality = 1
call Initialize (Index%Index1, SIZE(Many_of_One_Vector,1), &
allocate_status(3))
Index%Index1 = Many_of_One_Vector
! Set up the Off_PE_Index vector, and modify the Index1 vector to
! point off-PE references into Off_PE_Index with a negative flag.
! Also, change from global to local numbering.
! Loop over Index1 variables.
Index%NOff_PE = 0
do i = 1, SIZE(Many_of_One_Vector,1)
! Select Off-PE entries in Index1.
if (Index%Index1(i) .NotInInterval. Range_PE(Many_Structure)) then
! If this value of Index1 hasn't been stored, store it.
if (.not.ANY(Index%Index1(i) == Off_PE_Index_Temp)) then
Index%NOff_PE = Index%NOff_PE + 1
Off_PE_Index_Temp(Index%NOff_PE) = Index%Index1(i)
Index%Index1(i) = -Index%NOff_PE
! Otherwise, figure out which entry in Off_PE_Index_Temp
! to set Index1 to (with a negative flag).
else
do entry = 1, Index%NOff_PE
if (Index%Index1(i) == Off_PE_Index_Temp(entry)) then
Index%Index1(i) = -entry
end if
end do
end if
! For the On-PE indices, change to a local numbering.
else
Index%Index1(i) = Index%Index1(i) - First_PE(Many_Structure) + 1
end if
end do
! Set up for an Array Index.
else if (PRESENT(Many_of_One_Array)) then
! Verifications for an Array.
VERIFY(.not.PRESENT(Many_of_One_Vector),7)
VERIFY(.not.PRESENT(Many_of_One_Ragged),1000) ! Activate this later.
VERIFY(Length_PE(One_Structure) == SIZE(Many_of_One_Array,1), 5)
! Initialize Index2.
Index%Dimensionality = 2
call Initialize (Index%Index2, SIZE(Many_of_One_Array,1), &
SIZE(Many_of_One_Array,2), allocate_status(3))
Index%Index2 = Many_of_One_Array
! Set up the Off_PE_Index vector, and modify the Index2 array to
! point off-PE references into Off_PE_Index with a negative flag.
! Also, change from global to local numbering.
! Loop over Index2 variables.
Index%NOff_PE = 0
do i = 1, SIZE(Many_of_One_Array,1)
do j = 1, SIZE(Many_of_One_Array,2)
! Select Off-PE entries in Index2.
if (Index%Index2(i,j) .NotInInterval. Range_PE(Many_Structure)) then
! If this value of Index2 hasn't been stored, store it.
if (.not.ANY(Index%Index2(i,j) == Off_PE_Index_Temp)) then
Index%NOff_PE = Index%NOff_PE + 1
Off_PE_Index_Temp(Index%NOff_PE) = Index%Index2(i,j)
Index%Index2(i,j) = -Index%NOff_PE
! Otherwise, figure out which entry in Off_PE_Index_Temp
! to set Index2 to (with a negative flag).
else
do entry = 1, Index%NOff_PE
if (Index%Index2(i,j) == Off_PE_Index_Temp(entry)) then
Index%Index2(i,j) = -entry
end if
end do
end if
! For the On-PE indices, change to a local numbering.
else
Index%Index2(i,j) = Index%Index2(i,j) &
- First_PE(Many_Structure) + 1
end if
end do
end do
! Set up for a Ragged Index.
! <in the future>
end if
! Store temporary in final form.
VERIFY(Index%NOff_PE <= SIZE(Off_PE_Index_Temp),7)
call Initialize (Index%Off_PE_Index, Index%NOff_PE, allocate_status(4))
Index%Off_PE_Index = Off_PE_Index_Temp(1:Index%NOff_PE)
call Finalize (Off_PE_Index_Temp, allocate_status(5))
! Set up off-PE trace.
!if (Index%NOff_PE /= 0) then
call Initialize (Index%Off_PE_Trace, Index%Off_PE_Index, &
Length_PE(Many_Structure), allocate_status(6))
!end if
! Process status variables.
consolidated_status = allocate_status
if (PRESENT(status)) then
WARN_IF(Error(consolidated_status), 5)
status = consolidated_status
else
VERIFY(Normal(consolidated_status), 5)
end if
call Finalize (consolidated_status)
call Finalize (allocate_status)
! Set initialization flag.
Index%Initialized = initialized_flag
! Verify guarantees.
VERIFY(Valid_State(Index),5) ! Index is now valid.
return
end subroutine Initialize_Data_Index