Line data    Source code

       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
       3             : ! This file is part of FLEUR and available as free software under the conditions
       4             : ! of the MIT license as expressed in the LICENSE file in more detail.
       5             : !--------------------------------------------------------------------------------
       6             : 
       7             : MODULE m_io_matrix
       8             :   USE m_types_mat
       9             :   USE m_types_mpimat
      10             :   USE m_judft
      11             : #ifdef CPP_HDF
      12             :   USE m_iomatrix_hdf
      13             :   USE hdf5
      14             : #endif
      15             :   IMPLICIT NONE
      16             :   PRIVATE
      17             :   TYPE t_iomatrix_handle
      18             :      INTEGER:: mode=0 !can be 1 for DA or 2 for HDF
      19             :      INTEGER:: id !file ID in direct-access mode
      20             : #ifdef CPP_HDF
      21             :      INTEGER(hid_t):: fid,did !file-handle in hdf mode
      22             : #endif
      23             :   END TYPE t_iomatrix_handle
      24             : 
      25             :   TYPE(t_iomatrix_handle)::fh(10)
      26             : 
      27             :   PUBLIC:: t_iomatrix_handle,open_matrix,read_matrix,write_matrix,close_matrix
      28             : CONTAINS
      29           0 :   INTEGER FUNCTION OPEN_matrix(l_real,matsize,mode,no_rec,filename)
      30             :     LOGICAL,INTENT(IN)          :: l_real
      31             :     INTEGER,INTENT(in)          :: matsize,no_rec,mode
      32             :     CHARACTER(len=*),INTENT(in) :: filename
      33             :     !Find free handle
      34           0 :     DO open_matrix=1,SIZE(fh)
      35           0 :        IF (fh(open_matrix)%mode==0) EXIT
      36             :     ENDDO
      37           0 :     IF (open_matrix>SIZE(fh)) CALL judft_error("Too many filehandles for matrix IO")
      38             : 
      39           0 :     SELECT CASE (mode)
      40             :     CASE (1)
      41           0 :        fh(open_matrix)%mode=1
      42           0 :        fh(OPEN_matrix)%id=open_DA(l_real,matsize,no_rec,filename)
      43             :     CASE(2)
      44             : #ifdef CPP_HDF
      45           0 :        fh(open_matrix)%mode=2
      46           0 :        CALL iomatrix_hdf_open(l_real,matsize,no_rec,filename,fh(open_matrix)%fid,fh(open_matrix)%did)
      47             : #else
      48             :        CALL judft_error("You compiled without HDF5")
      49             : #endif
      50             :     CASE default
      51           0 :        CALL judft_error("BUG in io_matrix: case default open mtx")
      52             :     END SELECT
      53           0 :   END FUNCTION OPEN_MATRIX
      54             : 
      55           0 :   SUBROUTINE read_matrix(mat,rec,id)
      56             :     CLASS(t_Mat),INTENT(INOUT)  :: mat
      57             :     INTEGER,INTENT(IN)          :: rec,id
      58             : 
      59             :     !CALL mat%alloc()
      60           0 :     SELECT CASE (fh(id)%mode)
      61             :     CASE (1)
      62           0 :        SELECT TYPE(mat)
      63             :        TYPE is (t_mat)
      64           0 :           CALL read_matrix_DA(mat,rec,fh(id)%id)
      65             :        TYPE is (t_mpimat)
      66           0 :           CALL judft_error("Matrix IO for parallel matrix only with HDF5")
      67             :        END SELECT  
      68             :     CASE(2)
      69             : #ifdef CPP_HDF
      70           0 :        CALL iomatrix_hdf_read(mat,rec,fh(id)%did)
      71             : #else
      72             :        CALL judft_error("You compiled without HDF5")
      73             : #endif
      74             :     CASE default
      75           0 :        CALL judft_error("BUG in io_matrix: case default read mtx")
      76             :     END SELECT
      77           0 :   END SUBROUTINE read_matrix
      78             : 
      79           0 :   SUBROUTINE write_matrix(mat,rec,id)
      80             :     CLASS(t_Mat),INTENT(IN)  :: mat
      81             :     INTEGER,INTENT(IN)       :: rec,id
      82             : 
      83           0 :     SELECT CASE (fh(id)%mode)
      84             :     CASE (1)
      85           0 :        SELECT TYPE(mat)
      86             :        TYPE is (t_mat)
      87           0 :           CALL write_matrix_DA(mat,rec,fh(id)%id)
      88             :        TYPE is (t_mpimat)
      89           0 :           CALL judft_error("Matrix IO for parallel matrix only with HDF5")
      90             :        END SELECT
      91             :     CASE(2)
      92             : #ifdef CPP_HDF
      93           0 :        CALL iomatrix_hdf_write(mat,rec,fh(id)%did)
      94             : #else
      95             :        CALL judft_error("You compiled without HDF5")
      96             : #endif
      97             :     CASE default
      98           0 :        CALL judft_error("BUG in io_matrix: case default write mtx")
      99             :     END SELECT
     100           0 :   END SUBROUTINE write_matrix
     101             :   
     102           0 :   SUBROUTINE close_matrix(id)
     103             :     INTEGER,INTENT(IN):: id
     104           0 :     SELECT CASE (fh(id)%mode)
     105             :     CASE (1)
     106           0 :        CALL close_matrix_DA(fh(id)%id)
     107             :     CASE (2)
     108             : #ifdef CPP_HDF
     109           0 :        CALL iomatrix_hdf_close(fh(id)%fid,fh(id)%did)
     110             : #else
     111             :        CALL judft_error("You compiled without HDF5")
     112             : #endif
     113             :     CASE default
     114           0 :        CALL judft_error("BUG in io_matrix: case default close mtx")
     115             :     END SELECT
     116           0 :        fh(id)%mode=0
     117           0 :   END SUBROUTINE CLOSE_MATRIX
     118             : 
     119             :   !Now the implementation in terms of fortran DA-files
     120           0 :   INTEGER FUNCTION open_DA(l_real,matsize,no_rec,filename)
     121             :     LOGICAL,INTENT(IN)           :: l_real
     122             :     INTEGER,INTENT(in)          :: matsize,no_rec
     123             :     CHARACTER(len=*),INTENT(in) :: filename
     124             : 
     125             :     LOGICAL :: used_unit
     126             :     REAL    :: r
     127             :     COMPLEX :: c
     128             :     INTEGER :: datasize
     129             : 
     130             :     !Determine size of data
     131           0 :     IF (l_real) THEN
     132           0 :        INQUIRE(IOLENGTH=datasize) r
     133             :     ELSE
     134           0 :        INQUIRE(IOLENGTH=datasize) c
     135             :     END IF
     136             : 
     137             :     !find free unit starting at 901
     138           0 :     open_DA=901
     139           0 :     DO
     140           0 :        INQUIRE(unit=open_DA,opened=used_unit)
     141           0 :        IF (.NOT.used_unit) EXIT
     142           0 :        open_DA=open_DA+1
     143             :     END DO
     144             :     !openfile
     145           0 :     OPEN(unit=open_DA,file=filename,access='direct',recl=datasize*(matsize*matsize+6))!Three to include matsize
     146             : 
     147             : 
     148           0 :   END FUNCTION open_DA
     149             : 
     150           0 :   SUBROUTINE read_matrix_DA(mat,rec,id)
     151             :     TYPE(t_Mat),INTENT(INOUT):: mat
     152             :     INTEGER,INTENT(IN)           :: rec,id
     153             :     LOGICAL :: l_real
     154             :     INTEGER:: err,matsize1,matsize2
     155           0 :     l_real=mat%l_real
     156             :    
     157           0 :     READ(id,rec=rec,iostat=err) l_real,matsize1,matsize2
     158           0 :     IF (err.NE.0) CALL judft_error("Data not found in file")
     159           0 :     CALL mat%init(l_real,matsize1,matsize2)
     160             : 
     161           0 :     IF (mat%l_real) THEN
     162           0 :       READ(id,rec=rec,iostat=err) l_real,matsize1,matsize2,mat%data_r
     163             :     ELSE
     164           0 :       READ(id,rec=rec,iostat=err) l_real,matsize1,matsize2,mat%data_c
     165             :     END IF
     166           0 :     IF (err.NE.0) CALL judft_error("Failed in reading of matrix: " // int2str(err))
     167           0 :   END SUBROUTINE read_matrix_DA
     168             : 
     169           0 :   SUBROUTINE write_matrix_DA(mat,rec,id)
     170             :     TYPE(t_Mat),INTENT(IN):: mat
     171             :     INTEGER,INTENT(IN)        :: rec,id
     172             :     INTEGER    :: err
     173             :     INTEGER(8) :: matsize
     174           0 :     IF (mat%l_real) THEN
     175           0 :        WRITE(id,rec=rec,iostat=err) mat%l_real,mat%matsize1,mat%matsize2,mat%data_r
     176           0 :        matsize = 8 * size(mat%data_r)
     177             :     ELSE
     178           0 :        WRITE(id,rec=rec,iostat=err) mat%l_real,mat%matsize1,mat%matsize2,mat%data_c
     179           0 :        matsize = 16 * size(mat%data_c)
     180             :     END IF
     181           0 :     IF (err.NE.0) CALL judft_error("Failed in writing of matrix. Matrix size in byte = " // int2str(matsize))
     182           0 :   END SUBROUTINE write_matrix_DA
     183             : 
     184           0 :   SUBROUTINE close_matrix_DA(id)
     185             :     INTEGER,INTENT(IN)        :: id
     186             :     INTEGER:: err
     187             : 
     188           0 :     close(id)
     189           0 :   END SUBROUTINE close_matrix_DA
     190             : 
     191           0 : END MODULE m_io_matrix