D.7.11 Output_Overlapped_Vector Procedure

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

  subroutine Output_Overlapped_Vector (OV, Many_First, Many_Last, One_First, &
                                       One_Last, Unit)

    ! Input variables.

    type(Overlapped_Vector_type), intent(in) :: OV    ! Variable to be output.
    type(integer), intent(in), optional :: Many_First ! Extents of many value 
    type(integer), intent(in), optional :: Many_Last  !   data 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                              ! Loop counter.
    type(integer) :: A_Many_First                   ! Actual many first value.
    type(integer) :: A_Many_Last                    ! Actual many last value.
    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 OV.
    type(character,80) :: Output_1                  ! Output buffer.
    type(character,80,1) :: Output_Buffer           ! Output buffer vector.
    type(integer) :: Version_Number                 ! Version of the OV.

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

    ! Verify requirements.

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

    Version_Number = Version(OV)
    Name_Name = Name(OV)

    ! Output Identification Info.

    if (this_is_IO_PE) then
      write (A_Unit,100) 'Overlapped Vector Information:'
      write (A_Unit,*) ' Name                    = ', TRIM(Name_Name)
      write (A_Unit,*) ' Locus                   = ', &
                       TRIM(Locus(OV%Many_Structure)), ' of ', &
                       TRIM(Locus(OV%One_Structure))
      write (A_Unit,*) ' Initialized             = ', Initialized(OV)
      write (A_Unit,*) ' Version                 = ', Version_Number
      write (A_Unit,*) ' Internal DV             = ', &
                       Initialized(OV%DV_Internal)
      write (A_Unit,*) ' Dimensionality          = ', OV%Dimensionality
    end if

    ! PE-dependent info.

    Buffer_Size = MAX(1, (SIZE(OV%Overlap_Index) + 3)/ 4)
    call Initialize (Output_Buffer, Buffer_Size)

    write (Output_1,102) 'PE:', this_PE, &
                         ', Dimensions    =', OV%Dimensions
    call Parallel_Write (Output_1, A_Unit)

    !write (Output_Buffer(1),102) 'PE:', this_PE, &
    !                             ', NOff_PE =', OV%NOff_PE
    !call Parallel_Write (Output_Buffer(1), A_Unit)
    write (Output_Buffer,104) 'PE:', this_PE, &
                              ', Overlap_Index =', OV%Overlap_Index
    call Parallel_Write (Output_Buffer, A_Unit)

    call Finalize (Output_Buffer)

    ! Set up actual limit values for pass-through.

    if (PRESENT(Many_First)) then
      A_Many_First = Many_First
    else
      A_Many_First = 1
    end if
    if (PRESENT(Many_Last)) then
      A_Many_Last = Many_Last
    else
      A_Many_Last = Length_Total(OV%Many_Structure)
    end if
    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(OV%One_Structure)
    end if

    ! Output internal structure info.

    call Output (OV%DV, A_Many_First, A_Many_Last, A_Unit, Indent=2)
    call Output (OV%Many_of_One_Index, A_One_First, A_One_Last, A_Unit, &
                 Indent=2)
    !call Output (OV%Trace, A_Unit)
    !call Output (OV%Off_PE_Trace, A_Unit)

    ! Output internal values.

    if (this_is_IO_PE) then
      write (A_Unit,100) '  Internal Overlap Values:'
    end if

    ! Output the values based on the dimensionality.
    ! (In the future, I could limit this with the First and Last limits above,
    ! but for now, just output the whole thing.)
    
    select case (OV%Dimensionality)
    case (1)
      Buffer_Size = MAX(0, OV%Many_of_One_Index%NOff_PE)
      call Initialize (Output_Buffer, Buffer_Size)
      if (Buffer_Size /= 0) then
        Buffer_Skip = 1
        Buffer_Loc = 1
        do i = 1, OV%Many_of_One_Index%NOff_PE
          write (Output_Buffer(Buffer_Loc:Buffer_Loc+Buffer_Skip-1),103) &
            'PE:', this_PE, ', O_Values1(', i, ') =', &
            OV%Overlap_Values1(i)
          Buffer_Loc = Buffer_Loc + Buffer_Skip
        end do
      end if
    case (2)
      Buffer_Size = MAX(0, ((SIZE(OV%Overlap_Values2(:,1)) + 2) / 3) &
                    * OV%Many_of_One_Index%NOff_PE)
      call Initialize (Output_Buffer, Buffer_Size)
      if (Buffer_Size /= 0) then
        Buffer_Skip = (SIZE(OV%Overlap_Values2(:,1)) + 2) / 3
        Buffer_Loc = 1
        do i = 1, OV%Many_of_One_Index%NOff_PE
          write (Output_Buffer(Buffer_Loc:Buffer_Loc+Buffer_Skip-1),103) &
            'PE:', this_PE, ', O_Values2(:,', i, ') =', &
            OV%Overlap_Values2(:,i)
          Buffer_Loc = Buffer_Loc + Buffer_Skip
        end do
      end if
    case (3)
      Buffer_Size = MAX(0, ((SIZE(OV%Overlap_Values3(:,:,1)) + 2) / 3) &
                    * OV%Many_of_One_Index%NOff_PE)
      call Initialize (Output_Buffer, Buffer_Size)
      if (Buffer_Size /= 0) then
        Buffer_Skip = (SIZE(OV%Overlap_Values3(:,:,1)) + 2) / 3
        Buffer_Loc = 1
        do i = 1, OV%Many_of_One_Index%NOff_PE
          write (Output_Buffer(Buffer_Loc:Buffer_Loc+Buffer_Skip-1),103) &
            'PE:', this_PE, ', O_Values3(:,:,', i, ') =', &
            OV%Overlap_Values3(:,:,i)
          Buffer_Loc = Buffer_Loc + Buffer_Skip
        end do
      end if
    case (4)
      Buffer_Size = MAX(0, ((SIZE(OV%Overlap_Values4(:,:,:,1)) + 2) / 3) &
                    * OV%Many_of_One_Index%NOff_PE)
      call Initialize (Output_Buffer, Buffer_Size)
      if (Buffer_Size /= 0) then
        Buffer_Skip = (SIZE(OV%Overlap_Values4(:,:,:,1)) + 2) / 3
        Buffer_Loc = 1
        do i = 1, OV%Many_of_One_Index%NOff_PE
          write (Output_Buffer(Buffer_Loc:Buffer_Loc+Buffer_Skip-1),103) &
            'PE:', this_PE, ', O_Values4(:,:,:,', i, ') =', &
            OV%Overlap_Values4(:,:,:,i)
          Buffer_Loc = Buffer_Loc + Buffer_Skip
        end do
      end if
!    case (-1)
!      Buffer_Size = MAX(0, ((SIZE(OV%Overlap_ValuesRR(:,1)) + 2) / 3) &
!                    * OV%Many_of_One_Index%NOff_PE)
!      call Initialize (Output_Buffer, Buffer_Size)
!      if (Buffer_Size /= 0) then
!        Buffer_Skip = (SIZE(OV%Overlap_ValuesRR(:,1)) + 2) / 3
!        Buffer_Loc = 1
!        do i = 1, OV%Many_of_One_Index%NOff_PE
!          write (Output_Buffer(Buffer_Loc:Buffer_Loc+Buffer_Skip-1),103) &
!            'PE:', this_PE, ', O_ValuesRR(:,', i, ') =', &
!            OV%Overlap_ValuesRR(:,i)
!          Buffer_Loc = Buffer_Loc + Buffer_Skip
!        end do
!      end if
    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, i11, :, 3(',', i11, :), ',', /, &
            (24x, i11, :, 3(',', i11, :), ','))
102 format (2x, a, i5, a, i11, :, 4(',', i11, :))
103 format (2x, a, i5, a, i11, a, 1p, e13.5e3, :, &
            2(',', e13.5e3, :), ',', /, &
            (38x, e13.5e3, :, 2(',', e13.5e3, :), ','))
104 format (2x, a, i5, a, i11, :, &
            3(',', i11, :), ',', /, &
            (27x, i11, :, 3(',', i11, :), ','))

    ! Verify guarantees - none.

    return
  end subroutine Output_Overlapped_Vector



Michael L. Hall