Next: I.1.9 Dump_GMV DV and Up: I.1 Multi_Mesh Class Code Previous: I.1.7 Dump_CGNS_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