## D.7.5 Collect_and_Combine_DV_from_OV Procedure

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

define([COLLECT_AND_COMBINE_ROUTINE],[
pushdef([OP], [\$1])
pushdef([Collect_and_OP_DV_from_OV], expand(Collect_and_\$1_DV_from_OV))

subroutine Collect_and_OP_DV_from_OV (DV, OV)

! Input variable.

type(Overlapped_Vector_type), intent(in) :: OV ! Variable to be combined.

! Input/Output variable.

type(Distributed_Vector_type), intent(inout) :: DV ! Resultant DV.

! Internal variables.

type(integer) :: i, j, k, m, o  ! Loop counters.

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

! Verify requirements.

VERIFY(Valid_State(OV),5)                           ! OV is valid.
VERIFY(Valid_State(DV),5)                           ! DV is valid.
VERIFY(OV%Dimensionality == DV%Dimensionality,5)    ! Same dimensionality.
VERIFY(OV%Dimensions(1:OV%Dimensionality-1) == dnl
DV%Dimensions(1:DV%Dimensionality-1),5)      ! Same dimensions.
VERIFY(ASSOCIATED(OV%One_Structure,DV%Structure),5) ! Same one-structure.

! Collect and combine the values. There are different versions based
! on the dimensionality of the Index and on the dimensionality of the
! "Vector" itself.

select case (OV%Many_of_One_Index%Dimensionality)

! Vector Index. Shape of DV%Values must be:
!
!   DV%Values ( [dim1, [dim2, [dim3, ]]] One_Axis )
!
! There is no Many_Axis to be combined -- no combination operation
! is used.

case (1)

! Switch on the dimensionality of the data itself.

select case (OV%Dimensionality)

case (1)

DV%Values1 = OPSTART
where (OV%Many_of_One_Index%Index1 > 0)
DV%Values1(:) = OV%DV%Values1(OV%Many_of_One_Index%Index1)
end where
where (OV%Many_of_One_Index%Index1 < 0)
DV%Values1(:) = OV%Overlap_Values1(-OV%Many_of_One_Index%Index1)
end where

case (2)

DV%Values2 = OPSTART
do i = 1, OV%Dimensions(1)
where (OV%Many_of_One_Index%Index1 > 0)
DV%Values2(i,:) = OV%DV%Values2(i, OV%Many_of_One_Index%Index1)
end where
where (OV%Many_of_One_Index%Index1 < 0)
DV%Values2(i,:) = &
OV%Overlap_Values2(i, -OV%Many_of_One_Index%Index1)
end where
end do

case (3)

DV%Values3 = OPSTART
do i = 1, OV%Dimensions(1)
do j = 1, OV%Dimensions(2)
where (OV%Many_of_One_Index%Index1 > 0)
DV%Values3(i,j,:) = &
OV%DV%Values3(i, j, OV%Many_of_One_Index%Index1)
end where
where (OV%Many_of_One_Index%Index1 < 0)
DV%Values3(i,j,:) = &
OV%Overlap_Values3(i, j, -OV%Many_of_One_Index%Index1)
end where
end do
end do

case (4)

DV%Values4 = OPSTART
do i = 1, OV%Dimensions(1)
do j = 1, OV%Dimensions(2)
do k = 1, OV%Dimensions(3)
where (OV%Many_of_One_Index%Index1 > 0)
DV%Values4(i,j,k,:) = &
OV%DV%Values4(i, j, k, OV%Many_of_One_Index%Index1)
end where
where (OV%Many_of_One_Index%Index1 < 0)
DV%Values4(i,j,k,:) = &
OV%Overlap_Values4(i, j, k, -OV%Many_of_One_Index%Index1)
end where
end do
end do
end do

end select

! Array Index. Shape of DV%Values must be:
!
!     DV%Values ( [dim1, [dim2, [dim3, ]]] One_Axis )
!
! The Many_Axis has been combined.

case (2)

! Switch on the dimensionality of the data itself.

select case (OV%Dimensionality)

case (1)

DV%Values1 = OPSTART
do o = 1, SIZE(OV%Many_of_One_Index%Index2, 1)
do m = 1, SIZE(OV%Many_of_One_Index%Index2, 2)
if (OV%Many_of_One_Index%Index2(o,m) > 0) then
DV%Values1(o) = OPERATION(DV%Values1(o), dnl
OV%DV%Values1(OV%Many_of_One_Index%Index2(o,m)))
else if (OV%Many_of_One_Index%Index2(o,m) < 0) then
DV%Values1(o) = OPERATION(DV%Values1(o), dnl
OV%Overlap_Values1(-OV%Many_of_One_Index%Index2(o,m)))
end if
end do
ifelse(OP, [Average], [
DV%Values1(o) = DV%Values1(o) / &
changetype(real, COUNT(OV%Many_of_One_Index%Index2(o,:) /= 0))
])
end do

case (2)

DV%Values2 = OPSTART
do i = 1, OV%Dimensions(1)
do o = 1, SIZE(OV%Many_of_One_Index%Index2, 1)
do m = 1, SIZE(OV%Many_of_One_Index%Index2, 2)
if (OV%Many_of_One_Index%Index2(o,m) > 0) then
DV%Values2(i,o) = OPERATION(DV%Values2(i,o), dnl
OV%DV%Values2(i, OV%Many_of_One_Index%Index2(o,m)))
else if (OV%Many_of_One_Index%Index2(o,m) < 0) then
DV%Values2(i,o) = OPERATION(DV%Values2(i,o), dnl
OV%Overlap_Values2(i, -OV%Many_of_One_Index%Index2(o,m)))
end if
end do
ifelse(OP, [Average], [
DV%Values2(i,o) = DV%Values2(i,o) / &
changetype(real, COUNT(OV%Many_of_One_Index%Index2(o,:) /= 0))
])
end do
end do

case (3)

DV%Values3 = OPSTART
do i = 1, OV%Dimensions(1)
do j = 1, OV%Dimensions(2)
do o = 1, SIZE(OV%Many_of_One_Index%Index2, 1)
do m = 1, SIZE(OV%Many_of_One_Index%Index2, 2)
if (OV%Many_of_One_Index%Index2(o,m) > 0) then
DV%Values3(i,j,o) = OPERATION(DV%Values3(i,j,o), dnl
OV%DV%Values3(i, j, OV%Many_of_One_Index%Index2(o,m)))
else if (OV%Many_of_One_Index%Index2(o,m) < 0) then
DV%Values3(i,j,o) = OPERATION(DV%Values3(i,j,o), dnl
OV%Overlap_Values3 dnl
(i, j, -OV%Many_of_One_Index%Index2(o,m)))
end if
end do
ifelse(OP, [Average], [
DV%Values3(i,j,o) = DV%Values3(i,j,o) / &
changetype(real, dnl
COUNT(OV%Many_of_One_Index%Index2(o,:) /= 0))
])
end do
end do
end do

case (4)

DV%Values4 = OPSTART
do i = 1, OV%Dimensions(1)
do j = 1, OV%Dimensions(2)
do k = 1, OV%Dimensions(3)
do o = 1, SIZE(OV%Many_of_One_Index%Index2, 1)
do m = 1, SIZE(OV%Many_of_One_Index%Index2, 2)
if (OV%Many_of_One_Index%Index2(o,m) > 0) then
DV%Values4(i,j,k,o) = OPERATION(DV%Values4(i,j,k,o), dnl
OV%DV%Values4 dnl
(i, j, k, OV%Many_of_One_Index%Index2(o,m)))
else if (OV%Many_of_One_Index%Index2(o,m) < 0) then
DV%Values4(i,j,k,o) = OPERATION(DV%Values4(i,j,k,o), dnl
OV%Overlap_Values4 dnl
(i, j, k, -OV%Many_of_One_Index%Index2(o,m)))
end if
end do
ifelse(OP, [Average], [
DV%Values4(i,j,k,o) = DV%Values4(i,j,k,o) / &
changetype(real, dnl
COUNT(OV%Many_of_One_Index%Index2(o,:) /= 0))
])
end do
end do
end do
end do

end select

end select

! Set version number.

DV = Version(OV)

! Verify guarantees.

VERIFY(Valid_State(OV),5)    ! OV is still valid.
VERIFY(Valid_State(DV),5)    ! DV is valid.

return
end subroutine Collect_and_OP_DV_from_OV

popdef([OP])
popdef([OPERATION])
popdef([OPSTART])
popdef([Collect_and_OP_DV_from_OV])
])

! Add "Conserve" later if needed.

fortext([Op],[Average SUM MAX MIN],[
ifelse(
Op, [MAX], [
pushdef([OPERATION], [Op[](\$1, &
\$2)])
pushdef([OPSTART],[-HUGE(zero)])
], Op, [MIN], [
pushdef([OPERATION], [Op[](\$1, &
\$2)])
pushdef([OPSTART],[HUGE(zero)])
], [
pushdef([OPERATION], [\$1 + &
\$2])
pushdef([OPSTART],[zero])
]
)
COLLECT_AND_COMBINE_ROUTINE(Op)
])

Michael L. Hall