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_eig66_da
8 : use m_juDFT
9 : ! Do the IO of the eig-file in fortran direct-access
10 : ! The eig-file is split into two parts:
11 : ! eig.bas contains the basis-set information
12 : ! eig.vec contains the eigenvalues and the eigenvectors
13 : ! The record number is given by nrec=nk+(jspin-1)*nkpts
14 : ! each record contains:
15 : ! eig.bas: el,evac,ello,bkpt,wtkpt,nv,nmat
16 : ! eig.vec: ne,eig,z**
17 : !**: real or complex depending on calculation type
18 : USE m_eig66_data
19 : USE m_types_mat
20 : IMPLICIT NONE
21 :
22 : CONTAINS
23 0 : SUBROUTINE priv_find_data(id, d)
24 : INTEGER, INTENT(IN) :: id
25 : TYPE(t_data_DA), POINTER, INTENT(out) :: d
26 :
27 : CLASS(t_data), POINTER ::dp
28 0 : CALL eig66_find_data(dp, id)
29 : SELECT TYPE (dp)
30 : TYPE is (t_data_da)
31 0 : d => dp
32 : CLASS default
33 0 : CALL judft_error("BUG: wrong datatype in eig66_da")
34 : END SELECT
35 0 : END SUBROUTINE priv_find_data
36 :
37 0 : SUBROUTINE open_eig(id, nmat, neig, nkpts, jspins, create, l_real, l_soc, l_olap, filename)
38 : INTEGER, INTENT(IN) :: id, nmat, neig, nkpts, jspins
39 : LOGICAL, INTENT(IN) :: create, l_real, l_soc, l_olap
40 : CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: filename
41 : !locals
42 : LOGICAL :: l_file
43 : INTEGER :: i1, recl_z, recl_eig
44 : REAL :: r1, r3(3)
45 : COMPLEX :: c1
46 : TYPE(t_data_DA), POINTER:: d
47 :
48 0 : if(l_olap) call judft_error("olap not implemented for DA")
49 :
50 0 : CALL priv_find_data(id, d)
51 :
52 0 : IF (PRESENT(filename)) d%fname = filename
53 0 : CALL eig66_data_storedefault(d, jspins, nkpts, nmat, neig, l_real, l_soc)
54 :
55 : !Calculate the record length
56 :
57 0 : INQUIRE (IOLENGTH=recl_eig) r1
58 0 : d%recl_wiks = recl_eig*neig
59 :
60 0 : recl_eig = recl_eig*(neig + 2) ! add a 2 for integer 'neig'
61 0 : if (l_real .and. .not. l_soc) THEN
62 0 : INQUIRE (IOLENGTH=recl_z) r1
63 : else
64 0 : INQUIRE (IOLENGTH=recl_z) c1
65 : endif
66 0 : recl_z = recl_z*nmat*neig
67 :
68 0 : d%recl_vec = recl_eig + recl_z
69 :
70 0 : IF (create) THEN
71 0 : INQUIRE (file=TRIM(d%fname), opened=l_file)
72 0 : DO WHILE (l_file)
73 0 : write (*, *) "eig66_open_da:", d%fname, " in use"
74 0 : d%fname = TRIM(d%fname)//"6"
75 0 : INQUIRE (file=TRIM(d%fname), opened=l_file)
76 : ENDDO
77 0 : d%file_io_id_vec = priv_free_uid()
78 0 : OPEN (d%file_io_id_vec, FILE=TRIM(d%fname), ACCESS='direct', FORM='unformatted', RECL=d%recl_vec, STATUS='unknown')
79 0 : d%file_io_id_wiks = priv_free_uid()
80 0 : OPEN (d%file_io_id_wiks, FILE=TRIM(d%fname)//".wiks", ACCESS='direct', FORM='unformatted', RECL=d%recl_wiks, STATUS='unknown')
81 : ELSE
82 0 : d%file_io_id_vec = priv_free_uid()
83 0 : OPEN (d%file_io_id_vec, FILE=TRIM(d%fname), ACCESS='direct', FORM='unformatted', RECL=d%recl_vec, STATUS='old')
84 0 : d%file_io_id_wiks = priv_free_uid()
85 0 : OPEN (d%file_io_id_wiks, FILE=TRIM(d%fname)//".wiks", ACCESS='direct', FORM='unformatted', RECL=d%recl_wiks, STATUS='old')
86 : ENDIF
87 : CONTAINS
88 0 : INTEGER FUNCTION priv_free_uid() RESULT(uid)
89 : IMPLICIT NONE
90 : LOGICAL::used
91 0 : used = .TRUE.
92 0 : uid = 665
93 0 : DO WHILE (used)
94 0 : uid = uid + 1
95 0 : INQUIRE (UNIT=uid, OPENED=used)
96 : END DO
97 0 : END FUNCTION priv_free_uid
98 : END SUBROUTINE open_eig
99 0 : SUBROUTINE close_eig(id, filename)
100 : INTEGER, INTENT(IN)::id
101 : CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: filename
102 : TYPE(t_data_DA), POINTER:: d
103 :
104 0 : CALL priv_find_data(id, d)
105 :
106 0 : CLOSE (d%file_io_id_vec)
107 0 : CLOSE (d%file_io_id_wiks)
108 0 : d%recl_vec = 0
109 0 : d%recl_wiks = 0
110 :
111 : !If a filename was given and the name is not the current filename then rename
112 0 : IF (PRESENT(filename)) THEN
113 0 : IF (filename .NE. d%fname) THEN
114 0 : CALL system("mv "//TRIM(d%fname)//" "//TRIM(filename))
115 : ENDIF
116 : ENDIF
117 0 : d%fname = "eig"
118 0 : CALL eig66_remove_data(id)
119 0 : END SUBROUTINE close_eig
120 0 : SUBROUTINE read_eig(id, nk, jspin, neig, eig, list, zmat, smat)
121 : IMPLICIT NONE
122 : INTEGER, INTENT(IN) :: id, nk, jspin
123 : INTEGER, INTENT(OUT), OPTIONAL :: neig
124 : REAL, INTENT(OUT), OPTIONAL :: eig(:)
125 : INTEGER, INTENT(IN), OPTIONAL :: list(:)
126 : TYPE(t_mat), OPTIONAL :: zmat, smat
127 :
128 : !Local variables
129 : INTEGER:: nv_s, nmat_s, n, nrec, neig_s
130 : REAL :: bkpt(3), wtkpt
131 0 : REAL, ALLOCATABLE::eig_s(:), zr_s(:, :)
132 : COMPLEX, ALLOCATABLE::zc_s(:, :)
133 : TYPE(t_data_DA), POINTER:: d
134 :
135 0 : if(present(smat)) call juDFT_error("reading smat not supported for DA")
136 0 : CALL priv_find_data(id, d)
137 : ! check if io is performed correctly
138 0 : IF (PRESENT(list)) THEN
139 0 : IF (list(1) /= 1) &
140 0 : CALL juDFT_error("In direct access mode only all eigenstates can be read")
141 : ENDIF
142 :
143 0 : nrec = nk + (jspin - 1)*d%nkpts
144 :
145 0 : IF (.NOT. (PRESENT(eig) .OR. PRESENT(neig) .OR. PRESENT(zmat))) RETURN
146 0 : READ (d%file_io_id_vec, REC=nrec) neig_s
147 0 : IF (PRESENT(neig)) THEN
148 0 : neig = neig_s
149 : ENDIF
150 0 : IF (.NOT. (PRESENT(eig) .OR. PRESENT(zmat))) RETURN
151 0 : ALLOCATE (eig_s(neig_s))
152 0 : IF (PRESENT(zmat)) THEN
153 0 : IF (zmat%l_real) THEN
154 0 : INQUIRE (IOLENGTH=n) neig_s, eig_s, REAL(zmat%data_r)
155 0 : IF (n > d%recl_vec) THEN
156 0 : CALL juDFT_error("BUG: Too long record")
157 : END IF
158 0 : READ (d%file_io_id_vec, REC=nrec) neig_s, eig_s, zmat%data_r
159 : ELSE
160 0 : INQUIRE (IOLENGTH=n) neig_s, eig_s, CMPLX(zmat%data_c)
161 0 : IF (n > d%recl_vec) THEN
162 0 : CALL juDFT_error("BUG: Too long record")
163 : END IF
164 0 : READ (d%file_io_id_vec, REC=nrec) neig_s, eig_s, zmat%data_c
165 : ENDIF
166 : ELSE
167 0 : INQUIRE (IOLENGTH=n) neig_s, eig_s
168 0 : IF (n > d%recl_vec) CALL juDFT_error("BUG: Too long record")
169 0 : READ (d%file_io_id_vec, REC=nrec) neig_s, eig_s
170 : ENDIF
171 0 : IF (PRESENT(eig)) eig(:min(size(eig), neig_s)) = eig_s(:min(size(eig), neig_s))
172 :
173 0 : END SUBROUTINE read_eig
174 :
175 0 : SUBROUTINE write_eig(id, nk, jspin, neig, neig_total, eig, n_size, n_rank, zmat, smat)
176 : INTEGER, INTENT(IN) :: id, nk, jspin
177 : INTEGER, INTENT(IN), OPTIONAL :: n_size, n_rank
178 : INTEGER, INTENT(IN), OPTIONAL :: neig, neig_total
179 : REAL, INTENT(IN), OPTIONAL :: eig(:)
180 : TYPE(t_mat), INTENT(IN), OPTIONAL :: zmat, smat
181 :
182 : INTEGER:: nrec, r_len
183 : INTEGER:: nv_s, nmat_s
184 : REAL :: bkpt(3), wtkpt
185 : TYPE(t_data_DA), POINTER:: d
186 :
187 0 : if(present(smat)) call juDFT_error("writing smat in DA not supported yet")
188 :
189 0 : CALL priv_find_data(id, d)
190 : !This mode requires all data to be written at once!!
191 :
192 0 : IF (PRESENT(n_size) .AND. PRESENT(n_rank)) THEN
193 0 : IF (n_size /= 1 .OR. n_rank /= 0) &
194 0 : CALL juDFT_error("Direct Access IO not possible in eigenvalue parallel code")
195 : ENDIF
196 : !check record length
197 : !INQUIRE(iolength=r_len) nmat,el,evac,ello,bk,wk,nv,d%kvec_s,kveclo
198 : !if (r_len>recl_bas) call juDFT_error("BUG: too long record")
199 :
200 : !Now it is time for the IO :-)
201 0 : nrec = nk + (jspin - 1)*d%nkpts
202 0 : IF (PRESENT(neig) .AND. PRESENT(neig_total)) THEN
203 0 : IF (neig .NE. neig_total) THEN
204 0 : CALL juDFT_error("Neig and neig_total have to be equal in DA mode", calledby="eig66_da")
205 : ENDIF
206 : ENDIF
207 :
208 0 : IF (.NOT. PRESENT(eig) .OR. .NOT. PRESENT(neig)) RETURN
209 : !Now the IO of the eigenvalues/vectors
210 0 : IF (PRESENT(zmat)) THEN
211 0 : IF (zmat%l_real) THEN
212 0 : INQUIRE (IOLENGTH=r_len) neig, eig, REAL(zmat%data_r)
213 0 : IF (r_len > d%recl_vec) CALL juDFT_error("BUG: too long record")
214 0 : WRITE (d%file_io_id_vec, REC=nrec) neig, eig, REAL(zmat%data_r)
215 : ELSE
216 0 : INQUIRE (IOLENGTH=r_len) neig, eig(:neig), CMPLX(zmat%data_c)
217 0 : IF (r_len > d%recl_vec) CALL juDFT_error("BUG: too long record")
218 0 : WRITE (d%file_io_id_vec, REC=nrec) neig, eig(:neig), CMPLX(zmat%data_c)
219 : ENDIF
220 : ELSE
221 0 : INQUIRE (IOLENGTH=r_len) neig, eig
222 0 : IF (r_len > d%recl_vec) CALL juDFT_error("BUG: too long record")
223 0 : WRITE (d%file_io_id_vec, REC=nrec) neig, eig
224 : ENDIF
225 :
226 : END SUBROUTINE write_eig
227 :
228 0 : END MODULE m_eig66_da
|
