Next: D.7.2 Finalize_Overlapped_Vector Procedure Up: D.7 Overlapped_Vector Class Code Previous: D.7 Overlapped_Vector Class Code
The main documentation of the Initialize_Overlapped_Vector Procedure contains additional explanation of this code listing.
subroutine Initialize_Overlapped_Vector_1 (OV, DV, Many_of_One_Index, &
Name, status)
! Use associations.
use Caesar_Flags_Module, only: initialized_flag
! Input variables.
type(character,*), intent(in), optional :: Name ! Variable name.
type(Distributed_Vector_type), intent(in), target :: DV ! DV for this OV.
! Index for Many-One.
type(Data_Index_type), intent(in), target :: Many_of_One_Index
! Output variables.
! Overlapped_Vector to be initialized.
type(Overlapped_Vector_type), intent(inout) :: OV
type(Status_type), intent(out), optional :: status ! Exit status.
! Internal variables.
type(Status_type), dimension(1) :: allocate_status ! Allocation Status.
type(Status_type) :: consolidated_status ! Consolidated Status.
type(integer) :: i, j, k ! Loop counters.
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! Verify requirements.
VERIFY(Valid_State(DV),5) ! Distributed Vector is valid.
VERIFY(Valid_State(Many_of_One_Index),5) ! Index is valid.
! Structures are the same.
VERIFY(ASSOCIATED(Many_of_One_Index%Many_Structure, DV%Structure),5)
! Set up pointers.
OV%One_Structure => Many_of_One_Index%One_Structure
OV%Many_Structure => DV%Structure
OV%Dimensions => DV%Dimensions
OV%DV => DV
OV%Many_of_One_Index => Many_of_One_Index
OV%Overlap_Index => Many_of_One_Index%Off_PE_Index
OV%Overlap_Trace => Many_of_One_Index%Off_PE_Trace
! Set up internals.
if (PRESENT(Name)) OV%Name = Name
OV%Dimensionality = DV%Dimensionality
OV%Version = DV%Version
! Allocations and initializations.
call Initialize (allocate_status)
call Initialize (consolidated_status)
! Set up the Overlapped Values.
select case (OV%Dimensionality)
case (1)
call Initialize (OV%Overlap_Values1, Many_of_One_Index%NOff_PE, &
allocate_status(1))
call Gather (OV%Overlap_Values1, DV%Values1, Trace=OV%Overlap_Trace)
case (2)
call Initialize (OV%Overlap_Values2, OV%Dimensions(1), &
Many_of_One_Index%NOff_PE, &
allocate_status(1))
do i = 1, OV%Dimensions(1)
call Gather (OV%Overlap_Values2(i,:), DV%Values2(i,:), &
Trace=OV%Overlap_Trace)
end do
case (3)
call Initialize (OV%Overlap_Values3, OV%Dimensions(1), &
OV%Dimensions(2), Many_of_One_Index%NOff_PE, &
allocate_status(1))
do i = 1, OV%Dimensions(1)
do j = 1, OV%Dimensions(2)
call Gather (OV%Overlap_Values3(i,j,:), DV%Values3(i,j,:), &
Trace=OV%Overlap_Trace)
end do
end do
case (4)
call Initialize (OV%Overlap_Values4, OV%Dimensions(1), &
OV%Dimensions(2), OV%Dimensions(3), &
Many_of_One_Index%NOff_PE, &
allocate_status(1))
do i = 1, OV%Dimensions(1)
do j = 1, OV%Dimensions(2)
do k = 1, OV%Dimensions(3)
call Gather (OV%Overlap_Values4(i,j,k,:), DV%Values4(i,j,k,:), &
Trace=OV%Overlap_Trace)
end do
end do
end do
!case (-1)
! call Initialize (OV%Overlap_ValuesRR, Many_of_One_Index%NOff_PE, &
! allocate_status)
end select
! Consolidate and handle status.
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.
OV%Initialized = initialized_flag
! Verify guarantees.
VERIFY(Valid_State(OV),5) ! OV is now valid.
return
end subroutine Initialize_Overlapped_Vector_1
subroutine Initialize_Overlapped_Vector_2 (OV, Many_of_One_Index, &
Dimensionality, Name, status, &
dim1, dim2, dim3)
! Input variables.
type(character,*), intent(in), optional :: Name ! Variable name.
type(Data_Index_type), intent(in) :: Many_of_One_Index ! Index for Many-1.
type(integer), intent(in) :: Dimensionality ! Dimensionality for this OV.
type(integer), intent(in), optional :: dim1, dim2, dim3 ! Dimensions.
! Output variables.
! Overlapped_Vector to be initialized.
type(Overlapped_Vector_type), intent(out) :: OV
type(Status_type), intent(out), optional :: status ! Exit status.
! Internal variables.
type(Status_type), dimension(2) :: allocate_status ! Allocation Status.
type(Status_type) :: consolidated_status ! Consolidated Status.
! Pass-through variables.
type(character,name_length) :: Name_Pass
type(integer) :: dim1_Pass, dim2_Pass, dim3_Pass
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! Verify requirements.
VERIFY(Valid_State(Many_of_One_Index),5) ! Index is valid.
VERIFY(Dimensionality .InInterval. (/1,4/),5) ! Dimensionality is in range.
VERIFY(PRESENT(dim1) .or. Dimensionality == 1,5) ! Proper dimensions exist.
VERIFY(PRESENT(dim2) .or. Dimensionality <= 2,5) ! Proper dimensions exist.
VERIFY(PRESENT(dim3) .or. Dimensionality <= 3,5) ! Proper dimensions exist.
! Make "Pass" versions of the optional inputs.
if (PRESENT(Name)) then
Name_Pass = Name
else
Name_Pass = ''
end if
if (PRESENT(dim1)) then
dim1_Pass = dim1
else
dim1_Pass = 0
end if
if (PRESENT(dim2)) then
dim2_Pass = dim2
else
dim2_Pass = 0
end if
if (PRESENT(dim3)) then
dim3_Pass = dim3
else
dim3_Pass = 0
end if
! Allocations and initializations.
call Initialize (allocate_status)
call Initialize (consolidated_status)
! Initialize the internal DV.
call Initialize (OV%DV_Internal, Many_of_One_Index%Many_Structure, &
Dimensionality, Name_Pass, allocate_status(1), &
dim1_Pass, dim2_Pass, dim3_Pass)
!OV%DV_Internal = (/ 0.d0 /)
! Use other OV initialization procedure.
call Initialize_Overlapped_Vector_1 (OV, OV%DV_Internal, &
Many_of_One_Index, Name_Pass, &
allocate_status(2))
! Consolidate and handle status.
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)
! Verify guarantees.
VERIFY(Valid_State(OV),5) ! OV is now valid.
return
end subroutine Initialize_Overlapped_Vector_2