Next: D.8.2 Finalize_Collected_Array Procedure Up: D.8 Collected_Array Class Code Previous: D.8 Collected_Array Class Code
The main documentation of the Initialize_Collected_Array Procedure contains additional explanation of this code listing.
subroutine Initialize_Collected_Array_1 (CA, OV, Name, status)
! Use associations.
use Caesar_Flags_Module, only: initialized_flag
! Input variables.
type(character,*), intent(in), optional :: Name ! Variable name.
type(Overlapped_Vector_type), intent(in) :: OV ! OV for this CA.
! Output variables.
! Collected_Array to be initialized.
type(Collected_Array_type), intent(inout) :: CA
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.
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! Verify requirements.
VERIFY(Valid_State(OV),5) ! Overlapped Vector is valid.
! Set up pointers.
CA%One_Structure => OV%One_Structure
CA%Many_Structure => OV%Many_Structure
CA%Many_of_One_Index => OV%Many_of_One_Index
! Set up internals.
if (PRESENT(Name)) CA%Name = Name
CA%Dimensionality = OV%Dimensionality
CA%Version = OV%Version
! Allocations and initializations.
call Initialize (allocate_status)
call Initialize (consolidated_status)
! Set to maximum dimensionality of 5 to enable VERIFYs without if-checks.
! Also, this gets around problems with using the dimensionality when it
! is set to a negative number for a ragged right array.
call Initialize (CA%Dimensions, 5, allocate_status(1))
! Set initial dimensions.
CA%Dimensions(1:CA%Dimensionality-1) = OV%Dimensions(1:OV%Dimensionality-1)
! Set One Axis size.
CA%Dimensions(CA%Dimensionality) = Length_PE(CA%One_Structure)
! Set Many Axis size.
if (CA%Many_of_One_Index%Dimensionality == 2) then
CA%A_Dimensionality = CA%Dimensionality + 1
CA%Dimensions(CA%A_Dimensionality) = &
SIZE(CA%Many_of_One_Index%Index2, 2)
else if (CA%Many_of_One_Index%Dimensionality == 1) then
CA%A_Dimensionality = CA%Dimensionality
CA%Dimensions(CA%Dimensionality + 1) = 0
else
! Shouldn't be triggered. Will add something for RR here later.
VERIFY(.false.,0)
end if
! Set up the Collected Values.
select case (CA%A_Dimensionality)
case (1)
call Initialize (CA%Values1, CA%Dimensions(1), allocate_status(2))
CA%Values1 = OV
case (2)
call Initialize (CA%Values2, CA%Dimensions(1), CA%Dimensions(2), &
allocate_status(2))
CA%Values2 = OV
case (3)
call Initialize (CA%Values3, CA%Dimensions(1), CA%Dimensions(2), &
CA%Dimensions(3), allocate_status(2))
CA%Values3 = OV
case (4)
call Initialize (CA%Values4, CA%Dimensions(1), CA%Dimensions(2), &
CA%Dimensions(3), CA%Dimensions(4), allocate_status(2))
CA%Values4 = OV
case (5)
call Initialize (CA%Values5, CA%Dimensions(1), CA%Dimensions(2), &
CA%Dimensions(3), CA%Dimensions(4), CA%Dimensions(5), &
allocate_status(2))
CA%Values5 = OV
!case (-1)
! call Initialize (CA%ValuesRR, CA%Dimensions(1), CA%Dimensions(2), &
! allocate_status(2))
! CA%ValuesRR = OV
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.
CA%Initialized = initialized_flag
! Verify guarantees.
VERIFY(Valid_State(CA),5) ! CA is now valid.
return
end subroutine Initialize_Collected_Array_1
subroutine Initialize_Collected_Array_2 (CA, Many_of_One_Index, &
Dimensionality, Name, status, &
dim1, dim2, dim3)
! Use associations.
use Caesar_Flags_Module, only: initialized_flag
! Input variables.
type(character,*), intent(in), optional :: Name ! Variable name.
! Index for Many-1.
type(Data_Index_type), intent(in), target :: Many_of_One_Index
type(integer), intent(in) :: Dimensionality ! Dimensionality for this CA.
type(integer), intent(in), optional :: dim1, dim2, dim3 ! Dimensions.
! Output variables.
! Collected_Array to be initialized.
type(Collected_Array_type), intent(out) :: CA
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.
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! 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.
! Allocations and initializations.
call Initialize (allocate_status)
call Initialize (consolidated_status)
! Set up pointers.
CA%One_Structure => Many_of_One_Index%One_Structure
CA%Many_Structure => Many_of_One_Index%Many_Structure
CA%Many_of_One_Index => Many_of_One_Index
! Set up internals.
if (PRESENT(Name)) CA%Name = Name
CA%Dimensionality = Dimensionality
CA%Version = 0
! Allocations and initializations.
call Initialize (allocate_status)
call Initialize (consolidated_status)
! Set to maximum dimensionality of 5 to enable VERIFYs without if-checks.
! Also, this gets around problems with using the dimensionality when it
! is set to a negative number for a ragged right array.
call Initialize (CA%Dimensions, 5, allocate_status(1))
! Set initial dimensions.
select case (CA%Dimensionality)
case (1)
! No initial dimensions.
case (2)
CA%Dimensions(1) = dim1
case (3)
CA%Dimensions(1) = dim1
CA%Dimensions(2) = dim2
case (4)
CA%Dimensions(1) = dim1
CA%Dimensions(2) = dim2
CA%Dimensions(3) = dim3
end select
! Set One Axis size.
CA%Dimensions(CA%Dimensionality) = Length_PE(CA%One_Structure)
! Set Many Axis size.
if (CA%Many_of_One_Index%Dimensionality == 2) then
CA%A_Dimensionality = CA%Dimensionality + 1
CA%Dimensions(CA%A_Dimensionality) = &
SIZE(CA%Many_of_One_Index%Index2, 2)
else if (CA%Many_of_One_Index%Dimensionality == 1) then
CA%A_Dimensionality = CA%Dimensionality
CA%Dimensions(CA%Dimensionality + 1) = 0
else
! Shouldn't be triggered. Will add something for RR here later.
VERIFY(.false.,0)
end if
! Set up the Collected Values.
select case (CA%A_Dimensionality)
case (1)
call Initialize (CA%Values1, CA%Dimensions(1), allocate_status(2))
case (2)
call Initialize (CA%Values2, CA%Dimensions(1), CA%Dimensions(2), &
allocate_status(2))
case (3)
call Initialize (CA%Values3, CA%Dimensions(1), CA%Dimensions(2), &
CA%Dimensions(3), allocate_status(2))
case (4)
call Initialize (CA%Values4, CA%Dimensions(1), CA%Dimensions(2), &
CA%Dimensions(3), CA%Dimensions(4), allocate_status(2))
case (5)
call Initialize (CA%Values5, CA%Dimensions(1), CA%Dimensions(2), &
CA%Dimensions(3), CA%Dimensions(4), CA%Dimensions(5), &
allocate_status(2))
!case (-1)
! call Initialize (CA%ValuesRR, CA%Dimensions(1), CA%Dimensions(2), &
! allocate_status(2))
end select
! 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.
CA%Initialized = initialized_flag
! Verify guarantees.
VERIFY(Valid_State(CA),5) ! CA is now valid.
return
end subroutine Initialize_Collected_Array_2