Next: G.2.11 Read_Harwell_Boeing_ELL_Matrix Procedure Up: G.2 ELL_Matrix Class Code Previous: G.2.9 MatVec_ELL_Matrix Procedure
The main documentation of the Output_ELL_Matrix Procedure contains additional explanation of this code listing.
subroutine Output_ELL_Matrix (ELLM, Row_First, Row_Last, Unit, Indent)
! Input variables.
! Variable to be output.
type(ELL_Matrix_type), intent(inout) :: ELLM
type(integer), intent(in), optional :: Row_First ! Extents of value data
type(integer), intent(in), optional :: Row_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_Row_First ! Actual first row value.
type(integer) :: A_Row_Last ! Actual last row value.
type(integer) :: A_Unit ! Actual output unit.
type(integer) :: A_Indent ! Actual indentation.
type(character,80) :: Blanks ! A line of blanks.
type(character,80) :: ELLM_Name ! Name of the ELLM.
type(character,80) :: Output_1 ! Output buffer.
type(character,80,1) :: Output_Buffer ! Output buffer vector.
type(real) :: ELLM_Average, ELLM_Frobenius_Norm, & ! Get Value variables.
ELLM_Infinity_Norm, ELLM_Maximum, &
ELLM_Minimum, ELLM_One_Norm, &
ELLM_Sum, ELLM_Two_Norm_Estimate
type(real), dimension(2) :: ELLM_Two_Norm_Range
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! Verify requirements.
VERIFY(Valid_State(ELLM),5) ! ELLM 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 ELLM and thus require
! global communication.
ELLM_Name = Name(ELLM)
ELLM_Average = Average(ELLM)
ELLM_Infinity_Norm = Infinity_Norm(ELLM)
ELLM_Maximum = Maximum(ELLM)
ELLM_Minimum = Minimum(ELLM)
ELLM_One_Norm = One_Norm(ELLM)
ELLM_Frobenius_Norm = Frobenius_Norm(ELLM)
ELLM_Sum = Sum(ELLM)
ELLM_Two_Norm_Estimate = Two_Norm_Estimate(ELLM)
ELLM_Two_Norm_Range = Two_Norm_Range(ELLM)
! Output Identification Info.
if (this_is_IO_PE) then
write (A_Unit,100) Blanks(1:A_Indent), 'ELL Matrix Information:'
write (A_Unit,101) Blanks(1:A_Indent+2), 'Name = ', &
TRIM(ELLM_Name)
write (A_Unit,102) Blanks(1:A_Indent+2), 'Initialized = ', &
Initialized(ELLM)
write (A_Unit,103) Blanks(1:A_Indent+2), 'Dimensionality =', &
ELLM%Dimensionality
write (A_Unit,103) Blanks(1:A_Indent+2), 'Max_Nonzeros =', &
ELLM%Max_Nonzeros
write (A_Unit,104) Blanks(1:A_Indent+2), 'Average =', &
ELLM_Average
write (A_Unit,104) Blanks(1:A_Indent+2), 'Maximum =', &
ELLM_Maximum
write (A_Unit,104) Blanks(1:A_Indent+2), 'Minimum =', &
ELLM_Minimum
write (A_Unit,104) Blanks(1:A_Indent+2), 'Sum =', &
ELLM_Sum
write (A_Unit,104) Blanks(1:A_Indent+2), 'Infinity_Norm =', &
ELLM_Infinity_Norm
write (A_Unit,104) Blanks(1:A_Indent+2), 'One_Norm =', &
ELLM_One_Norm
write (A_Unit,104) Blanks(1:A_Indent+2), 'Two_Norm_Estimate =', &
ELLM_Two_Norm_Estimate
write (A_Unit,105) Blanks(1:A_Indent+2), 'Two_Norm_Range =', &
ELLM_Two_Norm_Range
write (A_Unit,104) Blanks(1:A_Indent+2), 'Frobenius_Norm =', &
ELLM_Frobenius_Norm
end if
! Output internal structure info.
call Output (ELLM%Row_Structure, A_Unit, 'Row', A_Indent+2)
call Output (ELLM%Column_Structure, A_Unit, 'Column', 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(Row_First)) then
A_Row_First = Row_First
else
A_Row_First = 1
end if
if (PRESENT(Row_Last)) then
A_Row_Last = Row_Last
else
A_Row_Last = Length_Total(ELLM%Row_Structure)
end if
A_Row_First = MAX(A_Row_First, First_PE(ELLM%Row_Structure))
A_Row_Last = MIN(A_Row_Last, Last_PE(ELLM%Row_Structure))
! Output Values.
Buffer_Size = MAX(0, ((ELLM%Max_Nonzeros + 2) / 3) &
* (A_Row_Last - A_Row_First + 1))
call Initialize (Output_Buffer, Buffer_Size)
if (Buffer_Size /= 0) then
Buffer_Skip = (ELLM%Max_Nonzeros + 2) / 3
Buffer_Loc = 1
do i_global = A_Row_First, A_Row_Last
i_local = i_global - First_PE(ELLM%Row_Structure) + 1
write (Output_Buffer(Buffer_Loc:Buffer_Loc+Buffer_Skip-1),106) &
'PE:', this_PE, ', Values(', i_global, ',:) =', &
ELLM%Values(i_local,:)
Buffer_Loc = Buffer_Loc + Buffer_Skip
end do
end if
! Add indentation and output.
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)
! Output Columns.
if (this_is_IO_PE) then
write (A_Unit,*) ' '
end if
if (Buffer_Size /= 0) then
Buffer_Skip = (ELLM%Max_Nonzeros + 2) / 3
Buffer_Loc = 1
do i_global = A_Row_First, A_Row_Last
i_local = i_global - First_PE(ELLM%Row_Structure) + 1
write (Output_Buffer(Buffer_Loc:Buffer_Loc+Buffer_Skip-1),107) &
'PE:', this_PE, ', Columns(', i_global, ',:) =', &
ELLM%Columns(i_local,:)
Buffer_Loc = Buffer_Loc + Buffer_Skip
end do
end if
! Add indentation and output.
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)
! Clean up.
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 (2a, ' ', 1p, e13.5e3)
105 format (2a, ' (', 1p, e13.5e3, ',', e13.5e3, ')')
106 format (2x, a, i5, a, i12, a, 1p, e13.5e3, :, &
2(',', e13.5e3, :), ',', /, &
(36x, e13.5e3, :, 2(',', e13.5e3, :), ','))
107 format (2x, a, i5, a, i11, a, i13, :, &
2(',', i13, :), ',', /, &
(36x, i13, :, 2(',', i13, :), ','))
! Verify guarantees - none.
return
end subroutine Output_ELL_Matrix