! hdf5io module for QuickPIC Open Source 1.0 ! update: 04/18/2016 module hdf5io_class use perrors_class use parallel_pipe_class use HDF5 use mpi implicit none private public :: hdf5file, pwfield, pwfield_pipe, wfield_pipe, pwpart_pipe, pwpart,& &wpart,rpart type hdf5file private character(len=100) :: filename = 'file.h5', timeunits = 'a.u.',& &dataname = 'Data', units = 'a.u.', label = 'Data' character(len=100) :: ty = 'grid' integer :: n = 1, rank = 2 real :: t = 1.0, dt = 1.0 character(len=100), dimension(3) :: axisname = (/'x1','x2','x3'/),& &axislabel = (/'x1','x2','x3'/), axisunits = (/'a.u.','a.u.','a.u.'/) real, dimension(3) :: axismax = (/1.0,1.0,1.0/), axismin = (/0.0,0.0,0.0/) contains generic :: new => init_hdf5file procedure, private :: init_hdf5file end type interface add_h5_atribute module procedure add_h5_atribute_str module procedure add_h5_atribute_str_v1 module procedure add_h5_atribute_single module procedure add_h5_atribute_v1_single module procedure add_h5_atribute_int module procedure add_h5_atribute_v1_int end interface interface pwfield module procedure pwfield_3d module procedure pwfield_2d end interface interface pwfield_pipe module procedure pwfield_3d_pipe module procedure pwfield_2d_pipe end interface interface wfield_pipe module procedure wfield_2d_pipe end interface interface pwpart_pipe module procedure pwpart_3d_pipe end interface interface pwpart module procedure pwpart_2d end interface contains subroutine init_hdf5file(this,filename,timeunits,ty,n,t,dt,axisname,& &axislabel,axisunits,axismax,axismin,dataname,units,label,rank) implicit none class(hdf5file), intent(inout) :: this character(len=*), intent(in), optional :: filename, timeunits character(len=*), intent(in), optional :: ty, dataname, units, label integer, intent(in), optional :: n, rank real, intent(in), optional :: t, dt character(len=*), dimension(3), intent(in), optional :: axisname, & &axislabel, axisunits real, dimension(3), intent(in), optional :: axismax, axismin if (present(filename)) then this%filename = filename end if if (present(dataname)) then this%dataname = dataname end if if (present(units)) then this%units = units end if if (present(label)) then this%label = label end if if (present(timeunits)) then this%timeunits = timeunits end if if (present(ty)) then this%ty = ty end if if (present(n)) then this%n = n end if if (present(rank)) then this%rank = rank end if if (present(t)) then this%t = t end if if (present(dt)) then this%dt = dt end if if (present(axisname)) then this%axisname = axisname end if if (present(axislabel)) then this%axislabel = axislabel end if if (present(axisunits)) then this%axisunits = axisunits end if if (present(axismax)) then this%axismax = axismax end if if (present(axismin)) then this%axismin = axismin end if end subroutine init_hdf5file ! subroutine add_h5_atribute_str( objID, name, attribute ) implicit none integer(hid_t), intent(in) :: objID character( len = * ), intent(in) :: name character( len = * ), intent(in) :: attribute integer(hid_t) :: dataspaceID, typeID, attrID integer(hsize_t), dimension(1) :: dims integer(size_t) :: size integer :: ierr dims(1) = 1 call h5screate_simple_f(1, dims, dataspaceID, ierr ) call h5tcopy_f(H5T_NATIVE_CHARACTER, typeID, ierr) size = len(attribute) call h5tset_size_f(typeID, size, ierr) call h5acreate_f( objID, name, typeID, dataspaceID, attrID, ierr ) call h5awrite_f( attrID, typeID, attribute, dims, ierr) call h5aclose_f( attrID, ierr ) call h5tclose_f( typeID, ierr ) call h5sclose_f( dataspaceID, ierr ) end subroutine add_h5_atribute_str ! subroutine add_h5_atribute_str_v1( objID, name, attribute ) implicit none integer(hid_t), intent(in) :: objID character( len = * ), intent(in) :: name character( len = * ), dimension(:), intent(in) :: attribute integer(hid_t) :: dataspaceID, typeID, attrID integer(hsize_t), dimension(1) :: dims integer(size_t) :: maxlen integer :: i, ierr dims(1) = size(attribute) call h5screate_simple_f(1, dims, dataspaceID, ierr ) maxlen = 0 do i = 1, size(attribute)-1 if (len(attribute(i)) > maxlen) maxlen = len(attribute(i)) enddo call h5tcopy_f(H5T_NATIVE_CHARACTER, typeID, ierr) call h5tset_size_f(typeID, maxlen, ierr) call h5acreate_f( objID, name, typeID, dataspaceID, attrID, ierr ) call h5awrite_f( attrID, typeID, attribute, dims, ierr) call h5aclose_f( attrID, ierr ) call h5tclose_f( typeID, ierr ) call h5sclose_f( dataspaceID, ierr ) end subroutine add_h5_atribute_str_v1 ! subroutine add_h5_atribute_single( objID, name, attribute ) implicit none integer(hid_t), intent(in) :: objID character( len = * ), intent(in) :: name real, intent(in) :: attribute integer(hid_t) :: dataspaceID, attrID integer(hid_t) :: d_float integer(hsize_t), dimension(1) :: dims integer :: ierr d_float = detect_precision() dims(1) = 1 call h5screate_simple_f(1, dims, dataspaceID, ierr ) call h5acreate_f( objID, name, d_float, dataspaceID, attrID, ierr ) call h5awrite_f( attrID, d_float, attribute, dims, ierr) call h5aclose_f( attrID, ierr ) call h5sclose_f( dataspaceID, ierr ) end subroutine add_h5_atribute_single ! subroutine add_h5_atribute_v1_single( objID, name, attribute ) implicit none integer(hid_t), intent(in) :: objID character( len = * ), intent(in) :: name real, dimension(:), intent(in) :: attribute integer(hid_t) :: dataspaceID, attrID integer(hid_t) :: d_float integer(hsize_t), dimension(1) :: dims integer :: ierr d_float = detect_precision() dims(1) = size(attribute) call h5screate_simple_f(1, dims, dataspaceID, ierr ) call h5acreate_f( objID, name, d_float, dataspaceID, attrID, ierr ) call h5awrite_f( attrID, d_float, attribute, dims, ierr) call h5aclose_f( attrID, ierr ) call h5sclose_f( dataspaceID, ierr ) end subroutine add_h5_atribute_v1_single ! subroutine add_h5_atribute_int( objID, name, attribute ) implicit none integer(hid_t), intent(in) :: objID character( len = * ), intent(in) :: name integer, intent(in) :: attribute integer(hid_t) :: dataspaceID, attrID integer(hsize_t), dimension(1) :: dims integer :: ierr dims(1) = 1 call h5screate_simple_f(1, dims, dataspaceID, ierr ) call h5acreate_f( objID, name, H5T_NATIVE_INTEGER, dataspaceID,& &attrID, ierr ) call h5awrite_f( attrID, H5T_NATIVE_INTEGER, attribute, dims, ierr) call h5aclose_f( attrID, ierr ) call h5sclose_f( dataspaceID, ierr ) end subroutine add_h5_atribute_int ! subroutine add_h5_atribute_v1_int( objID, name, attribute ) implicit none integer(hid_t), intent(in) :: objID character( len = * ), intent(in) :: name integer, dimension(:), intent(in) :: attribute integer(hid_t) :: dataspaceID, attrID integer(hsize_t), dimension(1) :: dims integer :: ierr dims(1) = size(attribute) call h5screate_simple_f(1, dims, dataspaceID, ierr ) call h5acreate_f( objID, name, H5T_NATIVE_INTEGER, dataspaceID,& &attrID, ierr ) call h5awrite_f( attrID, H5T_NATIVE_INTEGER, attribute, dims, ierr) call h5aclose_f( attrID, ierr ) call h5sclose_f( dataspaceID, ierr ) end subroutine add_h5_atribute_v1_int ! subroutine wrattr_file(this,file_id,xferID) implicit none class(hdf5file), intent(in) :: this integer(hid_t), intent(in) :: file_id ! local data integer(hid_t) :: rootID, aid, dspace_id, dset_id, treal, xferID integer(hsize_t), dimension(1) :: dims integer, parameter :: zero = ichar('0') integer :: i, ierr treal = detect_precision() call h5gopen_f(file_id, '/', rootID, ierr) call add_h5_atribute(rootID, 'NAME', this%dataname) call add_h5_atribute(rootID, 'TYPE', this%ty) call add_h5_atribute(rootID, 'TIME', this%t) call add_h5_atribute(rootID, 'ITER', this%n) call add_h5_atribute(rootID, 'DT', this%dt) call add_h5_atribute(rootID, 'TIME UNITS', this%timeunits) if (this%ty == 'grid') then call h5gcreate_f(rootID, 'AXIS', aid, ierr) dims(1) = 2 call h5screate_simple_f(1, dims, dspace_id, ierr ) do i = 1, this%rank call h5dcreate_f(aid, 'AXIS'//char(zero+i), treal, dspace_id,& &dset_id, ierr ) call add_h5_atribute(dset_id, 'TYPE', 'linear') call add_h5_atribute(dset_id, 'UNITS', trim(this%axisunits(i))) call add_h5_atribute(dset_id, 'NAME', trim(this%axisname(i))) call add_h5_atribute(dset_id, 'LONG_NAME', trim(this%axislabel(i))) call h5dwrite_f(dset_id, treal, (/this%axismin(i),this%axismax(i)/),& &dims, ierr, xfer_prp=xferID) call h5dclose_f(dset_id, ierr) enddo call h5sclose_f(dspace_id, ierr) call h5gclose_f(aid, ierr) endif call h5gclose_f(rootID, ierr) end subroutine wrattr_file ! subroutine wrattr_dataset(this,dset_id,unit,name) implicit none class(hdf5file), intent(in) :: this integer(hid_t), intent(in) :: dset_id character(len=*), intent(in), optional :: unit,name if (present(unit)) then call add_h5_atribute(dset_id, 'UNITS', unit) else call add_h5_atribute(dset_id, 'UNITS', this%units) endif if (present(name)) then call add_h5_atribute(dset_id, 'LONG_NAME', name) else call add_h5_atribute(dset_id, 'LONG_NAME', this%label) endif end subroutine wrattr_dataset ! subroutine pwfield_3d(pp,perr,file,fd,gs,ls,noff,ierr) implicit none class(perrors), intent(in), pointer :: perr class(parallel_pipe), intent(in), pointer :: pp class(hdf5file), intent(in) :: file real, dimension(:,:,:), intent(in) :: fd integer, dimension(3), intent(in) :: gs, ls integer, dimension(2), intent(in) :: noff integer, intent(inout) :: ierr ! local data integer(hid_t) :: treal,flplID, xferID, dcplID, memspaceID integer(hid_t) :: file_id, rootID, dset_id, dspace_id integer(hsize_t), dimension(3) :: start integer(hsize_t), dimension(3) :: gsize, lsize integer(hsize_t), dimension(2) :: lnoff integer :: info character(len=:), allocatable :: filename character(len=8) :: st allocate(character(len(trim(file%filename))+len(trim(file%dataname))+11) :: filename) write (st,'(I8.8)') file%n filename = trim(file%filename)//trim(file%dataname)//'_'//st//'.h5' ierr = 0 gsize = gs lsize = ls lnoff = noff call h5open_f(ierr) treal = detect_precision() call h5pcreate_f(H5P_FILE_ACCESS_F, flplID, ierr) call h5pcreate_f(H5P_DATASET_CREATE_F, dcplID, ierr) call h5pcreate_f(H5P_DATASET_XFER_F, xferID, ierr) info = MPI_INFO_NULL call h5pset_fapl_mpio_f(flplID, pp%getlgrp(), info, ierr) call h5pset_dxpl_mpio_f(xferID, H5FD_MPIO_COLLECTIVE_F, ierr) call h5fcreate_f(filename,H5F_ACC_TRUNC_F,file_id,ierr,& &access_prp=flplID) call wrattr_file(file,file_id,xferID) call h5screate_simple_f(3, gsize, dspace_id, ierr) call h5screate_simple_f(3, lsize, memspaceID, ierr ) call h5gopen_f(file_id, '/', rootID, ierr) call h5dcreate_f(rootID, file%dataname, treal, dspace_id, dset_id,& &ierr, dcplID) start(1) = 0 start(2) = lnoff(1) start(3) = lnoff(2) call h5sselect_hyperslab_f(dspace_id, H5S_SELECT_SET_F, start, lsize,& &ierr) call h5dwrite_f(dset_id, treal, fd(1:lsize(1),1:lsize(2),1:lsize(3)),& &lsize, ierr, memspaceID, dspace_id, xfer_prp=xferID) call wrattr_dataset(file,dset_id) call h5sclose_f(memspaceID, ierr) call h5sclose_f(dspace_id, ierr) call h5pclose_f(xferID, ierr) call h5pclose_f(dcplID, ierr) call h5pclose_f(flplID, ierr) call h5gclose_f(rootID, ierr) call h5dclose_f(dset_id, ierr) call h5fclose_f(file_id, ierr) call h5close_f(ierr) end subroutine pwfield_3d ! subroutine pwfield_2d(pp,perr,file,fd,gs,ls,noff,ierr) implicit none class(perrors), intent(in), pointer :: perr class(parallel_pipe), intent(in), pointer :: pp class(hdf5file), intent(in) :: file real, dimension(:,:), intent(in) :: fd integer, dimension(2), intent(in) :: gs, ls integer, intent(in) :: noff integer, intent(inout) :: ierr ! local data integer(hid_t) :: treal,flplID, xferID, dcplID, memspaceID integer(hid_t) :: file_id, rootID, dset_id, dspace_id integer(hsize_t), dimension(2) :: start integer(hsize_t), dimension(2) :: gsize, lsize integer(hsize_t) :: lnoff integer :: info character(len=:), allocatable :: filename character(len=8) :: st allocate(character(len(trim(file%filename))+len(trim(file%dataname))+11) :: filename) write (st,'(I8.8)') file%n filename = trim(file%filename)//trim(file%dataname)//'_'//st//'.h5' ierr = 0 gsize = gs lsize = ls lnoff = noff call h5open_f(ierr) treal = detect_precision() call h5pcreate_f(H5P_FILE_ACCESS_F, flplID, ierr) call h5pcreate_f(H5P_DATASET_CREATE_F, dcplID, ierr) call h5pcreate_f(H5P_DATASET_XFER_F, xferID, ierr) info = MPI_INFO_NULL call h5pset_fapl_mpio_f(flplID, pp%getlgrp(), info, ierr) call h5pset_dxpl_mpio_f(xferID, H5FD_MPIO_COLLECTIVE_F, ierr) call h5fcreate_f(filename,H5F_ACC_TRUNC_F,file_id,ierr,& &access_prp=flplID) call wrattr_file(file,file_id,xferID) call h5screate_simple_f(2, gsize, dspace_id, ierr) call h5screate_simple_f(2, lsize, memspaceID, ierr ) call h5gopen_f(file_id, '/', rootID, ierr) call h5dcreate_f(rootID, file%dataname, treal, dspace_id, dset_id,& &ierr, dcplID) start(1) = 0 start(2) = lnoff call h5sselect_hyperslab_f(dspace_id, H5S_SELECT_SET_F, start, lsize,& &ierr) call h5dwrite_f(dset_id, treal, fd(1:lsize(1),1:lsize(2)),lsize, ierr,& &memspaceID, dspace_id, xfer_prp=xferID) call wrattr_dataset(file,dset_id) call h5sclose_f(memspaceID, ierr) call h5sclose_f(dspace_id, ierr) call h5pclose_f(xferID, ierr) call h5pclose_f(dcplID, ierr) call h5pclose_f(flplID, ierr) call h5gclose_f(rootID, ierr) call h5dclose_f(dset_id, ierr) call h5fclose_f(file_id, ierr) call h5close_f(ierr) end subroutine pwfield_2d ! subroutine pwfield_3d_pipe(pp,perr,file,fd,gs,ls,noff,rtag,& &stag,id,ierr) implicit none class(perrors), intent(in), pointer :: perr class(parallel_pipe), intent(in), pointer :: pp class(hdf5file), intent(in) :: file real, dimension(:,:,:), intent(in) :: fd integer, dimension(3), intent(in) :: gs, ls integer, dimension(2), intent(in) :: noff integer, intent(in) :: rtag, stag integer, intent(inout) :: id, ierr ! local data integer(hid_t) :: treal,flplID, xferID, dcplID, memspaceID integer(hid_t) :: file_id, rootID, dset_id, dspace_id, aid integer(hid_t) :: tstring integer(hsize_t), dimension(3) :: gsize, lsize integer(hsize_t), dimension(2) :: lnoff character(len=80) :: string integer(hsize_t) :: lstr integer(hsize_t), dimension(3) :: start integer :: ori, des, nvyp, stageid, mid, message, info integer, dimension(10) :: istat integer(hsize_t), dimension(1) :: dims character(len=:), allocatable :: filename character(len=8) :: st allocate(character(len(trim(file%filename))+len(trim(file%dataname))+11) :: filename) write (st,'(I8.8)') file%n filename = trim(file%filename)//trim(file%dataname)//'_'//st//'.h5' ierr = 0 gsize = gs lsize = ls lnoff = noff nvyp = pp%getlnvp() ori = pp%getkstrt() - nvyp - 1 des = pp%getkstrt() + nvyp - 1 dims = 1 if (ori >= 0) then call MPI_IRECV(message,1,pp%getmint(),ori,rtag,pp%getlworld(),& &mid,ierr) call MPI_WAIT(mid,istat,ierr) endif call h5open_f(ierr) treal = detect_precision() call h5pcreate_f(H5P_FILE_ACCESS_F, flplID, ierr) call h5pcreate_f(H5P_DATASET_CREATE_F, dcplID, ierr) call h5pcreate_f(H5P_DATASET_XFER_F, xferID, ierr) info = MPI_INFO_NULL call h5pset_fapl_mpio_f(flplID, pp%getlgrp(), info, ierr) call h5pset_dxpl_mpio_f(xferID, H5FD_MPIO_COLLECTIVE_F, ierr) if (ori >= 0) then call h5fopen_f(filename,H5F_ACC_RDWR_F, file_id, ierr,& &access_prp=flplID) call h5aopen_by_name_f(file_id, "/", "NAME", aid, ierr) lstr = len(string) call h5tcopy_f(H5T_NATIVE_CHARACTER, tstring, ierr) call h5tset_size_f(tstring, lstr, ierr) call h5aread_f(aid, tstring, string, dims, ierr) call h5dopen_f(file_id, string, dset_id, ierr, H5P_DEFAULT_F) call h5aclose_f(aid, ierr) call h5tclose_f(tstring, ierr) else call h5fcreate_f(filename,H5F_ACC_TRUNC_F,file_id,ierr,& &access_prp=flplID) call wrattr_file(file,file_id,xferID) endif call h5screate_simple_f(3, gsize, dspace_id, ierr) call h5screate_simple_f(3, lsize, memspaceID, ierr ) call h5gopen_f(file_id, '/', rootID, ierr) if (ori < 0) then call h5dcreate_f(rootID, file%dataname, treal, dspace_id, dset_id,& &ierr, dcplID) call wrattr_dataset(file,dset_id) endif start(1) = 0 start(2) = lnoff(1) start(3) = lnoff(2) call h5sselect_hyperslab_f(dspace_id, H5S_SELECT_SET_F, start, lsize,& &ierr) call h5dwrite_f(dset_id, treal, fd(1:lsize(1),1:lsize(2),1:lsize(3)),& &lsize, ierr, memspaceID, dspace_id, xfer_prp=xferID) call h5sclose_f(memspaceID, ierr) call h5sclose_f(dspace_id, ierr) call h5pclose_f(xferID, ierr) call h5pclose_f(dcplID, ierr) call h5pclose_f(flplID, ierr) call h5gclose_f(rootID, ierr) call h5dclose_f(dset_id, ierr) call h5fclose_f(file_id, ierr) call h5close_f(ierr) if (des < pp%getnvp()) then call MPI_ISEND(message,1,pp%getmint(),des,stag,pp%getlworld(),& &id,ierr) else id = MPI_REQUEST_NULL endif end subroutine pwfield_3d_pipe ! subroutine pwfield_2d_pipe(pp,perr,file,fd,gs,ls,noff,rtag,& &stag,id,ierr) implicit none class(perrors), intent(in), pointer :: perr class(parallel_pipe), intent(in), pointer :: pp class(hdf5file), intent(in) :: file real, dimension(:,:), intent(in) :: fd integer, dimension(2), intent(in) :: gs, ls integer, dimension(2), intent(in) :: noff integer, intent(in) :: rtag, stag integer, intent(inout) :: id, ierr ! local data integer(hid_t) :: treal,flplID, xferID, dcplID, memspaceID integer(hid_t) :: file_id, rootID, dset_id, dspace_id, aid integer(hid_t) :: tstring integer(hsize_t), dimension(2) :: gsize, lsize integer(hsize_t), dimension(2) :: lnoff character(len=80) :: string integer(hsize_t) :: lstr integer(hsize_t), dimension(2) :: start integer :: ori, des, nvyp, stageid, mid, message, info integer, dimension(10) :: istat integer(hsize_t), dimension(1) :: dims character(len=:), allocatable :: filename character(len=8) :: st allocate(character(len(trim(file%filename))+len(trim(file%dataname))+11) :: filename) write (st,'(I8.8)') file%n filename = trim(file%filename)//trim(file%dataname)//'_'//st//'.h5' ierr = 0 gsize = gs lsize = ls lnoff = noff nvyp = pp%getlnvp() ori = pp%getkstrt() - nvyp - 1 des = pp%getkstrt() + nvyp - 1 dims = 1 if (ori >= 0) then call MPI_IRECV(message,1,pp%getmint(),ori,rtag,pp%getlworld(),& &mid,ierr) call MPI_WAIT(mid,istat,ierr) endif call h5open_f(ierr) treal = detect_precision() call h5pcreate_f(H5P_FILE_ACCESS_F, flplID, ierr) call h5pcreate_f(H5P_DATASET_CREATE_F, dcplID, ierr) call h5pcreate_f(H5P_DATASET_XFER_F, xferID, ierr) info = MPI_INFO_NULL call h5pset_fapl_mpio_f(flplID, pp%getlgrp(), info, ierr) call h5pset_dxpl_mpio_f(xferID, H5FD_MPIO_COLLECTIVE_F, ierr) if (ori >= 0) then call h5fopen_f(filename,H5F_ACC_RDWR_F, file_id, ierr,& &access_prp=flplID) call h5aopen_by_name_f(file_id, "/", "NAME", aid, ierr) lstr = len(string) call h5tcopy_f(H5T_NATIVE_CHARACTER, tstring, ierr) call h5tset_size_f(tstring, lstr, ierr) call h5aread_f(aid, tstring, string, dims, ierr) call h5dopen_f(file_id, string, dset_id, ierr, H5P_DEFAULT_F) call h5aclose_f(aid, ierr) call h5tclose_f(tstring, ierr) else call h5fcreate_f(filename,H5F_ACC_TRUNC_F,file_id,ierr,& &access_prp=flplID) call wrattr_file(file,file_id,xferID) endif call h5screate_simple_f(2, gsize, dspace_id, ierr) call h5screate_simple_f(2, lsize, memspaceID, ierr ) call h5gopen_f(file_id, '/', rootID, ierr) if (ori < 0) then call h5dcreate_f(rootID, file%dataname, treal, dspace_id, dset_id,& &ierr, dcplID) call wrattr_dataset(file,dset_id) endif start = lnoff call h5sselect_hyperslab_f(dspace_id, H5S_SELECT_SET_F, start, lsize,& &ierr) call h5dwrite_f(dset_id, treal, fd(1:lsize(1),1:lsize(2)),& &lsize, ierr, memspaceID, dspace_id, xfer_prp=xferID) call h5sclose_f(memspaceID, ierr) call h5sclose_f(dspace_id, ierr) call h5pclose_f(xferID, ierr) call h5pclose_f(dcplID, ierr) call h5pclose_f(flplID, ierr) call h5gclose_f(rootID, ierr) call h5dclose_f(dset_id, ierr) call h5fclose_f(file_id, ierr) call h5close_f(ierr) if (des < pp%getnvp()) then call MPI_ISEND(message,1,pp%getmint(),des,stag,pp%getlworld(),& &id,ierr) else id = MPI_REQUEST_NULL endif end subroutine pwfield_2d_pipe ! subroutine wfield_2d_pipe(pp,perr,file,fd,gs,ls,noff,rtag,& &stag,id,ierr) implicit none class(perrors), intent(in), pointer :: perr class(parallel_pipe), intent(in), pointer :: pp class(hdf5file), intent(in) :: file real, dimension(:,:), intent(in) :: fd integer, dimension(2), intent(in) :: gs, ls integer, dimension(2), intent(in) :: noff integer, intent(in) :: rtag, stag integer, intent(inout) :: id, ierr ! local data integer(hid_t) :: treal, memspaceID integer(hid_t) :: file_id, rootID, dset_id, dspace_id, aid integer(hid_t) :: tstring integer(hsize_t), dimension(2) :: gsize, lsize integer(hsize_t), dimension(2) :: lnoff character(len=80) :: string integer(hsize_t) :: lstr integer(hsize_t), dimension(2) :: start integer :: ori, des, nvyp, stageid, mid, message, info integer, dimension(10) :: istat integer(hsize_t), dimension(1) :: dims character(len=:), allocatable :: filename character(len=8) :: st allocate(character(len(trim(file%filename))+len(trim(file%dataname))+11) :: filename) write (st,'(I8.8)') file%n filename = trim(file%filename)//trim(file%dataname)//'_'//st//'.h5' ierr = 0 gsize = gs lsize = ls lnoff = noff nvyp = pp%getlnvp() ori = pp%getkstrt() - nvyp - 1 des = pp%getkstrt() + nvyp - 1 dims = 1 if (ori >= 0) then call MPI_IRECV(message,1,pp%getmint(),ori,rtag,pp%getlworld(),& &mid,ierr) call MPI_WAIT(mid,istat,ierr) endif call h5open_f(ierr) treal = detect_precision() info = MPI_INFO_NULL if (ori >= 0) then call h5fopen_f(filename,H5F_ACC_RDWR_F, file_id, ierr) call h5aopen_by_name_f(file_id, "/", "NAME", aid, ierr) lstr = len(string) call h5tcopy_f(H5T_NATIVE_CHARACTER, tstring, ierr) call h5tset_size_f(tstring, lstr, ierr) call h5aread_f(aid, tstring, string, dims, ierr) call h5dopen_f(file_id, string, dset_id, ierr, H5P_DEFAULT_F) call h5aclose_f(aid, ierr) call h5tclose_f(tstring, ierr) else call h5fcreate_f(filename,H5F_ACC_TRUNC_F,file_id,ierr) call wrattr_file(file,file_id,H5P_DEFAULT_F) endif call h5screate_simple_f(2, gsize, dspace_id, ierr) call h5screate_simple_f(2, lsize, memspaceID, ierr) call h5gopen_f(file_id, '/', rootID, ierr) if (ori < 0) then call h5dcreate_f(rootID, file%dataname, treal, dspace_id, dset_id,& &ierr) call wrattr_dataset(file,dset_id) endif start(1) = 0 start(2) = lnoff(2) call h5sselect_hyperslab_f(dspace_id, H5S_SELECT_SET_F, start, lsize,& &ierr) call h5dwrite_f(dset_id, treal, fd(1:lsize(1),1:lsize(2)),& &lsize, ierr, memspaceID, dspace_id) call h5sclose_f(memspaceID, ierr) call h5sclose_f(dspace_id, ierr) call h5gclose_f(rootID, ierr) call h5dclose_f(dset_id, ierr) call h5fclose_f(file_id, ierr) call h5close_f(ierr) if (des < pp%getnvp()) then call MPI_ISEND(message,1,pp%getmint(),des,stag,pp%getlworld(),& &id,ierr) else id = MPI_REQUEST_NULL endif end subroutine wfield_2d_pipe ! subroutine pwpart_2d(pp,perr,file,part,npp,dspl,delta,ierr) implicit none class(perrors), intent(in), pointer :: perr class(parallel_pipe), intent(in), pointer :: pp class(hdf5file), intent(in) :: file real, dimension(:,:), intent(in) :: part real, dimension(2), intent(in) :: delta integer, intent(in) :: npp,dspl integer, intent(inout) :: ierr ! local data integer :: tnpp, tp, color, pgrp, pid, pnvp, i, j integer(hsize_t), dimension(1) :: ldim integer, dimension(:), pointer :: np integer, dimension(:,:), pointer:: dims real, dimension(:), pointer :: buff integer(hsize_t), dimension(1) :: start,maxdim integer(hid_t) :: treal integer(hid_t) :: flplID, xferID, memspaceID, aid integer(hid_t) :: file_id, rootID, dset_id, dspace_id, aspace_id integer :: info integer, dimension(10) :: istat character(len=:), allocatable :: filename character(len=8) :: st allocate(character(len(trim(file%filename))+len(trim(file%dataname))+11) :: filename) write (st,'(I8.8)') file%n filename = trim(file%filename)//trim(file%dataname)//'_'//st//'.h5' ierr = 0 ldim(1) = 1 call h5open_f(ierr) treal = detect_precision() tnpp = int(npp/dspl) tp = 0 call MPI_ALLREDUCE(tnpp,tp,1,MPI_INTEGER,MPI_SUM,pp%getlgrp(),ierr) if (tp == 0) then call h5pcreate_f(H5P_FILE_ACCESS_F, flplID, ierr) call h5pcreate_f(H5P_DATASET_XFER_F, xferID, ierr) info = MPI_INFO_NULL call h5pset_fapl_mpio_f(flplID, pp%getlgrp(), info, ierr) call h5pset_dxpl_mpio_f(xferID, H5FD_MPIO_COLLECTIVE_F, ierr) call h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, ierr,& &access_prp=flplID) call wrattr_file(file,file_id,xferID) call h5gopen_f(file_id, '/', rootID, ierr) call h5screate_simple_f(1, ldim, aspace_id, ierr) call h5acreate_f(rootID, 'tp', H5T_NATIVE_INTEGER, aspace_id,& &aid, ierr ) call h5awrite_f(aid, H5T_NATIVE_INTEGER, tp, ldim, ierr) call h5aclose_f(aid, ierr) call h5sclose_f(aspace_id, ierr) call h5pclose_f(xferID, ierr) call h5pclose_f(flplID, ierr) call h5gclose_f(rootID, ierr) call h5fclose_f(file_id, ierr) call h5close_f(ierr) return else if (tnpp > 0) then color = 1 else color = MPI_UNDEFINED endif call MPI_COMM_SPLIT(pp%getlgrp(), color, 0, pgrp, ierr ) if (tnpp > 0) then call MPI_COMM_RANK(pgrp, pid, ierr) call MPI_COMM_SIZE(pgrp, pnvp, ierr) allocate(np(pnvp), dims(2,pnvp), stat = ierr) call MPI_ALLGATHER(tnpp, 1, MPI_INTEGER, np, 1, MPI_INTEGER,& &pgrp, ierr) dims(1, 1) = 1 dims(2, 1) = np(1) do i = 2, pnvp dims(1,i) = dims(2,i-1) + 1 dims(2,i) = dims(1,i) + np(i) - 1 enddo allocate(buff(tnpp), stat = ierr) call h5pcreate_f(H5P_FILE_ACCESS_F, flplID, ierr) call h5pcreate_f(H5P_DATASET_XFER_F, xferID, ierr) info = MPI_INFO_NULL call h5pset_fapl_mpio_f(flplID, pgrp, info, ierr) call h5pset_dxpl_mpio_f(xferID, H5FD_MPIO_COLLECTIVE_F, ierr) call h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, ierr,& &access_prp=flplID) call wrattr_file(file,file_id,xferID) call h5gopen_f(file_id, '/', rootID, ierr) call h5screate_simple_f(1, ldim, aspace_id, ierr) call h5acreate_f(rootID, 'tp', H5T_NATIVE_INTEGER, aspace_id,& &aid, ierr ) call h5awrite_f(aid, H5T_NATIVE_INTEGER, tp, ldim, ierr) call h5aclose_f(aid, ierr) call h5sclose_f(aspace_id, ierr) do i = 1, 2 buff(1:tnpp) = part(i,1:(1+(tnpp-1)*dspl):dspl)*delta(i) ldim(1) = tp call h5screate_simple_f(1, ldim, dspace_id, ierr) call h5dcreate_f(rootID, 'x'//char(iachar('0')+i), treal,& &dspace_id, dset_id, ierr) ldim(1) = tnpp call h5screate_simple_f(1, ldim, memspaceID, ierr) start = dims(1,pid+1) - 1 call h5sselect_hyperslab_f(dspace_id, H5S_SELECT_SET_F,start,& &ldim, ierr) call h5dwrite_f(dset_id, treal, buff, ldim, ierr, memspaceID,& &dspace_id, xfer_prp=xferID) call wrattr_dataset(file,dset_id,unit='c/\omega_p',& &name='x_'//char(iachar('0')+i)) call h5sclose_f(memspaceID, ierr) call h5sclose_f(dspace_id, ierr) call h5dclose_f(dset_id, ierr) enddo do i = 1, 3 buff(1:tnpp) = part((i+2),1:(1+(tnpp-1)*dspl):dspl) ldim(1) = tp call h5screate_simple_f(1, ldim, dspace_id, ierr) call h5dcreate_f(rootID, 'p'//char(iachar('0')+i), treal,& &dspace_id, dset_id, ierr) ldim(1) = tnpp call h5screate_simple_f(1, ldim, memspaceID, ierr) start = dims(1,pid+1) - 1 call h5sselect_hyperslab_f(dspace_id, H5S_SELECT_SET_F,start,& &ldim, ierr) call h5dwrite_f(dset_id, treal, buff, ldim, ierr, memspaceID,& &dspace_id, xfer_prp=xferID) call wrattr_dataset(file,dset_id,unit='c/\omega_p',& &name='p_'//char(iachar('0')+i)) call h5sclose_f(memspaceID, ierr) call h5sclose_f(dspace_id, ierr) call h5dclose_f(dset_id, ierr) enddo buff(1:tnpp) = part((i+2),1:(1+(tnpp-1)*dspl):dspl) ldim(1) = tp call h5screate_simple_f(1, ldim, dspace_id, ierr) call h5dcreate_f(rootID, 'q', treal,& &dspace_id, dset_id, ierr) ldim(1) = tnpp call h5screate_simple_f(1, ldim, memspaceID, ierr) start = dims(1,pid+1) - 1 call h5sselect_hyperslab_f(dspace_id, H5S_SELECT_SET_F,start,& &ldim, ierr) call h5dwrite_f(dset_id, treal, buff, ldim, ierr, memspaceID,& &dspace_id, xfer_prp=xferID) call wrattr_dataset(file,dset_id,unit='a.u.',& &name='q') call h5sclose_f(memspaceID, ierr) call h5sclose_f(dspace_id, ierr) call h5dclose_f(dset_id, ierr) call h5pclose_f(xferID, ierr) call h5pclose_f(flplID, ierr) call h5gclose_f(rootID, ierr) call h5fclose_f(file_id, ierr) deallocate(np,dims,buff) endif if (pgrp /= MPI_COMM_NULL) then call MPI_COMM_FREE(pgrp, ierr) endif call h5close_f(ierr) endif end subroutine pwpart_2d ! subroutine pwpart_3d_pipe(pp,perr,file,part,npp,dspl,delta,rtag,stag,& &id,ierr) implicit none class(perrors), intent(in), pointer :: perr class(parallel_pipe), intent(in), pointer :: pp class(hdf5file), intent(in) :: file real, dimension(:,:), intent(in) :: part real, dimension(3), intent(in) :: delta integer, intent(in) :: npp,dspl integer, intent(in) :: rtag, stag integer, intent(inout) :: id, ierr ! local data integer :: tnpp, tp, tpo, color, pgrp, pid, pnvp, i, j integer(hsize_t), dimension(1) :: ldim integer, dimension(:), pointer :: np integer, dimension(:,:), pointer:: dims real, dimension(:), pointer :: buff integer(hsize_t), dimension(1) :: start,maxdim integer(hid_t) :: treal integer(hid_t) :: flplID, xferID, dcplID, memspaceID, aid integer(hid_t) :: file_id, rootID, dset_id, dspace_id, aspace_id integer :: ori, des, nvyp, stageid, mid, message, info integer, dimension(10) :: istat character(len=:), allocatable :: filename character(len=8) :: st allocate(character(len(trim(file%filename))+len(trim(file%dataname))+11) :: filename) write (st,'(I8.8)') file%n filename = trim(file%filename)//trim(file%dataname)//'_'//st//'.h5' ierr = 0 tpo = 0 ldim(1) = 1 call h5open_f(ierr) treal = detect_precision() tnpp = int(npp/dspl) nvyp = pp%getlnvp() ori = pp%getkstrt() - nvyp - 1 des = pp%getkstrt() + nvyp - 1 if (ori >= 0) then call MPI_IRECV(message,1,pp%getmint(),ori,rtag,pp%getlworld(),& &mid,ierr) call MPI_WAIT(mid,istat,ierr) endif call MPI_ALLREDUCE(tnpp,tp,1,MPI_INTEGER,MPI_SUM,pp%getlgrp(),ierr) if (tp == 0) then if (ori < 0) then call h5pcreate_f(H5P_FILE_ACCESS_F, flplID, ierr) call h5pcreate_f(H5P_DATASET_XFER_F, xferID, ierr) info = MPI_INFO_NULL call h5pset_fapl_mpio_f(flplID, pp%getlgrp(), info, ierr) call h5pset_dxpl_mpio_f(xferID, H5FD_MPIO_COLLECTIVE_F, ierr) call h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, ierr,& &access_prp=flplID) call wrattr_file(file,file_id,xferID) call h5gopen_f(file_id, '/', rootID, ierr) call h5screate_simple_f(1, ldim, aspace_id, ierr) call h5acreate_f(rootID, 'tp', H5T_NATIVE_INTEGER, aspace_id,& &aid, ierr ) call h5awrite_f(aid, H5T_NATIVE_INTEGER, tp, ldim, ierr) call h5aclose_f(aid, ierr) call h5sclose_f(aspace_id, ierr) call h5pclose_f(xferID, ierr) call h5pclose_f(flplID, ierr) call h5gclose_f(rootID, ierr) call h5fclose_f(file_id, ierr) endif if (des < pp%getnvp()) then call MPI_ISEND(message,1,pp%getmint(),des,stag,pp%getlworld(),& &id,ierr) else id = MPI_REQUEST_NULL endif call h5close_f(ierr) return else if (tnpp > 0) then color = 1 else color = MPI_UNDEFINED endif call MPI_COMM_SPLIT(pp%getlgrp(), color, 0, pgrp, ierr ) if (tnpp > 0) then call MPI_COMM_RANK(pgrp, pid, ierr) call MPI_COMM_SIZE(pgrp, pnvp, ierr) allocate(np(pnvp), dims(2,pnvp), stat = ierr) call MPI_ALLGATHER(tnpp, 1, MPI_INTEGER, np, 1, MPI_INTEGER,& &pgrp, ierr) dims(1, 1) = 1 dims(2, 1) = np(1) do i = 2, pnvp dims(1,i) = dims(2,i-1) + 1 dims(2,i) = dims(1,i) + np(i) - 1 enddo allocate(buff(tnpp), stat = ierr) call h5pcreate_f(H5P_FILE_ACCESS_F, flplID, ierr) call h5pcreate_f(H5P_DATASET_XFER_F, xferID, ierr) info = MPI_INFO_NULL call h5pset_fapl_mpio_f(flplID, pgrp, info, ierr) call h5pset_dxpl_mpio_f(xferID, H5FD_MPIO_COLLECTIVE_F, ierr) if (ori < 0) then call h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, ierr,& &access_prp=flplID) call wrattr_file(file,file_id,xferID) call h5gopen_f(file_id, '/', rootID, ierr) call h5screate_simple_f(1, ldim, aspace_id, ierr) call h5acreate_f(rootID, 'tp', H5T_NATIVE_INTEGER, aspace_id,& &aid, ierr ) call h5awrite_f(aid, H5T_NATIVE_INTEGER, tp, ldim, ierr) call h5aclose_f(aid, ierr) call h5sclose_f(aspace_id, ierr) else call h5fopen_f(filename,H5F_ACC_RDWR_F, file_id, ierr,& &access_prp=flplID) call h5gopen_f(file_id, '/', rootID, ierr) call h5aopen_f(rootID, 'tp', aid, ierr) call h5aread_f(aid, H5T_NATIVE_INTEGER, tpo, ldim, ierr) tp = tp + tpo call h5awrite_f(aid, H5T_NATIVE_INTEGER, tp, ldim, ierr) call h5aclose_f(aid, ierr) endif do i = 1, 3 buff(1:tnpp) = part(i,1:((tnpp-1)*dspl+1):dspl)*delta(i) if (ori >=0 .and. tpo /= 0) then call h5dopen_f(rootID, 'x'//char(iachar('0')+i), dset_id, ierr) ldim(1) = tp call h5dextend_f(dset_id, ldim, ierr) call h5screate_simple_f(1, ldim, dspace_id, ierr) ldim(1) = tnpp call h5screate_simple_f(1, ldim, memspaceID, ierr ) start = tpo + dims(1,pid+1) - 1 call h5sselect_hyperslab_f(dspace_id,H5S_SELECT_SET_F,start,& &ldim,ierr) call h5dwrite_f(dset_id, treal, buff, ldim, ierr, memspaceID,& &dspace_id, xfer_prp=xferID) else maxdim = (/H5S_UNLIMITED_F/) ldim(1) = 1 call h5screate_simple_f(1, ldim, dspace_id, ierr, maxdim) call h5pcreate_f(H5P_DATASET_CREATE_F, dcplID, ierr) ldim(1) = tp call h5pset_chunk_f(dcplID, 1, ldim, ierr) call h5dcreate_f(rootID, 'x'//char(iachar('0')+i), treal,& &dspace_id, dset_id, ierr, dcplID) ldim(1) = tp call h5dextend_f(dset_id, ldim, ierr) call h5sclose_f(dspace_id, ierr) call h5screate_simple_f(1, ldim, dspace_id, ierr) ldim(1) = tnpp call h5screate_simple_f(1, ldim, memspaceID, ierr ) start = tpo + dims(1,pid+1) - 1 call h5sselect_hyperslab_f(dspace_id, H5S_SELECT_SET_F,start,& &ldim, ierr) call h5dwrite_f(dset_id, treal, buff, ldim, ierr, memspaceID,& &dspace_id, xfer_prp=xferID) call wrattr_dataset(file,dset_id,unit='c/\omega_p',& &name='x_'//char(iachar('0')+i)) call h5pclose_f(dcplID, ierr) endif call h5sclose_f(memspaceID, ierr) call h5sclose_f(dspace_id, ierr) call h5dclose_f(dset_id, ierr) enddo do i = 1, 3 buff(1:tnpp) = part((i+3),1:((tnpp-1)*dspl+1):dspl) if (ori >= 0 .and. tpo /= 0) then call h5dopen_f(rootID, 'p'//char(iachar('0')+i), dset_id, ierr) ldim(1) = tp call h5dextend_f(dset_id, ldim, ierr) call h5screate_simple_f(1, ldim, dspace_id, ierr) ldim(1) = tnpp call h5screate_simple_f(1, ldim, memspaceID, ierr ) start = tpo + dims(1,pid+1) - 1 call h5sselect_hyperslab_f(dspace_id,H5S_SELECT_SET_F,start,& &ldim,ierr) call h5dwrite_f(dset_id, treal, buff, ldim, ierr, memspaceID,& &dspace_id, xfer_prp=xferID) else maxdim = (/H5S_UNLIMITED_F/) ldim(1) = 1 call h5screate_simple_f(1, ldim, dspace_id, ierr, maxdim) call h5pcreate_f(H5P_DATASET_CREATE_F, dcplID, ierr) ldim(1) = tp call h5pset_chunk_f(dcplID, 1, ldim, ierr) call h5dcreate_f(rootID, 'p'//char(iachar('0')+i), treal,& &dspace_id, dset_id, ierr, dcplID) ldim(1) = tp call h5dextend_f(dset_id, ldim, ierr) call h5sclose_f(dspace_id, ierr) call h5screate_simple_f(1, ldim, dspace_id, ierr) ldim(1) = tnpp call h5screate_simple_f(1, ldim, memspaceID, ierr ) start = tpo + dims(1,pid+1) - 1 call h5sselect_hyperslab_f(dspace_id, H5S_SELECT_SET_F,start,& &ldim, ierr) call h5dwrite_f(dset_id, treal, buff, ldim, ierr, memspaceID,& &dspace_id, xfer_prp=xferID) call wrattr_dataset(file,dset_id,unit='c/\omega_p',& &name='p_'//char(iachar('0')+i)) call h5pclose_f(dcplID, ierr) endif call h5sclose_f(memspaceID, ierr) call h5sclose_f(dspace_id, ierr) call h5dclose_f(dset_id, ierr) enddo buff(1:tnpp) = part(7,1:((tnpp-1)*dspl+1):dspl) if (ori >= 0 .and. tpo /= 0) then call h5dopen_f(rootID, 'q', dset_id, ierr) ldim(1) = tp call h5dextend_f(dset_id, ldim, ierr) call h5screate_simple_f(1, ldim, dspace_id, ierr) ldim(1) = tnpp call h5screate_simple_f(1, ldim, memspaceID, ierr ) start = tpo + dims(1,pid+1) - 1 call h5sselect_hyperslab_f(dspace_id,H5S_SELECT_SET_F,start,& &ldim,ierr) call h5dwrite_f(dset_id, treal, buff, ldim, ierr, memspaceID,& &dspace_id, xfer_prp=xferID) else maxdim = (/H5S_UNLIMITED_F/) ldim(1) = 1 call h5screate_simple_f(1, ldim, dspace_id, ierr, maxdim) call h5pcreate_f(H5P_DATASET_CREATE_F, dcplID, ierr) ldim(1) = tp call h5pset_chunk_f(dcplID, 1, ldim, ierr) call h5dcreate_f(rootID, 'q', treal,& &dspace_id, dset_id, ierr, dcplID) ldim(1) = tp call h5dextend_f(dset_id, ldim, ierr) call h5sclose_f(dspace_id, ierr) call h5screate_simple_f(1, ldim, dspace_id, ierr) ldim(1) = tnpp call h5screate_simple_f(1, ldim, memspaceID, ierr ) start = tpo + dims(1,pid+1) - 1 call h5sselect_hyperslab_f(dspace_id, H5S_SELECT_SET_F,start,& &ldim, ierr) call h5dwrite_f(dset_id, treal, buff, ldim, ierr, memspaceID,& &dspace_id, xfer_prp=xferID) call wrattr_dataset(file,dset_id,unit='a.u.',& &name='q') call h5pclose_f(dcplID, ierr) endif call h5sclose_f(memspaceID, ierr) call h5sclose_f(dspace_id, ierr) call h5dclose_f(dset_id, ierr) call h5pclose_f(xferID, ierr) call h5pclose_f(flplID, ierr) call h5gclose_f(rootID, ierr) call h5fclose_f(file_id, ierr) deallocate(np,dims,buff) endif endif if (des < pp%getnvp()) then call MPI_ISEND(message,1,pp%getmint(),des,stag,pp%getlworld(),& &id,ierr) else id = MPI_REQUEST_NULL endif if (pgrp /= MPI_COMM_NULL) then call MPI_COMM_FREE(pgrp, ierr ) endif call h5close_f(ierr) end subroutine pwpart_3d_pipe ! subroutine wpart(pp,perr,file,part,npp,dspl,ierr) implicit none class(perrors), intent(in), pointer :: perr class(parallel_pipe), intent(in), pointer :: pp class(hdf5file), intent(in) :: file real, dimension(:,:), intent(in) :: part integer, intent(in) :: npp,dspl integer, intent(inout) :: ierr ! local data integer :: tp integer(hsize_t), dimension(1) :: ldim integer(hsize_t), dimension(2) :: dim integer(hid_t) :: treal integer(hid_t) :: file_id, rootID, dset_id, dspace_id, aspace_id integer(hid_t) :: memspaceID, aid character(len=:), allocatable :: filename character(len=8) :: st allocate(character(len(trim(file%filename))+len(trim(file%dataname))+11) :: filename) write (st,'(I8.8)') file%n filename = trim(file%filename)//trim(file%dataname)//'_'//st//'.h5' ierr = 0 ldim(1) = 1 call h5open_f(ierr) treal = detect_precision() tp = int(npp/dspl) call h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, ierr) call wrattr_file(file,file_id,H5P_DEFAULT_F) call h5gopen_f(file_id, '/', rootID, ierr) call h5screate_simple_f(1, ldim, aspace_id, ierr) call h5acreate_f(rootID, 'tp', H5T_NATIVE_INTEGER, aspace_id,& &aid, ierr ) call h5awrite_f(aid, H5T_NATIVE_INTEGER, tp, ldim, ierr) call h5aclose_f(aid, ierr) call h5sclose_f(aspace_id, ierr) if (tp == 0) then call h5gclose_f(rootID, ierr) call h5fclose_f(file_id, ierr) call h5close_f(ierr) else dim(1) = size(part,1) dim(2) = tp call h5screate_simple_f(2, dim, dspace_id, ierr) call h5screate_simple_f(2, dim, memspaceID, ierr) call h5dcreate_f(rootID, file%dataname, treal, dspace_id, dset_id,& &ierr) call wrattr_dataset(file,dset_id) call h5dwrite_f(dset_id, treal, part(:,1:(1+(tp-1)*dspl):dspl),& &dim, ierr, memspaceID, dspace_id) call h5sclose_f(memspaceID, ierr) call h5sclose_f(dspace_id, ierr) call h5gclose_f(rootID, ierr) call h5dclose_f(dset_id, ierr) call h5fclose_f(file_id, ierr) call h5close_f(ierr) end if end subroutine wpart ! subroutine rpart(pp,perr,file,part,npp,ierr) implicit none class(perrors), intent(in), pointer :: perr class(parallel_pipe), intent(in), pointer :: pp class(hdf5file), intent(in) :: file real, dimension(:,:), intent(inout) :: part integer, intent(out) :: npp integer, intent(inout) :: ierr ! local data integer :: tp integer(hsize_t), dimension(1) :: ldim integer(hsize_t), dimension(2) :: dim integer(hid_t) :: treal integer(hid_t) :: file_id, rootID, dset_id, dspace_id, aspace_id integer(hid_t) :: memspaceID, aid character(len=:), allocatable :: filename character(len=8) :: st allocate(character(len(trim(file%filename))+len(trim(file%dataname))+11) :: filename) write (st,'(I8.8)') file%n filename = trim(file%filename)//trim(file%dataname)//'_'//st//'.h5' ierr = 0 ldim(1) = 1 call h5open_f(ierr) treal = detect_precision() call h5fopen_f(filename,H5F_ACC_RDONLY_F, file_id, ierr) call h5gopen_f(file_id, '/', rootID, ierr) call h5aopen_f(rootID, 'tp', aid, ierr) call h5aread_f(aid, H5T_NATIVE_INTEGER, tp, ldim, ierr) call h5aclose_f(aid, ierr) npp = tp if (tp == 0) then call h5gclose_f(rootID, ierr) call h5fclose_f(file_id, ierr) call h5close_f(ierr) else dim(1) = size(part,1) dim(2) = tp call h5screate_simple_f(2, dim, dspace_id, ierr) call h5screate_simple_f(2, dim, memspaceID, ierr) call h5dopen_f(rootID, file%dataname, dset_id, ierr) call h5dread_f(dset_id, treal, part,& &dim, ierr, memspaceID, dspace_id) call h5sclose_f(memspaceID, ierr) call h5sclose_f(dspace_id, ierr) call h5gclose_f(rootID, ierr) call h5dclose_f(dset_id, ierr) call h5fclose_f(file_id, ierr) call h5close_f(ierr) end if end subroutine rpart ! function detect_precision() integer(hid_t) :: detect_precision ! local data real :: small small = 1.0e-12 small = 1.0 + small if (small>1.0) then detect_precision = H5T_NATIVE_DOUBLE else detect_precision = H5T_NATIVE_REAL endif end function detect_precision ! end module hdf5io_class