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