Homec4science
Diffusion futils (master) Browse

rFUTILS/src/getarr.tpl
a0d1d4830c01master

Last Change
Raw File

getarr.tpl
View Options

!>
!> @file getarr.tpl
!>
!> @brief
!>
!> @copyright
!> Copyright (©) 2021 EPFL (Ecole Polytechnique Fédérale de Lausanne)
!> SPC (Swiss Plasma Center)
!>
!> futils is free software: you can redistribute it and/or modify it under
!> the terms of the GNU Lesser General Public License as published by the Free
!> Software Foundation, either version 3 of the License, or (at your option)
!> any later version.
!>
!> futils is distributed in the hope that it will be useful, but WITHOUT ANY
!> WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
!> FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
!>
!> You should have received a copy of the GNU Lesser General Public License
!> along with this program. If not, see <https://www.gnu.org/licenses/>.
!>
!> @authors
!> (in alphabetical order)
!> @author Trach-Minh Tran <trach-minh.tran@epfl.ch>
!>
INTEGER, INTENT(in) :: fid
CHARACTER(len=*), INTENT(in) :: name
INTEGER, INTENT(in), OPTIONAL :: pardim
INTEGER, INTENT(in), OPTIONAL :: ionode
INTEGER, INTENT(in), OPTIONAL :: offsets(SIZE(SHAPE(array)))
!
INTEGER(HID_T) :: dtype
INTEGER(HID_T) :: id, did, dspace_id, memspace_id, plist_id
INTEGER(HSIZE_T), DIMENSION(SIZE(SHAPE(array))) :: dims, mdims, maxdims
INTEGER(HSIZE_T), DIMENSION(SIZE(SHAPE(array))) :: starts, counts
INTEGER :: i, s, rank, mrank, nlocal, nglobal, pdim, ierr
LOGICAL :: nlio
!
id = file_id(fid) ! file id
!
! Data type of array (memory)
SELECT CASE (ctype)
CASE('R')
CALL h5tcopy_f(H5T_NATIVE_DOUBLE, dtype, ierr)
CASE('S')
CALL h5tcopy_f(H5T_NATIVE_REAL, dtype, ierr)
CASE('I')
CALL h5tcopy_f(H5T_NATIVE_INTEGER, dtype, ierr)
END SELECT
!
! Am I the io node ?
nlio = .TRUE.
IF( ispara(fid) .AND. PRESENT(ionode) ) THEN ! Ignore "ionode" if not parallel IO
nlio = mpi_rank(fid) .EQ. ionode
END IF
!
! Data transfer property (default is H5FD_MPIO_INDEPENDENT_F)
CALL h5pcreate_f(H5P_DATASET_XFER_F, plist_id, ierr)
!
! Get dataset from file
CALL h5dopen_f(id, name, did, ierr)
!
! Get file dataspace
CALL h5dget_space_f(did, dspace_id, ierr)
CALL h5sget_simple_extent_dims_f(dspace_id, dims, maxdims, ierr)
rank = ierr
!
! Set memory dataspace
mdims=SHAPE(array)
mrank = SIZE(mdims)
IF( mrank .NE. rank) THEN
PRINT*, 'rank mismatch while reading ', name(1:LEN_TRIM(name))
STOP
END IF
CALL h5screate_simple_f(rank, mdims, memspace_id, ierr)
!
! Selection on file space based on 1D parallel partition
starts = 0
counts = dims ! The whole dataset in file
IF( ispara(fid) .AND. PRESENT(pardim) ) THEN
pdim = pardim
IF( .NOT. ispara(fid) ) THEN
PRINT*, 'File was not open with paralleilization option'
STOP
END IF
nlocal = mdims(pdim) ! Assume the part. was specified by array shape.
CALL part1d( file_comm(fid), nlocal, s, nglobal)
starts(pdim) = s
counts(pdim) = nlocal
CALL h5sselect_hyperslab_f(dspace_id, H5S_SELECT_SET_F, starts, counts, ierr)
END IF
!
! Select slice in file
IF( PRESENT(offsets) ) THEN
IF( PRESENT(pardim) ) THEN
PRINT*, 'GETARR: Distributed array not allowed for partial read!'
STOP
END IF
!counts(rank) = mdims(rank)
counts = mdims !!! modification to read with offset not only in the last dimension, dp-26.06.15
starts = offsets
CALL h5sselect_hyperslab_f(dspace_id, H5S_SELECT_SET_F, starts, counts, ierr)
END IF
!
! Selection of memory space
starts = 0
CALL h5sselect_hyperslab_f(memspace_id, H5S_SELECT_SET_F, starts, counts, ierr)
!
! Check consistency between file and memory dataspace
DO i=1,rank
IF( mdims(i) .LT. counts(i) ) THEN
PRINT*, 'dim.', i, ' too small while reading ', &
& name(1:LEN_TRIM(name))
STOP
END IF
END DO
!
! IO node read dataset
IF( ispara(fid) .AND. PRESENT(pardim) ) THEN
CALL h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, ierr)
END IF
IF( nlio ) THEN
CALL h5dread_f(did, dtype, array, dims, ierr, &
& memspace_id, dspace_id, plist_id)
END IF
!
CALL h5tclose_f(dtype, ierr)
CALL h5pclose_f(plist_id, ierr)
CALL h5sclose_f(dspace_id, ierr)
CALL h5sclose_f(memspace_id, ierr)
CALL h5dclose_f(did, ierr)
!
c4science · Help