Next: D.7.12 Set_Version_Overlapped_Vector Procedure Up: D.7 Overlapped_Vector Class Code Previous: D.7.10 Get_Version_Overlapped_Vector Procedure
The main documentation of the Output_Overlapped_Vector Procedure contains additional explanation of this code listing.
subroutine Output_Overlapped_Vector (OV, Many_First, Many_Last, One_First, &
One_Last, Unit)
! Input variables.
type(Overlapped_Vector_type), intent(in) :: OV ! Variable to be output.
type(integer), intent(in), optional :: Many_First ! Extents of many value
type(integer), intent(in), optional :: Many_Last ! data to be output.
type(integer), intent(in), optional :: One_First ! Extents of one value
type(integer), intent(in), optional :: One_Last ! data to be output.
type(integer), intent(in), optional :: Unit ! Output unit.
! Internal variables.
type(integer) :: Buffer_Loc ! Buffer location.
type(integer) :: Buffer_Size ! Output buffer size.
type(integer) :: Buffer_Skip ! Buffer increment.
type(integer) :: i ! Loop counter.
type(integer) :: A_Many_First ! Actual many first value.
type(integer) :: A_Many_Last ! Actual many last value.
type(integer) :: A_One_First ! Actual one first value.
type(integer) :: A_One_Last ! Actual one last value.
type(integer) :: A_Unit ! Actual output unit.
type(character,80) :: Name_Name ! Name of the OV.
type(character,80) :: Output_1 ! Output buffer.
type(character,80,1) :: Output_Buffer ! Output buffer vector.
type(integer) :: Version_Number ! Version of the OV.
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! Verify requirements.
VERIFY(Valid_State(OV),5) ! OV is valid.
! Set unit number.
if (PRESENT(Unit)) then
A_Unit = Unit
else
A_Unit = 6
end if
! These are evaluated on all PEs -- NOT inside an IO PE block -- because
! they contain validity checks on OV and thus require global communication.
Version_Number = Version(OV)
Name_Name = Name(OV)
! Output Identification Info.
if (this_is_IO_PE) then
write (A_Unit,100) 'Overlapped Vector Information:'
write (A_Unit,*) ' Name = ', TRIM(Name_Name)
write (A_Unit,*) ' Locus = ', &
TRIM(Locus(OV%Many_Structure)), ' of ', &
TRIM(Locus(OV%One_Structure))
write (A_Unit,*) ' Initialized = ', Initialized(OV)
write (A_Unit,*) ' Version = ', Version_Number
write (A_Unit,*) ' Internal DV = ', &
Initialized(OV%DV_Internal)
write (A_Unit,*) ' Dimensionality = ', OV%Dimensionality
end if
! PE-dependent info.
Buffer_Size = MAX(1, (SIZE(OV%Overlap_Index) + 3)/ 4)
call Initialize (Output_Buffer, Buffer_Size)
write (Output_1,102) 'PE:', this_PE, &
', Dimensions =', OV%Dimensions
call Parallel_Write (Output_1, A_Unit)
!write (Output_Buffer(1),102) 'PE:', this_PE, &
! ', NOff_PE =', OV%NOff_PE
!call Parallel_Write (Output_Buffer(1), A_Unit)
write (Output_Buffer,104) 'PE:', this_PE, &
', Overlap_Index =', OV%Overlap_Index
call Parallel_Write (Output_Buffer, A_Unit)
call Finalize (Output_Buffer)
! Set up actual limit values for pass-through.
if (PRESENT(Many_First)) then
A_Many_First = Many_First
else
A_Many_First = 1
end if
if (PRESENT(Many_Last)) then
A_Many_Last = Many_Last
else
A_Many_Last = Length_Total(OV%Many_Structure)
end if
if (PRESENT(One_First)) then
A_One_First = One_First
else
A_One_First = 1
end if
if (PRESENT(One_Last)) then
A_One_Last = One_Last
else
A_One_Last = Length_Total(OV%One_Structure)
end if
! Output internal structure info.
call Output (OV%DV, A_Many_First, A_Many_Last, A_Unit, Indent=2)
call Output (OV%Many_of_One_Index, A_One_First, A_One_Last, A_Unit, &
Indent=2)
!call Output (OV%Trace, A_Unit)
!call Output (OV%Off_PE_Trace, A_Unit)
! Output internal values.
if (this_is_IO_PE) then
write (A_Unit,100) ' Internal Overlap Values:'
end if
! Output the values based on the dimensionality.
! (In the future, I could limit this with the First and Last limits above,
! but for now, just output the whole thing.)
select case (OV%Dimensionality)
case (1)
Buffer_Size = MAX(0, OV%Many_of_One_Index%NOff_PE)
call Initialize (Output_Buffer, Buffer_Size)
if (Buffer_Size /= 0) then
Buffer_Skip = 1
Buffer_Loc = 1
do i = 1, OV%Many_of_One_Index%NOff_PE
write (Output_Buffer(Buffer_Loc:Buffer_Loc+Buffer_Skip-1),103) &
'PE:', this_PE, ', O_Values1(', i, ') =', &
OV%Overlap_Values1(i)
Buffer_Loc = Buffer_Loc + Buffer_Skip
end do
end if
case (2)
Buffer_Size = MAX(0, ((SIZE(OV%Overlap_Values2(:,1)) + 2) / 3) &
* OV%Many_of_One_Index%NOff_PE)
call Initialize (Output_Buffer, Buffer_Size)
if (Buffer_Size /= 0) then
Buffer_Skip = (SIZE(OV%Overlap_Values2(:,1)) + 2) / 3
Buffer_Loc = 1
do i = 1, OV%Many_of_One_Index%NOff_PE
write (Output_Buffer(Buffer_Loc:Buffer_Loc+Buffer_Skip-1),103) &
'PE:', this_PE, ', O_Values2(:,', i, ') =', &
OV%Overlap_Values2(:,i)
Buffer_Loc = Buffer_Loc + Buffer_Skip
end do
end if
case (3)
Buffer_Size = MAX(0, ((SIZE(OV%Overlap_Values3(:,:,1)) + 2) / 3) &
* OV%Many_of_One_Index%NOff_PE)
call Initialize (Output_Buffer, Buffer_Size)
if (Buffer_Size /= 0) then
Buffer_Skip = (SIZE(OV%Overlap_Values3(:,:,1)) + 2) / 3
Buffer_Loc = 1
do i = 1, OV%Many_of_One_Index%NOff_PE
write (Output_Buffer(Buffer_Loc:Buffer_Loc+Buffer_Skip-1),103) &
'PE:', this_PE, ', O_Values3(:,:,', i, ') =', &
OV%Overlap_Values3(:,:,i)
Buffer_Loc = Buffer_Loc + Buffer_Skip
end do
end if
case (4)
Buffer_Size = MAX(0, ((SIZE(OV%Overlap_Values4(:,:,:,1)) + 2) / 3) &
* OV%Many_of_One_Index%NOff_PE)
call Initialize (Output_Buffer, Buffer_Size)
if (Buffer_Size /= 0) then
Buffer_Skip = (SIZE(OV%Overlap_Values4(:,:,:,1)) + 2) / 3
Buffer_Loc = 1
do i = 1, OV%Many_of_One_Index%NOff_PE
write (Output_Buffer(Buffer_Loc:Buffer_Loc+Buffer_Skip-1),103) &
'PE:', this_PE, ', O_Values4(:,:,:,', i, ') =', &
OV%Overlap_Values4(:,:,:,i)
Buffer_Loc = Buffer_Loc + Buffer_Skip
end do
end if
! case (-1)
! Buffer_Size = MAX(0, ((SIZE(OV%Overlap_ValuesRR(:,1)) + 2) / 3) &
! * OV%Many_of_One_Index%NOff_PE)
! call Initialize (Output_Buffer, Buffer_Size)
! if (Buffer_Size /= 0) then
! Buffer_Skip = (SIZE(OV%Overlap_ValuesRR(:,1)) + 2) / 3
! Buffer_Loc = 1
! do i = 1, OV%Many_of_One_Index%NOff_PE
! write (Output_Buffer(Buffer_Loc:Buffer_Loc+Buffer_Skip-1),103) &
! 'PE:', this_PE, ', O_ValuesRR(:,', i, ') =', &
! OV%Overlap_ValuesRR(:,i)
! Buffer_Loc = Buffer_Loc + Buffer_Skip
! end do
! end if
end select
call Parallel_Write (Output_Buffer, A_Unit)
call Finalize (Output_Buffer)
! Format statements. With these formats, this should work up to
! (10^6 - 1) PEs.
100 format (/, a, /)
101 format (2x, a, i11, :, 3(',', i11, :), ',', /, &
(24x, i11, :, 3(',', i11, :), ','))
102 format (2x, a, i5, a, i11, :, 4(',', i11, :))
103 format (2x, a, i5, a, i11, a, 1p, e13.5e3, :, &
2(',', e13.5e3, :), ',', /, &
(38x, e13.5e3, :, 2(',', e13.5e3, :), ','))
104 format (2x, a, i5, a, i11, :, &
3(',', i11, :), ',', /, &
(27x, i11, :, 3(',', i11, :), ','))
! Verify guarantees - none.
return
end subroutine Output_Overlapped_Vector