Line data Source code
1 : !--------------------------------------------------------------------------------
2 : ! Copyright (c) 2018 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_writeBasis
8 :
9 : CONTAINS
10 :
11 0 : SUBROUTINE writeBasis(input,noco,nococonv,kpts,atoms,sym,cell,enpara,hub1data,vTot,vCoul,vx,&
12 : fmpi,results,eig_id ,sphhar,stars,vacuum)
13 :
14 : USE m_types
15 : USE m_juDFT
16 : #ifdef CPP_HDF
17 : USE hdf5
18 : USE m_hdf_tools
19 : #endif
20 : USE m_genmtbasis
21 : USE m_pot_io
22 : USE m_abcof
23 : USE m_abcrot
24 : USE m_eig66_io, ONLY : read_eig
25 :
26 : IMPLICIT NONE
27 : ! TYPE(t_results),INTENT(IN) :: results
28 :
29 : TYPE(t_enpara),INTENT(IN) :: enpara
30 : ! TYPE(t_banddos),INTENT(IN) :: banddos
31 :
32 : TYPE(t_sphhar),INTENT(IN) :: sphhar
33 : TYPE(t_stars),INTENT(IN) :: stars
34 : TYPE(t_vacuum),INTENT(IN) :: vacuum
35 :
36 : TYPE(t_input),INTENT(IN) :: input
37 : TYPE(t_noco),INTENT(IN) :: noco
38 : TYPE(t_nococonv),INTENT(IN) :: nococonv
39 : TYPE(t_kpts),INTENT(IN) :: kpts
40 : TYPE(t_atoms),INTENT(IN) :: atoms
41 : TYPE(t_sym),INTENT(IN) :: sym
42 : TYPE(t_cell),INTENT(IN) :: cell
43 : TYPE(t_hub1data),INTENT(IN) :: hub1data
44 : TYPE(t_potden), INTENT(INOUT) :: vTot
45 : TYPE(t_potden), INTENT(INOUT) :: vCoul
46 : TYPE(t_potden), INTENT(INOUT) :: vx
47 : TYPE(t_mpi), INTENT(IN) :: fmpi
48 : TYPE(t_results), INTENT(INOUT):: results
49 : INTEGER, INTENT(IN) :: eig_id
50 :
51 :
52 0 : TYPE (t_usdus) :: usdus
53 0 : TYPE(t_lapw) :: lapw
54 0 : TYPE (t_eigVecCoeffs) :: eigVecCoeffs
55 0 : TYPE (t_force) :: force
56 0 : TYPE(t_mat) :: zMat
57 :
58 : #ifdef CPP_HDF
59 :
60 : LOGICAL :: l_exist
61 : CHARACTER(LEN=30) :: filename
62 : CHARACTER(LEN=50) :: kpt_name
63 : CHARACTER(LEN=30) :: jsp_name
64 : CHARACTER(LEN=30) :: itype_name
65 : ! CHARACTER(LEN=30) :: l_name
66 :
67 :
68 : INTEGER(HID_T) :: fileID
69 : INTEGER(HID_T) :: metaGroupID
70 : INTEGER(HID_T) :: generalGroupID
71 : INTEGER(HID_T) :: cellGroupID
72 : INTEGER(HID_T) :: atomsGroupID
73 : INTEGER(HID_T) :: kptsGroupID
74 : INTEGER(HID_T) :: kptGroupID
75 : INTEGER(HID_T) :: jspGroupID
76 : INTEGER(HID_T) :: itypeGroupID, itypeSpaceID, itypeSetID
77 : ! INTEGER(HID_T) :: lGroupID
78 :
79 : ! INTEGER(HID_T) :: stringTypeID
80 : ! INTEGER(SIZE_T) :: stringLength
81 :
82 : INTEGER(HID_T) :: bravaisMatrixSpaceID, bravaisMatrixSetID
83 : INTEGER(HID_T) :: reciprocalCellSpaceID, reciprocalCellSetID
84 :
85 : INTEGER(HID_T) :: atomPosSpaceID, atomPosSetID
86 : INTEGER(HID_T) :: gvecSpaceID, gvecSetID
87 : INTEGER(HID_T) :: eigSpaceID, eigSetID
88 : INTEGER(HID_T) :: zmatSpaceID, zmatSetID
89 : INTEGER(HID_T) :: atomicNumbersSpaceID, atomicNumbersSetID
90 : INTEGER(HID_T) :: equivAtomsClassSpaceID, equivAtomsClassSetID
91 :
92 : INTEGER(HID_T) :: kptCoordSpaceID, kptCoordSetID
93 : INTEGER(HID_T) :: kptWeightSpaceID, kptWeightSetID
94 : ! INTEGER(HID_T) :: kptSPLabelsSpaceID, kptSPLabelsSetID
95 : ! INTEGER(HID_T) :: kptsSPIndicesSpaceID, kptsSPIndicesSetID
96 : INTEGER(HSIZE_T) :: dims(7)
97 :
98 : INTEGER :: j, iAtom, i
99 : ! INTEGER :: noded, nodeu
100 :
101 : INTEGER :: hdfError, dimsInt(7)
102 : INTEGER :: version
103 0 : REAL, ALLOCATABLE :: output(:,:,:,:),output5(:,:,:,:,:),output3(:,:,:)
104 : ! INTEGER :: fakeLogical
105 : ! REAL :: eFermiPrev
106 : ! LOGICAL :: l_error
107 : LOGICAL :: l_real
108 :
109 0 : INTEGER :: atomicNumbers(atoms%nat),ngopr_temp(atoms%nat)
110 0 : INTEGER :: equivAtomsGroup(atoms%nat)
111 :
112 :
113 :
114 0 : REAL, ALLOCATABLE :: f(:,:,:,:),g(:,:,:,:)
115 0 : REAL, ALLOCATABLE :: flo(:,:,:)
116 :
117 0 : real, allocatable :: cof(:,:,:,:)
118 : integer(HSIZE_T) :: Hdim1(4)
119 : INTEGER :: lmn, na,lm,n,nn, m
120 : complex,parameter :: img=(0.,1.)
121 : REAL :: bk(3)
122 :
123 : LOGICAL link_exists
124 : INTEGER jsp,nk,l,itype, jspNoco
125 : INTEGER numbands, nbasfcn, ndbands !ndbands number of bands without highest (degenerate)
126 :
127 : !WRITE(5000,*) 'writeBasis entry'
128 :
129 0 : l_real = sym%invs.AND.(.NOT.noco%l_soc).AND.(.NOT.noco%l_noco).AND.atoms%n_hia==0
130 :
131 0 : CALL force%init1(input,atoms)
132 :
133 0 : IF (noco%l_mperp) THEN
134 0 : ALLOCATE ( f(atoms%jmtd,2,0:atoms%lmaxd,input%jspins),g(atoms%jmtd,2,0:atoms%lmaxd,input%jspins) )
135 : ELSE
136 0 : ALLOCATE ( f(atoms%jmtd,2,0:atoms%lmaxd,1:input%jspins) )
137 0 : ALLOCATE ( g(atoms%jmtd,2,0:atoms%lmaxd,1:input%jspins) )
138 : ENDIF
139 0 : ALLOCATE (flo(atoms%jmtd,2,atoms%nlod))
140 0 : flo(:,:,:) = 0.0
141 :
142 :
143 : !-------------------------write potential--------------------
144 0 : IF(input%gw==1) THEN
145 0 : CALL writePotential(stars,noco,vacuum,atoms,cell,sphhar,input,sym ,POT_ARCHIVE_TYPE_TOT_const,vTot%iter,vTot,vTot%pw_w)
146 0 : CALL writePotential(stars,noco,vacuum,atoms,cell,sphhar,input,sym ,POT_ARCHIVE_TYPE_COUL_const,vCoul%iter,vCoul,vCoul%pw_w)
147 0 : CALL writePotential(stars,noco,vacuum,atoms,cell,sphhar,input,sym ,POT_ARCHIVE_TYPE_X_const,vx%iter,vx,vx%pw_w)
148 : END IF
149 :
150 : ! check if z-reflection trick can be used
151 0 : version = 1
152 0 : filename = 'basis.hdf'
153 :
154 0 : INQUIRE(FILE=TRIM(ADJUSTL(filename)),EXIST=l_exist)
155 0 : IF(l_exist) THEN
156 0 : CALL system('rm '//TRIM(ADJUSTL(filename)))
157 : END IF
158 :
159 0 : CALL h5fcreate_f(TRIM(ADJUSTL(filename)), H5F_ACC_TRUNC_F, fileID, hdfError, H5P_DEFAULT_F, H5P_DEFAULT_F)
160 :
161 0 : CALL h5gcreate_f(fileID, '/meta', metaGroupID, hdfError)
162 0 : CALL io_write_attint0(metaGroupID,'version',version)
163 0 : CALL h5gclose_f(metaGroupID, hdfError)
164 :
165 0 : CALL h5gcreate_f(fileID, '/general', generalGroupID, hdfError)
166 0 : CALL io_write_attint0(generalGroupID,'jspins',input%jspins)
167 0 : CALL io_write_attlog0(generalGroupID,'invs',sym%invs)
168 0 : CALL io_write_attlog0(generalGroupID,'l_soc',noco%l_soc)
169 0 : CALL io_write_attlog0(generalGroupID,'l_real',l_real)
170 0 : CALL io_write_attreal0(generalGroupID,'rkmax',input%rkmax)
171 0 : CALL h5gclose_f(generalGroupID, hdfError)
172 :
173 0 : CALL h5gcreate_f(fileID, '/cell', cellGroupID, hdfError)
174 :
175 0 : dims(:2)=(/3,3/)
176 0 : dimsInt=dims
177 0 : CALL h5screate_simple_f(2,dims(:2),bravaisMatrixSpaceID,hdfError)
178 0 : CALL h5dcreate_f(cellGroupID, "amat", H5T_NATIVE_DOUBLE, bravaisMatrixSpaceID, bravaisMatrixSetID, hdfError)
179 0 : CALL h5sclose_f(bravaisMatrixSpaceID,hdfError)
180 0 : CALL io_write_real2(bravaisMatrixSetID,(/1,1/),dimsInt(:2),"amat",cell%amat)
181 0 : CALL h5dclose_f(bravaisMatrixSetID, hdfError)
182 :
183 0 : dims(:2)=(/3,3/)
184 0 : dimsInt=dims
185 0 : CALL h5screate_simple_f(2,dims(:2),reciprocalCellSpaceID,hdfError)
186 0 : CALL h5dcreate_f(cellGroupID, "bmat", H5T_NATIVE_DOUBLE, reciprocalCellSpaceID, reciprocalCellSetID, hdfError)
187 0 : CALL h5sclose_f(reciprocalCellSpaceID,hdfError)
188 0 : CALL io_write_real2(reciprocalCellSetID,(/1,1/),dimsInt(:2),"bmat",cell%bmat)
189 0 : CALL h5dclose_f(reciprocalCellSetID, hdfError)
190 :
191 : !CALL io_write_attreal0(cellGroupID,'scaleCell',input%scaleCell)
192 : !CALL io_write_attreal0(cellGroupID,'scaleA1',input%scaleA1)
193 : !CALL io_write_attreal0(cellGroupID,'scaleA2',input%scaleA2)
194 : !CALL io_write_attreal0(cellGroupID,'scaleC',input%scaleC)
195 :
196 :
197 0 : CALL h5gclose_f(cellGroupID, hdfError)
198 0 : iAtom = 0
199 0 : DO iType = 1, atoms%ntype
200 0 : DO j = 1, atoms%neq(iType)
201 0 : iAtom = iAtom + 1
202 0 : atomicNumbers(iAtom) = atoms%nz(iType)
203 0 : equivAtomsGroup(iAtom) = iType
204 : END DO
205 : END DO
206 :
207 0 : CALL h5gcreate_f(fileID, '/atoms', atomsGroupID, hdfError)
208 0 : CALL io_write_attint0(atomsGroupID,'nAtoms',atoms%nat)
209 0 : CALL io_write_attint0(atomsGroupID,'nTypes',atoms%ntype)
210 0 : CALL io_write_attint0(atomsGroupID,'nlod',atoms%nlod)
211 0 : CALL io_write_attint0(atomsGroupID,'llod',atoms%llod)
212 0 : CALL io_write_attint0(atomsGroupID,'nlotot',atoms%nlotot)
213 0 : CALL io_write_attint0(atomsGroupID,'lmaxd',atoms%lmaxd)
214 0 : CALL io_write_attint0(atomsGroupID,'jmtd',atoms%jmtd)
215 :
216 0 : dims(:1)=(/atoms%ntype/)
217 0 : dimsInt=dims
218 0 : CALL h5screate_simple_f(1,dims(:1),atomicNumbersSpaceID,hdfError)
219 0 : CALL h5dcreate_f(atomsGroupID, "jri", H5T_NATIVE_INTEGER, atomicNumbersSpaceID, atomicNumbersSetID, hdfError)
220 0 : CALL h5sclose_f(atomicNumbersSpaceID,hdfError)
221 0 : CALL io_write_integer1(atomicNumbersSetID,(/1/),dimsInt(:1),"jri",atoms%jri)
222 0 : CALL h5dclose_f(atomicNumbersSetID, hdfError)
223 :
224 0 : dims(:1)=(/atoms%ntype/)
225 0 : dimsInt=dims
226 0 : CALL h5screate_simple_f(1,dims(:1),atomicNumbersSpaceID,hdfError)
227 0 : CALL h5dcreate_f(atomsGroupID, "lmax", H5T_NATIVE_INTEGER, atomicNumbersSpaceID, atomicNumbersSetID, hdfError)
228 0 : CALL h5sclose_f(atomicNumbersSpaceID,hdfError)
229 0 : CALL io_write_integer1(atomicNumbersSetID,(/1/),dimsInt(:1),"lmax",atoms%lmax)
230 0 : CALL h5dclose_f(atomicNumbersSetID, hdfError)
231 :
232 0 : dims(:1)=(/atoms%ntype/)
233 0 : dimsInt=dims
234 0 : CALL h5screate_simple_f(1,dims(:1),atomicNumbersSpaceID,hdfError)
235 0 : CALL h5dcreate_f(atomsGroupID, "neq", H5T_NATIVE_INTEGER, atomicNumbersSpaceID, atomicNumbersSetID, hdfError)
236 0 : CALL h5sclose_f(atomicNumbersSpaceID,hdfError)
237 0 : CALL io_write_integer1(atomicNumbersSetID,(/1/),dimsInt(:1),"neq",atoms%neq)
238 0 : CALL h5dclose_f(atomicNumbersSetID, hdfError)
239 :
240 0 : dims(:1)=(/atoms%ntype/)
241 0 : dimsInt=dims
242 0 : CALL h5screate_simple_f(1,dims(:1),atomicNumbersSpaceID,hdfError)
243 0 : CALL h5dcreate_f(atomsGroupID, "nlo", H5T_NATIVE_INTEGER, atomicNumbersSpaceID, atomicNumbersSetID, hdfError)
244 0 : CALL h5sclose_f(atomicNumbersSpaceID,hdfError)
245 0 : CALL io_write_integer1(atomicNumbersSetID,(/1/),dimsInt(:1),"nlo",atoms%nlo)
246 0 : CALL h5dclose_f(atomicNumbersSetID, hdfError)
247 :
248 0 : dims(:2)=(/atoms%nlod,atoms%ntype/)
249 0 : dimsInt=dims
250 0 : CALL h5screate_simple_f(2,dims(:2),atomPosSpaceID,hdfError)
251 0 : CALL h5dcreate_f(atomsGroupID, "llo", H5T_NATIVE_INTEGER, atomPosSpaceID, atomPosSetID, hdfError)
252 0 : CALL h5sclose_f(atomPosSpaceID,hdfError)
253 0 : CALL io_write_integer2(atomPosSetID,(/1,1/),dimsInt(:2),"llo",atoms%llo)
254 0 : CALL h5dclose_f(atomPosSetID, hdfError)
255 :
256 0 : dims(:2)=(/atoms%jmtd,atoms%ntype/)
257 0 : dimsInt=dims
258 0 : CALL h5screate_simple_f(2,dims(:2),atomPosSpaceID,hdfError)
259 0 : CALL h5dcreate_f(atomsGroupID, "rmsh", H5T_NATIVE_DOUBLE, atomPosSpaceID, atomPosSetID, hdfError)
260 0 : CALL h5sclose_f(atomPosSpaceID,hdfError)
261 0 : CALL io_write_real2(atomPosSetID,(/1,1/),dimsInt(:2),"rmsh",atoms%rmsh)
262 0 : CALL h5dclose_f(atomPosSetID, hdfError)
263 :
264 0 : dims(:2)=(/3,atoms%nat/)
265 0 : dimsInt=dims
266 0 : CALL h5screate_simple_f(2,dims(:2),atomPosSpaceID,hdfError)
267 0 : CALL h5dcreate_f(atomsGroupID, "ratoms", H5T_NATIVE_DOUBLE, atomPosSpaceID, atomPosSetID, hdfError)
268 0 : CALL h5sclose_f(atomPosSpaceID,hdfError)
269 0 : CALL io_write_real2(atomPosSetID,(/1,1/),dimsInt(:2),"taual",atoms%taual)
270 0 : CALL h5dclose_f(atomPosSetID, hdfError)
271 :
272 0 : dims(:1)=(/atoms%nat/)
273 0 : dimsInt=dims
274 0 : CALL h5screate_simple_f(1,dims(:1),atomicNumbersSpaceID,hdfError)
275 0 : CALL h5dcreate_f(atomsGroupID, "zatoms", H5T_NATIVE_INTEGER, atomicNumbersSpaceID, atomicNumbersSetID, hdfError)
276 0 : CALL h5sclose_f(atomicNumbersSpaceID,hdfError)
277 0 : CALL io_write_integer1(atomicNumbersSetID,(/1/),dimsInt(:1),"atomicNumbers",atomicNumbers)
278 0 : CALL h5dclose_f(atomicNumbersSetID, hdfError)
279 :
280 0 : dims(:1)=(/atoms%ntype/)
281 0 : dimsInt=dims
282 0 : CALL h5screate_simple_f(1,dims(:1),atomicNumbersSpaceID,hdfError)
283 0 : CALL h5dcreate_f(atomsGroupID, "ztype", H5T_NATIVE_INTEGER, atomicNumbersSpaceID, atomicNumbersSetID, hdfError)
284 0 : CALL h5sclose_f(atomicNumbersSpaceID,hdfError)
285 0 : CALL io_write_integer1(atomicNumbersSetID,(/1/),dimsInt(:1),"nz",atoms%nz)
286 0 : CALL h5dclose_f(atomicNumbersSetID, hdfError)
287 :
288 0 : dims(:1)=(/atoms%nat/)
289 0 : dimsInt=dims
290 0 : CALL h5screate_simple_f(1,dims(:1),equivAtomsClassSpaceID,hdfError)
291 0 : CALL h5dcreate_f(atomsGroupID, "equivAtomsGroup", H5T_NATIVE_INTEGER, equivAtomsClassSpaceID, equivAtomsClassSetID, hdfError)
292 0 : CALL h5sclose_f(equivAtomsClassSpaceID,hdfError)
293 0 : CALL io_write_integer1(equivAtomsClassSetID,(/1/),dimsInt(:1),"equivAtomsGroup",equivAtomsGroup)
294 0 : CALL h5dclose_f(equivAtomsClassSetID, hdfError)
295 :
296 0 : CALL h5gclose_f(atomsGroupID, hdfError)
297 :
298 0 : CALL h5gcreate_f(fileID, '/kpts', kptsGroupID, hdfError)
299 :
300 0 : CALL io_write_attint0(kptsGroupID,'nkpt',kpts%nkpt)
301 :
302 0 : dims(:2)=(/3,kpts%nkpt/)
303 0 : dimsInt=dims
304 0 : CALL h5screate_simple_f(2,dims(:2),kptCoordSpaceID,hdfError)
305 0 : CALL h5dcreate_f(kptsGroupID, "coordinates", H5T_NATIVE_DOUBLE, kptCoordSpaceID, kptCoordSetID, hdfError)
306 0 : CALL h5sclose_f(kptCoordSpaceID,hdfError)
307 0 : CALL io_write_real2(kptCoordSetID,(/1,1/),dimsInt(:2),"bk",kpts%bk)
308 0 : CALL h5dclose_f(kptCoordSetID, hdfError)
309 :
310 0 : dims(:1)=(/kpts%nkpt/)
311 0 : dimsInt=dims
312 0 : CALL h5screate_simple_f(1,dims(:1),kptWeightSpaceID,hdfError)
313 0 : CALL h5dcreate_f(kptsGroupID, "weights", H5T_NATIVE_DOUBLE, kptWeightSpaceID, kptWeightSetID, hdfError)
314 0 : CALL h5sclose_f(kptWeightSpaceID,hdfError)
315 0 : CALL io_write_real1(kptWeightSetID,(/1/),dimsInt(:1),"wtkpt",kpts%wtkpt)
316 0 : CALL h5dclose_f(kptWeightSetID, hdfError)
317 :
318 0 : CALL h5gclose_f(kptsGroupID, hdfError)
319 :
320 0 : CALL usdus%init(atoms,input%jspins)
321 :
322 0 : DO jsp = 1, input%jspins !MERGE(1,input%jspins,noco%l_noco)
323 0 : write(jsp_name , '(a,i0)') '/jsp_',jsp
324 0 : CALL h5gcreate_f(fileID, TRIM(ADJUSTL(jsp_name)), jspGroupID, hdfError)
325 : ! DO nk = fmpi%n_start,kpts%nkpt,fmpi%n_stride
326 0 : DO nk = 1,kpts%nkpt
327 0 : CALL lapw%init(input,noco,nococonv,kpts,atoms,sym,nk,cell)
328 0 : bk(:) = kpts%bk(:,nk)
329 0 : IF(abs(bk(1)).LT.1e-7) bk(1) = abs(bk(1))
330 0 : IF(abs(bk(2)).LT.1e-7) bk(2) = abs(bk(2))
331 0 : IF(abs(bk(3)).LT.1e-7) bk(3) = abs(bk(3))
332 : !write(kpt_name , '(2a,i0)') TRIM(ADJUSTL(jsp_name)),'/kpt_',nk
333 0 : write(kpt_name , '(2a,f12.10,a,f12.10,a,f12.10)') TRIM(ADJUSTL(jsp_name)),'/kpt_',bk(1),',',bk(2),',',bk(3)
334 0 : CALL h5lexists_f(fileID, TRIM(ADJUSTL(kpt_name)), link_exists, hdfError)
335 0 : IF (link_exists) CYCLE
336 0 : CALL h5gcreate_f(fileID, TRIM(ADJUSTL(kpt_name)), kptGroupID, hdfError)
337 : !--------------------enter output gvec etc here--------------------
338 0 : CALL io_write_attint0(kptGroupID,'nv',lapw%nv(jsp))
339 :
340 0 : dims(:2)=(/3,lapw%nv(jsp)/)
341 0 : dimsInt=dims
342 0 : CALL h5screate_simple_f(2,dims(:2),gvecSpaceID,hdfError)
343 0 : CALL h5dcreate_f(kptGroupID, "gvec", H5T_NATIVE_INTEGER, gvecSpaceID, gvecSetID, hdfError)
344 0 : CALL h5sclose_f(gvecSpaceID,hdfError)
345 0 : CALL io_write_integer2(gvecSetID,(/1,1/),dimsInt(:2),"gvec",lapw%gvec(:,:lapw%nv(jsp),jsp))
346 0 : CALL h5dclose_f(gvecSetID, hdfError)
347 :
348 0 : CALL h5gclose_f(kptGroupID, hdfError)
349 : END DO
350 :
351 0 : DO itype = 1,atoms%ntype
352 0 : write(itype_name , '(2a,i0)') TRIM(ADJUSTL(jsp_name)),'/itype_',itype
353 0 : CALL h5gcreate_f(fileID, TRIM(ADJUSTL(itype_name)), itypeGroupID, hdfError)
354 :
355 0 : CALL genMTBasis(atoms,enpara,vTot,fmpi,itype,jsp,usdus,f(:,:,0:,jsp),g(:,:,0:,jsp),flo,hub1data=hub1data)
356 0 : dims(:3)=(/atoms%jmtd,2,atoms%lmaxd+1/)
357 0 : dimsInt = dims
358 0 : CALL h5screate_simple_f(3,dims(:3),itypeSpaceID,hdfError)
359 0 : CALL h5dcreate_f(itypeGroupID, "f", H5T_NATIVE_DOUBLE, itypeSpaceID, itypeSetID, hdfError)
360 0 : CALL h5sclose_f(itypeSpaceID,hdfError)
361 0 : CALL io_write_real3(itypeSetID,(/1,1,1/),dimsInt(:3),"f",f(:,:,0:,jsp))
362 0 : CALL h5dclose_f(itypeSetID, hdfError)
363 :
364 0 : CALL h5screate_simple_f(3,dims(:3),itypeSpaceID,hdfError)
365 0 : CALL h5dcreate_f(itypeGroupID, "g", H5T_NATIVE_DOUBLE, itypeSpaceID, itypeSetID, hdfError)
366 0 : CALL h5sclose_f(itypeSpaceID,hdfError)
367 0 : CALL io_write_real3(itypeSetID,(/1,1,1/),dimsInt(:3),"g",g(:,:,0:,jsp))
368 0 : CALL h5dclose_f(itypeSetID, hdfError)
369 :
370 0 : dims(:3)=(/atoms%jmtd,2,atoms%nlod/)
371 0 : dimsInt = dims
372 0 : CALL h5screate_simple_f(3,dims(:3),itypeSpaceID,hdfError)
373 0 : CALL h5dcreate_f(itypeGroupID, "flo", H5T_NATIVE_DOUBLE, itypeSpaceID, itypeSetID, hdfError)
374 0 : CALL h5sclose_f(itypeSpaceID,hdfError)
375 0 : CALL io_write_real3(itypeSetID,(/1,1,1/),dimsInt(:3),"flo",flo(:,:,:))
376 0 : CALL h5dclose_f(itypeSetID, hdfError)
377 :
378 0 : dims(:1)=(/atoms%lmaxd+1/)
379 0 : dimsInt = dims
380 0 : CALL h5screate_simple_f(1,dims(:1),itypeSpaceID,hdfError)
381 0 : CALL h5dcreate_f(itypeGroupID, "us", H5T_NATIVE_DOUBLE, itypeSpaceID, itypeSetID, hdfError)
382 0 : CALL h5sclose_f(itypeSpaceID,hdfError)
383 0 : CALL io_write_real1(itypeSetID,(/1/),dimsInt(:1),"us",usdus%us(:,itype,jsp))
384 0 : CALL h5dclose_f(itypeSetID, hdfError)
385 :
386 0 : CALL h5screate_simple_f(1,dims(:1),itypeSpaceID,hdfError)
387 0 : CALL h5dcreate_f(itypeGroupID, "dus", H5T_NATIVE_DOUBLE, itypeSpaceID, itypeSetID, hdfError)
388 0 : CALL h5sclose_f(itypeSpaceID,hdfError)
389 0 : CALL io_write_real1(itypeSetID,(/1/),dimsInt(:1),"dus",usdus%dus(:,itype,jsp))
390 0 : CALL h5dclose_f(itypeSetID, hdfError)
391 :
392 0 : CALL h5screate_simple_f(1,dims(:1),itypeSpaceID,hdfError)
393 0 : CALL h5dcreate_f(itypeGroupID, "uds", H5T_NATIVE_DOUBLE, itypeSpaceID, itypeSetID, hdfError)
394 0 : CALL h5sclose_f(itypeSpaceID,hdfError)
395 0 : CALL io_write_real1(itypeSetID,(/1/),dimsInt(:1),"uds",usdus%uds(:,itype,jsp))
396 0 : CALL h5dclose_f(itypeSetID, hdfError)
397 :
398 0 : CALL h5screate_simple_f(1,dims(:1),itypeSpaceID,hdfError)
399 0 : CALL h5dcreate_f(itypeGroupID, "duds", H5T_NATIVE_DOUBLE, itypeSpaceID, itypeSetID, hdfError)
400 0 : CALL h5sclose_f(itypeSpaceID,hdfError)
401 0 : CALL io_write_real1(itypeSetID,(/1/),dimsInt(:1),"duds",usdus%duds(:,itype,jsp))
402 0 : CALL h5dclose_f(itypeSetID, hdfError)
403 :
404 0 : dims(:1)=(/atoms%nlod/)
405 0 : dimsInt = dims
406 0 : CALL h5screate_simple_f(1,dims(:1),itypeSpaceID,hdfError)
407 0 : CALL h5dcreate_f(itypeGroupID, "dulos", H5T_NATIVE_DOUBLE, itypeSpaceID, itypeSetID, hdfError)
408 0 : CALL h5sclose_f(itypeSpaceID,hdfError)
409 0 : CALL io_write_real1(itypeSetID,(/1/),dimsInt(:1),"dulos",usdus%dulos(:,itype,jsp))
410 0 : CALL h5dclose_f(itypeSetID, hdfError)
411 :
412 0 : CALL h5screate_simple_f(1,dims(:1),itypeSpaceID,hdfError)
413 0 : CALL h5dcreate_f(itypeGroupID, "ulos", H5T_NATIVE_DOUBLE, itypeSpaceID, itypeSetID, hdfError)
414 0 : CALL h5sclose_f(itypeSpaceID,hdfError)
415 0 : CALL io_write_real1(itypeSetID,(/1/),dimsInt(:1),"ulos",usdus%ulos(:,itype,jsp))
416 0 : CALL h5dclose_f(itypeSetID, hdfError)
417 :
418 0 : dims(:1)=(/atoms%lmaxd+1/)
419 0 : dimsInt = dims
420 0 : CALL h5screate_simple_f(1,dims(:1),itypeSpaceID,hdfError)
421 0 : CALL h5dcreate_f(itypeGroupID, "el0", H5T_NATIVE_DOUBLE, itypeSpaceID, itypeSetID, hdfError)
422 0 : CALL h5sclose_f(itypeSpaceID,hdfError)
423 0 : CALL io_write_real1(itypeSetID,(/1/),dimsInt(:1),"el0",enpara%el0(:,itype,jsp))
424 0 : CALL h5dclose_f(itypeSetID, hdfError)
425 :
426 0 : dims(:1)=(/atoms%nlod/)
427 0 : dimsInt = dims
428 0 : CALL h5screate_simple_f(1,dims(:1),itypeSpaceID,hdfError)
429 0 : CALL h5dcreate_f(itypeGroupID, "ello0", H5T_NATIVE_DOUBLE, itypeSpaceID, itypeSetID, hdfError)
430 0 : CALL h5sclose_f(itypeSpaceID,hdfError)
431 0 : CALL io_write_real1(itypeSetID,(/1/),dimsInt(:1),"ello0",enpara%ello0(:,itype,jsp))
432 0 : CALL h5dclose_f(itypeSetID, hdfError)
433 :
434 :
435 : ! write(kpt_name , '(3a,i0)') TRIM(ADJUSTL(jsp_name)),TRIM(ADJUSTL(itype_name)),'/l_',l
436 : ! CALL h5gcreate_f(fileID, TRIM(ADJUSTL(l_name)), lGroupID, hdfError)
437 : ! CALL h5gclose_f(lGroupID, hdfError)
438 0 : CALL h5gclose_f(itypeGroupID, hdfError)
439 : END DO
440 :
441 0 : CALL h5gclose_f(jspGroupID, hdfError)
442 : END DO
443 0 : CALL h5fclose_f(fileID, hdfError)
444 0 : version = 1
445 0 : filename = 'eig_gw.hdf'
446 :
447 :
448 0 : IF(input%gw==2) THEN
449 0 : INQUIRE(FILE=TRIM(ADJUSTL(filename)),EXIST=l_exist)
450 0 : IF(l_exist) THEN
451 0 : CALL system('rm '//TRIM(ADJUSTL(filename)))
452 : END IF
453 :
454 0 : CALL h5fcreate_f(TRIM(ADJUSTL(filename)), H5F_ACC_TRUNC_F, fileID, hdfError, H5P_DEFAULT_F, H5P_DEFAULT_F)
455 :
456 0 : CALL h5gcreate_f(fileID, '/meta', metaGroupID, hdfError)
457 0 : CALL io_write_attint0(metaGroupID,'version',version)
458 0 : CALL h5gclose_f(metaGroupID, hdfError)
459 :
460 0 : DO jsp = 1,input%jspins !MERGE(1,input%jspins,noco%l_noco)
461 0 : jspNoco = MERGE(1,jsp,noco%l_noco)
462 0 : write(jsp_name , '(a,i0)') '/jsp_',jsp
463 0 : CALL h5gcreate_f(fileID, TRIM(ADJUSTL(jsp_name)), jspGroupID, hdfError)
464 : ! DO nk = fmpi%n_start,kpts%nkpt,fmpi%n_stride
465 0 : DO nk = 1,kpts%nkpt
466 0 : CALL lapw%init(input,noco,nococonv,kpts,atoms,sym,nk,cell)
467 0 : bk(:) = kpts%bk(:,nk)
468 0 : IF(abs(bk(1)).LT.1e-7) bk(1) = abs(bk(1))
469 0 : IF(abs(bk(2)).LT.1e-7) bk(2) = abs(bk(2))
470 0 : IF(abs(bk(3)).LT.1e-7) bk(3) = abs(bk(3))
471 : !write(kpt_name , '(2a,i0)') TRIM(ADJUSTL(jsp_name)),'/kpt_',nk
472 0 : write(kpt_name , '(2a,f12.10,a,f12.10,a,f12.10)') TRIM(ADJUSTL(jsp_name)),'/kpt_',bk(1),',',bk(2),',',bk(3)
473 0 : CALL h5lexists_f(fileID, TRIM(ADJUSTL(kpt_name)), link_exists, hdfError)
474 0 : IF (link_exists) CYCLE
475 0 : CALL h5gcreate_f(fileID, TRIM(ADJUSTL(kpt_name)), kptGroupID, hdfError)
476 : !--------------------abcoff, zmat, eig output here-------------------
477 : !,results%neig(nk,jsp),results%eig(:,nk,jsp)
478 0 : numbands=results%neig(nk,jspNoco)
479 0 : nbasfcn = MERGE(lapw%nv(1)+lapw%nv(2)+2*atoms%nlotot,lapw%nv(1)+atoms%nlotot,noco%l_noco)
480 0 : CALL zMat%init(l_real,nbasfcn,numbands)
481 0 : CALL read_eig(eig_id,nk,jspNoco,zmat=zMat)
482 0 : CALL eigVecCoeffs%init(input,atoms,jsp,numbands,noco%l_mperp)
483 0 : IF (input%l_f) CALL force%init2(numbands,input,atoms)
484 : ! DO i=1,atoms%nat
485 : ! ngopr_temp(i)=sym%ngopr(i)
486 : ! sym%ngopr(i)=1
487 : ! END DO
488 : CALL abcof(input,atoms,sym,cell,lapw,numbands,usdus,noco,nococonv,jsp,&
489 : eigVecCoeffs%abcof(:,0:,0,:,jsp),eigVecCoeffs%abcof(:,0:,1,:,jsp),&
490 0 : eigVecCoeffs%ccof(-atoms%llod:,:,:,:,jsp),zMat,results%eig(:,nk,jsp),force)
491 : ! DO i=1,atoms%nat
492 : ! sym%ngopr(i)=ngopr_temp(i)
493 : ! END DO
494 : CALL abcrot(atoms%ntype,atoms%nat,numbands,atoms%lmaxd,atoms%lmaxd*(atoms%lmaxd+2),atoms%llod,atoms%nlod,atoms%ntype,atoms%neq,&
495 : numbands,atoms%lmax,atoms%nlo,atoms%llo,sym%nop,sym%ngopr,sym%mrot,sym%invsat,sym%invsatnr,cell%bmat,&
496 0 : eigVecCoeffs%abcof(:,0:,0,:,jsp),eigVecCoeffs%abcof(:,0:,1,:,jsp),eigVecCoeffs%ccof(-atoms%llod:,:,:,:,jsp))
497 :
498 : !-------------------------for spex output: nbasfcn=nv(because lo info not needed) and numbands setting to numbands without highest (degenerat) state--------
499 : ! nbasfcn= MERGE(lapw%nv(1)+lapw%nv(2)+2*atoms%nlotot,lapw%nv(1)+atoms%nlotot,noco%l_noco)
500 0 : ndbands=numbands-1
501 0 : DO i=(numbands-1),1,-1
502 0 : IF (abs(results%eig(i+1,nk,jspNoco)-results%eig(i,nk,jspNoco)).LT.0.000001) THEN
503 0 : ndbands=ndbands-1
504 : ELSE
505 : EXIT
506 : END IF
507 : END DO
508 0 : write(*,*)numbands,ndbands
509 0 : numbands=ndbands
510 : !------------------------setting variables numbands and nbasfcn end -------------------
511 : !CALL read_eig(eig_id,nk,jsp,eig=results%eig(:,nk,jsp),zmat=zMat)
512 0 : dims(:1)=(/numbands/)
513 0 : dimsInt=dims
514 :
515 0 : IF((jsp.EQ.1).OR.(.NOT.noco%l_noco)) THEN
516 0 : CALL h5screate_simple_f(1,dims(:1),eigSpaceID,hdfError)
517 0 : CALL h5dcreate_f(kptGroupID, "eig", H5T_NATIVE_DOUBLE, eigSpaceID, eigSetID, hdfError)
518 0 : CALL h5sclose_f(eigSpaceID,hdfError)
519 0 : CALL io_write_real1(eigSetID,(/1/),dimsInt(:1),"eig",results%eig(:numbands,nk,jsp))
520 0 : CALL h5dclose_f(eigSetID, hdfError)
521 0 : CALL io_write_attint0(kptGroupID,'numbands',numbands)
522 :
523 0 : IF (zMat%l_real) THEN
524 0 : dims(:2)=(/nbasfcn,numbands/)
525 0 : dimsInt=dims
526 0 : CALL h5screate_simple_f(2,dims(:2),kptCoordSpaceID,hdfError)
527 0 : CALL h5dcreate_f(kptGroupID, "pw", H5T_NATIVE_DOUBLE, kptCoordSpaceID, kptCoordSetID, hdfError)
528 0 : CALL h5sclose_f(kptCoordSpaceID,hdfError)
529 0 : CALL io_write_real2(kptCoordSetID,(/1,1/),dimsInt(:2),"evec_r",zMat%data_r(:nbasfcn,:numbands))
530 0 : CALL h5dclose_f(kptCoordSetID, hdfError)
531 : ELSE
532 0 : AllOCATE(output3(2,nbasfcn,numbands))
533 : ! SIZE(zMat%data_c,1),SIZE(zMat%data_c,2)
534 0 : output3(1,:,:)=REAL(zMat%data_c(:,:numbands))
535 0 : output3(2,:,:)=AIMAG(zMat%data_c(:,:numbands))
536 0 : dims(:3)=(/2,nbasfcn,numbands/)
537 0 : dimsInt=dims
538 0 : CALL h5screate_simple_f(3,dims(:3),zmatSpaceID,hdfError)
539 0 : CALL h5dcreate_f(kptGroupID, "pw", H5T_NATIVE_DOUBLE, zmatSpaceID, zmatSetID, hdfError)
540 0 : CALL h5sclose_f(zmatSpaceID,hdfError)
541 0 : CALL io_write_real3(zmatSetID,(/1,1,1/),dimsInt(:3),"output3",output3(:2,:nbasfcn,:numbands))
542 0 : CALL h5dclose_f(zmatSetID, hdfError)
543 0 : DEAllOCATE(output3)
544 : END IF
545 : END IF
546 : !AllOCATE(output(2,numbands,atoms%lmaxd*(atoms%lmaxd+2)+1,atoms%nat))
547 : !output(1,:,:,:)=REAL(eigVecCoeffs%acof(:,0:,:,jsp))
548 : !output(2,:,:,:)=AIMAG(eigVecCoeffs%acof(:,0:,:,jsp))
549 : !dims(:4)=(/2,numbands,atoms%lmaxd*(atoms%lmaxd+2)+1,atoms%nat/)
550 : !dimsInt = dims
551 : !CALL h5screate_simple_f(4,dims(:4),itypeSpaceID,hdfError)
552 : !CALL h5dcreate_f(kptGroupID, "acof", H5T_NATIVE_DOUBLE, itypeSpaceID, itypeSetID, hdfError)
553 : !CALL h5sclose_f(itypeSpaceID,hdfError)
554 : !CALL io_write_real4(itypeSetID,(/1,1,1,1/),dimsInt(:4), output)
555 : !CALL h5dclose_f(itypeSetID, hdfError)
556 : !DEAllOCATE(output)
557 :
558 : !AllOCATE(output(2,numbands,atoms%lmaxd*(atoms%lmaxd+2)+1,atoms%nat))
559 : !output(1,:,:,:)=REAL(eigVecCoeffs%bcof(:,0:,:,jsp))
560 : !output(2,:,:,:)=AIMAG(eigVecCoeffs%bcof(:,0:,:,jsp))
561 : !dims(:4)=(/2,numbands,atoms%lmaxd*(atoms%lmaxd+2)+1,atoms%nat/)
562 : !dimsInt = dims
563 : !CALL h5screate_simple_f(4,dims(:4),itypeSpaceID,hdfError)
564 : !CALL h5dcreate_f(kptGroupID, "bcof", H5T_NATIVE_DOUBLE, itypeSpaceID, itypeSetID, hdfError)
565 : !CALL h5sclose_f(itypeSpaceID,hdfError)
566 : !CALL io_write_real4(itypeSetID,(/1,1,1,1/),dimsInt(:4), output)
567 : !CALL h5dclose_f(itypeSetID, hdfError)
568 : !DEAllOCATE(output)
569 :
570 : !AllOCATE(output5(2,atoms%llod*2+1,numbands,atoms%nlod,atoms%nat))
571 : !output5(1,:,:,:,:)=REAL(eigVecCoeffs%ccof(-atoms%llod:,:,:,:,jsp))
572 : !output5(2,:,:,:,:)=AIMAG(eigVecCoeffs%ccof(-atoms%llod:,:,:,:,jsp))
573 : !dims(:5)=(/2,atoms%llod*2+1,numbands,atoms%nlod,atoms%nat/)
574 : !dimsInt = dims
575 : !CALL h5screate_simple_f(5,dims(:5),itypeSpaceID,hdfError)
576 : !CALL h5dcreate_f(kptGroupID, "ccof", H5T_NATIVE_DOUBLE, itypeSpaceID, itypeSetID, hdfError)
577 : !CALL h5sclose_f(itypeSpaceID,hdfError)
578 : !CALL io_write_real5(itypeSetID,(/1,1,1,1,1/),dimsInt(:5), output5)
579 : !CALL h5dclose_f(itypeSetID, hdfError)
580 : !DEAllOCATE(output5)
581 :
582 : !-------------------------output spex format-------------------
583 : ! get dimensions for MT cof
584 0 : lmn = 0
585 0 : na = 0
586 0 : do n = 1,atoms%ntype
587 0 : do nn = 1,atoms%neq(n)
588 0 : na = na + 1
589 0 : lm = 0
590 0 : do l = 0,atoms%lmax(n)
591 0 : lm = lm + 2*(2*l+1)
592 : enddo
593 0 : do i = 1,atoms%nlo(n)
594 0 : lm = lm + 2*atoms%llo(i,n)+1
595 : enddo
596 0 : lmn = max(lmn,lm)
597 : enddo
598 : enddo
599 0 : Hdim1 = (/ 2,lmn,na,numbands /)
600 :
601 0 : allocate ( cof(Hdim1(1),Hdim1(2),Hdim1(3),Hdim1(4)) )
602 0 : cof = 0
603 : na = 0
604 0 : do n = 1,atoms%ntype
605 0 : do nn = 1,atoms%neq(n)
606 0 : na = na + 1
607 0 : lm = 0
608 0 : lmn = 0
609 0 : do l = 0,atoms%lmax(n)
610 0 : do m = -l,l
611 0 : cof(1,lmn+1,na,:) = real ( eigVecCoeffs%abcof(:numbands,lm,0,na,jsp) * img**l )
612 0 : cof(1,lmn+2,na,:) = real ( eigVecCoeffs%abcof(:numbands,lm,1,na,jsp) * img**l )
613 0 : cof(2,lmn+1,na,:) = aimag ( eigVecCoeffs%abcof(:numbands,lm,0,na,jsp) * img**l )
614 0 : cof(2,lmn+2,na,:) = aimag ( eigVecCoeffs%abcof(:numbands,lm,1,na,jsp) * img**l )
615 0 : lm = lm + 1
616 0 : lmn = lmn + 2
617 0 : do i = 1,atoms%nlo(n)
618 0 : if(atoms%llo(i,n).eq.l) then
619 0 : lmn = lmn + 1
620 0 : cof(1,lmn,na,:) = real( eigVecCoeffs%ccof(m,:numbands,i,na,jsp) * img**l )
621 0 : cof(2,lmn,na,:) = aimag( eigVecCoeffs%ccof(m,:numbands,i,na,jsp) * img**l )
622 : endif
623 : enddo
624 : enddo
625 : enddo
626 : enddo
627 0 : if(lmn.gt.size(cof,2)) then
628 0 : write(*,*) lmn,size(cof,2)
629 : endif
630 : enddo
631 :
632 0 : dims(:4)=Hdim1
633 0 : dimsInt = dims
634 0 : CALL h5screate_simple_f(4,dims(:4),itypeSpaceID,hdfError)
635 0 : CALL h5dcreate_f(kptGroupID, "mt", H5T_NATIVE_DOUBLE, itypeSpaceID, itypeSetID, hdfError)
636 0 : CALL h5sclose_f(itypeSpaceID,hdfError)
637 0 : CALL io_write_real4(itypeSetID,(/1,1,1,1/),dimsInt(:4),"cof",cof)
638 0 : CALL h5dclose_f(itypeSetID, hdfError)
639 0 : deallocate ( cof )
640 : !-------------------------end output spex format-----------------
641 :
642 0 : CALL h5gclose_f(kptGroupID, hdfError)
643 :
644 : END DO
645 0 : CALL h5gclose_f(jspGroupID, hdfError)
646 : END DO
647 0 : CALL h5fclose_f(fileID, hdfError)
648 :
649 : END IF
650 :
651 : #else
652 : CALL juDFT_error("writeBasis called without HDF5! ",calledby="writeBasis")
653 : #endif
654 :
655 0 : END SUBROUTINE writeBasis
656 :
657 : END MODULE m_writeBasis
|