io_matrix.F90 5.07 KB
Newer Older
1 2 3 4 5 6
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------

Daniel Wortmann's avatar
Daniel Wortmann committed
7 8
MODULE m_io_matrix
  USE m_types
9
  USE m_judft
10 11 12 13
  USE m_iomatrix_hdf
#ifdef CPP_HDF
  USE hdf5
#endif
Daniel Wortmann's avatar
Daniel Wortmann committed
14
  IMPLICIT NONE
15 16 17 18 19 20 21 22 23 24
  PRIVATE
  TYPE t_iomatrix_handle
     INTEGER:: mode=0 !can be 1 for DA or 2 for HDF
     INTEGER:: id !file ID in direct-access mode
     INTEGER(hid_t):: fid,did !file-handle in hdf mode
  END TYPE t_iomatrix_handle

  TYPE(t_iomatrix_handle)::fh(10)

  PUBLIC:: t_iomatrix_handle,open_matrix,read_matrix,write_matrix,close_matrix
Daniel Wortmann's avatar
Daniel Wortmann committed
25
CONTAINS
26
  INTEGER FUNCTION OPEN_matrix(l_real,matsize,mode,no_rec,filename)
Daniel Wortmann's avatar
Daniel Wortmann committed
27
    LOGICAL,INTENT(IN)          :: l_real
28
    INTEGER,INTENT(in)          :: matsize,no_rec,mode
Daniel Wortmann's avatar
Daniel Wortmann committed
29
    CHARACTER(len=*),INTENT(in) :: filename
30 31 32 33 34 35
    !Find free handle
    DO open_matrix=1,SIZE(fh)
       IF (fh(open_matrix)%mode==0) EXIT
    ENDDO
    IF (open_matrix>SIZE(fh)) CALL judft_error("Too many filehandles for matrix IO")

Daniel Wortmann's avatar
Daniel Wortmann committed
36 37
    SELECT CASE (mode)
    CASE (1)
38 39 40 41 42
       fh(open_matrix)%mode=1
       fh(OPEN_matrix)%id=open_DA(l_real,matsize,no_rec,filename)
    CASE(2)
       fh(open_matrix)%mode=2
       CALL iomatrix_hdf_open(l_real,matsize,no_rec,filename,fh(open_matrix)%fid,fh(open_matrix)%did)
Daniel Wortmann's avatar
Daniel Wortmann committed
43 44 45 46 47 48
    CASE default
       CALL judft_error("BUG in io_matrix")
    END SELECT
  END FUNCTION OPEN_MATRIX

  SUBROUTINE read_matrix(mat,rec,id)
49 50 51
    USE m_types_mpimat
    CLASS(t_Mat),INTENT(INOUT)  :: mat
    INTEGER,INTENT(IN)          :: rec,id
Daniel Wortmann's avatar
Daniel Wortmann committed
52 53

    CALL mat%alloc()
54
    SELECT CASE (fh(id)%mode)
Daniel Wortmann's avatar
Daniel Wortmann committed
55
    CASE (1)
56 57 58 59 60 61 62 63
       SELECT TYPE(mat)
       TYPE is (t_mat)
          CALL read_matrix_DA(mat,rec,fh(id)%id)
       TYPE is (t_mpimat)
          CALL judft_error("Matrix IO for parallel matrix only with HDF5")
       END SELECT  
    CASE(2)
       CALL iomatrix_hdf_read(mat,rec,fh(id)%did)
Daniel Wortmann's avatar
Daniel Wortmann committed
64 65 66 67 68 69
    CASE default
       CALL judft_error("BUG in io_matrix")
    END SELECT
  END SUBROUTINE read_matrix

  SUBROUTINE write_matrix(mat,rec,id)
70 71 72
    USE m_types_mpimat
    CLASS(t_Mat),INTENT(IN)  :: mat
    INTEGER,INTENT(IN)       :: rec,id
Daniel Wortmann's avatar
Daniel Wortmann committed
73

74
    SELECT CASE (fh(id)%mode)
Daniel Wortmann's avatar
Daniel Wortmann committed
75
    CASE (1)
76 77 78 79 80 81 82 83
       SELECT TYPE(mat)
       TYPE is (t_mat)
          CALL write_matrix_DA(mat,rec,fh(id)%id)
       TYPE is (t_mpimat)
          CALL judft_error("Matrix IO for parallel matrix only with HDF5")
       END SELECT
    CASE(2)
       CALL iomatrix_hdf_write(mat,rec,fh(id)%did)
Daniel Wortmann's avatar
Daniel Wortmann committed
84 85 86 87
    CASE default
       CALL judft_error("BUG in io_matrix")
    END SELECT
  END SUBROUTINE write_matrix
88 89 90 91 92 93 94 95 96 97 98 99 100
  
  SUBROUTINE close_matrix(id)
    INTEGER,INTENT(IN):: id
    SELECT CASE (fh(id)%mode)
    CASE (1)
       CALL close_matrix_DA(fh(id)%id)
    CASE (2)
       CALL iomatrix_hdf_close(fh(id)%fid,fh(id)%did)
    CASE default
       CALL judft_error("BUG in io_matrix")
    END SELECT
       fh(id)%mode=0
  END SUBROUTINE CLOSE_MATRIX
Daniel Wortmann's avatar
Daniel Wortmann committed
101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127

  !Now the implementation in terms of fortran DA-files
  INTEGER FUNCTION open_DA(l_real,matsize,no_rec,filename)
    LOGICAL,INTENT(IN)           :: l_real
    INTEGER,INTENT(in)          :: matsize,no_rec
    CHARACTER(len=*),INTENT(in) :: filename

    LOGICAL :: used_unit
    REAL    :: r
    COMPLEX :: c
    INTEGER :: datasize

    !Determine size of data
    IF (l_real) THEN
       INQUIRE(IOLENGTH=datasize) r
    ELSE
       INQUIRE(IOLENGTH=datasize) c
    END IF

    !find free unit starting at 901
    open_DA=901
    DO
       INQUIRE(unit=open_DA,opened=used_unit)
       IF (.NOT.used_unit) EXIT
       open_DA=open_DA+1
    END DO
    !openfile
128
    OPEN(unit=open_DA,file=filename,access='direct',recl=datasize*(matsize*matsize+6))!Three to include matsize
Daniel Wortmann's avatar
Daniel Wortmann committed
129 130 131 132 133


  END FUNCTION open_DA

  SUBROUTINE read_matrix_DA(mat,rec,id)
134
    TYPE(t_Mat),INTENT(OUT):: mat
Daniel Wortmann's avatar
Daniel Wortmann committed
135
    INTEGER,INTENT(IN)           :: rec,id
136 137 138
    LOGICAL :: l_real
    INTEGER:: err,matsize1,matsize2
    l_real=mat%l_real
139 140 141 142 143
   
    READ(id,rec=rec,iostat=err) l_real,matsize1,matsize2
    IF (err.NE.0) CALL judft_error("Data not found in file")
    CALL mat%init(l_real,matsize1,matsize2)

Daniel Wortmann's avatar
Daniel Wortmann committed
144
    IF (mat%l_real) THEN
145
       READ(id,rec=rec,iostat=err) l_real,matsize1,matsize2,mat%data_r
Daniel Wortmann's avatar
Daniel Wortmann committed
146
    ELSE
147
       READ(id,rec=rec,iostat=err) l_real,matsize1,matsize2,mat%data_c
Daniel Wortmann's avatar
Daniel Wortmann committed
148 149 150 151 152 153 154 155 156
    END IF
    IF (err.NE.0) CALL judft_error("Failed in reading of matrix")
  END SUBROUTINE read_matrix_DA

  SUBROUTINE write_matrix_DA(mat,rec,id)
    TYPE(t_Mat),INTENT(IN):: mat
    INTEGER,INTENT(IN)        :: rec,id
    INTEGER:: err
    IF (mat%l_real) THEN
157
       WRITE(id,rec=rec,iostat=err) mat%l_real,mat%matsize1,mat%matsize2,mat%data_r
Daniel Wortmann's avatar
Daniel Wortmann committed
158
    ELSE
159
       WRITE(id,rec=rec,iostat=err) mat%l_real,mat%matsize1,mat%matsize2,mat%data_c
Daniel Wortmann's avatar
Daniel Wortmann committed
160 161 162 163
    END IF
    IF (err.NE.0) CALL judft_error("Failed in writing of matrix")
  END SUBROUTINE write_matrix_DA

164 165 166 167 168 169 170
  SUBROUTINE close_matrix_DA(id)
    INTEGER,INTENT(IN)        :: id
    INTEGER:: err

    close(id)
  END SUBROUTINE close_matrix_DA

Daniel Wortmann's avatar
Daniel Wortmann committed
171
END MODULE m_io_matrix