I.1.11 Dump_XMGrace DV and MV Vector Procedures

The main documentation of the Dump_XMGrace DV and MV Vector Procedures contains additional explanation of this code listing.

  define([DUMP_XMGrace_VARIABLE_ROUTINE],[
    subroutine Dump_XMGrace_$1_Vector (Variable, Mesh, Coordinate, unit, &
                                       Xmin, Xmax, Ymin, Ymax, Zmin, Zmax, &
                                       status)

      ! Input variables.

      type($1_Vector_type), intent(in) :: Variable    ! Variable to be output.
      type(Multi_Mesh_type), intent(inout) :: Mesh    ! Mesh to be output.
      type(character,1) :: Coordinate                 ! X, Y or Z (for output).
      type(integer), intent(in) :: unit               ! XMGrace output unit.
      ! Limits on the points to be output.
      type(real), intent(in) :: Xmin, Xmax, Ymin, Ymax, Zmin, Zmax

      ! Output variable.

      type(Status_type), intent(out), optional :: status ! Exit status.

      ! Internal variables.

      type(integer) :: XMGrace_Locus_Number ! XMGrace Locus: 0-Cells, 1-Nodes, 
                                            ! 2-Faces.
      type(real,2) :: Coordinates_Cells_PE  ! Coordinates of cells on the PE.
      type(real,2) :: Coordinates_Cells_Total ! Coordinates of all cells.
      type(integer) :: cell                 ! Cell number loop variable.
      type(integer) :: dim                  ! Dimension loop variable.
      type(real,1) :: Variable_PE     ! BNV of the variable on each PE.
      type(real,1) :: Variable_Total  ! BNV of the total variable on the IO_PE.
      type(Status_type) :: consolidated_status        ! Consolidated Status.
      type(Status_type), dimension(8) :: dump_status  ! Status vector.

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

      ! Verify requirements.

      VERIFY(Valid_State(Mesh),5)      ! Mesh is valid.
      VERIFY(Valid_State(Variable),5)  ! Variable is valid.

      ! Allocations and initializations.

      call Initialize (dump_status)
      call Initialize (consolidated_status)

      ! Toggle on Variable Locus to initialize temporaries.

      select case (Locus(Variable))
      case ("Cells")
        XMGrace_Locus_Number = 0
        call Initialize (Variable_PE, Mesh%NCells_PE, dump_status(1))
        call Initialize (Variable_Total, Mesh%NCells_Total, dump_status(2))
        call Initialize (Coordinates_Cells_PE, Mesh%NDimensions, &
                         Mesh%NCells_PE, dump_status(3))
        call Initialize (Coordinates_Cells_Total, Mesh%NDimensions, &
                         Mesh%NCells_Total, dump_status(4))
        call Get_Coordinates_Cells (Coordinates_Cells_PE, Mesh)
        do dim = 1, Mesh%NDimensions
          call Assemble (Coordinates_Cells_Total(dim,:), &
                         Coordinates_Cells_PE(dim,:))
        end do
      case ("Nodes")
        XMGrace_Locus_Number = 1
        call Initialize (Variable_PE, Mesh%NNodes_PE, dump_status(1))
        call Initialize (Variable_Total, Mesh%NNodes_Total, dump_status(2))
        VERIFY(.false.,1) ! Node-based variables cannot be output to XMGrace 
                          ! until a Get_Coordinates_Nodes procedure is written.
      case ("Faces")
        XMGrace_Locus_Number = 2
        call Initialize (Variable_PE, Mesh%NFaces_PE, dump_status(1))
        call Initialize (Variable_Total, Mesh%NFaces_Total, dump_status(2))
        VERIFY(.false.,1) ! Face-based variables cannot be output to XMGrace 
                          ! until the mesh is defined by faces instead of cells.
      case default
        VERIFY(.false.,1) ! XMGrace variable output is only available for 
                          ! mesh-based variables with a Locus of Cells, 
                          ! Nodes or Faces.
      end select

      ! Move data to the IO_PE and output.

      Variable_PE = Variable
      call Assemble (Variable_Total, Variable_PE)
      if (this_is_IO_PE .AND. XMGrace_Locus_Number==0) then
        write (unit,*)
        write (unit,*) '#     ', Coordinate, '          ', TRIM(Name(Variable))
        do cell = 1, Mesh%NCells_Total
          ! InInterval wouldn't work here. Not sure why, maybe explore later.
          if (Coordinates_Cells_Total(1,cell) >= Xmin .AND. &
              Coordinates_Cells_Total(1,cell) <= Xmax .AND. &
              Coordinates_Cells_Total(2,cell) >= Ymin .AND. &
              Coordinates_Cells_Total(2,cell) <= Ymax .AND. &
              Coordinates_Cells_Total(3,cell) >= Zmin .AND. &
              Coordinates_Cells_Total(3,cell) <= Zmax) then
            select case (Coordinate)
            case ("X")
              write (unit,*) Coordinates_Cells_Total(1,cell), &
                             Variable_Total(cell)
            case ("Y")
              write (unit,*) Coordinates_Cells_Total(2,cell), &
                             Variable_Total(cell)
            case ("Z")
              write (unit,*) Coordinates_Cells_Total(3,cell), &
                             Variable_Total(cell)
            end select
          end if
        end do
      end if

      ! Clean up temporary vectors.

      call Finalize (Variable_PE, dump_status(5))
      call Finalize (Variable_Total, dump_status(6))
      if (XMGrace_Locus_Number==0) then
        call Finalize (Coordinates_Cells_PE, dump_status(7))
        call Finalize (Coordinates_Cells_Total, dump_status(8))
      end if

      ! Consolidate and handle status.

      consolidated_status = dump_status
      if (PRESENT(status)) then
        WARN_IF(Error(consolidated_status), 5)
        status = consolidated_status
      else
        VERIFY(Normal(consolidated_status), 5)
      end if
      call Finalize (consolidated_status)
      call Finalize (dump_status)

      ! Verify guarantees - none.

      return
    end subroutine Dump_XMGrace_$1_Vector
  ])
  fortext([Type], [Mathematic Distributed],[
    DUMP_XMGrace_VARIABLE_ROUTINE(Type)
  ])