D.3.8 Output_Base_Structure Procedure

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

  subroutine Output_Base_Structure (Structure, Unit, Type, Indent)

    ! Input variables.

    type(Base_Structure_type), intent(in) :: Structure ! Output Variable.
    type(integer), intent(in), optional :: Unit        ! Output unit.
    type(character,*), optional :: Type                ! Structure type.
    type(integer), optional :: Indent                  ! Indentation.

    ! Internal variables.

    type(integer) :: A_Unit                            ! Actual output unit.
    type(character,80) :: A_Type                       ! Actual structure type.
    type(integer) :: A_Indent                          ! Actual indentation.
    type(integer) :: PE, i                             ! PE loop counter.
    type(character,80) :: Blanks                       ! A line of blanks.
    type(character,80) :: Output_Buffer                ! Output buffer.

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

    ! Verify requirements.

    VERIFY(Valid_State(Structure),5)      ! Structure 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 = ' '
     
    ! Only output on the IO PE.

    if (this_is_IO_PE) then

      ! Set structure type.
     
      if (PRESENT(Type)) then
        A_Type = Type
      else
        A_Type = 'Base'
      end if
     
      ! Output Identification Info.

      write (A_Unit,100) Blanks(1:A_Indent), TRIM(A_Type), &
                         ' Structure Information:'
      write (A_Unit,101) Blanks(1:A_Indent+2), 'Locus               = ', &
                         TRIM(Structure%Locus)
      write (A_Unit,102) Blanks(1:A_Indent+2), 'Initialized         = ', &
                         Initialized(Structure)
      write (A_Unit,103) Blanks(1:A_Indent+2), 'Length_Total        =', &
                         Structure%Length_Total
      if (NPEs <= 4) then
        write (A_Unit,103) Blanks(1:A_Indent+2), 'Length_Vector       =', &
                           (Structure%Length_Vector(PE), PE = 1, MIN(NPEs, 4))
      else
        write (A_Unit,103) Blanks(1:A_Indent+2), 'Length_Vector       =', &
                           (Structure%Length_Vector(PE), PE = 1, 4), ','
        do PE = 5, NPEs, 4
          if (PE + 4 <= NPEs) then 
            write (A_Unit,104) Blanks(1:A_Indent+23), &
                               (Structure%Length_Vector(i), &
                               i = PE, MIN(PE+3, NPEs)), ','
          else
            write (A_Unit,104) Blanks(1:A_Indent+23), &
                               (Structure%Length_Vector(i), &
                               i = PE, MIN(PE+3, NPEs))
          end if
        end do
      end if
    end if

    ! PE-dependent output.

    write (Output_Buffer,105) Blanks(1:A_Indent+2), 'PE:', this_PE, &
                              ', Length_PE =', Structure%Length_PE, &
                              ', Range_PE = (', Structure%Range_PE, ')'
    call Parallel_Write (Output_Buffer, A_Unit)

    ! Format statements. With these formats, this should work up to
    ! (10^6 - 1) PEs and (10^12 - 1) items / PE.

100 format (/, 3a, /)
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, a, i12, ',', i12, a)

    ! Verify guarantees - none.

    return
  end subroutine Output_Base_Structure