Next: I.1.8 Dump_GMV_Multi_Mesh Procedure Up: I.1 Multi_Mesh Class Code Previous: I.1.6 Initialized_Multi_Mesh Procedure
The main documentation of the Dump_CGNS_Multi_Mesh Procedure contains additional explanation of this code listing.
ifdef([USE_CGNSLIB],[
subroutine Dump_CGNS_Multi_Mesh (Mesh, Filename, status)
! Input variables.
type(Multi_Mesh_type), intent(in) :: Mesh ! Mesh to be output.
type(character,*), intent(in) :: Filename ! Output filename.
! Output variable.
type(Status_type), optional :: status ! Consolidated Status.
! Internal variables.
type(integer) :: CGNS_Base_Index ! CGNS base index number.
type(integer) :: CGNS_File_Index ! CGNS file index number.
type(integer) :: CGNS_Zone_Index ! CGNS zone index number.
type(integer) :: CGNS_Status ! CGNS status.
type(Status_type) :: consolidated_status ! Consolidated Status.
type(character,10), dimension(3) :: Coordinate_Name ! Coordinate names.
type(Status_type), dimension(13) :: dump_status ! Status vector.
type(integer) :: Element_Type ! Element type number.
type(integer) :: Section_Number ! Section number.
! Included CGNS setup file.
include (../../../external/CGNSLib/cgnslib_f.h)
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! Verify requirements.
VERIFY(Valid_State(Mesh),5) ! Mesh is valid.
! Allocations and initializations.
call Initialize (dump_status)
call Initialize (consolidated_status)
! Open CGNS file for writing, get CGNS_File_Index.
if (this_is_IO_PE) then
call CG_Open_f (Filename, MODE_WRITE, CGNS_File_Index, CGNS_Status)
end if
if (CGNS_Status == ERROR) dump_status(1) = 'CGNS Error'
! Write CGNS Base information (dimensionality info), get CGNS_Base_Index.
if (this_is_IO_PE) then
call CG_Base_Write_f (CGNS_File_Index, 'Caesar Base', &
Mesh%NDimensions, Mesh%NDimensions, &
CGNS_Base_Index, CGNS_Status)
end if
if (CGNS_Status == ERROR) dump_status(2) = 'CGNS Error'
! ### Add if-check on "structured" here eventually.
! Write CGNS Zone information (mesh dimension info), get CGNS_Zone_Index.
if (this_is_IO_PE) then
call CG_Zone_Write_f (CGNS_File_Index, CGNS_Base_Index, Name_Name, &
(/ Mesh%NNodes_total, Mesh%NCells_total, 0 /), &
Unstructured, CGNS_Zone_Index, CGNS_Status)
end if
if (CGNS_Status == ERROR) dump_status(3) = 'CGNS Error'
! Define Coordinate Names.
if (Mesh%Geometry == 'Cartesian') then
Coordinate_Name(1) = 'CoordinateX'
Coordinate_Name(2) = 'CoordinateY'
Coordinate_Name(3) = 'CoordinateZ'
else if (Mesh%Geometry == 'Cylindrical') then
Coordinate_Name(1) = 'CoordinateR'
Coordinate_Name(2) = 'CoordinateZ'
else if (Mesh%Geometry == 'Spherical') then
Coordinate_Name(1) = 'CoordinateR'
end if
! Define DataType parameter.
ifdef([SINGLE],[
define([CGNS_DataType],[RealSingle])
],[
define([CGNS_DataType],[RealDouble])
])
! Write CGNS Zone coordinates (node coordinates),
! after assembling on the IO PE.
call Initialize (Coordinates_Nodes_AV, Mesh%Node_Structure, &
2, 'Coordinates of Nodes', dump_status(4), &
Mesh%NDimensions)
call Initialize (Coordinates_Nodes_BNV, Mesh%NDimensions, &
Mesh%NNodes_total, dump_status(5))
Coordinates_Nodes_AV = Mesh%Coordinates_Nodes_DV
Coordinates_Nodes_BNV = Coordinates_Nodes_AV
if (this_is_IO_PE) then
do dim = 1, Mesh%NDimensions
call CG_Coord_Write_f (CGNS_File_Index, CGNS_Base_Index, &
CGNS_Zone_Index, CGNS_DataType, &
Coordinate_Name(dim), &
Coordinates_Nodes_BNV(dim,:), &
dim, CGNS_Status)
end do
end if
call Finalize (Coordinates_Nodes_BNV, dump_status(6))
call Finalize (Coordinates_Nodes_AV, dump_status(7))
if (CGNS_Status == ERROR) dump_status(8) = 'CGNS Error'
! Write CGNS Elements Connectivity (mesh 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(9))
call Initialize (Nodes_of_Cells_Index_Val_Total, Index_Size, &
Mesh%Nodes_per_Cell, dump_status(10))
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
call Initialize (CGNS_Elements, Mesh%Nodes_per_Cell, Index_Size, &
dump_status(11))
do cell = 1, Mesh%NCells
select case (Mesh%Shape) ! Select on Mesh%Shape.
case ('Segmented')
Element_Type = BAR_2
CGNS_Elements(:,cell) = Nodes_of_Cells_Index_Val_Total(cell,:)
case ('Triangular')
Element_Type = TRI_3
! Note: it is unclear what order the nodes are in for triangles
! in CGNS format. It is assumed that the order is counterclockwise.
CGNS_Elements(:,cell) = Nodes_of_Cells_Index_Val_Total(cell,:)
case ('Quadrilateral')
Element_Type = QUAD_4
! Note: it is unclear what order the nodes are in for quadrilaterals
! in CGNS format. It is assumed that the order is counterclockwise.
CGNS_Elements(1,cell) = Nodes_of_Cells_Index_Val_Total(cell,1)
CGNS_Elements(2,cell) = Nodes_of_Cells_Index_Val_Total(cell,2)
CGNS_Elements(3,cell) = Nodes_of_Cells_Index_Val_Total(cell,4)
CGNS_Elements(4,cell) = Nodes_of_Cells_Index_Val_Total(cell,3)
case ('Polygonal')
VERIFY(.false.,0) ! Not implemented yet.
case ('Tetrahedral')
Element_Type = TETRA_4
CGNS_Elements(:,cell) = Nodes_of_Cells_Index_Val_Total(cell,:)
case ('Hexahedral')
Element_Type = HEXA_8
CGNS_Elements(1,cell) = Nodes_of_Cells_Index_Val_Total(cell,1)
CGNS_Elements(2,cell) = Nodes_of_Cells_Index_Val_Total(cell,2)
CGNS_Elements(3,cell) = Nodes_of_Cells_Index_Val_Total(cell,4)
CGNS_Elements(4,cell) = Nodes_of_Cells_Index_Val_Total(cell,3)
CGNS_Elements(5,cell) = Nodes_of_Cells_Index_Val_Total(cell,5)
CGNS_Elements(6,cell) = Nodes_of_Cells_Index_Val_Total(cell,6)
CGNS_Elements(7,cell) = Nodes_of_Cells_Index_Val_Total(cell,8)
CGNS_Elements(8,cell) = Nodes_of_Cells_Index_Val_Total(cell,7)
case ('Polyhedral')
VERIFY(.false.,0) ! Not implemented yet.
end select
end do
if (this_is_IO_PE) then
call CG_Section_Write_f (CGNS_File_Index, CGNS_Base_Index, &
CGNS_Zone_Index, 'VolumeElements', &
Element_Type, 1, Mesh%NCells, 0, &
CGNS_Elements, S, CGNS_Status)
end if
call Finalize (Nodes_of_Cells_Index_Val_PE, dump_status(12))
if (CGNS_Status == ERROR) dump_status(12) = 'CGNS Error'
! Close CGNS file.
if (this_is_IO_PE) then
call CG_Close_f (CGNS_File_Index, CGNS_Status)
end if
if (CGNS_Status == ERROR) dump_status(13) = 'CGNS 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)
! Verify guarantees - none.
return
end subroutine Dump_CGNS_Multi_Mesh
])