io_matrix.F90 5.38 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
MODULE m_io_matrix
8 9
  USE m_types_mat
  USE m_types_mpimat
10
  USE m_judft
11
#ifdef CPP_HDF
12
  USE m_iomatrix_hdf
13 14
  USE hdf5
#endif
Daniel Wortmann's avatar
Daniel Wortmann committed
15
  IMPLICIT NONE
16 17 18 19
  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
20
#ifdef CPP_HDF
21
     INTEGER(hid_t):: fid,did !file-handle in hdf mode
22
#endif
23 24 25 26 27
  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
28
CONTAINS
29
  INTEGER FUNCTION OPEN_matrix(l_real,matsize,mode,no_rec,filename)
Daniel Wortmann's avatar
Daniel Wortmann committed
30
    LOGICAL,INTENT(IN)          :: l_real
31
    INTEGER,INTENT(in)          :: matsize,no_rec,mode
Daniel Wortmann's avatar
Daniel Wortmann committed
32
    CHARACTER(len=*),INTENT(in) :: filename
33 34 35 36 37 38
    !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
39 40
    SELECT CASE (mode)
    CASE (1)
41 42 43
       fh(open_matrix)%mode=1
       fh(OPEN_matrix)%id=open_DA(l_real,matsize,no_rec,filename)
    CASE(2)
44
#ifdef CPP_HDF
45 46
       fh(open_matrix)%mode=2
       CALL iomatrix_hdf_open(l_real,matsize,no_rec,filename,fh(open_matrix)%fid,fh(open_matrix)%did)
47 48 49
#else
       CALL judft_error("You compiled without HDF5")
#endif
Daniel Wortmann's avatar
Daniel Wortmann committed
50 51 52 53 54 55
    CASE default
       CALL judft_error("BUG in io_matrix")
    END SELECT
  END FUNCTION OPEN_MATRIX

  SUBROUTINE read_matrix(mat,rec,id)
56 57
    CLASS(t_Mat),INTENT(INOUT)  :: mat
    INTEGER,INTENT(IN)          :: rec,id
Daniel Wortmann's avatar
Daniel Wortmann committed
58

59
    !CALL mat%alloc()
60
    SELECT CASE (fh(id)%mode)
Daniel Wortmann's avatar
Daniel Wortmann committed
61
    CASE (1)
62 63 64 65 66 67 68
       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)
69
#ifdef CPP_HDF
70
       CALL iomatrix_hdf_read(mat,rec,fh(id)%did)
71 72 73
#else
       CALL judft_error("You compiled without HDF5")
#endif
Daniel Wortmann's avatar
Daniel Wortmann committed
74 75 76 77 78 79
    CASE default
       CALL judft_error("BUG in io_matrix")
    END SELECT
  END SUBROUTINE read_matrix

  SUBROUTINE write_matrix(mat,rec,id)
80 81
    CLASS(t_Mat),INTENT(IN)  :: mat
    INTEGER,INTENT(IN)       :: rec,id
Daniel Wortmann's avatar
Daniel Wortmann committed
82

83
    SELECT CASE (fh(id)%mode)
Daniel Wortmann's avatar
Daniel Wortmann committed
84
    CASE (1)
85 86 87 88 89 90 91
       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)
92
#ifdef CPP_HDF
93
       CALL iomatrix_hdf_write(mat,rec,fh(id)%did)
94 95 96
#else
       CALL judft_error("You compiled without HDF5")
#endif
Daniel Wortmann's avatar
Daniel Wortmann committed
97 98 99 100
    CASE default
       CALL judft_error("BUG in io_matrix")
    END SELECT
  END SUBROUTINE write_matrix
101 102 103 104 105 106 107
  
  SUBROUTINE close_matrix(id)
    INTEGER,INTENT(IN):: id
    SELECT CASE (fh(id)%mode)
    CASE (1)
       CALL close_matrix_DA(fh(id)%id)
    CASE (2)
108
#ifdef CPP_HDF
109
       CALL iomatrix_hdf_close(fh(id)%fid,fh(id)%did)
110 111 112
#else
       CALL judft_error("You compiled without HDF5")
#endif
113 114 115 116 117
    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
118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144

  !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
145
    OPEN(unit=open_DA,file=filename,access='direct',recl=datasize*(matsize*matsize+6))!Three to include matsize
Daniel Wortmann's avatar
Daniel Wortmann committed
146 147 148 149 150


  END FUNCTION open_DA

  SUBROUTINE read_matrix_DA(mat,rec,id)
151
    TYPE(t_Mat),INTENT(OUT):: mat
Daniel Wortmann's avatar
Daniel Wortmann committed
152
    INTEGER,INTENT(IN)           :: rec,id
153 154 155
    LOGICAL :: l_real
    INTEGER:: err,matsize1,matsize2
    l_real=mat%l_real
156 157 158 159 160
   
    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
161
    IF (mat%l_real) THEN
162
       READ(id,rec=rec,iostat=err) l_real,matsize1,matsize2,mat%data_r
Daniel Wortmann's avatar
Daniel Wortmann committed
163
    ELSE
164
       READ(id,rec=rec,iostat=err) l_real,matsize1,matsize2,mat%data_c
Daniel Wortmann's avatar
Daniel Wortmann committed
165 166 167 168 169 170 171 172 173
    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
174
       WRITE(id,rec=rec,iostat=err) mat%l_real,mat%matsize1,mat%matsize2,mat%data_r
Daniel Wortmann's avatar
Daniel Wortmann committed
175
    ELSE
176
       WRITE(id,rec=rec,iostat=err) mat%l_real,mat%matsize1,mat%matsize2,mat%data_c
Daniel Wortmann's avatar
Daniel Wortmann committed
177 178 179 180
    END IF
    IF (err.NE.0) CALL judft_error("Failed in writing of matrix")
  END SUBROUTINE write_matrix_DA

181 182 183 184 185 186 187
  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
188
END MODULE m_io_matrix