Branch data Line data Source code
1 : : !!****m* ABINIT/m_rwwf
2 : : !! NAME
3 : : !! m_rwwf
4 : : !!
5 : : !! FUNCTION
6 : : !! Read/Write wavefunctions.
7 : : !!
8 : : !! COPYRIGHT
9 : : !! Copyright (C) 1998-2026 ABINIT group (DCA,XG,GMR,MVer,MB,MT)
10 : : !! This file is distributed under the terms of the
11 : : !! GNU General Public License, see ~abinit/COPYING
12 : : !! or http://www.gnu.org/copyleft/gpl.txt .
13 : : !!
14 : : !! SOURCE
15 : :
16 : : #if defined HAVE_CONFIG_H
17 : : #include "config.h"
18 : : #endif
19 : :
20 : : #include "abi_common.h"
21 : :
22 : : module m_rwwf
23 : :
24 : : use defs_basis
25 : : use m_errors
26 : : use m_wffile
27 : : use m_abicore
28 : : use m_xmpi
29 : : USE_MPI
30 : : use m_nctk
31 : : use netcdf
32 : :
33 : : use defs_abitypes, only : mpi_type
34 : : use m_time, only : timab
35 : :
36 : : implicit none
37 : :
38 : : private
39 : :
40 : : #if defined HAVE_MPI1
41 : : include 'mpif.h'
42 : : #endif
43 : :
44 : : !!***
45 : :
46 : : public :: rwwf
47 : : public :: WffReadSkipK
48 : : !!***
49 : :
50 : : contains
51 : : !!***
52 : :
53 : : !!****f* m_rwwf/rwwf
54 : : !! NAME
55 : : !! rwwf
56 : : !!
57 : : !! FUNCTION
58 : : !! This subroutine reads (different options) or write (option=2) the block of records
59 : : !! related to one k point, and one spin-polarization, that
60 : : !! contains the wavefunctions (as well as the eigenvalues and occupations).
61 : : !! If called with option -1, the records will be skipped.
62 : : !! If called with option -2, only the wavefunctions are read.
63 : : !! The disk file unitwf should have been prepared
64 : : !! outside of this routine, in order to read or write the correct records.
65 : : !!
66 : : !! INPUTS
67 : : !! formeig=format of the eigenvalues
68 : : !! 0 => vector of eigenvalues
69 : : !! 1 => hermitian matrix of eigenvalues
70 : : !! headform=format of the header of the wf file, also governing the k block format
71 : : !! in case headform=0, use the default (current) format and headform
72 : : !! icg=shift to be given to the location of the cg array
73 : : !! ikpt=index of current k point (only needed for error message)
74 : : !! isppol=spin polarization currently treated (only needed for error message)
75 : : !! mband=maximum number of bands (dimension of cg, eigen and occ)
76 : : !! mcg=dimention of cg
77 : : !! nband=number of bands actually in cg, eigen and occ
78 : : !! (if writing mode : must be larger or equal to nband_disk, only nband_disk bands are written ;
79 : : !! if reading mode : can be equal, larger or smaller than nband_disk, but
80 : : !! cg, eigen and occ will not be completely filled if nband>nband_disk)
81 : : !! nband_disk=number of bands on the disk file
82 : : !! npw=number of plane waves
83 : : !! nspinor=number of spinorial components of the wavefunctions (on current proc)
84 : : !! option= 2 for writing cg, eigen and occ,
85 : : !! 1 for reading cg and eigen,
86 : : !! -1 for reading/skipping,
87 : : !! -2 for reading cg only
88 : : !! 3 for reading the eigenvalues only
89 : : !! 4 for writing a file containing only eigenvalues and occupations (need to be read with option 4)
90 : : !! 5 for writing a file containing only eigenvalues and occupations, that can however be read with option 3)
91 : : !! -4 for reading a file written with 4
92 : : !! (different from 3 which reads a normal option 2 file)
93 : : !! optkg= if 1 , read or write kg_k ; if 0, do not care about kg_k
94 : : !! tim_rwwf=timing code of the calling routine (set to 0 if not attributed)
95 : : !! wff=struct info for wavefunction
96 : : !! | unitwf=unit number for wavefunction
97 : : !!
98 : : !! SIDE EFFECTS
99 : : !! cg(2,npw*nspinor*mband)=planewave coefficients of wavefunctions,
100 : : !! input if option=2; output if option=1 or -2
101 : : !! eigen((2*mband)**formeig *mband)=array for holding eigenvalues (hartree)
102 : : !! input if option=2 or 4 or 5; output if option=1
103 : : !! kg_k(3,optkg*npw)=k+g data (only if optkg==1)
104 : : !! input if option=2; output if option=1 or -2
105 : : !! nband_disk=number of bands on disk
106 : : !! input if option=2 or 4 or 5; output in the other cases
107 : : !! occ(mband)=array for holding eigenvalues (hartree)
108 : : !! input if option=2 or 4 or 5; output if option=1
109 : : !! no meaning if frmeig/=0
110 : : !!
111 : : !! NOTES
112 : : !! WARNING : occ is not read in the present status of this routine
113 : : !! WARNING : skipping k-blocks is also done in the randac subroutine
114 : : !! WARNING : reading the two first records is also done in the rdnpw routine
115 : : !! WARNING : writing the two first records is also done in the dfpt_vtowfk routine
116 : : !!
117 : : !! TODO! if (mpi_enreg%flag_ind_kg_mpi_to_seq==1 ) then
118 : : !! Some arguments are contained in the wff datastructure, and should be eliminated.
119 : : !! option 3 should be called -3 (reading -> negative option) and others (-1,1) re-shuffled.
120 : : !!
121 : : !! SOURCE
122 : :
123 : 64238 : subroutine rwwf(cg,eigen,formeig,headform,icg,ikpt,isppol,kg_k,mband,mcg,mpi_enreg,&
124 : 64238 : & nband,nband_disk,npw,nspinor,occ,option,optkg,tim_rwwf,wff)
125 : :
126 : : !Arguments ------------------------------------
127 : : integer,intent(in) :: formeig,headform,icg,ikpt,isppol,mband,mcg,nband,npw
128 : : integer,intent(inout) :: nband_disk
129 : : integer,intent(in) :: nspinor,option,optkg,tim_rwwf
130 : : integer,intent(inout),target :: kg_k(3,optkg*npw)
131 : : real(dp),intent(inout),target :: cg(2,mcg),eigen((2*mband)**formeig*mband),occ(mband)
132 : : type(wffile_type),intent(inout) :: wff
133 : : type(MPI_type), intent(in) :: mpi_enreg
134 : :
135 : : !Local variables-------------------------------
136 : : !scalars
137 : : character(len=500) :: msg
138 : : !arrays
139 : : real(dp) :: tsec(2)
140 : :
141 : : ! *************************************************************************
142 : :
143 : 64238 : call timab(270+tim_rwwf,1,tsec)
144 : :
145 : : !Might check that icg+npw*nband*nspinor is smaller than mcg
146 : :
147 : : !Check that nband is smaller than mband, if one will not skip the records.
148 [ - + - - ]: 64238 : if (nband>mband .and. option/=-1)then
149 : 0 : write(msg,'(a,i0,a,i0,a)')' One should have nband<=mband. However, nband=',nband,', and mband=',mband,'.'
150 : 0 : ABI_BUG(msg)
151 : : end if
152 : :
153 : : !Check that formeig is 0 or 1.
154 [ - + ]: 64238 : if ( ALL(formeig/=(/0,1/)) ) then
155 : 0 : write(msg,'(a,i0,a)')' The argument formeig should be 0 or 1. However, formeig=',formeig,'.'
156 : 0 : ABI_BUG(msg)
157 : : end if
158 : :
159 : : !Check the value of option
160 [ + - + + : 64654 : if ( ALL( option /= (/1,2,3,4,5,-1,-2,-4/) )) then
- + ]
161 : 0 : write(msg,'(a,i0,a)')' The argument option should be between 1 and 5, or -1, -2, -4. However, option=',option,'.'
162 : 0 : ABI_BUG(msg)
163 : : end if
164 : :
165 [ + + + - ]: 64238 : if (option/=2.and.option/=4 .and. option/=5 ) then ! read
166 : : call readwf(cg,eigen,formeig,headform,icg,ikpt,isppol,kg_k,mband,mcg,mpi_enreg,&
167 : 63822 : & nband,nband_disk,npw,nspinor,occ,option,optkg,wff)
168 : : else ! write
169 : : call writewf(cg,eigen,formeig,icg,ikpt,isppol,kg_k,mband,mcg,mpi_enreg,&
170 : 416 : & nband,nband_disk,npw,nspinor,occ,option,optkg,wff)
171 : : end if
172 : :
173 : 64238 : call timab(270+tim_rwwf,2,tsec)
174 : :
175 : 64238 : end subroutine rwwf
176 : : !!***
177 : :
178 : : !!****f* m_rwwf/WffReadSkipK
179 : : !! NAME
180 : : !! WffReadSkipK
181 : : !!
182 : : !! FUNCTION
183 : : !! (Wavefunction file, read action : skip one k-point blok)
184 : : !! This subroutine skips the block of records
185 : : !! related to one k point, and one spin-polarization, that
186 : : !! contains the wavefunctions as well as the eigenvalues and occupations,
187 : : !! in a wavefunction file that has been already initialized.
188 : : !!
189 : : !! INPUTS
190 : : !! formeig=format of the eigenvalues
191 : : !! 0 => vector of eigenvalues (for Ground-State files)
192 : : !! 1 => hermitian matrix of eigenvalues (for Response-Function files)
193 : : !! headform=format of the header of the wf file, also governing the k block format
194 : : !! in case headform=0, use the default (current) format and headform
195 : : !! ikpt=index of current k point (only needed for error message)
196 : : !! isppol=spin polarization currently treated (only needed for error message)
197 : : !! mpi_enreg=information about MPI parallelization
198 : : !! wff=structured info for wavefunction file
199 : : !!
200 : : !! OUTPUT
201 : : !!
202 : : !! NOTES
203 : : !!
204 : : !! SOURCE
205 : :
206 : 2120 : subroutine WffReadSkipK(formeig,headform,ikpt,isppol,mpi_enreg,wff)
207 : :
208 : : !Arguments ------------------------------------
209 : : !scalars
210 : : integer,intent(in) :: formeig,headform,ikpt,isppol
211 : : type(MPI_type),intent(in) :: mpi_enreg
212 : : type(wffile_type),intent(inout) :: wff
213 : :
214 : : !Local variables-------------------------------
215 : : !scalars
216 : : integer :: icg,mband,mcg,nband,nband_disk,option,optkg,tim_rwwf
217 : : integer,parameter :: nspinor1=1,npw1=1
218 : : !arrays
219 : 2120 : integer,allocatable :: kg_dum(:,:)
220 : : real(dp) :: cg_dum(2,1),occ_dum(1)
221 : 2120 : real(dp),allocatable :: eig_dum(:)
222 : :
223 : : ! *************************************************************************
224 : :
225 : : ! No need to skip if netcdf
226 [ + - ]: 2120 : if (wff%iomode == IO_MODE_ETSF) return
227 : :
228 : 0 : option=-1
229 : 0 : tim_rwwf=0 ; mcg=1 ; mband=1 ; icg=0 ; optkg=0 ; nband=0
230 [ # # # # : 0 : ABI_MALLOC(eig_dum,(2**formeig))
# # # # #
# # # # #
# # # # #
# # # ]
231 [ # # ]: 0 : ABI_MALLOC(kg_dum,(3,optkg*npw1))
232 : :
233 : : call rwwf(cg_dum,eig_dum,formeig,headform,icg,ikpt,isppol,kg_dum,mband,mcg,mpi_enreg,nband,&
234 : 0 : & nband_disk,npw1,nspinor1,occ_dum,option,optkg,tim_rwwf,wff)
235 : :
236 [ # # ]: 0 : ABI_FREE(eig_dum)
237 [ # # ]: 0 : ABI_FREE(kg_dum)
238 : :
239 : : end subroutine WffReadSkipK
240 : : !!***
241 : :
242 : : ! -------------------------------------------------------------------------------------------------
243 : :
244 : : !!****f* m_rwwf/readwf
245 : : !! NAME
246 : : !! readwf
247 : : !!
248 : : !! FUNCTION
249 : : !! This subroutine reads the block of records related to one k point, and one spin-polarization, that
250 : : !! contains the wavefunctions (as well as the eigenvalues).
251 : : !! The disk file unitwf should have been prepared outside of this routine, in order to read the correct records.
252 : : !!
253 : : !! INPUTS
254 : : !! formeig=format of the eigenvalues
255 : : !! 0 => vector of eigenvalues
256 : : !! 1 => hermitian matrix of eigenvalues
257 : : !! icg=shift to be given to the location of the cg array
258 : : !! ikpt=index of current k point (only needed for error message)
259 : : !! isppol=spin polarization currently treated (only needed for error message)
260 : : !! kg_k(3,optkg*npw)=k+g data (only if optkg==1)
261 : : !! mband=maximum number of bands (dimension of cg, eigen and occ)
262 : : !! mcg=dimension of cg
263 : : !! nband=number of bands actually in cg, eigen and occ
264 : : !! nband_disk=number of bands on the disk file
265 : : !! npw=number of plane waves (on current proc)
266 : : !! nspinor=number of spinorial components of the wavefunctions (on current proc)
267 : : !! option= 1 for reading cg, eigen and occ,
268 : : !! -1 for reading/skipping,
269 : : !! -2 for reading cg only
270 : : !! 3 for reading the eigenvalues only
271 : : !! -4 for reading a file written with 4
272 : : !! optkg= if 1 , read or write kg_k ; if 0, do not care about kg_k
273 : : !! wff=struct info for wavefunction
274 : : !!
275 : : !! SIDE EFFECTS
276 : : !! Current kpt and spin updated
277 : : !! cg(2,npw*nspinor*mband)=planewave coefficients of wavefunctions,
278 : : !! eigen((2*mband)**formeig *mband)=array for holding eigenvalues (hartree)
279 : : !! occ(mband)=array for holding electronic occupations
280 : : !!
281 : : !! NOTES
282 : : !! WARNING : occ is not read in the present status of this routine
283 : : !! WARNING : skipping k-blocks is also done in the randac subroutine
284 : : !! WARNING : reading the two first records is also done in the rdnpw routine
285 : : !!
286 : : !! SOURCE
287 : :
288 : 63822 : subroutine readwf(cg,eigen,formeig,headform,icg,ikpt,isppol,kg_k,mband,mcg,mpi_enreg,&
289 : 63822 : & nband,nband_disk,npw,nspinor,occ,option,optkg,wff)
290 : :
291 : : !Arguments ------------------------------------
292 : : integer,intent(in) :: formeig,headform,icg,ikpt,isppol,mband,mcg,nband,npw
293 : : integer,intent(in) :: nspinor,option,optkg
294 : : integer,intent(inout) :: nband_disk
295 : : integer,intent(inout),target :: kg_k(3,optkg*npw)
296 : : real(dp),intent(inout),target :: cg(2,mcg),eigen((2*mband)**formeig*mband),occ(mband)
297 : : type(MPI_type),intent(in) :: mpi_enreg
298 : : type(wffile_type),intent(inout) :: wff
299 : :
300 : : !Local variables-------------------------------
301 : : integer :: iband,indxx,ios,ipw,ispinor_index,nband1,ncid_hdr
302 : : integer :: npw1,npwso,npwso1,npwsotot,npwtot,nrec,nspinor1,nspinortot,unitwf,use_f90
303 : : integer :: band1,band2,ierr
304 : : character(len=500) :: msg
305 : : character(len=fnlen) :: fname
306 : : integer :: ikpt_this_proc,ispinor
307 : 63822 : integer,allocatable :: ind_cg_mpi_to_seq(:)
308 : : integer :: kg_varid,eig_varid,occ_varid,cg_varid,h1_varid,mband_varid,ncerr,ii,mband_file
309 : 63822 : integer,allocatable :: gall(:,:)
310 : 63822 : real(dp),allocatable :: cg_all(:,:,:),h1mat(:,:,:)
311 : : ! *********************************************************************
312 : :
313 : : !write(std_out,*)"rwwf with ikpt, isppol, option, etsf",ikpt, isppol, option, wff%iomode == IO_MODE_ETSF
314 : :
315 : : !Check the options
316 [ + - - + : 63822 : if ( ALL(option /= [1,3,-1,-2,-4])) then
- + ]
317 : 0 : write(msg,'(a,i0,a)')'The argument option should be -4, -2, -1, 1 or 3. However, option=',option,'.'
318 : 0 : ABI_BUG(msg)
319 : : end if
320 : :
321 : 63822 : npwtot=npw; npwso=npw*nspinor
322 : 63822 : npwsotot=npwso
323 : 63822 : nspinortot=min(2,(1+mpi_enreg%paral_spinor)*nspinor)
324 : :
325 : 63822 : unitwf=wff%unwff
326 : 63822 : ncid_hdr=unitwf
327 : :
328 : 63822 : use_f90=0
329 [ + - + - : 63822 : if (wff%iomode==IO_MODE_FORTRAN.or.(wff%iomode==IO_MODE_FORTRAN_MASTER.and.wff%master==wff%me)) use_f90=1
- - ]
330 : :
331 [ + - ]: 63822 : if (option==1.or.option==-2) then
332 : :
333 : : ! Compute mapping my_gtable --> sequential gtable.
334 [ + - + - ]: 63822 : if (any(wff%iomode==[IO_MODE_MPI, IO_MODE_ETSF]).and.nband>0) then
335 : 63822 : call xmpi_sum(npwsotot,wff%spaceComm_mpiio,ios)
336 : 63822 : npwtot=npwsotot/nspinortot
337 [ - + + - : 191466 : ABI_MALLOC(ind_cg_mpi_to_seq,(npwso))
+ - + - -
+ - + ]
338 [ + + ]: 127644 : if (allocated(mpi_enreg%my_kgtab)) then
339 : 532 : ikpt_this_proc=mpi_enreg%my_kpttab(ikpt)
340 [ - + ]: 532 : if ( ikpt_this_proc <= 0 ) then
341 : 0 : ABI_BUG("rwwf: ikpt_this_proc <= 0")
342 : : end if
343 [ + + ]: 1064 : do ispinor=1,nspinor
344 : 532 : ispinor_index=ispinor
345 [ + + ]: 532 : if (mpi_enreg%nproc_spinor>1) ispinor_index=mpi_enreg%me_spinor + 1
346 : : ind_cg_mpi_to_seq(1+npw*(ispinor-1):npw*ispinor)=npwtot*(ispinor_index-1) &
347 [ + + ]: 81632 : & + mpi_enreg%my_kgtab(1:npw,ikpt_this_proc)
348 : : end do
349 : : else
350 [ + - + + : 15205088 : ind_cg_mpi_to_seq(1:npwso) = (/(ipw,ipw=1,npwso)/)
+ + ]
351 : : end if
352 : : end if
353 : : end if
354 : :
355 : : !---------------------------------------------------------------------------
356 : : !Read the first record: npw, nspinor, nband_disk
357 : : !---------------------------------------------------------------------------
358 : :
359 [ + - ]: 63822 : if (headform>=40.or.headform==0) then ! headform==0 refers to the current headform
360 : 63822 : call WffReadNpwRec(ios,ikpt,isppol,nband_disk,npw1,nspinor1,wff)
361 : 63822 : npwso1=npw1*nspinor1
362 [ - + ]: 63822 : if(ios/=0)then
363 : 0 : inquire (unit=unitwf, NAME=fname)
364 : : write(msg,'(3a,i4,2a,i4,4a)') &
365 : 0 : & 'Reading option of rwwf. Trying to read',ch10,&
366 : 0 : & 'the (npw,nspinor,nband) record of a wf file, unit=',unitwf,ch10,&
367 : 0 : & 'gave iostat=',ios,'. Your file is likely not correct.',ch10,&
368 : 0 : & 'Action: check your input wf file:',trim(fname)
369 : 0 : ABI_ERROR(msg)
370 : : end if
371 : :
372 : : else
373 : : ! Old format
374 [ # # ]: 0 : if(use_f90==1)then
375 : 0 : read (unitwf,iostat=ios) npwso1,nband_disk
376 [ # # ]: 0 : else if(wff%iomode==IO_MODE_MPI)then
377 : 0 : call xderiveRRecInit(wff,ios)
378 : 0 : call xderiveRead(wff,npwso1,ios)
379 : 0 : call xderiveRead(wff,nband_disk,ios)
380 : 0 : call xderiveRRecEnd(wff,ios)
381 : : end if
382 [ # # ]: 0 : if(ios/=0)then
383 : 0 : inquire (unit=unitwf, NAME=fname)
384 : : write(msg,'(3a,i4,2a,i4,4a)') &
385 : 0 : & 'Reading option of rwwf. Trying to read',ch10,&
386 : 0 : & 'the (npw,nband) record of a wf file with headform <40 , unit=',unitwf,ch10,&
387 : 0 : & 'gave iostat=',ios,'. Your file is likely not correct.',ch10,&
388 : 0 : & 'Action: check your input wf file:',trim(fname)
389 : 0 : ABI_ERROR(msg)
390 : : end if
391 : : end if ! headform
392 : :
393 [ + - ]: 63822 : if (option==1.or.option==-2) then ! Will read the wavefunction and/or kg data, so check npw and nspinor
394 : :
395 [ + - ]: 63822 : if (headform>=40.or.headform==0) then ! New format. headform==0 refers to the current headform
396 [ - + ]: 63822 : if (npwtot/=npw1) then
397 : : write(msg,'(3a,i0,a,i0,a)') &
398 : 0 : & 'Reading option of rwwf. One should have npwtot=npw1',ch10,&
399 : 0 : & 'However, npwtot= ',npwtot,', and npw1= ',npw1,'.'
400 : 0 : ABI_BUG(msg)
401 : : end if
402 [ - + ]: 63822 : if(nspinortot/=nspinor1)then
403 : : write(msg,'(3a,i0,a,i0,a)') &
404 : 0 : & 'Reading option of rwwf. One should have nspinor=nspinor1',ch10,&
405 : 0 : & 'However, nspinortot= ',nspinortot,', and nspinor1= ',nspinor1,'.'
406 : 0 : ABI_BUG(msg)
407 : : end if
408 : : else ! Treat the Old format.
409 [ # # ]: 0 : if(npwsotot/=npwso1)then
410 : : write(msg,'(3a,i0,a,i0,a)') &
411 : 0 : & 'Reading option of rwwf. One should have npwso=npwso1',ch10,&
412 : 0 : & 'However, npwsotot= ',npwsotot,', and npwso1= ',npwso1,'.'
413 : 0 : ABI_BUG(msg)
414 : : end if
415 : : end if ! headform
416 : : !
417 : : end if ! option==1.or.option==2
418 : :
419 : : !---------------------------------------------------------------------------
420 : : !Read the second record: (k+G) vectors
421 : : !---------------------------------------------------------------------------
422 : :
423 [ + - ]: 63822 : if (headform>=40.or.headform==0) then ! headform==0 refers to the current headform
424 : :
425 [ - + ]: 63822 : if ((option==1.or.option==-2.or.option==3).and.optkg/=0 )then
426 : :
427 [ # # ]: 0 : if(use_f90==1)then
428 : 0 : read(unitwf,iostat=ios) kg_k(1:3,1:npw)
429 : :
430 [ # # ]: 0 : else if(wff%iomode==IO_MODE_MPI)then
431 : 0 : call xderiveRRecInit(wff,ios)
432 [ # # ]: 0 : if (allocated(mpi_enreg%my_kgtab)) then
433 : 0 : ikpt_this_proc=mpi_enreg%my_kpttab(ikpt)
434 : : call xderiveRead(wff,kg_k(1:3,1:npw),3,npw,wff%spaceComm_mpiio,&
435 : 0 : & mpi_enreg%my_kgtab(1:npw,ikpt_this_proc),ios)
436 : : else
437 : : ! MG The call below uses MPI_SCAN but here we want to read the full set of G.
438 : 0 : call xderiveRead(wff,kg_k(1:3,1:npw),3,npw,wff%spaceComm_mpiio,ios)
439 : 0 : call xmpi_read_int2d(wff,kg_k(1:3,1:npw),wff%spaceComm_mpiio,xmpio_collective,ios)
440 : : end if
441 : 0 : call xderiveRRecEnd(wff,ios)
442 : :
443 [ # # ]: 0 : else if (wff%iomode == IO_MODE_ETSF) then
444 : : ! Read reduced_coordinates_of_plane_waves for this k point (npw1 is npw_disk).
445 : : ! TODO: spinor parallelism
446 [ # # ]: 0 : NCF_CHECK(nf90_inq_varid(wff%unwff, "reduced_coordinates_of_plane_waves", kg_varid))
447 [ # # ]: 0 : if (npw == npw1) then
448 [ # # # # ]: 0 : ncerr = nf90_get_var(wff%unwff, kg_varid, kg_k, start=[1,1,ikpt], count=[3,npw1,1])
449 [ # # ]: 0 : NCF_CHECK_MSG(ncerr, "getting kg_k")
450 : : else
451 : 0 : write(std_out,*)"ETSF Reading distributed kg_k"
452 [ # # # # : 0 : ABI_MALLOC(gall, (3, npw1))
# # # # #
# # # ]
453 [ # # # # ]: 0 : ncerr = nf90_get_var(wff%unwff, kg_varid, gall, start=[1,1,ikpt], count=[3,npw1,1])
454 [ # # ]: 0 : NCF_CHECK_MSG(ncerr, "getting kg_k")
455 [ # # ]: 0 : do ipw=1,npw
456 [ # # ]: 0 : kg_k(:,ipw) = gall(:,ind_cg_mpi_to_seq(ipw))
457 : : end do
458 [ # # ]: 0 : ABI_FREE(gall)
459 : : end if
460 : : end if
461 : :
462 : : else ! option
463 : 63822 : call WffReadSkipRec(ios,1,wff) ! Skip the record
464 : : end if
465 : :
466 [ - + ]: 63822 : if(ios/=0)then
467 : 0 : inquire (unit=unitwf, NAME=fname)
468 : : write(msg,'(3a,i4,2a,i4,4a)') &
469 : 0 : & 'Reading option of rwwf. Trying to read',ch10,&
470 : 0 : & 'the k+g record of a wf file, unit=',unitwf,ch10,&
471 : 0 : & 'gave iostat=',ios,'. Your file is likely not correct.',ch10,&
472 : 0 : & 'Action: check your input wf file:',trim(fname)
473 : 0 : ABI_ERROR(msg)
474 : : end if
475 : : end if ! headform
476 : :
477 : : !---------------------------------------------------------------------------
478 : : !Read the third record: eigenvalues
479 : : !---------------------------------------------------------------------------
480 : : !The reading of occ should be enabled, BUT taking into account
481 : : !of headform of the disk file : occ was NOT present in the disk files with headform=22
482 : :
483 : 63822 : nband1 = min(nband,nband_disk)
484 : :
485 : : !===== Case formeig=0: read eigenvalues =====
486 [ + + ]: 63822 : if (formeig==0) then
487 : :
488 [ + - ]: 9613 : if (option==1.or.option==3.or.option==-4) then
489 [ - + ]: 9613 : if(use_f90==1)then
490 : 0 : read (unitwf,iostat=ios) eigen(1:nband1)
491 [ + + ]: 9613 : else if(wff%iomode==IO_MODE_MPI)then
492 : 16 : call xderiveRRecInit(wff,ios)
493 : 16 : call xderiveRead(wff,eigen,nband1,xmpi_comm_self,ios)
494 : 16 : call xderiveRRecEnd(wff,ios)
495 : : end if
496 : : else
497 : 0 : call WffReadSkipRec(ios,1,wff)
498 : : end if ! option
499 : :
500 [ - + ]: 9613 : if(ios/=0)then
501 : 0 : inquire (unit=unitwf, NAME=fname)
502 : : write(msg,'(3a,i4,2a,i4,4a)') &
503 : 0 : & 'Reading option of rwwf. Trying to read',ch10,&
504 : 0 : & 'an eigenvalue record of a wf file, unit=',unitwf,ch10,&
505 : 0 : & 'gave iostat=',ios,'. Your file is likely not correct.',ch10,&
506 : 0 : & 'Action: check your input wf file.',trim(fname)
507 : 0 : ABI_ERROR(msg)
508 : : end if
509 : :
510 [ + + ]: 9613 : if (wff%iomode == IO_MODE_ETSF) then
511 : : ! get eigenvalues and occupations
512 [ - + ]: 9597 : NCF_CHECK(nf90_inq_varid(wff%unwff, "eigenvalues", eig_varid))
513 [ + + + + ]: 67179 : ncerr = nf90_get_var(wff%unwff, eig_varid, eigen, start=[1,ikpt,isppol], count=[nband1,1,1])
514 [ - + ]: 9597 : NCF_CHECK_MSG(ncerr, "getting eig_k")
515 : :
516 [ - + ]: 9597 : NCF_CHECK(nf90_inq_varid(wff%unwff, "occupations", occ_varid))
517 [ + + + + ]: 67179 : ncerr = nf90_get_var(wff%unwff, occ_varid, occ, start=[1,ikpt,isppol], count=[nband1,1,1])
518 [ - + ]: 9597 : NCF_CHECK_MSG(ncerr, "getting occ_k")
519 : : end if
520 : :
521 : : ! ===== Case formeig=1: read matrix of eigenvalues =====
522 : : ! Will be written later (together with wave-functions)
523 : : else if(formeig==1)then
524 : : end if ! formeig
525 : :
526 : : !---------------------------------------------------------------------------
527 : : !Read the wave-function coefficients
528 : : !---------------------------------------------------------------------------
529 : :
530 : : !Select bands
531 : 63822 : nband1=min(nband,nband_disk)
532 [ + - + - ]: 63822 : if(nband1>0.and.option/=-1)then
533 : :
534 : : ! ===== Case formeig=0: read only wave-functions =====
535 [ + + ]: 63822 : if (formeig==0) then
536 : :
537 [ + - ]: 9613 : if (option==1.or.option==-2) then
538 : :
539 [ - + ]: 9613 : if (use_f90==1) then
540 [ # # ]: 0 : do iband=1,nband1
541 : 0 : ipw=(iband-1)*npwso+icg
542 : 0 : read(unitwf,iostat=ios) cg(1:2,ipw+1:ipw+npwso)
543 [ # # ]: 0 : if (ios/=0) exit
544 : : end do
545 [ + + ]: 9613 : else if (wff%iomode==IO_MODE_MPI) then
546 : 16 : call WffReadWrite_mpio(wff,1,cg,mcg,icg,nband1,npwso,npwsotot,ind_cg_mpi_to_seq,ios)
547 : : end if
548 : :
549 [ # # ]: 0 : else if (option/=-4) then
550 [ # # ]: 0 : do iband=1,nband1
551 : 0 : call WffReadSkipRec(ios,1,wff) ! Skip the record
552 : : end do
553 : : end if ! option
554 : :
555 [ - + ]: 9613 : if(ios/=0)then
556 : 0 : inquire (unit=unitwf, NAME=fname)
557 : : write(msg,'(3a,i4,2a,i4,4a)') &
558 : 0 : & 'Reading option of rwwf. Trying to read',ch10,&
559 : 0 : & 'a RF wf record of a wf file, unit=',unitwf,ch10,&
560 : 0 : & 'gave iostat=',ios,'. Your file is likely not correct.',ch10,&
561 : 0 : & 'Action: check your input wf file.',trim(fname)
562 : 0 : ABI_ERROR(msg)
563 : : end if
564 : :
565 [ + + ]: 9613 : if (wff%iomode == IO_MODE_ETSF) then
566 : : ! The coefficients_of_wavefunctions on file have shape [cplex, mpw, nspinor, mband, nkpt, nsppol]
567 [ - + ]: 9597 : NCF_CHECK(nf90_inq_varid(wff%unwff, "coefficients_of_wavefunctions", cg_varid))
568 [ + + ]: 9597 : if (npw == npw1) then
569 : : ncerr = nf90_get_var(wff%unwff, cg_varid, cg(:, icg+1:), start=[1,1,1,1,ikpt,isppol], &
570 [ + + + + ]: 118053 : count=[2,npw,nspinor,nband1,1,1])
571 [ - + ]: 9081 : NCF_CHECK_MSG(ncerr, "getting cg_k")
572 : : else
573 : 516 : write(std_out,*)"ETSF Reading distributed cg"
574 [ - + + - : 2064 : ABI_MALLOC_OR_DIE(cg_all, (2, npw1*nspinor, nband1), ierr)
- + + - +
- + - + -
- + - + ]
575 : : ncerr = nf90_get_var(wff%unwff, cg_varid, cg_all, start=[1,1,1,1,ikpt,isppol], &
576 [ + + + + ]: 6708 : count=[2,npw1,nspinor,nband1,1,1])
577 [ - + ]: 516 : NCF_CHECK_MSG(ncerr, "getting cg_k")
578 : : ! A band has npwso = npw*nspinor coefficients: ind_cg_mpi_to_seq maps them, spinor components included,
579 : : ! to the (npw1, nspinor) block on file. Looping over npw only skipped the second spinor component.
580 : 516 : ii = icg
581 [ + + ]: 6860 : do iband=1,nband1
582 [ + + ]: 1525502 : do ipw=1,npwso
583 : 1518642 : ii = ii + 1
584 [ + + ]: 4562270 : cg(:,ii) = cg_all(:,ind_cg_mpi_to_seq(ipw),iband)
585 : : end do
586 : : end do
587 [ - + ]: 516 : ABI_FREE(cg_all)
588 : : end if
589 : : end if
590 : :
591 : : ! ===== Case formeig=1: read eigenvalues, occupations and wave-functions =====
592 [ + - ]: 54209 : else if(formeig==1)then
593 : : ! write(std_out,*)"nband1",nband1
594 : : ! ABI_CHECK(nband1==nband_disk,"nband != nband_disk")
595 : :
596 [ - + ]: 54209 : if (wff%iomode /= IO_MODE_ETSF) then
597 : : indxx=0
598 [ # # ]: 0 : do iband=1,nband1
599 : :
600 [ # # ]: 0 : if (option==1.or.option==3.or.option==-4) then
601 [ # # ]: 0 : if(use_f90==1)then
602 : 0 : read (unitwf,iostat=ios) eigen(1+indxx:2*nband1+indxx)
603 [ # # ]: 0 : else if(wff%iomode==IO_MODE_MPI)then
604 : : ! Should use an access with a "view"
605 : 0 : call xderiveRRecInit(wff,ios)
606 : 0 : call xderiveRead(wff,eigen(1+indxx:2*nband1+indxx),2*nband1,xmpi_comm_self,ios)
607 : 0 : call xderiveRRecEnd(wff,ios)
608 : : end if
609 : 0 : indxx=indxx+2*nband1
610 : : else
611 : 0 : call WffReadSkipRec(ios,1,wff) ! Skip the record
612 : : end if
613 : :
614 [ # # ]: 0 : if(ios/=0)then
615 : 0 : inquire (unit=unitwf, NAME=fname)
616 : : write(msg,'(3a,i4,2a,i4,4a)') &
617 : 0 : & 'Reading option of rwwf. Trying to read',ch10,&
618 : 0 : & 'a RF eigenvalue record of a wf file, unit=',unitwf,ch10,&
619 : 0 : & 'gave iostat=',ios,'. Your file is likely not correct.',ch10,&
620 : 0 : & 'Action: check your input wf file.',trim(fname)
621 : 0 : ABI_ERROR(msg)
622 : : end if
623 : :
624 [ # # ]: 0 : if(option==1.or.option==-2)then
625 : 0 : ipw=(iband-1)*npwso+icg
626 [ # # ]: 0 : if(use_f90==1)then
627 : 0 : ipw=(iband-1)*npwso+icg
628 : 0 : read(unitwf,iostat=ios) cg(1:2,ipw+1:ipw+npwso)
629 [ # # ]: 0 : else if(wff%iomode==IO_MODE_MPI)then
630 : : ! Should use an access with a "view"
631 : 0 : call xderiveRRecInit(wff,ios)
632 : 0 : call xderiveRead(wff,cg(1:2,ipw+1:ipw+npwso),2,npwso,wff%spaceComm_mpiio,ind_cg_mpi_to_seq,ios)
633 : 0 : call xderiveRRecEnd(wff,ios)
634 : : end if
635 [ # # ]: 0 : else if (option/=-4) then
636 : 0 : call WffReadSkipRec(ios,1,wff) ! Skip the record
637 : : end if ! option
638 : :
639 [ # # ]: 0 : if(ios/=0)then
640 : 0 : inquire (unit=unitwf, NAME=fname)
641 : : write(msg,'(3a,i4,2a,i4,4a)') &
642 : 0 : & 'Reading option of rwwf. Trying to read',ch10,&
643 : 0 : & 'a RF wf record of a wf file, unit=',unitwf,ch10,&
644 : 0 : & 'gave iostat=',ios,'. Your file is likely not correct.',ch10,&
645 : 0 : & 'Action: check your input wf file.',trim(fname)
646 : 0 : ABI_ERROR(msg)
647 : : end if
648 : : end do ! iband
649 : :
650 : : else
651 : : ! ETSF-IO
652 [ + - ]: 54209 : if (any(option == [1, 3, -4])) then
653 : : ! Read eigen. Remember that the matrix on file has shape [2, mband, mband, nkpt, nspin]
654 : : ! whereas the eigen array used in Abinit is packed. Read the full matrix first, then pack data.
655 [ - + ]: 54209 : NCF_CHECK(nf90_inq_dimid(wff%unwff, "max_number_of_states", mband_varid))
656 [ - + ]: 54209 : NCF_CHECK(nf90_inquire_dimension(wff%unwff, mband_varid, len=mband_file))
657 : 54209 : h1_varid = nctk_idname(wff%unwff, "h1_matrix_elements")
658 : :
659 [ - + + - : 216836 : ABI_MALLOC(h1mat, (2, mband_file, mband_file))
- + + - +
- + - - +
- + ]
660 [ + + ]: 325254 : ncerr = nf90_get_var(wff%unwff, h1_varid, h1mat, start=[1,1,1,ikpt,isppol])
661 [ - + ]: 54209 : NCF_CHECK_MSG(ncerr, "getting h1_matrix_elements")
662 : :
663 : : indxx=1
664 [ + + ]: 333461 : do band2=1,nband1
665 [ + + ]: 2761725 : do band1=1,nband1
666 [ + + ]: 7284792 : eigen(indxx:indxx+1) = h1mat(:,band1,band2)
667 : 2707516 : indxx = indxx + 2
668 : : end do
669 : : end do
670 [ - + ]: 54209 : ABI_FREE(h1mat)
671 : : end if
672 : :
673 [ + - ]: 54209 : if (any(option == [1, -2])) then
674 : : ! Read wavefunctions.
675 : : ! The coefficients_of_wavefunctions on file have shape [cplex, mpw, nspinor, mband, nkpt, nsppol]
676 [ - + ]: 54209 : ABI_CHECK(npw == npw1, "npw != npw1 not coded")
677 : :
678 : 54209 : cg_varid = nctk_idname(wff%unwff, "coefficients_of_wavefunctions")
679 : : ncerr = nf90_get_var(wff%unwff, cg_varid, cg(:, icg+1:), start=[1,1,1,1,ikpt,isppol], &
680 [ + + + + ]: 704717 : count=[2,npw,nspinor,nband1,1,1])
681 [ - + ]: 54209 : NCF_CHECK_MSG(ncerr, "getting cg_k")
682 : : end if
683 : : end if
684 : :
685 : : end if ! formeig == 1
686 : :
687 : : end if ! nband >0
688 : :
689 : : !If fewer than all bands were read wind disk file forward to end of bands for this k point.
690 : : !Will have to fill the non-filled bands outside of this routine ...
691 [ + + - + ]: 63822 : if (nband<nband_disk .or. option==-1) then
692 : 72 : nrec=(formeig+1)*(nband_disk-nband)
693 [ - + ]: 72 : if(option==-1)nrec=(formeig+1)*nband_disk
694 : 72 : call WffReadSkipRec(ios,nrec,wff)
695 : : end if
696 : :
697 : : !---------------------------------------------------------------------------
698 : : ! Free memory
699 : : !---------------------------------------------------------------------------
700 [ + - ]: 63822 : ABI_SFREE(ind_cg_mpi_to_seq)
701 : :
702 [ - + - + : 63822 : end subroutine readwf
- + - + ]
703 : : !!***
704 : :
705 : : ! -------------------------------------------------------------------------------------------------
706 : :
707 : : !!****f* m_rwwf/writewf
708 : : !! NAME
709 : : !! writewf
710 : : !!
711 : : !! FUNCTION
712 : : !! This subroutine writes the block of records
713 : : !! related to one k point, and one spin-polarization, that
714 : : !! contains the wavefunctions (as well as the eigenvalues and occupations).
715 : : !! The disk file unitwf should have been prepared
716 : : !! outside of this routine, in order to write the correct records.
717 : : !!
718 : : !! INPUTS
719 : : !! cg(2,npw*nspinor*mband)=planewave coefficients of wavefunctions,
720 : : !! eigen((2*mband)**formeig *mband)=array for holding eigenvalues (hartree)
721 : : !! formeig=format of the eigenvalues
722 : : !! 0 => vector of eigenvalues
723 : : !! 1 => hermitian matrix of eigenvalues
724 : : !! icg=shift to be given to the location of the cg array
725 : : !! ikpt=index of current k point (only needed for error message)
726 : : !! isppol=spin polarization currently treated (only needed for error message)
727 : : !! kg_k(3,optkg*npw)=k+g data (only if optkg==1)
728 : : !! mband=maximum number of bands (dimension of cg, eigen and occ)
729 : : !! mcg=dimension of cg
730 : : !! nband=number of bands actually in cg, eigen and occ
731 : : !! (must be larger or equal to nband_disk, only nband_disk bands are written)
732 : : !! nband_disk=number of bands on the disk file
733 : : !! npw=number of plane waves
734 : : !! nspinor=number of spinorial components of the wavefunctions (on current proc)
735 : : !! occ(mband)=array for holding electronic occupations
736 : : !! option= 2 for writing cg, eigen and occ,
737 : : !! 4 for writing a file containing only eigenvalues and occupations
738 : : !! optkg= if 1 , read or write kg_k ; if 0, do not care about kg_k
739 : : !! wff=struct info for wavefunction
740 : : !!
741 : : !! OUTPUT
742 : : !! (none, only writing)
743 : : !!
744 : : !! SIDE EFFECTS
745 : : !!
746 : : !! NOTES
747 : : !! WARNING : skipping k-blocks is also done in the randac subroutine
748 : : !! WARNING : writing the two first records is also done in the dfpt_vtowfk routine
749 : : !!
750 : : !! SOURCE
751 : :
752 : 416 : subroutine writewf(cg,eigen,formeig,icg,ikpt,isppol,kg_k,mband,mcg,mpi_enreg,&
753 : 416 : & nband,nband_disk,npw,nspinor,occ,option,optkg,wff)
754 : :
755 : : !Arguments ------------------------------------
756 : : integer,intent(in) :: formeig,icg,ikpt,isppol,mband,mcg,nband,nband_disk,npw,nspinor,option,optkg
757 : : integer,intent(in),target :: kg_k(3,optkg*npw)
758 : : real(dp),intent(in),target :: cg(2,mcg),eigen((2*mband)**formeig*mband),occ(mband)
759 : : type(MPI_type),intent(in) :: mpi_enreg
760 : : type(wffile_type),intent(inout) :: wff
761 : :
762 : : !Local variables-------------------------------
763 : : integer :: iband,ii,ios,ipw,ispinor_index,nband2,ncid_hdr,npwso,npwsotot,npwtot,nspinortot
764 : : integer :: unitwf,use_f90
765 : : character(len=500) :: msg
766 : : integer :: ikpt_this_proc,ispinor,me_cart_3d
767 : 416 : integer,allocatable :: ind_cg_mpi_to_seq(:)
768 : 416 : real(dp),contiguous, pointer :: cg_ptr(:,:)
769 : : integer :: kg_varid,eig_varid,occ_varid,cg_varid,ncerr
770 : : character(len=nctk_slen) :: kdep
771 : : #ifdef HAVE_MPI
772 : : integer(kind=MPI_OFFSET_KIND) :: off(1)
773 : : #endif
774 : : ! *********************************************************************
775 : :
776 : : !Check the options
777 [ + - - + : 416 : if ( ALL(option /= (/2,4,5/)) ) then
- + ]
778 : 0 : write(msg,'(a,i0)')' The argument option should be 2, 4 or 5. However, option=',option
779 : 0 : ABI_BUG(msg)
780 : : end if
781 : :
782 [ + + ]: 416 : if(wff%iomode==IO_MODE_MPI)then
783 [ - + ]: 52 : if(option==5)then
784 : 0 : write(msg,'(a,i0)')' With MPI-IO activated, the argument option should be 2 or 4. However, option=',option
785 : 0 : ABI_BUG(msg)
786 : : end if
787 : : end if
788 : :
789 [ - + ]: 416 : if (wff%iomode==IO_MODE_ETSF) then
790 : : ! outkss still calls this routine!
791 : 0 : ABI_WARNING("You should use outwff or ncwrite_cg to write data in netcdf format!")
792 : : end if
793 : :
794 : : !Check that nband_disk is not larger than nband (only for writing)
795 [ - + ]: 416 : if (nband<nband_disk) then
796 : : write(msg,'(3a,i5,a,i5,a)') &
797 : 0 : & 'Writing option of rwwf. One should have nband<=nband_disk',ch10,&
798 : 0 : & 'However, nband= ',nband,', and nband_disk= ',nband_disk,'.'
799 : 0 : ABI_BUG(msg)
800 : : end if
801 : :
802 : 416 : npwtot=npw; npwso=npw*nspinor
803 : 416 : unitwf=wff%unwff; ncid_hdr=unitwf
804 : 416 : npwsotot=npwso
805 : 416 : nspinortot=min(2,(1+mpi_enreg%paral_spinor)*nspinor)
806 : :
807 : 416 : use_f90=0
808 [ + - + + : 416 : if (wff%iomode==IO_MODE_FORTRAN.or.(wff%iomode ==IO_MODE_FORTRAN_MASTER.and.wff%master==wff%me)) use_f90=1
- + ]
809 : :
810 [ + + ]: 416 : if (wff%iomode==IO_MODE_MPI) then
811 : :
812 : 52 : call xmpi_sum(npwsotot,wff%spaceComm_mpiio,ios)
813 : 52 : npwtot=npwsotot/nspinortot
814 : :
815 [ - + ]: 52 : if (option/=4) then
816 [ - + + - : 156 : ABI_MALLOC(ind_cg_mpi_to_seq,(npwso))
+ - + - -
+ - + ]
817 [ + - ]: 52 : if (allocated(mpi_enreg%my_kgtab)) then
818 : 52 : ikpt_this_proc=mpi_enreg%my_kpttab(ikpt)
819 [ + + ]: 112 : do ispinor=1,nspinor
820 : 60 : ispinor_index=ispinor
821 [ + + ]: 60 : if (mpi_enreg%nproc_spinor > 1) ispinor_index = mpi_enreg%me_spinor + 1
822 : : ind_cg_mpi_to_seq(1+npw*(ispinor-1):npw*ispinor)=npwtot*(ispinor_index-1) &
823 [ + + ]: 14402 : & + mpi_enreg%my_kgtab(1:npw,ikpt_this_proc)
824 : : end do
825 : : else
826 [ # # # # : 0 : ind_cg_mpi_to_seq(1:npwso) = (/(ipw,ipw=1,npwso)/)
# # ]
827 : : end if
828 : : !write(std_out,*)"MPI-IO ind_cg_mpi_to_seq", ind_cg_mpi_to_seq(1:5)
829 : : end if
830 : : end if
831 : :
832 : : !---------------------------------------------------------------------------
833 : : !Write the first record: npw, nspinor, nband_disk
834 : : !---------------------------------------------------------------------------
835 : : !Not modified for netCDF: no need to add writing of nband_disk,npw,nspinor
836 : :
837 : 416 : call WffWriteNpwRec(ios,nband_disk,npwtot,nspinortot,wff,opt_paral=2)
838 : :
839 : : !---------------------------------------------------------------------------
840 : : !Write the second record: (k+G) vectors
841 : : !---------------------------------------------------------------------------
842 : :
843 [ + - + - ]: 416 : if (optkg/=0.and.option/=4) then
844 [ + + ]: 416 : if(use_f90==1)then
845 : 364 : write(unitwf) kg_k(1:3,1:optkg*npw)
846 [ + - ]: 52 : else if (wff%iomode==IO_MODE_MPI) then
847 : :
848 [ + - ]: 52 : if (allocated(mpi_enreg%my_kgtab)) then
849 : 52 : me_cart_3d=xmpi_comm_rank(mpi_enreg%comm_bandspinorfft)
850 : 52 : ikpt_this_proc=mpi_enreg%my_kpttab(ikpt)
851 : 52 : call xderiveWRecInit(wff,ios,me_cart_3d)
852 [ + + ]: 52 : if (mpi_enreg%me_spinor==0) then
853 : : call xderiveWrite(wff,kg_k,3,npw,mpi_enreg%comm_bandfft, &
854 : 38 : & mpi_enreg%my_kgtab(1:npw,ikpt_this_proc),ios)
855 : : end if
856 : 52 : call xderiveWRecEnd(wff,ios,me_cart_3d)
857 : : else
858 : : ! MG does it work if we are not using FFT distribution ?
859 : 0 : call xderiveWRecInit(wff,ios )
860 [ # # ]: 0 : if (mpi_enreg%me_spinor==0) then
861 : 0 : call xderiveWrite(wff,kg_k,3,optkg*npw,Wff%spaceComm_mpiio,ios)
862 : : end if
863 : 0 : call xderiveWRecEnd(wff,ios)
864 : : end if
865 : :
866 [ # # ]: 0 : else if (wff%iomode == IO_MODE_ETSF) then
867 : : ! Write the reduced_coordinates_of_plane_waves for this k point.
868 [ # # ]: 0 : NCF_CHECK(nf90_inq_varid(wff%unwff, "reduced_coordinates_of_plane_waves", kg_varid))
869 [ # # ]: 0 : NCF_CHECK(nf90_get_att(wff%unwff, kg_varid, "k_dependent", kdep))
870 [ # # ]: 0 : if (kdep == "no") then
871 [ # # ]: 0 : ncerr = nf90_put_var(wff%unwff, kg_varid, kg_k, start=[1,1], count=[3,npw])
872 : : else
873 [ # # # # ]: 0 : ncerr = nf90_put_var(wff%unwff, kg_varid, kg_k, start=[1,1,ikpt], count=[3,npw,1])
874 : : end if
875 [ # # ]: 0 : NCF_CHECK_MSG(ncerr, "putting kg_k")
876 : : end if ! end if wff%iomode
877 : : else ! Still skip the record
878 [ # # ]: 0 : if (use_f90==1) then
879 : 0 : write(unitwf)
880 [ # # ]: 0 : else if (wff%iomode==IO_MODE_MPI) then
881 : 0 : call xderiveWRecInit(wff,wff%spaceComm_mpiio,ios)
882 : 0 : call xderiveWRecEnd(wff,wff%spaceComm_mpiio,ios)
883 : : end if
884 : : end if
885 : :
886 : : !---------------------------------------------------------------------------
887 : : !Write the third record: eigenvalues and occupations
888 : : !---------------------------------------------------------------------------
889 : :
890 : : !===== Case formeig=0: write eigenvalues and occupations =====
891 [ + - ]: 416 : if (formeig==0) then
892 [ + + ]: 416 : if (use_f90==1) then
893 : 364 : write(unitwf) (eigen(iband),iband=1,nband_disk),(occ(iband),iband=1,nband_disk)
894 [ + - ]: 52 : else if(wff%iomode==IO_MODE_MPI) then
895 [ + + ]: 52 : if (wff%me_mpiio==0) then
896 : 15 : call xderiveWRecInit(wff,ios)
897 : 15 : call xderiveWrite(wff,eigen,nband_disk,xmpi_comm_self,ios)
898 : 15 : call xderiveWrite(wff,occ,nband_disk,xmpi_comm_self,ios)
899 : 15 : call xderiveWRecEnd(wff,ios)
900 : : end if
901 : : #ifdef HAVE_MPI
902 : 52 : off(1)=wff%offwff
903 : 52 : call MPI_BCAST(off,1,wff%offset_mpi_type,0,wff%spaceComm_mpiio,ios)
904 : 52 : wff%offwff=off(1)
905 : : #endif
906 [ # # ]: 0 : else if (wff%iomode == IO_MODE_ETSF) then
907 : : ! Write eigenvalues and occupation factors.
908 [ # # ]: 0 : NCF_CHECK(nf90_inq_varid(wff%unwff, "eigenvalues", eig_varid))
909 [ # # # # ]: 0 : ncerr = nf90_put_var(wff%unwff, eig_varid, eigen, start=[1,ikpt,isppol], count=[mband,1,1])
910 [ # # ]: 0 : NCF_CHECK_MSG(ncerr, "putting eig_k")
911 : :
912 [ # # ]: 0 : NCF_CHECK(nf90_inq_varid(wff%unwff, "occupations", occ_varid))
913 [ # # # # ]: 0 : ncerr = nf90_put_var(wff%unwff, occ_varid, occ, start=[1,ikpt,isppol], count=[mband,1,1])
914 [ # # ]: 0 : NCF_CHECK_MSG(ncerr, "putting occ_k")
915 : : end if
916 : :
917 : : ! ===== Case formeig=1: write matrix of eigenvalues =====
918 : : ! Will be written later (together with wave-functions)
919 : : else if(formeig==1)then
920 : : end if ! formeig
921 : :
922 : : !---------------------------------------------------------------------------
923 : : !Write the wave-function coefficients
924 : : !---------------------------------------------------------------------------
925 : :
926 : : !===== Case formeig=0: write only wave-functions =====
927 [ + - ]: 416 : if (formeig==0) then
928 : : ! If option=4, do not write wave functions
929 [ + - ]: 416 : if (option/=4) then
930 [ + + ]: 416 : if (use_f90==1) then
931 [ + + ]: 5484 : do iband=1,nband_disk
932 : 5120 : ipw=(iband-1)*npwso+icg
933 [ + - ]: 5484 : if(option/=5)then
934 : 5120 : write(unitwf) cg(1:2,ipw+1:ipw+npwso) ! VALGRIND complains some elements of cg are not initialized, but written
935 : : else
936 : 0 : write(unitwf)
937 : : end if
938 : : end do
939 [ + - ]: 52 : else if(wff%iomode==IO_MODE_MPI)then
940 : 52 : cg_ptr => cg ! Need pointer to bypass "inout" intent attribute
941 : 52 : call WffReadWrite_mpio(wff,2,cg_ptr,mcg,icg,nband_disk,npwso,npwsotot,ind_cg_mpi_to_seq,ios)
942 : 52 : nullify(cg_ptr)
943 [ # # # # ]: 0 : else if (wff%iomode == IO_MODE_ETSF .and. option/=5) then
944 : :
945 [ # # ]: 0 : NCF_CHECK(nf90_inq_varid(wff%unwff, "reduced_coordinates_of_plane_waves", kg_varid))
946 [ # # ]: 0 : NCF_CHECK(nf90_get_att(wff%unwff, kg_varid, "k_dependent", kdep))
947 : :
948 : : ! The coefficients_of_wavefunctions on file have shape [cplex, mpw, nspinor, mband, nkpt, nsppol]
949 [ # # ]: 0 : NCF_CHECK(nf90_inq_varid(wff%unwff, "coefficients_of_wavefunctions", cg_varid))
950 : : !write(std_out,*)"put cg, count: ",[2,npw,nspinor,nband,1,1]
951 : : ncerr = nf90_put_var(wff%unwff, cg_varid, cg(:, icg+1:), start=[1,1,1,1,ikpt,isppol], &
952 [ # # # # ]: 0 : count=[2,npw,nspinor,nband,1,1])
953 [ # # ]: 0 : NCF_CHECK_MSG(ncerr, "putting cg_k")
954 : : !write(std_out,*)"after cg"
955 : : end if
956 : : end if ! option/=4
957 : :
958 : : ! ===== Case formeig=1: write eigenvalues and wave-functions =====
959 [ # # ]: 0 : else if(formeig==1)then
960 : :
961 : : ! Not available for NETCDF and ETSF_IO
962 [ # # ]: 0 : ABI_CHECK(wff%iomode /= IO_MODE_ETSF, "ETSF-write-eigen1 not coded!")
963 : :
964 : : ! ABI_CHECK(nband_disk==nband,"nband_disk!=nband")
965 : :
966 : 0 : nband2=2*nband_disk
967 [ # # ]: 0 : do iband=1,nband_disk
968 : 0 : ipw=(iband-1)*npwso+icg
969 : 0 : ii=(iband-1)*nband2
970 [ # # ]: 0 : if(use_f90==1)then
971 : 0 : write(unitwf) eigen(1+ii:nband2+ii)
972 [ # # ]: 0 : if (option/=5) then
973 : 0 : write(unitwf) cg(1:2,1+ipw:npwso+ipw)
974 : : else
975 : 0 : write(unitwf)
976 : : end if
977 [ # # ]: 0 : else if(wff%iomode==IO_MODE_MPI)then
978 : : ! Should use an access with a "view"
979 : 0 : call xderiveWRecInit(wff,ios)
980 : 0 : call xderiveWrite(wff,eigen(1+ii:ii+nband2),nband2,wff%spaceComm_mpiio,ios)
981 : 0 : call xderiveWRecEnd(wff,ios)
982 [ # # ]: 0 : if (option/=4) then
983 : 0 : call xderiveWRecInit(wff,ios)
984 : 0 : call xderiveWrite(wff,cg(1:2,ipw+1:ipw+npwso),2,npwso,wff%spaceComm_mpiio,ios)
985 : 0 : call xderiveWRecEnd(wff,ios)
986 : : end if
987 : : end if
988 : : end do
989 : :
990 : : end if ! formeig
991 : :
992 : : !---------------------------------------------------------------------------
993 : : !Final statements
994 : : !---------------------------------------------------------------------------
995 : :
996 [ + + ]: 416 : ABI_SFREE(ind_cg_mpi_to_seq)
997 : :
998 : : RETURN
999 : :
1000 : : !Silence compiler warning.
1001 : : ABI_UNUSED((/ii,mpi_enreg%me/))
1002 : :
1003 : 416 : end subroutine writewf
1004 : : !!***
1005 : :
1006 : : end module m_rwwf
1007 : : !!***
|
