Next: D.7.6 Gather_OV_from_DV Procedure Up: D.7 Overlapped_Vector Class Code Previous: D.7.4 Initialized_Overlapped_Vector 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)
])