Next: D.4.9 Data_Index Class Unit Up: D.4 Data_Index Class Code Previous: D.4.7 Initialize_Shell_Partition Procedure
The main documentation of the Output_Data_Index Procedure contains additional explanation of this code listing.
subroutine Output_Data_Index (Index, First, Last, Unit, Indent, Output_OPE)
! Input variables.
type(Data_Index_type), intent(in) :: Index ! 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), intent(in), optional :: Indent ! Indentation.
type(logical), intent(in), optional :: Output_OPE ! Output OPE toggle.
! 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(logical) :: A_Output_OPE ! Actual output OPE toggle.
type(integer) :: i, j, OPE ! Off-PE loop counters.
type(integer) :: A_Indent ! Actual indentation.
type(character,80) :: Blanks ! A line of blanks.
type(character,80) :: Output_1 ! Output buffer.
type(character,80,1) :: Output_Buffer ! Output buffer vector.
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! Verify requirements.
VERIFY(Valid_State(Index),5) ! Index 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 = ' '
! Output Identification Info.
if (this_is_IO_PE) then
write (A_Unit,100) Blanks(1:A_Indent), 'Data Index Information:'
write (A_Unit,101) Blanks(1:A_Indent+2), 'Locus = ', &
TRIM(Locus(Index%Many_Structure)), ' of ', &
TRIM(Locus(Index%One_Structure))
write (A_Unit,102) Blanks(1:A_Indent+2), 'Initialized = ', &
Initialized(Index)
write (A_Unit,103) Blanks(1:A_Indent+2), 'Dimensionality =', &
Index%Dimensionality
end if
! PE-dependent info.
write (Output_1,104) Blanks(1:A_Indent+2), 'PE:', this_PE, &
', NOff_PE =', Index%NOff_PE
call Parallel_Write (Output_1, A_Unit)
if (PRESENT(Output_OPE)) then
A_Output_OPE = Output_OPE
else
A_Output_OPE = .true.
end if
if (A_Output_OPE) then
Buffer_Size = MAX(1, (SIZE(Index%Off_PE_Index) + 3)/ 4)
call Initialize (Output_Buffer, Buffer_Size)
if (Index%NOff_PE <= 4) then
write (Output_Buffer,105) Blanks(1:A_Indent+2), 'PE:', this_PE, &
', Off_PE_Index =', &
(Index%Off_PE_Index(OPE), &
OPE = 1, MIN(Index%NOff_PE, 4))
else
write (Output_Buffer,105) Blanks(1:A_Indent+2), 'PE:', this_PE, &
', Off_PE_Index =', &
(Index%Off_PE_Index(OPE), OPE = 1, 4), ','
j = 2
do OPE = 5, Index%NOff_PE, 4
if (OPE + 4 <= Index%NOff_PE) then
write (Output_Buffer(j),106) Blanks(1:A_Indent+26), &
(Index%Off_PE_Index(i), &
i = OPE, MIN(OPE+3, Index%NOff_PE)), &
','
else
write (Output_Buffer(j),106) Blanks(1:A_Indent+26), &
(Index%Off_PE_Index(i), &
i = OPE, MIN(OPE+3, Index%NOff_PE))
end if
j = j+1
end do
end if
call Parallel_Write (Output_Buffer, A_Unit)
call Finalize (Output_Buffer)
end if
! Output internal structure info.
call Output (Index%Many_Structure, A_Unit, 'Many', A_Indent+2)
call Output (Index%One_Structure, A_Unit, 'One', A_Indent+2)
!call Output (Index%Trace, A_Unit)
!call Output (Index%Off_PE_Trace, A_Unit)
! 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(Index%One_Structure)
end if
A_First = MAX(A_First, First_PE(Index%One_Structure))
A_Last = MIN(A_Last, Last_PE(Index%One_Structure))
! Output the indices based on the dimensionality.
select case (Index%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(Index%One_Structure) + 1
write (Output_Buffer(Buffer_Loc:Buffer_Loc+Buffer_Skip-1),107) &
'PE:', this_PE, ', Index1(', i_global, ') =', &
Index%Index1(i_local)
Buffer_Loc = Buffer_Loc + Buffer_Skip
end do
end if
case (2)
Buffer_Size = MAX(0, ((SIZE(Index%Index2(1,:)) + 2) / 3) &
* (A_Last - A_First + 1))
call Initialize (Output_Buffer, Buffer_Size)
if (Buffer_Size /= 0) then
Buffer_Skip = (SIZE(Index%Index2(1,:)) + 2) / 3
Buffer_Loc = 1
do i_global = A_First, A_Last
i_local = i_global - First_PE(Index%One_Structure) + 1
write (Output_Buffer(Buffer_Loc:Buffer_Loc+Buffer_Skip-1),107) &
'PE:', this_PE, ', Index2(', i_global, ',:) =', &
Index%Index2(i_local,:)
Buffer_Loc = Buffer_Loc + Buffer_Skip
end do
end if
! case (-1)
! Buffer_Size = MAX(0, ((SIZE(Index%IndexRR(:,1)) + 2) / 3) &
! * (A_Last - A_First + 1))
! call Initialize (Output_Buffer, Buffer_Size)
! if (Buffer_Size /= 0) then
! Buffer_Skip = (SIZE(Index%IndexRR(:,1)) + 2) / 3
! Buffer_Loc = 1
! do i_global = A_First, A_Last
! i_local = i_global - First_PE(Index%Structure) + 1
! write (Output_Buffer(Buffer_Loc:Buffer_Loc+Buffer_Skip-1),107) &
! 'PE:', this_PE, ', IndexRR(:,', i_global, ') =', &
! Index%IndexRR(:,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 (5a)
102 format (2a, l2)
103 format (2a, i11)
104 format (2a, i5, a, i11, :, 4(',', i11, :))
105 format (a, a, i5, a, i11, :, 3(',', i11, :), a)
106 format (a, i11, :, 3(',', i11, :), a)
107 format (2x, a, i5, a, i11, a, i13, :, &
2(',', i13, :), ',', /, &
(35x, i13, :, 2(',', i13, :), ','))
! Verify guarantees - none.
return
end subroutine Output_Data_Index