This subroutine reads a mesh in treelm format from disk at the specified directory name.
The mesh is so small, it probably is better to read it on one process and distribute the resulting data via the network. single proc read
single proc read
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| type(treelmesh_type), | intent(inout) | :: | me |
Structure to load the mesh to |
||
| integer, | intent(in) | :: | nParts |
Directory containing the mesh informations Partition to use on the calling process (= MPI Rank in comm) Number of partitions, the mesh is partitioned into (= Number of MPI processes in comm). |
subroutine load_treelmesh(me, nParts ) ! -------------------------------------------------------------------- ! !> Structure to load the mesh to type(treelmesh_type), intent(inout) :: me !> Directory containing the mesh informations ! character(len=*), intent(in) :: dirname !> Partition to use on the calling process (= MPI Rank in comm) ! integer, intent(in) :: myPart !> Number of partitions, the mesh is partitioned into (= Number of MPI !! processes in comm). integer, intent(in) :: nParts ! -------------------------------------------------------------------- ! logical :: ex integer :: iElem integer :: iProp integer :: fh, etype, ftype integer :: iostatus( MPI_STATUS_SIZE ) integer :: iError integer :: file_rec_len integer :: typesize character(len=300) :: ElemFileName character(len=4) :: EndianSuffix integer(kind=long_k), allocatable :: buffer(:) integer(kind=long_k), allocatable :: globbuffer(:) integer(kind=MPI_OFFSET_KIND) :: displacement ! -------------------------------------------------------------------- ! EndianSuffix = tem_create_EndianSuffix() ElemFileName = trim(me%global%dirname)//'elemlist'//EndianSuffix write(logUnit(1), *) 'Load mesh from file: '//trim(ElemFileName) if (associated(me%property)) deallocate(me%property) allocate(me%Property(me%global%nProperties)) allocate(me%Part_First(nParts)) allocate(me%Part_Last(nParts)) allocate(me%treeID(me%nElems)) if (me%global%myPart == 0) then ! Only one process should check the file existence inquire(file=trim(ElemFileName), exist=ex) if (.not. ex) then write(logUnit(1),*) 'ERROR: File ' // trim(ElemFileName) & & // ' not found!' write(logUnit(1),*) 'Aborting.' call tem_abort() end if end if allocate(me%ElemPropertyBits(me%nElems)) allocate(buffer(me%nElems*2)) if (me%global%nElems*2 > io_buffer_size) then write(logUnit(1),*) 'using MPI to read' ! 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 load_treelmesh') call MPI_Type_commit( etype, iError ) call check_mpi_error(iError,'commit etype in load_treelmesh') call MPI_Type_size(etype, typesize, iError ) call check_mpi_error(iError,'typesize in load_treelmesh') ! Create a MPI Subarray as ftype for file view call MPI_Type_contiguous( me%nElems, etype, ftype, iError ) call check_mpi_error(iError,'type ftype in load_treelmesh') call MPI_Type_commit( ftype, iError ) call check_mpi_error(iError,'commit ftype in load_treelmesh') ! Calculate displacement for file view displacement = me%elemOffset * typesize * 1_MPI_OFFSET_KIND ! Set the view for each process on the file above ! Open the binary file for MPI I/O (Write) call MPI_File_open( me%global%comm, trim(ElemFileName), & & MPI_MODE_RDONLY, MPI_INFO_NULL, fh, iError ) call check_mpi_error(iError,'file_open in load_treelmesh') call MPI_File_set_view( fh, displacement, etype, ftype, "native", & & MPI_INFO_NULL, iError ) call check_mpi_error(iError,'set_view in load_treelmesh') ! Read data from the file call MPI_File_read_all( fh, buffer, me%nElems, etype, iostatus, iError ) call check_mpi_error(iError,'read_all in load_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 load_treelmesh') call MPI_Type_free (ftype, iError) call check_mpi_error(iError,'free ftype in load_treelmesh') call MPI_File_close(fh, iError) call check_mpi_error(iError,'close file in load_treelmesh') ! END IO-part else !> The mesh is so small, it probably is better to read it on one process !! and distribute the resulting data via the network. write(logUnit(1),*) 'using one process to read and broadcast' allocate( globbuffer(me%global%nElems*2) ) if (me%global%myPart == 0) then !! single proc read inquire(iolength = file_rec_len) globbuffer call tem_open( newunit = fh, & & file = trim(ElemFileName), & & recl = file_rec_len, & & action = 'read', & & access = 'direct', & & form = 'unformatted' ) read(fh, rec=1) globbuffer close(fh) end if !! single proc read call MPI_Bcast( globbuffer, int(2*me%global%nElems), long_k_mpi, 0, & & me%global%comm, iError ) buffer = globbuffer(me%elemOffset*2+1:(me%ElemOffset+me%nElems)*2) deallocate(globbuffer) end if ! END IO-part ! Fill the tree with what was read in buffer from disk do iElem = 1, me%nElems me%treeID(iElem) = buffer( (iElem-1)*2 + 1 ) me%ElemPropertyBits(iElem) = buffer( (iElem-1)*2 + 2 ) end do deallocate( buffer ) ! clear the prp_sendHalo property since the distribution of elements ! might have changed do iElem=1,me%nElems me%ElemPropertyBits(iElem) = ibclr( me%ElemPropertyBits(iElem), & & prp_sendHalo ) end do call MPI_allgather( me%treeID(1), 1, long_k_mpi, & & me%Part_First, 1, long_k_mpi, & & me%global%comm, iError ) call MPI_allgather( me%treeID(me%nElems), 1, long_k_mpi, & & me%Part_Last, 1, long_k_mpi, & & me%global%comm, iError ) do iProp=1,me%global%nProperties call gather_Property( Property = me%Property(iProp), & & Header = me%global%Property(iProp), & & BitField = me%ElemPropertyBits, & & comm = me%global%comm ) end do write(logUnit(1),*) 'Done, reading the mesh!' end subroutine load_treelmesh