Next: D.7.10 Get_Version_Overlapped_Vector Procedure Up: D.7 Overlapped_Vector Class Code Previous: D.7.8 Get_Name_Overlapped_Vector Procedure
The main documentation of the Get_Values_Overlapped_Vector Procedure contains additional explanation of this code listing.
define([GET_VALUES_ROUTINE],[
pushdef([DIM], [$1])
pushdef([DIMS],
[ifelse(
[$1], [1],
[],
[forloop([i],2,$1,[:,])])])
pushdef([Get_Values_Overlapped_Vector_DIM],
expand(Get_Values_Overlapped_Vector_DIM))
subroutine Get_Values_Overlapped_Vector_DIM (Values, OV)
! Input variable.
type(Overlapped_Vector_type), intent(in) :: OV ! Variable to be queried.
! Input/Output variable.
type(real,DIM,np), intent(inout) :: Values ! Values bare naked array.
! Internal variables.
ifelse(DIM, [1], [
], DIM, [2], [
type(integer) :: i, m ! Loop counters.
], DIM, [3], [
type(integer) :: i, j, m ! Loop counters.
], DIM, [4], [
type(integer) :: i, j, k, m ! Loop counters.
], DIM, [5], [
type(integer) :: i, j, k, m ! Loop counters.
])
ifelse(m4_eval(DEBUG_LEVEL >= 5), 1, [
type(integer) :: IndexDim ! OV%Many_of_One_Index%Dimensionality, used
! in VERIFY commands below.
type(integer) :: Many_Axis_Size ! Number of Manys for each One.
])
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! Verification setup -- not done unless VERIFYs are turned on. The
! activation level used here should correspond to the one used in the
! VERIFY commands below. Also, see similar construct in declarations
! above.
ifelse(m4_eval(DEBUG_LEVEL >= 5), 1, [
! Define shorter form of OV%Many_of_One_Index%Dimensionality to
! avoid line length problems.
IndexDim = OV%Many_of_One_Index%Dimensionality
! Calculate Many Axis size.
if (IndexDim == 2) then
Many_Axis_Size = SIZE(OV%Many_of_One_Index%Index2, 2)
else if (IndexDim == 1) then
Many_Axis_Size = 1
else
! Shouldn't be triggered. Will add something for RR here later.
VERIFY(.false.,0)
end if
])
! Verify requirements.
VERIFY(Valid_State(OV),5) ! OV is valid.
VERIFY(Valid_State_NP(Values),5) ! Values is valid.
! OV has been set up for this call.
VERIFY(DIM .InInterval. (/ OV%Dimensionality, OV%Dimensionality+1 /),5)
! Values shape checks:
!
! Shape is
! Values ( [dim1, [dim2, [dim3, ]]] One_Axis [, Many_Axis] )
!
! First axes are OV%Dimensions.
VERIFY(SIZE(Values,MIN(1,DIM)) == OV%Dimensions(1) .or. dnl
OV%Dimensionality == 1,5)
VERIFY(SIZE(Values,MIN(2,DIM)) == OV%Dimensions(2) .or. dnl
OV%Dimensionality <= 2,5)
VERIFY(SIZE(Values,MIN(3,DIM)) == OV%Dimensions(3) .or. dnl
OV%Dimensionality <= 3,5)
! Penultimate axis is One_Structure axis if Index is two-dimensional.
VERIFY(SIZE(Values,MAX(1,DIM-1)) == Length_PE(OV%One_Structure) .or. dnl
IndexDim /= 2, 5)
! Last axis is One_Structure axis if Index is a vector index.
VERIFY(SIZE(Values,DIM) == Length_PE(OV%One_Structure) .or. dnl
IndexDim /= 1, 5)
! Last axis is Many_Structure axis if Index is two-dimensional.
VERIFY(SIZE(Values,DIM) == Many_Axis_Size .or. dnl
IndexDim /= 2, 5)
! Collect and set the values. There are different versions based on the
! dimensionality of the Index and on the dimensionality of the "Vector"
! itself. Note that there will only be two versions (for the Index
! dimensionality) for each routine in the m4-preprocessed file.
Values = zero
select case (OV%Many_of_One_Index%Dimensionality)
! Vector Index. Shape of Values must be:
!
! Values ( [dim1, [dim2, [dim3, ]]] One_Axis )
case (1)
ifelse(DIM, [1], [
where (OV%Many_of_One_Index%Index1 > 0)
Values(:) = &
OV%DV%Values1(OV%Many_of_One_Index%Index1)
end where
where (OV%Many_of_One_Index%Index1 < 0)
Values(:) = OV%Overlap_Values1(-OV%Many_of_One_Index%Index1)
end where
], DIM, [2], [
do i = 1, OV%Dimensions(1)
where (OV%Many_of_One_Index%Index1 > 0)
Values(i,:) = &
OV%DV%Values2(i, OV%Many_of_One_Index%Index1)
end where
where (OV%Many_of_One_Index%Index1 < 0)
Values(i,:) = OV%Overlap_Values2(i, -OV%Many_of_One_Index%Index1)
end where
end do
], DIM, [3], [
do i = 1, OV%Dimensions(1)
do j = 1, OV%Dimensions(2)
where (OV%Many_of_One_Index%Index1 > 0)
Values(i,j,:) = &
OV%DV%Values3(i, j, OV%Many_of_One_Index%Index1)
end where
where (OV%Many_of_One_Index%Index1 < 0)
Values(i,j,:) = &
OV%Overlap_Values3(i, j, -OV%Many_of_One_Index%Index1)
end where
end do
end do
], DIM, [4], [
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)
Values(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)
Values(i,j,k,:) = &
OV%Overlap_Values4(i, j, k, -OV%Many_of_One_Index%Index1)
end where
end do
end do
end do
], DIM, [5], [
! This combination shouldn't be triggered.
VERIFY(.false., 0)
])
! Array Index. Shape of Values must be:
!
! Values ( [dim1, [dim2, [dim3, ]]] One_Axis, Many_Axis )
case (2)
ifelse(DIM, [1], [
! This combination shouldn't be triggered.
VERIFY(.false., 0)
], DIM, [2], [
do m = 1, SIZE(OV%Many_of_One_Index%Index2, 2)
where (OV%Many_of_One_Index%Index2(:,m) > 0)
Values(:,m) = &
OV%DV%Values1(OV%Many_of_One_Index%Index2(:,m))
end where
where (OV%Many_of_One_Index%Index2(:,m) < 0)
Values(:,m) = &
OV%Overlap_Values1(-OV%Many_of_One_Index%Index2(:,m))
end where
end do
], DIM, [3], [
do i = 1, OV%Dimensions(1)
do m = 1, SIZE(OV%Many_of_One_Index%Index2, 2)
where (OV%Many_of_One_Index%Index2(:,m) > 0)
Values(i,:,m) = &
OV%DV%Values2(i, OV%Many_of_One_Index%Index2(:,m))
end where
where (OV%Many_of_One_Index%Index2(:,m) < 0)
Values(i,:,m) = &
OV%Overlap_Values2(i, -OV%Many_of_One_Index%Index2(:,m))
end where
end do
end do
], DIM, [4], [
do i = 1, OV%Dimensions(1)
do j = 1, OV%Dimensions(2)
do m = 1, SIZE(OV%Many_of_One_Index%Index2, 2)
where (OV%Many_of_One_Index%Index2(:,m) > 0)
Values(i,j,:,m) = &
OV%DV%Values3(i, j, OV%Many_of_One_Index%Index2(:,m))
end where
where (OV%Many_of_One_Index%Index2(:,m) < 0)
Values(i,j,:,m) = &
OV%Overlap_Values3(i, j, -OV%Many_of_One_Index%Index2(:,m))
end where
end do
end do
end do
], DIM, [5], [
do i = 1, OV%Dimensions(1)
do j = 1, OV%Dimensions(2)
do k = 1, OV%Dimensions(3)
do m = 1, SIZE(OV%Many_of_One_Index%Index2, 2)
where (OV%Many_of_One_Index%Index2(:,m) > 0)
Values(i,j,k,:,m) = &
OV%DV%Values4(i, j, k, OV%Many_of_One_Index%Index2(:,m))
end where
where (OV%Many_of_One_Index%Index2(:,m) < 0)
Values(i,j,k,:,m) = &
OV%Overlap_Values4 &
(i, j, k, -OV%Many_of_One_Index%Index2(:,m))
end where
end do
end do
end do
end do
])
end select
! Verify guarantees.
VERIFY(Valid_State(OV),5) ! OV is still valid.
VERIFY(Valid_State_NP(Values),5) ! Values is valid.
return
end subroutine Get_Values_Overlapped_Vector_DIM
popdef([DIM])
popdef([Get_Values_Overlapped_Vector_DIM])
])
forloop([Dim],[1],[5],[
GET_VALUES_ROUTINE(Dim)
])