Write a given mesh to disk. it is stored to the directory given in the tem_global_type.
Dump treelmesh_type%global to header.lua Dump treeID and propertyBits to elemlist.lsb (little endian environments) or elemlist.msb (big endian environments)
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(treelmesh_type), | intent(inout) | :: | me |
Mesh to dump to disk |
||
logical, | intent(in), | optional | :: | root_only |
root dump global mesh when true and all process dump its own mesh when false |
subroutine dump_treelmesh( me, root_only )
! -------------------------------------------------------------------- !
!> Mesh to dump to disk
type(treelmesh_type), intent(inout) :: me
!> root dump global mesh when true and
!! all process dump its own mesh when false
logical, intent(in), optional :: root_only
! -------------------------------------------------------------------- !
integer(kind=long_k), allocatable :: buffer(:)
integer :: fh, etype, ftype
integer :: iostatus( MPI_STATUS_SIZE )
integer :: iElem
integer :: iError
integer :: typesize
logical :: root_not_participating
character(len=300) :: ElemFileName
character(len=4) :: EndianSuffix
integer(kind=long_k) :: file_offset
integer(kind=MPI_OFFSET_KIND) :: displacement
! -------------------------------------------------------------------- !
if(present(root_only)) then
root_not_participating = root_only
else
root_not_participating = .true.
endif
EndianSuffix = tem_create_EndianSuffix()
! Dump global info to header.lua
! if root_not_participating = .false. that each process dumps its own mesh
! set global%nElems to local%nElems to dump local nElems
! in header file of each process
if (.not. root_not_participating) me%global%nElems = me%nElems
call dump_tem_global(me%global, root_only)
ElemFileName = trim(me%global%dirname) // 'elemlist' // EndianSuffix
file_offset = 0
allocate( buffer(me%nElems * 2) )
! Get the offset for MPI File view
if(root_not_participating) then
call MPI_Exscan( int(me%nElems,long_k), file_offset, 1, &
& long_k_mpi, MPI_SUM, me%global%comm, iError)
else
file_offset = 0
endif
! Fill the buffer with data to be written on disk
do iElem = 1, me%nElems
buffer((iElem-1)*2+1) = me%treeID(iElem)
buffer((iElem-1)*2+2) = me%ElemPropertyBits(iElem)
end do
write(logUnit(1),*) 'using MPI to write'
! Open the binary file for MPI I/O (Write)
call MPI_File_open( me%global%comm, &
& trim(ElemFileName), &
& ior(MPI_MODE_WRONLY,MPI_MODE_CREATE), &
& MPI_INFO_NULL, &
& fh, iError )
! Catch if there was an exception by MPI
call check_mpi_error(iError,'file_open in dump_treelmesh')
! Create a contiguous type to describe the vector per element
call MPI_Type_contiguous( 2, long_k_mpi, etype, iError )
call check_mpi_error(iError,'type etype in dump_treelmesh')
call MPI_Type_commit( etype, iError )
! Catch MPI Exception(s)
call check_mpi_error(iError,'commit etype in dump_treelmesh')
!get size of etype
call MPI_Type_size(etype, typesize, iError )
call check_mpi_error(iError,'typesize in dump_treelmesh')
! Create a MPI Contiguous as ftype for file view
call MPI_Type_contiguous( me%nElems, etype, ftype, iError )
call check_mpi_error(iError,'type ftype in dump_treelmesh')
call MPI_Type_commit( ftype, iError )
! Catch MPI Exception(s)
call check_mpi_error(iError,'commit ftype in dump_treelmesh')
! calculate dsplacement for file view
displacement = file_offset * typesize * 1_MPI_OFFSET_KIND
! Set the view for each process on the file above
call MPI_File_set_view( fh, displacement, etype, ftype, "native", &
& MPI_INFO_NULL, iError )
! Catch MPI Exception(s)
call check_mpi_error(iError,'set_view in dump_treelmesh')
! Write the Data to File
call MPI_File_write_all( fh, buffer, me%nElems, etype, iostatus, &
& iError )
! Catch MPI Exception(s)
call check_mpi_error(iError,'write_all in dump_treelmesh')
!Free the MPI_Datatypes which were created and close the file
call MPI_Type_free(etype, iError)
call check_mpi_error(iError,'free etype in dump_treelmesh')
call MPI_Type_free(ftype, iError)
call check_mpi_error(iError,'free ftype in dump_treelmesh')
call MPI_File_close(fh, iError)
call check_mpi_error(iError,'close file in dump_treelmesh')
deallocate( buffer )
end subroutine dump_treelmesh