Next: D.8.13 Set_Values_Collected_Array Procedure Up: D.8 Collected_Array Class Code Previous: D.8.11 Get_Version_Collected_Array Procedure
The main documentation of the Output_Collected_Array Procedure contains additional explanation of this code listing.
subroutine Output_Collected_Array (CA, One_First, One_Last, Unit)
! Input variables.
type(Collected_Array_type), intent(in) :: CA ! Variable 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_local, i_global ! Loop counter.
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 CA.
type(character,80) :: Output_1 ! Output buffer.
type(character,80,1) :: Output_Buffer ! Output buffer vector.
type(integer) :: Version_Number ! Version of the CA.
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! Verify requirements.
VERIFY(Valid_State(CA),5) ! CA 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 CA and thus require global communication.
Version_Number = Version(CA)
Name_Name = Name(CA)
! Output Identification Info.
if (this_is_IO_PE) then
write (A_Unit,100) 'Collected Array Information:'
write (A_Unit,*) ' Name = ', TRIM(Name_Name)
write (A_Unit,*) ' Locus = ', &
TRIM(Locus(CA%Many_Structure)), ' of ', &
TRIM(Locus(CA%One_Structure))
write (A_Unit,*) ' Initialized = ', Initialized(CA)
write (A_Unit,*) ' Version = ', Version_Number
write (A_Unit,*) ' Dimensionality = ', CA%Dimensionality
write (A_Unit,*) ' A_Dimensionality = ', CA%A_Dimensionality
end if
! PE-dependent info.
write (Output_1,101) 'PE:', this_PE, &
', Dimensions =', CA%Dimensions
call Parallel_Write (Output_1, A_Unit)
! Set up actual limit values for pass-through.
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(CA%One_Structure)
end if
A_One_First = MAX(A_One_First, First_PE(CA%One_Structure))
A_One_Last = MIN(A_One_Last, Last_PE(CA%One_Structure))
! Output internal structure info.
call Output (CA%Many_of_One_Index, A_One_First, A_One_Last, A_Unit, &
Indent=2)
! Output internal values.
if (this_is_IO_PE) then
write (A_Unit,100) ' Internal Values:'
end if
! Output the values based on the dimensionality.
select case (CA%Many_of_One_Index%Dimensionality)
! Vector index.
case (1)
select case (CA%Dimensionality)
case (1)
Buffer_Size = MAX(0, (A_One_Last - A_One_First + 1))
call Initialize (Output_Buffer, Buffer_Size)
if (Buffer_Size /= 0) then
Buffer_Skip = 1
Buffer_Loc = 1
do i_global = A_One_First, A_One_Last
i_local = i_global - First_PE(CA%One_Structure) + 1
write (Output_Buffer(Buffer_Loc:Buffer_Loc+Buffer_Skip-1),102) &
'PE:', this_PE, ', Values1(', i_global, ') =', &
CA%Values1(i_local)
Buffer_Loc = Buffer_Loc + Buffer_Skip
end do
end if
case (2)
Buffer_Size = MAX(0, ((SIZE(CA%Values2(:,1)) + 2) / 3) &
* (A_One_Last - A_One_First + 1))
call Initialize (Output_Buffer, Buffer_Size)
if (Buffer_Size /= 0) then
Buffer_Skip = (SIZE(CA%Values2(:,1)) + 2) / 3
Buffer_Loc = 1
do i_global = A_One_First, A_One_Last
i_local = i_global - First_PE(CA%One_Structure) + 1
write (Output_Buffer(Buffer_Loc:Buffer_Loc+Buffer_Skip-1),102) &
'PE:', this_PE, ', Values2(:,', i_global, ') =', &
CA%Values2(:,i_local)
Buffer_Loc = Buffer_Loc + Buffer_Skip
end do
end if
case (3)
Buffer_Size = MAX(0, ((SIZE(CA%Values3(:,:,1)) + 2) / 3) &
* (A_One_Last - A_One_First + 1))
call Initialize (Output_Buffer, Buffer_Size)
if (Buffer_Size /= 0) then
Buffer_Skip = (SIZE(CA%Values3(:,:,1)) + 2) / 3
Buffer_Loc = 1
do i_global = A_One_First, A_One_Last
i_local = i_global - First_PE(CA%One_Structure) + 1
write (Output_Buffer(Buffer_Loc:Buffer_Loc+Buffer_Skip-1),102) &
'PE:', this_PE, ', Values3(:,:,', i_global, ') =', &
CA%Values3(:,:,i_local)
Buffer_Loc = Buffer_Loc + Buffer_Skip
end do
end if
case (4)
Buffer_Size = MAX(0, ((SIZE(CA%Values4(:,:,:,1)) + 2) / 3) &
* (A_One_Last - A_One_First + 1))
call Initialize (Output_Buffer, Buffer_Size)
if (Buffer_Size /= 0) then
Buffer_Skip = (SIZE(CA%Values4(:,:,:,1)) + 2) / 3
Buffer_Loc = 1
do i_global = A_One_First, A_One_Last
i_local = i_global - First_PE(CA%One_Structure) + 1
write (Output_Buffer(Buffer_Loc:Buffer_Loc+Buffer_Skip-1),102) &
'PE:', this_PE, ', Values4(:,:,:,', i_global, ') =', &
CA%Values4(:,:,:,i_local)
Buffer_Loc = Buffer_Loc + Buffer_Skip
end do
end if
! case (-1)
! Buffer_Size = MAX(0, ((SIZE(CA%ValuesRR(:,1)) + 2) / 3) &
! * (A_One_Last - A_One_First + 1))
! call Initialize (Output_Buffer, Buffer_Size)
! if (Buffer_Size /= 0) then
! Buffer_Skip = (SIZE(CA%ValuesRR(:,1)) + 2) / 3
! Buffer_Loc = 1
! do i_global = A_One_First, A_One_Last
! i_local = i_global - First_PE(CA%One_Structure) + 1
! write (Output_Buffer(Buffer_Loc:Buffer_Loc+Buffer_Skip-1),102) &
! 'PE:', this_PE, ', ValuesRR(:,', i_global, ') =', &
! CA%ValuesRR(:,i_local)
! Buffer_Loc = Buffer_Loc + Buffer_Skip
! end do
! end if
end select
! Array index.
case (2)
select case (CA%Dimensionality)
case (1)
Buffer_Size = MAX(0, (A_One_Last - A_One_First + 1))
call Initialize (Output_Buffer, Buffer_Size)
if (Buffer_Size /= 0) then
Buffer_Skip = 1
Buffer_Loc = 1
do i_global = A_One_First, A_One_Last
i_local = i_global - First_PE(CA%One_Structure) + 1
write (Output_Buffer(Buffer_Loc:Buffer_Loc+Buffer_Skip-1),102) &
'PE:', this_PE, ', Values2(', i_global, ',:) =', &
CA%Values2(i_local,:)
Buffer_Loc = Buffer_Loc + Buffer_Skip
end do
end if
case (2)
Buffer_Size = MAX(0, ((SIZE(CA%Values3(:,1,:)) + 2) / 3) &
* (A_One_Last - A_One_First + 1))
call Initialize (Output_Buffer, Buffer_Size)
if (Buffer_Size /= 0) then
Buffer_Skip = (SIZE(CA%Values3(:,1,:)) + 2) / 3
Buffer_Loc = 1
do i_global = A_One_First, A_One_Last
i_local = i_global - First_PE(CA%One_Structure) + 1
write (Output_Buffer(Buffer_Loc:Buffer_Loc+Buffer_Skip-1),102) &
'PE:', this_PE, ', Values3(:,', i_global, ',:) =', &
CA%Values3(:,i_local,:)
Buffer_Loc = Buffer_Loc + Buffer_Skip
end do
end if
case (3)
Buffer_Size = MAX(0, ((SIZE(CA%Values4(:,:,1,:)) + 2) / 3) &
* (A_One_Last - A_One_First + 1))
call Initialize (Output_Buffer, Buffer_Size)
if (Buffer_Size /= 0) then
Buffer_Skip = (SIZE(CA%Values4(:,:,1,:)) + 2) / 3
Buffer_Loc = 1
do i_global = A_One_First, A_One_Last
i_local = i_global - First_PE(CA%One_Structure) + 1
write (Output_Buffer(Buffer_Loc:Buffer_Loc+Buffer_Skip-1),102) &
'PE:', this_PE, ', Values4(:,:,', i_global, ',:) =', &
CA%Values4(:,:,i_local,:)
Buffer_Loc = Buffer_Loc + Buffer_Skip
end do
end if
case (4)
Buffer_Size = MAX(0, ((SIZE(CA%Values5(:,:,:,1,:)) + 2) / 3) &
* (A_One_Last - A_One_First + 1))
call Initialize (Output_Buffer, Buffer_Size)
if (Buffer_Size /= 0) then
Buffer_Skip = (SIZE(CA%Values5(:,:,:,1,:)) + 2) / 3
Buffer_Loc = 1
do i_global = A_One_First, A_One_Last
i_local = i_global - First_PE(CA%One_Structure) + 1
write (Output_Buffer(Buffer_Loc:Buffer_Loc+Buffer_Skip-1),102) &
'PE:', this_PE, ', Values5(:,:,:,', i_global, ',:) =', &
CA%Values5(:,:,:,i_local,:)
Buffer_Loc = Buffer_Loc + Buffer_Skip
end do
end if
! case (-1)
! Buffer_Size = MAX(0, ((SIZE(CA%ValuesRR(:,1)) + 2) / 3) &
! * (A_One_Last - A_One_First + 1))
! call Initialize (Output_Buffer, Buffer_Size)
! if (Buffer_Size /= 0) then
! Buffer_Skip = (SIZE(CA%ValuesRR(:,1)) + 2) / 3
! Buffer_Loc = 1
! do i_global = A_One_First, A_One_Last
! i_local = i_global - First_PE(CA%One_Structure) + 1
! write (Output_Buffer(Buffer_Loc:Buffer_Loc+Buffer_Skip-1),102) &
! 'PE:', this_PE, ', ValuesRR(:,', i_global, ',:) =', &
! CA%ValuesRR(:,i_local)
! Buffer_Loc = Buffer_Loc + Buffer_Skip
! end do
! end if
end select
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, i5, a, i9, :, 4(',', i9, :))
102 format (2x, a, i5, a, i11, a, 1p, e13.5e3, :, &
2(',', e13.5e3, :), ',', /, &
(38x, e13.5e3, :, 2(',', e13.5e3, :), ','))
! Verify guarantees - none.
return
end subroutine Output_Collected_Array