G.1.11 Output_Mathematic_Vector Procedure

The main documentation of the Output_Mathematic_Vector Procedure contains additional explanation of this code listing.

  subroutine Output_Mathematic_Vector (MV, First, Last, Unit, Indent)

    ! Input variables.

    ! Variable to be output.
    type(Mathematic_Vector_type), intent(inout) :: MV 
    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(character,80) :: Blanks                     ! A line of blanks.
    type(character,80) :: MV_Name                    ! Name of the MV.
    type(character,80) :: Output_1                   ! Output buffer.
    type(character,80,1) :: Output_Buffer            ! Output buffer vector.
    type(real) :: MV_Average, MV_Infinity_Norm, &    ! Get Value variables.
                  MV_Maximum, MV_Minimum, &
                  MV_One_Norm, MV_P_Norm, MV_Sum, &
                  MV_Two_Norm

    !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    ! Verify requirements.

    VERIFY(Valid_State(MV),5)      ! MV 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 MV and thus require global communication.

    MV_Name = Name(MV)
    MV_Average = Average(MV)
    MV_Infinity_Norm = Infinity_Norm(MV)
    MV_Maximum = Maximum(MV)
    MV_Minimum = Minimum(MV)
    MV_One_Norm = One_Norm(MV)
    MV_P_Norm = P_Norm(MV, MV%P_Norm_Exponent)
    MV_Sum = Sum(MV)
    MV_Two_Norm = Two_Norm(MV)

    ! Output Identification Info.

    if (this_is_IO_PE) then
      write (A_Unit,100) Blanks(1:A_Indent), 'Mathematic Vector Information:'
      write (A_Unit,101) Blanks(1:A_Indent+2), 'Name                 = ', &
                         TRIM(MV_Name)
      write (A_Unit,102) Blanks(1:A_Indent+2), 'Initialized          = ', &
                         Initialized(MV)
      write (A_Unit,103) Blanks(1:A_Indent+2), 'Dimensionality       =', &
                         MV%Dimensionality
      write (A_Unit,104) Blanks(1:A_Indent+2), 'Average              =', &
                         MV_Average
      write (A_Unit,104) Blanks(1:A_Indent+2), 'Maximum              =', &
                         MV_Maximum
      write (A_Unit,104) Blanks(1:A_Indent+2), 'Minimum              =', &
                         MV_Minimum
      write (A_Unit,104) Blanks(1:A_Indent+2), 'Sum                  =', &
                         MV_Sum
      write (A_Unit,104) Blanks(1:A_Indent+2), 'Infinity_Norm        =', &
                         MV_Infinity_Norm
      write (A_Unit,104) Blanks(1:A_Indent+2), 'One_Norm             =', &
                         MV_One_Norm
      write (A_Unit,104) Blanks(1:A_Indent+2), 'Two_Norm             =', &
                         MV_Two_Norm
      write (A_Unit,103) Blanks(1:A_Indent+2), 'P_Norm_Exponent      =', &
                         MV%P_Norm_Exponent
      write (A_Unit,104) Blanks(1:A_Indent+2), 'P_Norm               =', &
                         MV_P_Norm
    end if

    ! Output internal structure info.

    call Output (MV%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(MV%Structure)
    end if
    A_First = MAX(A_First, First_PE(MV%Structure))
    A_Last = MIN(A_Last, Last_PE(MV%Structure))

    ! Output the values.
    
    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(MV%Structure) + 1
        write (Output_Buffer(Buffer_Loc:Buffer_Loc+Buffer_Skip-1),105) &
          'PE:', this_PE, ', Values(', i_global, ') =', &
          MV%Values(i_local)
        Buffer_Loc = Buffer_Loc + Buffer_Skip
      end do
    end if

    ! 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 (2a, 1p, e13.5e3)
105 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_Mathematic_Vector