io_matrix.F90 5.05 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 12 13 14
  USE m_iomatrix_hdf
#ifdef CPP_HDF
  USE hdf5
#endif
Daniel Wortmann's avatar
Daniel Wortmann committed
15
  IMPLICIT NONE
16 17 18 19 20 21 22 23 24 25
  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
26
CONTAINS
27
  INTEGER FUNCTION OPEN_matrix(l_real,matsize,mode,no_rec,filename)
Daniel Wortmann's avatar
Daniel Wortmann committed
28
    LOGICAL,INTENT(IN)          :: l_real
29
    INTEGER,INTENT(in)          :: matsize,no_rec,mode
Daniel Wortmann's avatar
Daniel Wortmann committed
30
    CHARACTER(len=*),INTENT(in) :: filename
31 32 33 34 35 36
    !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
37 38
    SELECT CASE (mode)
    CASE (1)
39 40 41 42 43
       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
44 45 46 47 48 49
    CASE default
       CALL judft_error("BUG in io_matrix")
    END SELECT
  END FUNCTION OPEN_MATRIX

  SUBROUTINE read_matrix(mat,rec,id)
50 51
    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
    CLASS(t_Mat),INTENT(IN)  :: mat
    INTEGER,INTENT(IN)       :: rec,id
Daniel Wortmann's avatar
Daniel Wortmann committed
72

73
    SELECT CASE (fh(id)%mode)
Daniel Wortmann's avatar
Daniel Wortmann committed
74
    CASE (1)
75 76 77 78 79 80 81 82
       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
83 84 85 86
    CASE default
       CALL judft_error("BUG in io_matrix")
    END SELECT
  END SUBROUTINE write_matrix
87 88 89 90 91 92 93 94 95 96 97 98 99
  
  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
100 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

  !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
127
    OPEN(unit=open_DA,file=filename,access='direct',recl=datasize*(matsize*matsize+6))!Three to include matsize
Daniel Wortmann's avatar
Daniel Wortmann committed
128 129 130 131 132


  END FUNCTION open_DA

  SUBROUTINE read_matrix_DA(mat,rec,id)
133
    TYPE(t_Mat),INTENT(OUT):: mat
Daniel Wortmann's avatar
Daniel Wortmann committed
134
    INTEGER,INTENT(IN)           :: rec,id
135 136 137
    LOGICAL :: l_real
    INTEGER:: err,matsize1,matsize2
    l_real=mat%l_real
138 139 140 141 142
   
    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
143
    IF (mat%l_real) THEN
144
       READ(id,rec=rec,iostat=err) l_real,matsize1,matsize2,mat%data_r
Daniel Wortmann's avatar
Daniel Wortmann committed
145
    ELSE
146
       READ(id,rec=rec,iostat=err) l_real,matsize1,matsize2,mat%data_c
Daniel Wortmann's avatar
Daniel Wortmann committed
147 148 149 150 151 152 153 154 155
    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
156
       WRITE(id,rec=rec,iostat=err) mat%l_real,mat%matsize1,mat%matsize2,mat%data_r
Daniel Wortmann's avatar
Daniel Wortmann committed
157
    ELSE
158
       WRITE(id,rec=rec,iostat=err) mat%l_real,mat%matsize1,mat%matsize2,mat%data_c
Daniel Wortmann's avatar
Daniel Wortmann committed
159 160 161 162
    END IF
    IF (err.NE.0) CALL judft_error("Failed in writing of matrix")
  END SUBROUTINE write_matrix_DA

163 164 165 166 167 168 169
  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
170
END MODULE m_io_matrix