I.1.8 Dump_GMV_Multi_Mesh Procedure

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

  ! Set number of Mathematic Vectors and Distributed Vectors allowed
  ! in the call line. This can be changed here and it will change all 
  ! necessary code to match. This makes use of the replicate m4 macros.
  ! Setting this to a number greater than 6 triggers errors on compilers 
  ! that limit lines to 132 characters (like Absoft).

  include(replicate.m4)
  define(REP_NUMBER, 6)

  subroutine Dump_GMV_Multi_Mesh (Filename, Mesh &
    REP_ARGS([Variable[]i[]_MV]) &
    REP_ARGS([Variable[]i[]_DV]) &
    , status)

    ! Input variables.

    type(Multi_Mesh_type), intent(in) :: Mesh       ! Mesh to be output.
    type(character,*), intent(in) :: Filename       ! Output filename.
    ! Output Mathematic_Vector variables.
    REP_DECLARE([type(Mathematic_Vector_type), optional], [Variable[]i[]_MV])
    ! Output Distributed_Vector variables.
    REP_DECLARE([type(Distributed_Vector_type), optional], [Variable[]i[]_DV])

    ! Output variable.

    type(Status_type), optional :: status           ! Consolidated Status.

    ! Internal variables.

    type(integer) :: GMV_Status                     ! GMV file open status.
    type(integer) :: unit                           ! GMV output unit.
    type(integer) :: cell, node                     ! Loop parameters.

    type(Assembled_Vector_type) :: Coordinates_Nodes_AV ! Node Coordinates AV.
    type(real,2) :: Coordinates_Nodes_BNV             ! Node Coordinates BNV.
    ! Values from the Nodes_of_Cells_Index for this PE.
    type(integer,2) :: Nodes_of_Cells_Index_Val_PE
    ! Values from the Nodes_of_Cells_Index for all PEs.
    type(integer,2) :: Nodes_of_Cells_Index_Val_Total
    type(integer) :: Index_Size
    ! Status vector.
    type(Status_type), dimension(10+2*REP_NUMBER) :: dump_status
    type(Status_type) :: consolidated_status           ! Consolidated Status.
    ifelse(COMPILER, Lahey, [
      type(character,256) :: Error_Message ! String for compiler error message.
    ])

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

    ! Verify requirements.

    VERIFY(Valid_State(Mesh),5)      ! Mesh is valid.
    ! Variable#_(DV|MV) is valid.
    define([VERIFY_VARIABLE],[
      if (PRESENT(Variable$1_$2)) then
        VERIFY(Valid_State(Variable$1_$2),5)
      end if
    ])
    fortext([Type], [DV MV], [
      forloop([Var],[1],[REP_NUMBER],[
        VERIFY_VARIABLE(Var,Type)
      ])
    ])

    ! Allocations and initializations.

    call Initialize (dump_status)
    call Initialize (consolidated_status)

    ! Open GMV file for writing.

    unit = 19
    if (this_is_IO_PE) then
      open (UNIT=unit, FILE=Filename, STATUS='new', IOSTAT=GMV_Status)
    end if
    call Broadcast (GMV_Status)
    if (GMV_Status > 0) then
      if (this_is_IO_PE) then
        ifelse(COMPILER, Lahey, [
          call IOSTAT_MSG (GMV_Status, Error_Message)
          write (6,*) 'Dump_GMV_Multi_Mesh: IOSTAT message = ', &
                       TRIM(Error_Message)
        ])
        write (6,*) 'Dump_GMV_Multi_Mesh: GMV_Status = ', GMV_Status
        write (6,*) 'Dump_GMV_Multi_Mesh: File open error -- ', &
                    'requested GMV file may already exist.'
      end if
      dump_status(1) = 'File Error'
    end if

    ! Write GMV header.

    if (this_is_IO_PE) write (unit,100) 'gmvinput ascii'

    ! Write GMV node coordinates after assembling on the IO PE.

    call Initialize (Coordinates_Nodes_AV, Mesh%Node_Structure, &
                     2, 'Coordinates of Nodes', dump_status(2), &
                     Mesh%NDimensions) 
    call Initialize (Coordinates_Nodes_BNV, Mesh%NDimensions, &
                     Mesh%NNodes_total, dump_status(3))
    Coordinates_Nodes_AV = Mesh%Coordinates_Nodes_DV
    Coordinates_Nodes_BNV = Coordinates_Nodes_AV
    if (this_is_IO_PE) then
      write (unit,100) 'nodev ', Mesh%NNodes_total
      select case (Mesh%NDimensions)
      case (1)
        do node = 1, Mesh%NNodes_total
          write (unit,101) Coordinates_Nodes_BNV(:,node), zero, zero
        end do
      case (2)
        do node = 1, Mesh%NNodes_total
          write (unit,101) Coordinates_Nodes_BNV(:,node), zero
        end do
      case (3)
        do node = 1, Mesh%NNodes_total
          write (unit,101) Coordinates_Nodes_BNV(:,node)
        end do
      end select
    end if
    call Finalize (Coordinates_Nodes_BNV, dump_status(4))
    call Finalize (Coordinates_Nodes_AV, dump_status(5))

    ! Write GMV Cell Connectivity after assembling on the IO PE.

    if (this_is_IO_PE) then
      Index_Size = Mesh%NCells_total
    else
      Index_Size = 0
    end if
    call Initialize (Nodes_of_Cells_Index_Val_PE, Mesh%NCells_PE, &
                     Mesh%Nodes_per_Cell, dump_status(6))
    call Initialize (Nodes_of_Cells_Index_Val_Total, Index_Size, &
                     Mesh%Nodes_per_Cell, dump_status(7))
    Nodes_of_Cells_Index_Val_PE = Mesh%Nodes_of_Cells_Index
    do node = 1, Mesh%Nodes_per_Cell
      call Assemble (Nodes_of_Cells_Index_Val_Total(:,node), &
                     Nodes_of_Cells_Index_Val_PE(:,node))
    end do
    if (this_is_IO_PE) then
      write (unit,100) 'cells ', Mesh%NCells_total
      do cell = 1, Mesh%NCells_total
        select case (Mesh%Shape)
        case ('Segmented')
          write (unit,100) 'line 2 ', Nodes_of_Cells_Index_Val_Total(cell,:)
        case ('Triangular')
          ! Numbering must be counter-clockwise for GMV.
          write (unit,100) 'tri 3 ', Nodes_of_Cells_Index_Val_Total(cell,:)
        case ('Quadrilateral')
          ! Numbering must be counter-clockwise for GMV.
          write (unit,100) 'quad 4 ', &
                           Nodes_of_Cells_Index_Val_Total(cell,1), &
                           Nodes_of_Cells_Index_Val_Total(cell,2), &
                           Nodes_of_Cells_Index_Val_Total(cell,4), &
                           Nodes_of_Cells_Index_Val_Total(cell,3)
        case ('Polygonal')
          VERIFY(.false.,0)   ! Not implemented yet.  
        case ('Tetrahedral')
          ! An ordering is specified in the GMV docs. Not sure if
          ! to-be-implemented ordering in Caesar will comply.
          write (unit,100) 'tet 4 ', &
                           Nodes_of_Cells_Index_Val_Total(cell,:)
        case ('Hexahedral')
          ! GMV uses alternate node ordering.
          write (unit,100) 'hex 8 ', &
                           Nodes_of_Cells_Index_Val_Total(cell,1), &
                           Nodes_of_Cells_Index_Val_Total(cell,2), &
                           Nodes_of_Cells_Index_Val_Total(cell,4), &
                           Nodes_of_Cells_Index_Val_Total(cell,3), &
                           Nodes_of_Cells_Index_Val_Total(cell,5), &
                           Nodes_of_Cells_Index_Val_Total(cell,6), &
                           Nodes_of_Cells_Index_Val_Total(cell,8), &
                           Nodes_of_Cells_Index_Val_Total(cell,7)
        case ('Polyhedral')
          VERIFY(.false.,0)   ! Not implemented yet.  
        end select
      end do
    end if
    call Finalize (Nodes_of_Cells_Index_Val_PE, dump_status(8))
    call Finalize (Nodes_of_Cells_Index_Val_Total, dump_status(9))

    ! Write out variables.

    if (this_is_IO_PE) write (unit,100) 'variable'

    define([CALL_DUMP_GMV_VARIABLE],[
      pushdef([TYPE], [$2])
      ifelse(TYPE, [Mathematic], [
        pushdef([VARIABLE], [Variable$1_MV])
        pushdef([DUMPNUMBER], [10+$1])
      ],[
        pushdef([VARIABLE], [Variable$1_DV])
        pushdef([DUMPNUMBER], [10+REP_NUMBER+$1])
      ])
      pushdef([Dump_GMV_TYPE_Vector], expand(Dump_GMV_TYPE_Vector))
      if (PRESENT(VARIABLE)) then
        call Dump_GMV_TYPE_Vector (VARIABLE, Mesh, unit, &
                                   dump_status(DUMPNUMBER))
      end if
      popdef([Dump_GMV_TYPE_Vector])
      popdef([DUMPNUMBER])
      popdef([VARIABLE])
      popdef([TYPE])
    ])
    fortext([Type], [Mathematic Distributed], [
      forloop([Var],[1],[REP_NUMBER],[
        CALL_DUMP_GMV_VARIABLE(Var,Type)
      ])
    ])

    if (this_is_IO_PE) write (unit,100) 'endvars'

    ! Write GMV closing statement and close GMV file.

    if (this_is_IO_PE) then
      write (unit,100) 'endgmv'
      close (UNIT=unit, IOSTAT=GMV_Status)
    end if
    call Broadcast (GMV_Status)
    if (GMV_Status > 0) dump_status(10) = 'File Error'

    ! 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)

    ! Format statements.

100 format (a,5(:,i11))
101 format ((1pg15.8,4(:,1pg16.8)))

    ! Verify guarantees - none.
  
    return
  end subroutine Dump_GMV_Multi_Mesh



Michael L. Hall