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 64222 : subroutine rwwf(cg,eigen,formeig,headform,icg,ikpt,isppol,kg_k,mband,mcg,mpi_enreg,&
124 64222 : & 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 64222 : 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 64222 : 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 64222 : 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 64638 : 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 64222 : 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 63806 : & 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 64222 : call timab(270+tim_rwwf,2,tsec)
174 :
175 64222 : 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 63806 : subroutine readwf(cg,eigen,formeig,headform,icg,ikpt,isppol,kg_k,mband,mcg,mpi_enreg,&
289 63806 : & 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 63806 : 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 63806 : integer,allocatable :: gall(:,:)
310 63806 : 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 63806 : 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 63806 : npwtot=npw; npwso=npw*nspinor
322 63806 : npwsotot=npwso
323 63806 : nspinortot=min(2,(1+mpi_enreg%paral_spinor)*nspinor)
324 :
325 63806 : unitwf=wff%unwff
326 63806 : ncid_hdr=unitwf
327 :
328 63806 : use_f90=0
329 63806 : if (wff%iomode==IO_MODE_FORTRAN.or.(wff%iomode==IO_MODE_FORTRAN_MASTER.and.wff%master==wff%me)) use_f90=1
330 :
331 63806 : if (option==1.or.option==-2) then
332 :
333 : ! Compute mapping my_gtable --> sequential gtable.
334 63806 : if (any(wff%iomode==[IO_MODE_MPI, IO_MODE_ETSF]).and.nband>0) then
335 63806 : call xmpi_sum(npwsotot,wff%spaceComm_mpiio,ios)
336 63806 : npwtot=npwsotot/nspinortot
337 191418 : ABI_MALLOC(ind_cg_mpi_to_seq,(npwso))
338 127612 : 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 15164552 : 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 63806 : if (headform>=40.or.headform==0) then ! headform==0 refers to the current headform
360 63806 : call WffReadNpwRec(ios,ikpt,isppol,nband_disk,npw1,nspinor1,wff)
361 63806 : npwso1=npw1*nspinor1
362 63806 : 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 63806 : if (option==1.or.option==-2) then ! Will read the wavefunction and/or kg data, so check npw and nspinor
394 :
395 63806 : if (headform>=40.or.headform==0) then ! New format. headform==0 refers to the current headform
396 63806 : 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 63806 : 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 63806 : if (headform>=40.or.headform==0) then ! headform==0 refers to the current headform
424 :
425 63806 : 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 63806 : call WffReadSkipRec(ios,1,wff) ! Skip the record
464 : end if
465 :
466 63806 : 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 63806 : nband1 = min(nband,nband_disk)
484 :
485 : !===== Case formeig=0: read eigenvalues =====
486 63806 : if (formeig==0) then
487 :
488 9597 : if (option==1.or.option==3.or.option==-4) then
489 9597 : if(use_f90==1)then
490 0 : read (unitwf,iostat=ios) eigen(1:nband1)
491 9597 : 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 9597 : 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 9597 : if (wff%iomode == IO_MODE_ETSF) then
511 : ! get eigenvalues and occupations
512 9581 : NCF_CHECK(nf90_inq_varid(wff%unwff, "eigenvalues", eig_varid))
513 67067 : ncerr = nf90_get_var(wff%unwff, eig_varid, eigen, start=[1,ikpt,isppol], count=[nband1,1,1])
514 9581 : NCF_CHECK_MSG(ncerr, "getting eig_k")
515 :
516 9581 : NCF_CHECK(nf90_inq_varid(wff%unwff, "occupations", occ_varid))
517 67067 : ncerr = nf90_get_var(wff%unwff, occ_varid, occ, start=[1,ikpt,isppol], count=[nband1,1,1])
518 9581 : 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 63806 : nband1=min(nband,nband_disk)
532 63806 : if(nband1>0.and.option/=-1)then
533 :
534 : ! ===== Case formeig=0: read only wave-functions =====
535 63806 : if (formeig==0) then
536 :
537 9597 : if (option==1.or.option==-2) then
538 :
539 9597 : 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 9597 : 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 9597 : 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 9597 : if (wff%iomode == IO_MODE_ETSF) then
566 : ! The coefficients_of_wavefunctions on file have shape [cplex, mpw, nspinor, mband, nkpt, nsppol]
567 9581 : NCF_CHECK(nf90_inq_varid(wff%unwff, "coefficients_of_wavefunctions", cg_varid))
568 9581 : if (npw == npw1) then
569 : ncerr = nf90_get_var(wff%unwff, cg_varid, cg(:, icg+1:), start=[1,1,1,1,ikpt,isppol], &
570 117845 : count=[2,npw,nspinor,nband1,1,1])
571 9065 : 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 516 : ii = icg
579 6860 : do iband=1,nband1
580 1525502 : do ipw=1,npw
581 1518642 : ii = ii + 1
582 4562270 : cg(:,ii) = cg_all(:,ind_cg_mpi_to_seq(ipw),iband)
583 : end do
584 : end do
585 516 : ABI_FREE(cg_all)
586 : end if
587 : end if
588 :
589 : ! ===== Case formeig=1: read eigenvalues, occupations and wave-functions =====
590 54209 : else if(formeig==1)then
591 : ! write(std_out,*)"nband1",nband1
592 : ! ABI_CHECK(nband1==nband_disk,"nband != nband_disk")
593 :
594 54209 : if (wff%iomode /= IO_MODE_ETSF) then
595 : indxx=0
596 0 : do iband=1,nband1
597 :
598 0 : if (option==1.or.option==3.or.option==-4) then
599 0 : if(use_f90==1)then
600 0 : read (unitwf,iostat=ios) eigen(1+indxx:2*nband1+indxx)
601 0 : else if(wff%iomode==IO_MODE_MPI)then
602 : ! Should use an access with a "view"
603 0 : call xderiveRRecInit(wff,ios)
604 0 : call xderiveRead(wff,eigen(1+indxx:2*nband1+indxx),2*nband1,xmpi_comm_self,ios)
605 0 : call xderiveRRecEnd(wff,ios)
606 : end if
607 0 : indxx=indxx+2*nband1
608 : else
609 0 : call WffReadSkipRec(ios,1,wff) ! Skip the record
610 : end if
611 :
612 0 : if(ios/=0)then
613 0 : inquire (unit=unitwf, NAME=fname)
614 : write(msg,'(3a,i4,2a,i4,4a)') &
615 0 : & 'Reading option of rwwf. Trying to read',ch10,&
616 0 : & 'a RF eigenvalue record of a wf file, unit=',unitwf,ch10,&
617 0 : & 'gave iostat=',ios,'. Your file is likely not correct.',ch10,&
618 0 : & 'Action: check your input wf file.',trim(fname)
619 0 : ABI_ERROR(msg)
620 : end if
621 :
622 0 : if(option==1.or.option==-2)then
623 0 : ipw=(iband-1)*npwso+icg
624 0 : if(use_f90==1)then
625 0 : ipw=(iband-1)*npwso+icg
626 0 : read(unitwf,iostat=ios) cg(1:2,ipw+1:ipw+npwso)
627 0 : else if(wff%iomode==IO_MODE_MPI)then
628 : ! Should use an access with a "view"
629 0 : call xderiveRRecInit(wff,ios)
630 0 : call xderiveRead(wff,cg(1:2,ipw+1:ipw+npwso),2,npwso,wff%spaceComm_mpiio,ind_cg_mpi_to_seq,ios)
631 0 : call xderiveRRecEnd(wff,ios)
632 : end if
633 0 : else if (option/=-4) then
634 0 : call WffReadSkipRec(ios,1,wff) ! Skip the record
635 : end if ! option
636 :
637 0 : if(ios/=0)then
638 0 : inquire (unit=unitwf, NAME=fname)
639 : write(msg,'(3a,i4,2a,i4,4a)') &
640 0 : & 'Reading option of rwwf. Trying to read',ch10,&
641 0 : & 'a RF wf record of a wf file, unit=',unitwf,ch10,&
642 0 : & 'gave iostat=',ios,'. Your file is likely not correct.',ch10,&
643 0 : & 'Action: check your input wf file.',trim(fname)
644 0 : ABI_ERROR(msg)
645 : end if
646 : end do ! iband
647 :
648 : else
649 : ! ETSF-IO
650 54209 : if (any(option == [1, 3, -4])) then
651 : ! Read eigen. Remember that the matrix on file has shape [2, mband, mband, nkpt, nspin]
652 : ! whereas the eigen array used in Abinit is packed. Read the full matrix first, then pack data.
653 54209 : NCF_CHECK(nf90_inq_dimid(wff%unwff, "max_number_of_states", mband_varid))
654 54209 : NCF_CHECK(nf90_inquire_dimension(wff%unwff, mband_varid, len=mband_file))
655 54209 : h1_varid = nctk_idname(wff%unwff, "h1_matrix_elements")
656 :
657 216836 : ABI_MALLOC(h1mat, (2, mband_file, mband_file))
658 325254 : ncerr = nf90_get_var(wff%unwff, h1_varid, h1mat, start=[1,1,1,ikpt,isppol])
659 54209 : NCF_CHECK_MSG(ncerr, "getting h1_matrix_elements")
660 :
661 : indxx=1
662 333461 : do band2=1,nband1
663 2761725 : do band1=1,nband1
664 7284792 : eigen(indxx:indxx+1) = h1mat(:,band1,band2)
665 2707516 : indxx = indxx + 2
666 : end do
667 : end do
668 54209 : ABI_FREE(h1mat)
669 : end if
670 :
671 54209 : if (any(option == [1, -2])) then
672 : ! Read wavefunctions.
673 : ! The coefficients_of_wavefunctions on file have shape [cplex, mpw, nspinor, mband, nkpt, nsppol]
674 54209 : ABI_CHECK(npw == npw1, "npw != npw1 not coded")
675 :
676 54209 : cg_varid = nctk_idname(wff%unwff, "coefficients_of_wavefunctions")
677 : ncerr = nf90_get_var(wff%unwff, cg_varid, cg(:, icg+1:), start=[1,1,1,1,ikpt,isppol], &
678 704717 : count=[2,npw,nspinor,nband1,1,1])
679 54209 : NCF_CHECK_MSG(ncerr, "getting cg_k")
680 : end if
681 : end if
682 :
683 : end if ! formeig == 1
684 :
685 : end if ! nband >0
686 :
687 : !If fewer than all bands were read wind disk file forward to end of bands for this k point.
688 : !Will have to fill the non-filled bands outside of this routine ...
689 63806 : if (nband<nband_disk .or. option==-1) then
690 72 : nrec=(formeig+1)*(nband_disk-nband)
691 72 : if(option==-1)nrec=(formeig+1)*nband_disk
692 72 : call WffReadSkipRec(ios,nrec,wff)
693 : end if
694 :
695 : !---------------------------------------------------------------------------
696 : ! Free memory
697 : !---------------------------------------------------------------------------
698 63806 : ABI_SFREE(ind_cg_mpi_to_seq)
699 :
700 63806 : end subroutine readwf
701 : !!***
702 :
703 : ! -------------------------------------------------------------------------------------------------
704 :
705 : !!****f* m_rwwf/writewf
706 : !! NAME
707 : !! writewf
708 : !!
709 : !! FUNCTION
710 : !! This subroutine writes the block of records
711 : !! related to one k point, and one spin-polarization, that
712 : !! contains the wavefunctions (as well as the eigenvalues and occupations).
713 : !! The disk file unitwf should have been prepared
714 : !! outside of this routine, in order to write the correct records.
715 : !!
716 : !! INPUTS
717 : !! cg(2,npw*nspinor*mband)=planewave coefficients of wavefunctions,
718 : !! eigen((2*mband)**formeig *mband)=array for holding eigenvalues (hartree)
719 : !! formeig=format of the eigenvalues
720 : !! 0 => vector of eigenvalues
721 : !! 1 => hermitian matrix of eigenvalues
722 : !! icg=shift to be given to the location of the cg array
723 : !! ikpt=index of current k point (only needed for error message)
724 : !! isppol=spin polarization currently treated (only needed for error message)
725 : !! kg_k(3,optkg*npw)=k+g data (only if optkg==1)
726 : !! mband=maximum number of bands (dimension of cg, eigen and occ)
727 : !! mcg=dimension of cg
728 : !! nband=number of bands actually in cg, eigen and occ
729 : !! (must be larger or equal to nband_disk, only nband_disk bands are written)
730 : !! nband_disk=number of bands on the disk file
731 : !! npw=number of plane waves
732 : !! nspinor=number of spinorial components of the wavefunctions (on current proc)
733 : !! occ(mband)=array for holding electronic occupations
734 : !! option= 2 for writing cg, eigen and occ,
735 : !! 4 for writing a file containing only eigenvalues and occupations
736 : !! optkg= if 1 , read or write kg_k ; if 0, do not care about kg_k
737 : !! wff=struct info for wavefunction
738 : !!
739 : !! OUTPUT
740 : !! (none, only writing)
741 : !!
742 : !! SIDE EFFECTS
743 : !!
744 : !! NOTES
745 : !! WARNING : skipping k-blocks is also done in the randac subroutine
746 : !! WARNING : writing the two first records is also done in the dfpt_vtowfk routine
747 : !!
748 : !! SOURCE
749 :
750 416 : subroutine writewf(cg,eigen,formeig,icg,ikpt,isppol,kg_k,mband,mcg,mpi_enreg,&
751 416 : & nband,nband_disk,npw,nspinor,occ,option,optkg,wff)
752 :
753 : !Arguments ------------------------------------
754 : integer,intent(in) :: formeig,icg,ikpt,isppol,mband,mcg,nband,nband_disk,npw,nspinor,option,optkg
755 : integer,intent(in),target :: kg_k(3,optkg*npw)
756 : real(dp),intent(in),target :: cg(2,mcg),eigen((2*mband)**formeig*mband),occ(mband)
757 : type(MPI_type),intent(in) :: mpi_enreg
758 : type(wffile_type),intent(inout) :: wff
759 :
760 : !Local variables-------------------------------
761 : integer :: iband,ii,ios,ipw,ispinor_index,nband2,ncid_hdr,npwso,npwsotot,npwtot,nspinortot
762 : integer :: unitwf,use_f90
763 : character(len=500) :: msg
764 : integer :: ikpt_this_proc,ispinor,me_cart_3d
765 416 : integer,allocatable :: ind_cg_mpi_to_seq(:)
766 416 : real(dp),contiguous, pointer :: cg_ptr(:,:)
767 : integer :: kg_varid,eig_varid,occ_varid,cg_varid,ncerr
768 : character(len=nctk_slen) :: kdep
769 : #ifdef HAVE_MPI
770 : integer(kind=MPI_OFFSET_KIND) :: off(1)
771 : #endif
772 : ! *********************************************************************
773 :
774 : !Check the options
775 416 : if ( ALL(option /= (/2,4,5/)) ) then
776 0 : write(msg,'(a,i0)')' The argument option should be 2, 4 or 5. However, option=',option
777 0 : ABI_BUG(msg)
778 : end if
779 :
780 416 : if(wff%iomode==IO_MODE_MPI)then
781 52 : if(option==5)then
782 0 : write(msg,'(a,i0)')' With MPI-IO activated, the argument option should be 2 or 4. However, option=',option
783 0 : ABI_BUG(msg)
784 : end if
785 : end if
786 :
787 416 : if (wff%iomode==IO_MODE_ETSF) then
788 : ! outkss still calls this routine!
789 0 : ABI_WARNING("You should use outwff or ncwrite_cg to write data in netcdf format!")
790 : end if
791 :
792 : !Check that nband_disk is not larger than nband (only for writing)
793 416 : if (nband<nband_disk) then
794 : write(msg,'(3a,i5,a,i5,a)') &
795 0 : & 'Writing option of rwwf. One should have nband<=nband_disk',ch10,&
796 0 : & 'However, nband= ',nband,', and nband_disk= ',nband_disk,'.'
797 0 : ABI_BUG(msg)
798 : end if
799 :
800 416 : npwtot=npw; npwso=npw*nspinor
801 416 : unitwf=wff%unwff; ncid_hdr=unitwf
802 416 : npwsotot=npwso
803 416 : nspinortot=min(2,(1+mpi_enreg%paral_spinor)*nspinor)
804 :
805 416 : use_f90=0
806 416 : if (wff%iomode==IO_MODE_FORTRAN.or.(wff%iomode ==IO_MODE_FORTRAN_MASTER.and.wff%master==wff%me)) use_f90=1
807 :
808 416 : if (wff%iomode==IO_MODE_MPI) then
809 :
810 52 : call xmpi_sum(npwsotot,wff%spaceComm_mpiio,ios)
811 52 : npwtot=npwsotot/nspinortot
812 :
813 52 : if (option/=4) then
814 156 : ABI_MALLOC(ind_cg_mpi_to_seq,(npwso))
815 52 : if (allocated(mpi_enreg%my_kgtab)) then
816 52 : ikpt_this_proc=mpi_enreg%my_kpttab(ikpt)
817 112 : do ispinor=1,nspinor
818 60 : ispinor_index=ispinor
819 60 : if (mpi_enreg%nproc_spinor > 1) ispinor_index = mpi_enreg%me_spinor + 1
820 : ind_cg_mpi_to_seq(1+npw*(ispinor-1):npw*ispinor)=npwtot*(ispinor_index-1) &
821 14402 : & + mpi_enreg%my_kgtab(1:npw,ikpt_this_proc)
822 : end do
823 : else
824 0 : ind_cg_mpi_to_seq(1:npwso) = (/(ipw,ipw=1,npwso)/)
825 : end if
826 : !write(std_out,*)"MPI-IO ind_cg_mpi_to_seq", ind_cg_mpi_to_seq(1:5)
827 : end if
828 : end if
829 :
830 : !---------------------------------------------------------------------------
831 : !Write the first record: npw, nspinor, nband_disk
832 : !---------------------------------------------------------------------------
833 : !Not modified for netCDF: no need to add writing of nband_disk,npw,nspinor
834 :
835 416 : call WffWriteNpwRec(ios,nband_disk,npwtot,nspinortot,wff,opt_paral=2)
836 :
837 : !---------------------------------------------------------------------------
838 : !Write the second record: (k+G) vectors
839 : !---------------------------------------------------------------------------
840 :
841 416 : if (optkg/=0.and.option/=4) then
842 416 : if(use_f90==1)then
843 364 : write(unitwf) kg_k(1:3,1:optkg*npw)
844 52 : else if (wff%iomode==IO_MODE_MPI) then
845 :
846 52 : if (allocated(mpi_enreg%my_kgtab)) then
847 52 : me_cart_3d=xmpi_comm_rank(mpi_enreg%comm_bandspinorfft)
848 52 : ikpt_this_proc=mpi_enreg%my_kpttab(ikpt)
849 52 : call xderiveWRecInit(wff,ios,me_cart_3d)
850 52 : if (mpi_enreg%me_spinor==0) then
851 : call xderiveWrite(wff,kg_k,3,npw,mpi_enreg%comm_bandfft, &
852 38 : & mpi_enreg%my_kgtab(1:npw,ikpt_this_proc),ios)
853 : end if
854 52 : call xderiveWRecEnd(wff,ios,me_cart_3d)
855 : else
856 : ! MG does it work if we are not using FFT distribution ?
857 0 : call xderiveWRecInit(wff,ios )
858 0 : if (mpi_enreg%me_spinor==0) then
859 0 : call xderiveWrite(wff,kg_k,3,optkg*npw,Wff%spaceComm_mpiio,ios)
860 : end if
861 0 : call xderiveWRecEnd(wff,ios)
862 : end if
863 :
864 0 : else if (wff%iomode == IO_MODE_ETSF) then
865 : ! Write the reduced_coordinates_of_plane_waves for this k point.
866 0 : NCF_CHECK(nf90_inq_varid(wff%unwff, "reduced_coordinates_of_plane_waves", kg_varid))
867 0 : NCF_CHECK(nf90_get_att(wff%unwff, kg_varid, "k_dependent", kdep))
868 0 : if (kdep == "no") then
869 0 : ncerr = nf90_put_var(wff%unwff, kg_varid, kg_k, start=[1,1], count=[3,npw])
870 : else
871 0 : ncerr = nf90_put_var(wff%unwff, kg_varid, kg_k, start=[1,1,ikpt], count=[3,npw,1])
872 : end if
873 0 : NCF_CHECK_MSG(ncerr, "putting kg_k")
874 : end if ! end if wff%iomode
875 : else ! Still skip the record
876 0 : if (use_f90==1) then
877 0 : write(unitwf)
878 0 : else if (wff%iomode==IO_MODE_MPI) then
879 0 : call xderiveWRecInit(wff,wff%spaceComm_mpiio,ios)
880 0 : call xderiveWRecEnd(wff,wff%spaceComm_mpiio,ios)
881 : end if
882 : end if
883 :
884 : !---------------------------------------------------------------------------
885 : !Write the third record: eigenvalues and occupations
886 : !---------------------------------------------------------------------------
887 :
888 : !===== Case formeig=0: write eigenvalues and occupations =====
889 416 : if (formeig==0) then
890 416 : if (use_f90==1) then
891 364 : write(unitwf) (eigen(iband),iband=1,nband_disk),(occ(iband),iband=1,nband_disk)
892 52 : else if(wff%iomode==IO_MODE_MPI) then
893 52 : if (wff%me_mpiio==0) then
894 15 : call xderiveWRecInit(wff,ios)
895 15 : call xderiveWrite(wff,eigen,nband_disk,xmpi_comm_self,ios)
896 15 : call xderiveWrite(wff,occ,nband_disk,xmpi_comm_self,ios)
897 15 : call xderiveWRecEnd(wff,ios)
898 : end if
899 : #ifdef HAVE_MPI
900 52 : off(1)=wff%offwff
901 52 : call MPI_BCAST(off,1,wff%offset_mpi_type,0,wff%spaceComm_mpiio,ios)
902 52 : wff%offwff=off(1)
903 : #endif
904 0 : else if (wff%iomode == IO_MODE_ETSF) then
905 : ! Write eigenvalues and occupation factors.
906 0 : NCF_CHECK(nf90_inq_varid(wff%unwff, "eigenvalues", eig_varid))
907 0 : ncerr = nf90_put_var(wff%unwff, eig_varid, eigen, start=[1,ikpt,isppol], count=[mband,1,1])
908 0 : NCF_CHECK_MSG(ncerr, "putting eig_k")
909 :
910 0 : NCF_CHECK(nf90_inq_varid(wff%unwff, "occupations", occ_varid))
911 0 : ncerr = nf90_put_var(wff%unwff, occ_varid, occ, start=[1,ikpt,isppol], count=[mband,1,1])
912 0 : NCF_CHECK_MSG(ncerr, "putting occ_k")
913 : end if
914 :
915 : ! ===== Case formeig=1: write matrix of eigenvalues =====
916 : ! Will be written later (together with wave-functions)
917 : else if(formeig==1)then
918 : end if ! formeig
919 :
920 : !---------------------------------------------------------------------------
921 : !Write the wave-function coefficients
922 : !---------------------------------------------------------------------------
923 :
924 : !===== Case formeig=0: write only wave-functions =====
925 416 : if (formeig==0) then
926 : ! If option=4, do not write wave functions
927 416 : if (option/=4) then
928 416 : if (use_f90==1) then
929 5484 : do iband=1,nband_disk
930 5120 : ipw=(iband-1)*npwso+icg
931 5484 : if(option/=5)then
932 5120 : write(unitwf) cg(1:2,ipw+1:ipw+npwso) ! VALGRIND complains some elements of cg are not initialized, but written
933 : else
934 0 : write(unitwf)
935 : end if
936 : end do
937 52 : else if(wff%iomode==IO_MODE_MPI)then
938 52 : cg_ptr => cg ! Need pointer to bypass "inout" intent attribute
939 52 : call WffReadWrite_mpio(wff,2,cg_ptr,mcg,icg,nband_disk,npwso,npwsotot,ind_cg_mpi_to_seq,ios)
940 52 : nullify(cg_ptr)
941 0 : else if (wff%iomode == IO_MODE_ETSF .and. option/=5) then
942 :
943 0 : NCF_CHECK(nf90_inq_varid(wff%unwff, "reduced_coordinates_of_plane_waves", kg_varid))
944 0 : NCF_CHECK(nf90_get_att(wff%unwff, kg_varid, "k_dependent", kdep))
945 :
946 : ! The coefficients_of_wavefunctions on file have shape [cplex, mpw, nspinor, mband, nkpt, nsppol]
947 0 : NCF_CHECK(nf90_inq_varid(wff%unwff, "coefficients_of_wavefunctions", cg_varid))
948 : !write(std_out,*)"put cg, count: ",[2,npw,nspinor,nband,1,1]
949 : ncerr = nf90_put_var(wff%unwff, cg_varid, cg(:, icg+1:), start=[1,1,1,1,ikpt,isppol], &
950 0 : count=[2,npw,nspinor,nband,1,1])
951 0 : NCF_CHECK_MSG(ncerr, "putting cg_k")
952 : !write(std_out,*)"after cg"
953 : end if
954 : end if ! option/=4
955 :
956 : ! ===== Case formeig=1: write eigenvalues and wave-functions =====
957 0 : else if(formeig==1)then
958 :
959 : ! Not available for NETCDF and ETSF_IO
960 0 : ABI_CHECK(wff%iomode /= IO_MODE_ETSF, "ETSF-write-eigen1 not coded!")
961 :
962 : ! ABI_CHECK(nband_disk==nband,"nband_disk!=nband")
963 :
964 0 : nband2=2*nband_disk
965 0 : do iband=1,nband_disk
966 0 : ipw=(iband-1)*npwso+icg
967 0 : ii=(iband-1)*nband2
968 0 : if(use_f90==1)then
969 0 : write(unitwf) eigen(1+ii:nband2+ii)
970 0 : if (option/=5) then
971 0 : write(unitwf) cg(1:2,1+ipw:npwso+ipw)
972 : else
973 0 : write(unitwf)
974 : end if
975 0 : else if(wff%iomode==IO_MODE_MPI)then
976 : ! Should use an access with a "view"
977 0 : call xderiveWRecInit(wff,ios)
978 0 : call xderiveWrite(wff,eigen(1+ii:ii+nband2),nband2,wff%spaceComm_mpiio,ios)
979 0 : call xderiveWRecEnd(wff,ios)
980 0 : if (option/=4) then
981 0 : call xderiveWRecInit(wff,ios)
982 0 : call xderiveWrite(wff,cg(1:2,ipw+1:ipw+npwso),2,npwso,wff%spaceComm_mpiio,ios)
983 0 : call xderiveWRecEnd(wff,ios)
984 : end if
985 : end if
986 : end do
987 :
988 : end if ! formeig
989 :
990 : !---------------------------------------------------------------------------
991 : !Final statements
992 : !---------------------------------------------------------------------------
993 :
994 416 : ABI_SFREE(ind_cg_mpi_to_seq)
995 :
996 : RETURN
997 :
998 : !Silence compiler warning.
999 : ABI_UNUSED((/ii,mpi_enreg%me/))
1000 :
1001 416 : end subroutine writewf
1002 : !!***
1003 :
1004 : end module m_rwwf
1005 : !!***
|
