LCOV - code coverage report
Current view: top level - io - iomatrix_hdf.F90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 84 0.0 %
Date: 2019-09-08 04:53:50 Functions: 0 5 0.0 %

          Line data    Source code
       1             : MODULE m_iomatrix_hdf
       2             :   USE m_judft
       3             :   USE hdf5
       4             :   USE m_hdf_tools
       5             :   USE m_types_mat
       6             :   USE m_types_mpimat
       7             :   IMPLICIT NONE
       8             :   PRIVATE
       9             :   PUBLIC iomatrix_hdf_close,iomatrix_hdf_open,iomatrix_hdf_write,iomatrix_hdf_read
      10             :   
      11             : CONTAINS
      12           0 :   SUBROUTINE  iomatrix_hdf_read(mat,nrec,did)
      13             :     CLASS(t_Mat),INTENT(INOUT)  :: mat
      14             :     INTEGER,INTENT(IN)          :: nrec
      15             :     INTEGER(HID_t),INTENT(in)   :: did
      16             : 
      17             :     INTEGER::mpi_comm,dim(4)
      18             : 
      19             :    
      20             :     INTEGER(HID_t) :: memspace,fspace,trans
      21             :     INTEGER(hsize_t):: dims(4)
      22             :     INTEGER        :: err
      23           0 :     REAL,ALLOCATABLE :: dat(:,:,:,:)
      24             :     SELECT TYPE(mat)
      25             :     TYPE is (t_mpimat)
      26           0 :        mpi_comm=mat%blacsdata%mpi_com !Only information used from mat intent(in)
      27             :     CLASS default
      28           0 :        mpi_comm=0
      29             :     END SELECT
      30           0 :     CALL io_datadim(did,dim)
      31           0 :     CALL mat%init(DIM(1)==1,DIM(2),DIM(3),mpi_comm,.TRUE.)
      32             :     SELECT TYPE(mat)
      33             :     TYPE is (t_mat)
      34           0 :        IF (mat%l_real) THEN
      35           0 :           CALL io_read(did,(/1,1,1,nrec/),(/1,mat%matsize1,mat%matsize2,1/),mat%data_r)
      36             :        ELSE
      37           0 :           CALL io_read(did,(/-1,1,1,nrec/),(/1,mat%matsize1,mat%matsize2,1/),mat%data_c)
      38             :        END IF
      39             :     TYPE is (t_mpimat)
      40           0 :        ALLOCATE(dat(MERGE(1,2,mat%l_real),mat%matsize1,mat%matsize2,1))
      41             :        
      42           0 :        CALL h5dget_space_f(did,fspace,err)
      43           0 :        CALL priv_create_hyperslab_from_blacsdesc(mat%l_real,nrec,fspace,mat%blacsdata%blacs_desc)
      44           0 :        dims=SHAPE(dat)
      45           0 :        CALL h5screate_simple_f(4,dims,memspace,err)
      46           0 :        trans=gettransprop()
      47           0 :        CALL h5dread_f(did,H5T_NATIVE_DOUBLE,dat,dims,err,memspace,fspace,trans)
      48           0 :        CALL h5sclose_f(memspace,err)                                  
      49           0 :        CALL h5sclose_f(fspace,err)
      50           0 :        CALL cleartransprop(trans) 
      51           0 :        IF (mat%l_real) THEN 
      52           0 :           mat%data_r=dat(1,:,:,1)
      53             :        ELSE
      54           0 :          mat%data_c=CMPLX(dat(1,:,:,1),dat(2,:,:,1))
      55             :       ENDIF
      56             :     END SELECT
      57           0 :   END SUBROUTINE iomatrix_hdf_read
      58             : 
      59           0 :   SUBROUTINE  iomatrix_hdf_write(mat,rec,did)
      60             :     CLASS(t_Mat),INTENT(IN)  :: mat
      61             :     INTEGER,INTENT(IN)       :: rec
      62             :     INTEGER(HID_t),INTENT(in)::did
      63             :     
      64             :     INTEGER(HID_t) :: memspace,fspace,trans
      65             :     INTEGER(HSIZE_t):: dims(4)
      66             :     INTEGER :: err
      67           0 :     REAL,ALLOCATABLE :: dat(:,:,:,:)
      68             : 
      69             :     
      70             :     SELECT TYPE(mat)
      71             :     TYPE is (t_mat)
      72           0 :        IF (mat%l_real) THEN
      73           0 :           CALL io_write(did,(/1,1,1,rec/),(/1,mat%matsize1,mat%matsize2,1/),mat%data_r)
      74             :        ELSE
      75           0 :           CALL io_write(did,(/1,1,1,rec/),(/1,mat%matsize1,mat%matsize2,1/),REAL(mat%data_c))
      76           0 :           CALL io_write(did,(/2,1,1,rec/),(/1,mat%matsize1,mat%matsize2,1/),AIMAG(mat%data_c))
      77             :        END IF
      78             :     TYPE is (t_mpimat)
      79           0 :        ALLOCATE(dat(MERGE(1,2,mat%l_real),mat%matsize1,mat%matsize2,1))
      80           0 :        IF (mat%l_real) THEN 
      81           0 :           dat(1,:,:,1)=mat%data_r
      82             :        ELSE
      83           0 :          dat(1,:,:,1)=REAL(mat%data_c)
      84           0 :          dat(2,:,:,1)=REAL(mat%data_c)
      85             :       ENDIF
      86           0 :       CALL h5dget_space_f(did,fspace,err)
      87           0 :       CALL priv_create_hyperslab_from_blacsdesc(mat%l_real,rec,fspace,mat%blacsdata%blacs_desc)
      88           0 :       dims=SHAPE(dat)
      89           0 :       CALL h5screate_simple_f(4,dims,memspace,err)
      90           0 :       trans=gettransprop()
      91           0 :       CALL h5dwrite_f(did,H5T_NATIVE_DOUBLE,dat,dims,err,memspace,fspace,trans)
      92           0 :       CALL h5sclose_f(memspace,err)                                  
      93           0 :       CALL h5sclose_f(fspace,err)
      94           0 :       CALL cleartransprop(trans) 
      95             :    END SELECT
      96             : 
      97           0 :   END SUBROUTINE iomatrix_hdf_write
      98             : 
      99           0 :   SUBROUTINE iomatrix_hdf_close(fid,did)
     100             :     INTEGER(hid_t),INTENT(inout):: fid,did
     101             :     INTEGER:: err
     102           0 :     CALL h5dclose_f(did,err)
     103           0 :     CALL h5fclose_f(fid,err)
     104           0 :   END SUBROUTINE iomatrix_hdf_close
     105             : 
     106           0 :   SUBROUTINE iomatrix_hdf_open(l_real,matsize,no_rec,filename,fid,did)
     107             :     LOGICAL,INTENT(IN)          :: l_real
     108             :     INTEGER,INTENT(in)          :: matsize,no_rec
     109             :     CHARACTER(len=*),INTENT(in) :: filename
     110             :     INTEGER(hid_t),INTENT(out)  :: fid,did
     111             :     
     112             :     INTEGER :: dims(4),err
     113             :     LOGICAL :: l_exist
     114             :     INTEGER(HID_T)  :: access_prp
     115             : #if defined(CPP_HDFMPI) && defined(CPP_MPI)
     116             :     include 'mpif.h'
     117           0 :     CALL h5pcreate_f(H5P_FILE_ACCESS_F, access_prp, err)
     118           0 :     CALL h5pset_fapl_mpio_f(access_prp, MPI_COMM_WORLD, MPI_INFO_NULL,err)
     119             : #else
     120             :     access_prp=H5P_DEFAULT_f
     121             : #endif
     122             : 
     123             : 
     124           0 :     INQUIRE(file=filename//'.hdf',exist=l_exist)
     125           0 :     IF (l_exist) THEN
     126           0 :        CALL h5fopen_f(filename//'.hdf',H5F_ACC_RDWR_F,fid,err,access_prp)
     127             :     ELSE
     128           0 :        CALL h5fcreate_f(filename//'.hdf',H5F_ACC_TRUNC_F,fid,err,H5P_DEFAULT_f,access_prp)
     129             :     ENDIF
     130           0 :     IF (io_dataexists(fid,'Matrix')) THEN
     131           0 :        CALL h5dopen_f(fid,"Matrix", did, err)
     132             :     ELSE
     133             :        !Create data-space
     134           0 :        dims(1)  = MERGE(1,2,l_real)
     135           0 :        dims(2:3)= matsize
     136           0 :        dims(4)  = no_rec
     137           0 :        call io_createvar(fid,"Matrix",H5T_NATIVE_DOUBLE,dims,did)
     138             :     END IF
     139           0 :   END SUBROUTINE iomatrix_hdf_open
     140             : 
     141             : 
     142           0 :   SUBROUTINE priv_create_hyperslab_from_blacsdesc(l_real,nrec,sid,blacsdesc)
     143             :     LOGICAL,INTENT(IN) :: l_real
     144             :     INTEGER,INTENT(in) :: nrec,blacsdesc(9)
     145             :     INTEGER(hid_t),INTENT(in):: sid
     146             :     
     147             :     INTEGER(hsize_t):: start(4),COUNT(4),stride(4),bloc(4)
     148             :     INTEGER         :: nprow,npcol,myrow,mycol,block_row,block_col,matsize,blacs_ctxt,err
     149             :     LOGICAL         :: ok
     150             :     !For readability get data from blacsdesc
     151             : #ifdef CPP_SCALAPACK
     152           0 :     blacs_ctxt=blacsdesc(2)
     153           0 :     block_row=blacsdesc(5)
     154           0 :     block_col=blacsdesc(6)
     155           0 :     matsize=blacsdesc(4)
     156           0 :     CALL blacs_gridinfo(blacs_ctxt,nprow,npcol,myrow,mycol)
     157             : 
     158           0 :     CALL h5Sselect_none_f(sid,err) !unselect all elements in dataspace
     159             :     !Select blocks of blacs-grid
     160           0 :     start=(/0,myrow*block_row,mycol*block_col,nrec-1/)
     161           0 :     count=(/1,FLOOR(1.*matsize/block_row)+1,FLOOR(1.*matsize/block_col)+1,1/)
     162           0 :     stride=(/1,nprow*block_row,npcol*block_col,1/)
     163           0 :     bloc=(/MERGE(1,2,l_real),block_row,block_col,1/)
     164           0 :     CALL h5sselect_hyperslab_f(sid,H5S_SELECT_OR_F,start,count,err,stride,bloc)
     165           0 :     CALL h5sselect_valid_f(sid,ok,err)
     166           0 :     IF (.NOT.ok) THEN
     167           0 :        CALL h5sget_simple_extent_dims_f(sid,start,stride,err)
     168             :        !Cut to actual sizes
     169           0 :        start=(/0,0,0,0/)
     170           0 :        count=(/MERGE(1,2,l_real),matsize,matsize,int(stride(4))/)
     171           0 :        CALL h5sselect_hyperslab_f(sid,H5S_SELECT_AND_F,start,count,err) 
     172           0 :        CALL h5sselect_valid_f(sid,ok,err)
     173           0 :        IF (.NOT.ok) CALL judft_error("Writing of matrix failed, BUG in parallel HDF-IO")
     174             :     ENDIF
     175             : #endif
     176           0 :   END SUBROUTINE priv_create_hyperslab_from_blacsdesc
     177           0 : END MODULE m_iomatrix_hdf

Generated by: LCOV version 1.13