Next: D.6.12 Set_Values_Distributed_Vector Procedure Up: D.6 Distributed_Vector Class Code Previous: D.6.10 Get_Version_Distributed_Vector Procedure
The main documentation of the Output_Distributed_Vector Procedure contains additional explanation of this code listing.
subroutine Output_Distributed_Vector (DV, First, Last, Unit, Indent)
! Input variables.
type(Distributed_Vector_type), intent(in) :: DV ! Variable to be output.
type(integer), intent(in), optional :: First ! Extents of value data
type(integer), intent(in), optional :: Last ! to be output.
type(integer), intent(in), optional :: Unit ! Output unit.
type(integer), optional :: Indent ! Indentation.
! Internal variables.
type(integer) :: Buffer_Loc ! Buffer location.
type(integer) :: Buffer_Size ! Output buffer size.
type(integer) :: Buffer_Skip ! Buffer increment.
type(integer) :: i_global, i_local ! Loop counters.
type(integer) :: A_First ! Actual first value.
type(integer) :: A_Last ! Actual last value.
type(integer) :: A_Unit ! Actual output unit.
type(integer) :: A_Indent ! Actual indentation.
type(integer) :: PE, i ! PE loop counter.
type(character,80) :: Blanks ! A line of blanks.
type(character,80) :: Name_Name ! Name of the DV.
type(character,80) :: Output_1 ! Output buffer.
type(character,80,1) :: Output_Buffer ! Output buffer vector.
type(integer) :: Version_Number ! Version of the DV.
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! Verify requirements.
VERIFY(Valid_State(DV),5) ! DV is valid.
! Set unit number.
if (PRESENT(Unit)) then
A_Unit = Unit
else
A_Unit = 6
end if
! Set indentation.
if (PRESENT(Indent)) then
A_Indent = Indent
else
A_Indent = 0
end if
Blanks = ' '
! These are evaluated on all PEs -- NOT inside an IO PE block -- because
! they contain validity checks on DV and thus require global communication.
Version_Number = Version(DV)
Name_Name = Name(DV)
! Output Identification Info.
if (this_is_IO_PE) then
write (A_Unit,100) Blanks(1:A_Indent), 'Distributed Vector Information:'
write (A_Unit,101) Blanks(1:A_Indent+2), 'Name = ', &
TRIM(Name_Name)
write (A_Unit,102) Blanks(1:A_Indent+2), 'Initialized = ', &
Initialized(DV)
write (A_Unit,103) Blanks(1:A_Indent+2), 'Version =', &
Version_Number
write (A_Unit,103) Blanks(1:A_Indent+2), 'Dimensionality =', &
DV%Dimensionality
write (A_Unit,103) Blanks(1:A_Indent+2), 'NValues_Total =', &
DV%NValues_Total
!write (A_Unit,101) 'NValues_Vector =', DV%NValues_Vector
if (NPEs <= 4) then
write (A_Unit,103) Blanks(1:A_Indent+2), 'NValues_Vector =', &
(DV%NValues_Vector(PE), PE = 1, MIN(NPEs, 4))
else
write (A_Unit,103) Blanks(1:A_Indent+2), 'NValues_Vector =', &
(DV%NValues_Vector(PE), PE = 1, 4), ','
do PE = 5, NPEs, 4
if (PE + 4 <= NPEs) then
write (A_Unit,104) Blanks(1:A_Indent+24), &
(DV%NValues_Vector(i), &
i = PE, MIN(PE+3, NPEs)), ','
else
write (A_Unit,104) Blanks(1:A_Indent+24), &
(DV%NValues_Vector(i), &
i = PE, MIN(PE+3, NPEs))
end if
end do
end if
end if
! PE-dependent info.
write (Output_1,105) Blanks(1:A_Indent+2), 'PE:', this_PE, &
', Dimensions =', DV%Dimensions
call Parallel_Write (Output_1, A_Unit)
write (Output_1,105) Blanks(1:A_Indent+2), 'PE:', this_PE, &
', NValues_PE =', DV%NValues_PE
call Parallel_Write (Output_1, A_Unit)
! Output internal structure info.
call Output (DV%Structure, A_Unit, 'Base', A_Indent+2)
! Output internal values.
if (this_is_IO_PE) then
write (A_Unit,100) Blanks(1:A_Indent), ' Internal Values:'
end if
! Set up local limits in terms of global limits.
if (PRESENT(First)) then
A_First = First
else
A_First = 1
end if
if (PRESENT(Last)) then
A_Last = Last
else
A_Last = Length_Total(DV%Structure)
end if
A_First = MAX(A_First, First_PE(DV%Structure))
A_Last = MIN(A_Last, Last_PE(DV%Structure))
! Output the values based on the dimensionality.
select case (DV%Dimensionality)
case (1)
Buffer_Size = MAX(0, (A_Last - A_First + 1))
call Initialize (Output_Buffer, Buffer_Size)
if (Buffer_Size /= 0) then
Buffer_Skip = 1
Buffer_Loc = 1
do i_global = A_First, A_Last
i_local = i_global - First_PE(DV%Structure) + 1
write (Output_Buffer(Buffer_Loc:Buffer_Loc+Buffer_Skip-1),106) &
'PE:', this_PE, ', Values1(', i_global, ') =', &
DV%Values1(i_local)
Buffer_Loc = Buffer_Loc + Buffer_Skip
end do
end if
case (2)
Buffer_Size = MAX(0, ((SIZE(DV%Values2(:,1)) + 2) / 3) &
* (A_Last - A_First + 1))
call Initialize (Output_Buffer, Buffer_Size)
if (Buffer_Size /= 0) then
Buffer_Skip = (SIZE(DV%Values2(:,1)) + 2) / 3
Buffer_Loc = 1
do i_global = A_First, A_Last
i_local = i_global - First_PE(DV%Structure) + 1
write (Output_Buffer(Buffer_Loc:Buffer_Loc+Buffer_Skip-1),106) &
'PE:', this_PE, ', Values2(:,', i_global, ') =', &
DV%Values2(:,i_local)
Buffer_Loc = Buffer_Loc + Buffer_Skip
end do
end if
case (3)
Buffer_Size = MAX(0, ((SIZE(DV%Values3(:,:,1)) + 2) / 3) &
* (A_Last - A_First + 1))
call Initialize (Output_Buffer, Buffer_Size)
if (Buffer_Size /= 0) then
Buffer_Skip = (SIZE(DV%Values3(:,:,1)) + 2) / 3
Buffer_Loc = 1
do i_global = A_First, A_Last
i_local = i_global - First_PE(DV%Structure) + 1
write (Output_Buffer(Buffer_Loc:Buffer_Loc+Buffer_Skip-1),106) &
'PE:', this_PE, ', Values3(:,:,', i_global, ') =', &
DV%Values3(:,:,i_local)
Buffer_Loc = Buffer_Loc + Buffer_Skip
end do
end if
case (4)
Buffer_Size = MAX(0, ((SIZE(DV%Values4(:,:,:,1)) + 2) / 3) &
* (A_Last - A_First + 1))
call Initialize (Output_Buffer, Buffer_Size)
if (Buffer_Size /= 0) then
Buffer_Skip = (SIZE(DV%Values4(:,:,:,1)) + 2) / 3
Buffer_Loc = 1
do i_global = A_First, A_Last
i_local = i_global - First_PE(DV%Structure) + 1
write (Output_Buffer(Buffer_Loc:Buffer_Loc+Buffer_Skip-1),106) &
'PE:', this_PE, ', Values4(:,:,:,', i_global, ') =', &
DV%Values4(:,:,:,i_local)
Buffer_Loc = Buffer_Loc + Buffer_Skip
end do
end if
! case (-1)
! Buffer_Size = MAX(0, ((SIZE(DV%ValuesRR(:,1)) + 2) / 3) &
! * (A_Last - A_First + 1))
! call Initialize (Output_Buffer, Buffer_Size)
! if (Buffer_Size /= 0) then
! Buffer_Skip = (SIZE(DV%ValuesRR(:,1)) + 2) / 3
! Buffer_Loc = 1
! do i_global = A_First, A_Last
! i_local = i_global - First_PE(DV%Structure) + 1
! write (Output_Buffer(Buffer_Loc:Buffer_Loc+Buffer_Skip-1),106) &
! 'PE:', this_PE, ', ValuesRR(:,', i_global, ') =', &
! DV%ValuesRR(:,i_local)
! Buffer_Loc = Buffer_Loc + Buffer_Skip
! end do
! end if
end select
! Add indentation.
do Buffer_loc = 1, Buffer_Size
Output_1 = Output_Buffer(Buffer_loc)
Output_Buffer(Buffer_loc) = Blanks(1:A_Indent) // Output_1
end do
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 (/, 2a, /)
101 format (3a)
102 format (2a, l2)
103 format (2a, i12, :, 3(',', i12, :), a)
104 format (a, i12, :, 3(',', i12, :), a)
105 format (2a, i5, a, i12, :, 4(',', i12, :))
106 format (2x, a, i5, a, i11, a, 1p, e13.5e3, :, &
2(',', e13.5e3, :), ',', /, &
(36x, e13.5e3, :, 2(',', e13.5e3, :), ','))
! Verify guarantees - none.
return
end subroutine Output_Distributed_Vector