summaryrefslogtreecommitdiffstats
path: root/m4
Commit message (Expand)AuthorAgeFilesLines
...
| | * [svn-r26917] added conditional for C_LONG_DOUBLEScot Breitenfeld2015-04-231-0/+35
| | * [svn-r26866] Removed the default REAL and DOUBLE PRECESION dependency.Scot Breitenfeld2015-04-211-33/+0
| |/
* | [svn-r26350] Merge of r26273-26348 from the trunk.Dana Robinson2015-03-041-6/+6
|\ \ | |/
| * [svn-r26280] Removed tab indenting for Fortran source, tab indenting is not F...Scot Breitenfeld2015-02-231-6/+6
| * [svn-r26247] Reverted back from using 'USE MPI' to include 'mpif.h' since win...Scot Breitenfeld2015-02-201-1/+1
| * [svn-r26188] Merged autotools fixes into the trunk:Scot Breitenfeld2015-02-162-0/+404
* | [svn-r26127] Fixed typo.Scot Breitenfeld2015-02-051-1/+1
* | [svn-r26113] Updated configure and the parallel tests to 'USE mpi' instead of...Scot Breitenfeld2015-02-021-1/+1
* | [svn-r26098] Removed copied m4 files from version control.Dana Robinson2015-02-025-8610/+0
* | [svn-r26063] Fixed the wrong number of arguments being used for MPI_FILE_OPEN...Scot Breitenfeld2015-01-281-3/+4
* | [svn-r26062] Changed the fortran test back from "USE mpi" to "include "mpif.h...Scot Breitenfeld2015-01-281-1/+1
* | [svn-r26061] Fixed unintentional typo.Scot Breitenfeld2015-01-281-2/+2
* | [svn-r26060] Fix for HDFFV-9091Scot Breitenfeld2015-01-271-0/+4
* | [svn-r26059] Fix for: HDFFV-9095 Scot Breitenfeld2015-01-271-1/+1
* | [svn-r26057] Fix for: HDFFV-9094Scot Breitenfeld2015-01-271-0/+27
* | [svn-r26053] Added comments.Scot Breitenfeld2015-01-272-0/+10
* | [svn-r26052] Fixed false positive tests for intrensic functions.Scot Breitenfeld2015-01-272-11/+14
* | [svn-r26051] Fix for HDFFV-9092Scot Breitenfeld2015-01-272-0/+359
|/
* [svn-r22706] Updated autotools: autoconf 2.69, automake 1.12.3, m4 1.4.16, l...Larry Knox2012-08-223-64/+230
* [svn-r19839] Updated to libtool v 2.4, autoconf 2.68 and m4-1.4.15.Larry Knox2010-11-232-330/+724
* [svn-r19366] Updated autoconf to version 2.6.7, libtool to version 2.2.10, an...Larry Knox2010-09-105-0/+8050
generated by cgit v0.12 at 2024-10-12 18:12:20 (GMT)
a> 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
!   Copyright by The HDF Group.                                               *
!   Copyright by the Board of Trustees of the University of Illinois.         *
!   All rights reserved.                                                      *
!                                                                             *
!   This file is part of HDF5.  The full HDF5 copyright notice, including     *
!   terms governing use, modification, and redistribution, is contained in    *
!   the files COPYING and Copyright.html.  COPYING can be found at the root   *
!   of the source code distribution tree; Copyright.html can be found at the  *
!   root level of an installed copy of the electronic HDF5 document set and   *
!   is linked from the top-level documents page.  It can also be found at     *
!   http://hdfgroup.org/HDF5/doc/Copyright.html.  If you do not have          *
!   access to either file, you may request a copy from help@hdfgroup.org.     *
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *


!
! writes/reads dataset by hyperslabs
!

SUBROUTINE hyper(length,do_collective,do_chunk, mpi_size, mpi_rank, nerrors)
  USE HDF5
  USE TH5_MISC
  IMPLICIT NONE
  INCLUDE 'mpif.h'

  INTEGER, INTENT(in) :: length                     ! array length
  LOGICAL, INTENT(in) :: do_collective              ! use collective I/O
  LOGICAL, INTENT(in) :: do_chunk                   ! use chunking
  INTEGER, INTENT(in) :: mpi_size                   ! number of processes in the group of communicator
  INTEGER, INTENT(in) :: mpi_rank                   ! rank of the calling process in the communicator
  INTEGER, INTENT(inout) :: nerrors                 ! number of errors
  INTEGER :: mpierror                               ! MPI hdferror flag
  INTEGER :: hdferror                               ! HDF hdferror flag
  INTEGER(hsize_t), DIMENSION(1) :: dims            ! dataset dimensions
  INTEGER(hsize_t), DIMENSION(1) :: cdims           ! chunk dimensions
  INTEGER, ALLOCATABLE :: wbuf(:)                   ! write buffer
  INTEGER, ALLOCATABLE :: rbuf(:)                   ! read buffer
  INTEGER(hsize_t), DIMENSION(1) :: counti          ! hyperslab selection
  INTEGER(hsize_t), DIMENSION(1) :: start           ! hyperslab selection
  INTEGER(hid_t) :: fapl_id                         ! file access identifier
  INTEGER(hid_t) :: dxpl_id                         ! dataset transfer property list
  INTEGER(hid_t) :: dcpl_id                         ! dataset creation property list
  INTEGER(hid_t) :: file_id                         ! file identifier
  INTEGER(hid_t) :: dset_id                         ! dataset identifier
  INTEGER(hid_t) :: fspace_id                       ! file space identifier
  INTEGER(hid_t) :: mspace_id                       ! memory space identifier
  INTEGER(hid_t) :: driver_id                       ! low-level file driver identifier
  INTEGER        :: istart                          ! start position in array
  INTEGER        :: iend                            ! end position in array
  INTEGER        :: icount                          ! number of elements in array
  CHARACTER(len=80) :: filename                     ! filename
  INTEGER        :: i
  INTEGER        :: actual_io_mode                  ! The type of I/O performed by this process
  LOGICAL        :: is_coll
  LOGICAL        :: is_coll_true = .TRUE.
  !
  ! initialize the array data between the processes (3)
  ! for the 12 size array we get
  ! p0 = 1,2,3,4
  ! p1 = 5,6,7,8
  ! p2 = 9,10,11,12
  !

  ALLOCATE(wbuf(0:length-1),stat=hdferror)
  IF (hdferror /= 0) THEN
     WRITE(*,*) 'allocate error'
     RETURN
  ENDIF

  ALLOCATE(rbuf(0:length-1),stat=hdferror)
  IF (hdferror /= 0) THEN
     WRITE(*,*) 'allocate error'
     RETURN
  ENDIF

  icount  = length/mpi_size     ! divide the array by the number of processes
  istart  = mpi_rank*icount     ! start position
  iend    = istart + icount     ! end position

  DO i = istart, iend-1
     wbuf(i) = i
  ENDDO

  !
  ! HDF5 I/O
  !

  dims(1)  = length
  cdims(1) = length/mpi_size     ! define chunks as the number of processes

  !
  ! setup file access property list with parallel I/O access
  !
  CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl_id, hdferror)
  CALL check("h5pcreate_f", hdferror, nerrors)

  CALL h5pset_fapl_mpio_f(fapl_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdferror)
  CALL check("h5pset_fapl_mpio_f", hdferror, nerrors)

  CALL h5pget_driver_f(fapl_id, driver_id, hdferror)
  CALL check("h5pget_driver_f", hdferror, nerrors)

  IF( driver_id /= H5FD_MPIO_F) THEN
     WRITE(*,*) "Wrong driver information returned"
     nerrors = nerrors + 1
  ENDIF

  !
  ! create the file collectively
  !
  CALL h5_fixname_f("parf1", filename, fapl_id, hdferror)

  IF(do_collective)THEN
     ! verify settings for file access properties

     ! Collective metadata writes
     CALL h5pget_coll_metadata_write_f(fapl_id, is_coll, hdferror)
     CALL check("h5pget_coll_metadata_write_f", hdferror, nerrors)
     IF(is_coll .NEQV. .FALSE.)THEN
        PRINT*, "Incorrect property setting for coll metadata writes"
        nerrors = nerrors + 1
     ENDIF

     ! Collective metadata read API calling requirement
     CALL h5pget_all_coll_metadata_ops_f(fapl_id, is_coll, hdferror)
     CALL check("h5pget_all_coll_metadata_ops_f", hdferror, nerrors)
     IF(is_coll .NEQV. .FALSE.)THEN
        PRINT*, "Incorrect property setting for coll metadata API calls requirement"
        nerrors = nerrors + 1
     ENDIF

     ! Collective metadata writes
     CALL h5pset_coll_metadata_write_f(fapl_id, .TRUE., hdferror)
     CALL check("h5pset_coll_metadata_write_f", hdferror, nerrors)
     ! Collective metadata READ API calling requirement
     CALL h5pset_all_coll_metadata_ops_f(fapl_id, is_coll_true, hdferror)
     CALL check("h5pset_all_coll_metadata_ops_f", hdferror, nerrors)
   
     CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, hdferror, access_prp = fapl_id)
     CALL check("h5fcreate_f", hdferror, nerrors)

     ! close fapl and retrieve it from file
     CALL h5pclose_f(fapl_id, hdferror)
     CALL check("h5pclose_f", hdferror, nerrors)
     CALL h5fget_access_plist_f(file_id, fapl_id, hdferror)
     CALL check("h5fget_access_plist_f", hdferror, nerrors)
    
     ! verify settings for file access properties

     ! Collective metadata writes
     CALL h5pget_coll_metadata_write_f(fapl_id, is_coll, hdferror)
     CALL check("h5pget_coll_metadata_write_f", hdferror, nerrors)
     IF(is_coll .NEQV. .TRUE.)THEN
        PRINT*, "Incorrect property setting for coll metadata writes"
        nerrors = nerrors + 1
     ENDIF

     ! Collective metadata read API calling requirement
     CALL h5pget_all_coll_metadata_ops_f(fapl_id, is_coll, hdferror)
     CALL check("h5pget_all_coll_metadata_ops_f", hdferror, nerrors)
     IF(is_coll .NEQV. .TRUE.)THEN
        PRINT*, "Incorrect property setting for coll metadata API calls requirement"
        nerrors = nerrors + 1
     ENDIF
  ELSE
     CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, hdferror, access_prp = fapl_id)
     CALL check("h5fcreate_f", hdferror, nerrors)
  ENDIF

  CALL h5screate_simple_f(1, dims, fspace_id, hdferror)
  CALL check("h5screate_simple_f", hdferror, nerrors)

  CALL h5screate_simple_f(1, dims, mspace_id, hdferror)
  CALL check("h5screate_simple_f", hdferror, nerrors)

  !
  ! modify dataset creation properties to enable chunking
  !

  CALL h5pcreate_f(H5P_DATASET_CREATE_F, dcpl_id, hdferror)
  CALL check("h5pcreate_f", hdferror, nerrors)

  IF (do_chunk) THEN
     CALL h5pset_chunk_f(dcpl_id, 1, cdims, hdferror)
     CALL check("h5pset_chunk_f", hdferror, nerrors)
  ENDIF

  !
  ! create the dataset
  !

  CALL h5dcreate_f(file_id, "dset", H5T_NATIVE_INTEGER, fspace_id, dset_id, hdferror, dcpl_id)
  CALL check("h5dcreate_f", hdferror, nerrors)

  !
  ! define hyperslab
  !

  counti(1) = icount
  start(1)  = istart

  !
  ! select hyperslab in memory
  !

  CALL h5sselect_hyperslab_f(mspace_id, H5S_SELECT_SET_F, start, counti, hdferror)
  CALL check("h5sselect_hyperslab_f", hdferror, nerrors)

  !
  ! select hyperslab in the file
  !

  CALL h5sselect_hyperslab_f(fspace_id, H5S_SELECT_SET_F, start, counti, hdferror)
  CALL check("h5sselect_hyperslab_f", hdferror, nerrors)


  !
  ! create a property list for collective dataset write
  !

  CALL h5pcreate_f(H5P_DATASET_XFER_F, dxpl_id, hdferror)
  CALL check("h5pcreate_f", hdferror, nerrors)

  IF (do_collective) THEN
     CALL h5pset_dxpl_mpio_f(dxpl_id, H5FD_MPIO_COLLECTIVE_F, hdferror)
     CALL check("h5pset_dxpl_mpio_f", hdferror, nerrors)
  ENDIF

  !
  ! write dataset
  !

  CALL h5dwrite_f(dset_id,H5T_NATIVE_INTEGER,wbuf,dims,hdferror,file_space_id=fspace_id,mem_space_id=mspace_id,xfer_prp=dxpl_id)
  CALL check("h5dwrite_f", hdferror, nerrors)


  ! Check h5pget_mpio_actual_io_mode_f function
  CALL h5pget_mpio_actual_io_mode_f(dxpl_id, actual_io_mode, hdferror)
  CALL check("h5pget_mpio_actual_io_mode_f", hdferror, nerrors)

  IF(do_collective.AND.do_chunk)THEN
     IF(actual_io_mode.NE.H5D_MPIO_CHUNK_COLLECTIVE_F)THEN
        CALL check("h5pget_mpio_actual_io_mode_f", -1, nerrors)
     ENDIF
  ELSEIF(.NOT.do_collective)THEN
     IF(actual_io_mode.NE.H5D_MPIO_NO_COLLECTIVE_F)THEN
        CALL check("h5pget_mpio_actual_io_mode_f", -1, nerrors)
     ENDIF
  ELSEIF( do_collective.AND.(.NOT.do_chunk))THEN
     IF(actual_io_mode.NE.H5D_MPIO_CONTIG_COLLECTIVE_F)THEN
        CALL check("h5pget_mpio_actual_io_mode_f", -1, nerrors)
     ENDIF
  ENDIF

  !
  ! close HDF5 I/O
  !

  CALL h5pclose_f(fapl_id, hdferror)
  CALL check("h5pclose_f", hdferror, nerrors)

  CALL h5pclose_f(dcpl_id, hdferror)
  CALL check("h5pclose_f", hdferror, nerrors)

  CALL h5pclose_f(dxpl_id, hdferror)
  CALL check("h5pclose_f", hdferror, nerrors)

  CALL h5sclose_f(mspace_id, hdferror)
  CALL check("h5sclose_f", hdferror, nerrors)

  CALL h5sclose_f(fspace_id, hdferror)
  CALL check("h5sclose_f", hdferror, nerrors)

  CALL h5dclose_f(dset_id, hdferror)
  CALL check("h5dclose_f", hdferror, nerrors)

  CALL h5fclose_f(file_id, hdferror)
  CALL check("h5fclose_f", hdferror, nerrors)

  !
  ! reopen file with read access
  !

  CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl_id, hdferror)
  CALL check("h5pcreate_f", hdferror, nerrors)

  CALL h5pset_fapl_mpio_f(fapl_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdferror)
  CALL check("h5pcreate_f", hdferror, nerrors)

  CALL h5fopen_f(filename, H5F_ACC_RDWR_F, file_id, hdferror, access_prp = fapl_id)
  CALL check("h5pcreate_f", hdferror, nerrors)

  CALL h5screate_simple_f(1, dims, fspace_id, hdferror)
  CALL check("h5pcreate_f", hdferror, nerrors)

  CALL h5screate_simple_f(1, dims, mspace_id, hdferror)
  CALL check("h5pcreate_f", hdferror, nerrors)

  CALL h5dopen_f(file_id, "dset", dset_id, hdferror)
  CALL check("h5pcreate_f", hdferror, nerrors)

  !
  ! select hyperslab in memory
  !

  CALL h5sselect_hyperslab_f(mspace_id, H5S_SELECT_SET_F, start, counti, hdferror)
  CALL check("h5pcreate_f", hdferror, nerrors)

  !
  ! select hyperslab in the file
  !

  CALL h5sselect_hyperslab_f(fspace_id, H5S_SELECT_SET_F, start, counti, hdferror)
  CALL check("h5pcreate_f", hdferror, nerrors)

  !
  ! create a property list for collective dataset read
  !

  CALL h5pcreate_f(H5P_DATASET_XFER_F, dxpl_id, hdferror)
  CALL check("h5pcreate_f", hdferror, nerrors)

  IF (do_collective) THEN
     CALL h5pset_dxpl_mpio_f(dxpl_id, H5FD_MPIO_COLLECTIVE_F, hdferror)
     CALL check("h5pcreate_f", hdferror, nerrors)
  ENDIF

  !
  ! read dataset
  !

  CALL h5dread_f(dset_id,H5T_NATIVE_INTEGER,rbuf,dims,hdferror,file_space_id=fspace_id,mem_space_id=mspace_id,xfer_prp=dxpl_id)
  CALL check("h5pcreate_f", hdferror, nerrors)

  !
  ! close HDF5 I/O
  !

  CALL h5pclose_f(fapl_id, hdferror)
  CALL check("h5pcreate_f", hdferror, nerrors)

  CALL h5pclose_f(dxpl_id, hdferror)
  CALL check("h5pcreate_f", hdferror, nerrors)

  CALL h5sclose_f(fspace_id, hdferror)
  CALL check("h5pcreate_f", hdferror, nerrors)

  CALL h5sclose_f(mspace_id, hdferror)
  CALL check("h5pcreate_f", hdferror, nerrors)

  CALL h5dclose_f(dset_id, hdferror)
  CALL check("h5pcreate_f", hdferror, nerrors)

  CALL h5fclose_f(file_id, hdferror)
  CALL check("h5pcreate_f", hdferror, nerrors)

  !
  ! compare read and write data. each process compares a subset of the array
  !

  DO i = istart, iend-1
     IF( wbuf(i) /= rbuf(i)) THEN
        WRITE(*,*) 'buffers differs at ', i, rbuf(i), wbuf(i)
        nerrors = nerrors + 1
     ENDIF
  ENDDO

  DEALLOCATE(wbuf)
  DEALLOCATE(rbuf)

END SUBROUTINE hyper
generated by cgit v0.12 at 2024-10-12 18:12:19 (GMT)