Branch data Line data Source code
1 : : !!****m* ABINIT/m_wfk
2 : : !! NAME
3 : : !! m_wfk
4 : : !!
5 : : !! FUNCTION
6 : : !! This module defines the wfk_t object providing a high-level API
7 : : !! to perform common IO operations on the WFK file produced by ABINIT.
8 : : !! The API wraps thee different formats/io-libraries:
9 : : !!
10 : : !! 1) binary Fortran files with sequential Fortran IO (read, write)
11 : : !! 2) binary Fortran files with MPI-IO primitives (C-steam + Fortran records)
12 : : !! 3) Netcdf files with parallel IO a.k.a HDF5
13 : : !!
14 : : !! and emulate random access when binary Fortran files are used in *read-only* mode.
15 : : !! See notes below for more info.
16 : : !!
17 : : !! COPYRIGHT
18 : : !! Copyright (C) 2009-2026 ABINIT group (MG)
19 : : !! This file is distributed under the terms of the
20 : : !! GNU General Public License, see ~abinit/COPYING
21 : : !! or http://www.gnu.org/copyleft/gpl.txt .
22 : : !! For the initials of contributors, see ~abinit/doc/developers/contributors.txt.
23 : : !!
24 : : !! NOTES
25 : : !! 1) The wfk_t object supports random access also when plain Fortran-IO is used.
26 : : !! One can easily *read* the block of wavefunctions with a given (kpt,spin)
27 : : !! by simply passing the appropriate indices (ik_ibz,spin) to the wfk_read_ routines.
28 : : !! Note however that the same feature is not available in write mode when Fortran IO
29 : : !! is used. In this case indeed one should access the block of wavefunctions
30 : : !! according to their (kpt,spin) indices in order to write the correct record markers
31 : : !! MPI-IO and NETCDF do not have such limitation.
32 : : !!
33 : : !! 2) MPI-IO read operations are done with file views even for contiguous data of the same type.
34 : : !! I found, indeed, that mixing views with explicit offset calls causes
35 : : !! wrong results unless the file is closed and re-open! Very strange since, according to
36 : : !! the documentation, the two APIs do not interfere and can be mixed. Calls to MPI_FILE_SEEK
37 : : !! to reset the pointer to the start of the file do not solve the problem. Don't know if it's
38 : : !! a feature or a bug (the problem showed up with MPICH2, I haven't tested other MPI libraries)
39 : : !!
40 : : !! SOURCE
41 : :
42 : : #if defined HAVE_CONFIG_H
43 : : #include "config.h"
44 : : #endif
45 : :
46 : : #include "abi_common.h"
47 : :
48 : : #define DEBUG_MODE
49 : :
50 : : module m_wfk
51 : :
52 : : use defs_basis
53 : : use m_abicore
54 : : use m_errors
55 : : use m_dtset
56 : : USE_MPI
57 : : use m_xmpi
58 : : use m_mpiotk
59 : : use m_hdr
60 : : use m_sort
61 : : use m_crystal
62 : : use m_pawtab
63 : : use m_ebands
64 : : use m_pawrhoij
65 : : use m_wffile
66 : : use m_nctk
67 : : use netcdf
68 : : use m_clib
69 : : use m_symkpt
70 : :
71 : : use defs_abitypes, only : MPI_type
72 : : use defs_datatypes, only : pseudopotential_type
73 : : use defs_wvltypes, only : wvl_internal_type
74 : : use m_build_info, only : abinit_version
75 : : use m_geometry, only : metric
76 : : use m_time, only : cwtime, cwtime_report, asctime
77 : : use m_fstrings, only : sjoin, strcat, endswith, itoa, ktoa, ftoa
78 : : use m_io_tools, only : get_unit, mvrecord, iomode_from_fname, iomode2str, open_file, close_unit, delete_file, file_exists
79 : : use m_numeric_tools,only : mask2blocks, stats_t, stats_eval, wrap2_pmhalf
80 : : use m_cgtk, only : cgtk_rotate, cgtk_rotate_symrec
81 : : use m_fftcore, only : get_kg, ngfft_seq
82 : : use m_mpinfo, only : destroy_mpi_enreg, initmpi_seq
83 : : use m_rwwf, only : rwwf
84 : : use m_kpts, only : listkk, kpts_timrev_from_kptopt
85 : :
86 : : implicit none
87 : :
88 : : private
89 : :
90 : : #ifdef HAVE_MPI1
91 : : include 'mpif.h'
92 : : #endif
93 : :
94 : : integer,private,parameter :: WFK_NOMODE = 0
95 : : integer,private,parameter :: WFK_READMODE = 1
96 : : integer,private,parameter :: WFK_WRITEMODE = 2
97 : : !!***
98 : :
99 : : !----------------------------------------------------------------------
100 : :
101 : : !!****t* m_wfk/wfk_t
102 : : !! NAME
103 : : !! wfk_t
104 : : !!
105 : : !! FUNCTION
106 : : !! File handler for the WFK file.
107 : : !!
108 : : !! SOURCE
109 : :
110 : : type,public :: wfk_t
111 : :
112 : : integer :: fh
113 : : ! unit number if IO_MODE_FORTRAN
114 : : ! MPI file handler if IO_MODE_MPI
115 : : ! Netcdf file handler if IO_MODE_ETSF
116 : :
117 : : integer :: iomode
118 : : ! Method used to access the WFK file:
119 : : ! IO_MODE_FORTRAN for usual Fortran IO routines
120 : : ! IO_MODE_MPI if MPI/IO routines.
121 : : ! IO_MODE_ETSF, NetCDF format read/written via etsf-io.
122 : :
123 : : integer :: mband
124 : : ! Max number of bands stored on file (MAX(Hdr%nband))
125 : :
126 : : integer :: nkpt
127 : : ! Number of k-points.
128 : :
129 : : integer :: nsppol
130 : : ! Number of spins
131 : :
132 : : integer :: nspinor
133 : : ! Number of spinor components.
134 : :
135 : : integer :: formeig
136 : : ! format of the eigenvalues
137 : : ! 0 => vector of eigenvalues (GS case)
138 : : ! 1 => Hermitian matrix of eigenvalues (DFPT case)
139 : : ! TODO: this should be reported somewhere in the WFK file, at present is passed to wfk_open
140 : :
141 : : integer :: fform
142 : : ! File type format of the header
143 : :
144 : : integer :: rw_mode = WFK_NOMODE
145 : : ! (Read|Write) mode
146 : :
147 : : character(len=fnlen) :: fname = ABI_NOFILE
148 : : ! File name
149 : :
150 : : integer :: master
151 : : ! master node of the IO procedure
152 : :
153 : : integer :: my_rank
154 : : ! index of my processor in the MPI communicator comm
155 : :
156 : : integer :: nproc
157 : : ! number of processors in comm
158 : :
159 : : integer :: comm
160 : : ! MPI communicator
161 : :
162 : : integer :: recn_eof
163 : : ! EOF record number (used for Fortran IO)
164 : :
165 : : integer(XMPI_OFFSET_KIND) :: offset_eof
166 : : ! EOF offset (used for MPI-IO access)
167 : :
168 : : logical :: debug = .FALSE.
169 : : !logical :: debug=.TRUE.
170 : :
171 : : type(hdr_type) :: Hdr
172 : : ! Abinit header.
173 : :
174 : : integer,allocatable :: nband(:,:)
175 : : ! nband(nkpt,nsppol) = Number of bands at each (k,s)
176 : :
177 : : integer :: f90_fptr(3) = [0,0,0]
178 : : ! The position of the file pointer used for sequential access with Fortran-IO.
179 : : ! f90_fprt(1) = Index of the k-point associated to the block.
180 : : ! f90_fprt(2) = the spin associated to the block.
181 : : ! f90_fprt(3) = Record Type (see REC_* variables).
182 : : ! [0,0,0] corresponds to the beginning of the file.
183 : : ! FPTR_EOF signals the end of file
184 : :
185 : : integer,allocatable :: recn_ks(:,:,:)
186 : : ! recn_ks(k,s,1) : record number of (npw, nspinor, nband_disk)
187 : : ! recn_ks(k,s,2) : record number of the (k+G) vectors.
188 : : ! recn_ks(k,s,3) : record number of the eigenvalues.
189 : : ! recn_ks(k,s,4) : record number of the first wavefunction in the wf coefficients block.
190 : :
191 : : integer(XMPI_OFFSET_KIND),allocatable :: offset_ks(:,:,:)
192 : : ! offset_ks(k,s,1) : offset of the record: npw, nspinor, nband_disk.
193 : : ! offset_ks(k,s,2) : offset of the Second record: (k+G) vectors.
194 : : ! offset_ks(k,s,3) : offset of the third record eigenvalues.
195 : : ! offset_ks(k,s,4) : offset of the fourth record (wavefunction coefficients).
196 : : !
197 : : ! **********************************************************************
198 : : ! NB: The offset point to the Fortran record marker and not to the data
199 : : ! **********************************************************************
200 : :
201 : : integer(XMPI_OFFSET_KIND) :: hdr_offset
202 : : ! offset of the header
203 : : ! TODO this should be the output of a hdr method!
204 : :
205 : : integer(XMPI_OFFSET_KIND) :: chunk_bsize
206 : : ! IO is performed in chunks of max size chunk_bsize [bytes]
207 : :
208 : : contains
209 : :
210 : : procedure :: open_write => wfk_open_write
211 : : ! Open the WFK file in write mode.
212 : :
213 : : procedure :: open_read => wfk_open_read
214 : : ! Open the WFK file in read mode.
215 : :
216 : : procedure :: close => wfk_close
217 : : ! Close the WFK file and release the memory allocated in wfk_t.
218 : :
219 : : procedure :: print => wfk_print
220 : : ! Print info on the wfk_t object
221 : :
222 : : procedure :: findk => wfk_findk
223 : : ! Returns the index of the k-point in the WFK file.
224 : :
225 : : procedure :: compare => wfk_compare
226 : : ! Test two wfk_t objects for consistency.
227 : :
228 : : procedure :: read_band_block => wfk_read_band_block
229 : : ! Read a contiguous block of bands for a given (kpoint, spin)
230 : :
231 : : procedure :: read_bks => wfk_read_bks
232 : : ! Read the wavefunction and the eigenvalues for a given (band, k-point, spin)
233 : :
234 : : procedure :: write_band_block => wfk_write_band_block
235 : : ! Write a contiguous block of bands for a given (kpoint, spin)
236 : :
237 : : procedure :: read_bmask => wfk_read_bmask
238 : : ! Read a scattered set of bands for a given (kpoint, spin).
239 : :
240 : : procedure :: read_eigk => wfk_read_eigk
241 : : ! Read the eigenvalues at a given (kpoint,spin).
242 : :
243 : : procedure :: write_h1mat => wfk_write_h1mat
244 : : ! Write all the H1 matrix elements.
245 : : end type wfk_t
246 : :
247 : : public :: wfk_to_bz ! Generate a new WFK file with wavefunctions in the full BZ and istwfk==1
248 : : ! Mainly used to interface ABINIT with other codes that
249 : : ! cannot handle symmetries e.g. lobster
250 : : public :: wfk_nc2fort ! Convert a netcdf WFK file to a Fortran WFK file.
251 : : public :: wfk_ncdef_dims_vars ! Define basic dimensions for netcdf file format.
252 : : public :: wfk_read_ebands ! Read the GS eigenvalues and return ebands_t object.
253 : : public :: wfk_read_eigenvalues ! Read all the GS eigenvalues stored in the WFK file.
254 : : public :: wfk_read_h1mat ! Read all the H1 matrix elements.
255 : : public :: wfk_read_my_kptbands ! Read in all of my bands and k, depending on a distribution flag array
256 : : public :: wfk_write_my_kptbands ! Write all of my bands and k to a file, depending on a distribution flag array
257 : : public :: wfk_klist2mesh ! Generate a full WFK file with k in the IBZ from a file with a subset of k-points
258 : : ! Mainly used in the transport part when the kerange trick is employed.
259 : :
260 : : ! Profiling tools
261 : : public :: wfk_prof ! Profiling tool.
262 : :
263 : : ! Unit tests
264 : : public :: wfk_diff ! Compare two WFK file for binary equality.
265 : : public :: wfk_create_wfkfile ! Create a FAKE WFK file.
266 : : public :: wfk_check_wfkfile ! Read a FAKE WFK file and perform basic tests.
267 : : public :: wfk_check_symtab
268 : :
269 : : !!***
270 : :
271 : : ! Indices associated to the start of the different records of the WFK file.
272 : : integer,private,parameter :: REC_HDR=0
273 : : integer,private,parameter :: REC_NPW=1
274 : : integer,private,parameter :: REC_KG =2
275 : : integer,private,parameter :: REC_EIG=3
276 : : integer,private,parameter :: REC_CG =4
277 : : integer,private,parameter :: REC_NUM=REC_CG
278 : :
279 : : integer,private,parameter :: FPTR_EOF(3) = [-1,-1,-1]
280 : :
281 : : integer(XMPI_OFFSET_KIND),private,parameter :: WFK_CHUNK_BSIZE = 1000 * (1024.0_dp**2)
282 : : ! Maximum size (in bytes) of the block of wavefunctions that are (read|written)
283 : : ! in a single MPI-IO call. (Some MPI-IO implementation crashes if we try to
284 : : ! (read|write) a big chunk of data with a single call.
285 : :
286 : : !----------------------------------------------------------------------
287 : :
288 : : !!****t* m_wfk/kvars_t
289 : : !! NAME
290 : : !!
291 : : !! FUNCTION
292 : : !!
293 : : !! SOURCE
294 : :
295 : : type,public :: kvars_t
296 : : integer,allocatable :: kg_k(:,:)
297 : : real(dp),pointer :: occ_k(:) => null()
298 : : real(dp),pointer :: eig_k(:) => null()
299 : : end type kvars_t
300 : :
301 : : CONTAINS
302 : : !!***
303 : :
304 : : !----------------------------------------------------------------------
305 : :
306 : : !!****f* m_wfk/wfk_open_read
307 : : !! NAME
308 : : !! wfk_open_read
309 : : !!
310 : : !! FUNCTION
311 : : !! Open the WFK file in read mode.
312 : : !!
313 : : !! INPUTS
314 : : !! fname = Name of the file
315 : : !! formeig = 0 for GS wavefunctions, 1 for RF wavefunctions.
316 : : !! iomode = access mode
317 : : !! funt = Fortran unit numer. Only used if iomode == IO_MODE_FORTRAN
318 : : !! comm = MPI communicator (used for collective parallel IO)
319 : : !!
320 : : !! OUTPUT
321 : : !! Wfk<class(wfk_t)> = WFK handler initialized and set in read mode
322 : : !! [Hdr_out]=Copy of the abinit header
323 : : !!
324 : : !! NOTES TODO
325 : : !! it would be better if formeig and iomode could be determined from the file itself!
326 : : !! e.g iomode from the file extension, and formeig from whether it is WFK or 1WF
327 : : !!
328 : : !! SOURCE
329 : :
330 : 9096 : subroutine wfk_open_read(Wfk, fname, formeig, iomode, funt, comm, Hdr_out)
331 : :
332 : : !Arguments ------------------------------------
333 : : !scalars
334 : : class(wfk_t),intent(inout) :: Wfk
335 : : integer,intent(in) :: iomode,comm,formeig,funt
336 : : character(len=*),intent(in) :: fname
337 : : type(hdr_type),optional,intent(inout) :: Hdr_out ! should be intent(out), but psc miscompiles the call!
338 : :
339 : : !Local variables-------------------------------
340 : : !scalars
341 : : integer :: ierr,mpierr
342 : : character(len=500) :: msg
343 : : #ifdef HAVE_MPI_IO
344 : : integer :: fform, nfrec !,ncerr
345 : : integer(XMPI_OFFSET_KIND) :: offset
346 : 9096 : integer(XMPI_OFFSET_KIND),allocatable :: bsize_frecords(:)
347 : : #endif
348 : : !************************************************************************
349 : :
350 : : DBG_ENTER("COLL")
351 : :
352 : 9096 : Wfk%comm = comm
353 : 9096 : Wfk%master = 0
354 : 18192 : Wfk%my_rank = xmpi_comm_rank(comm)
355 : 9096 : Wfk%nproc = xmpi_comm_size(comm)
356 : :
357 : : !Initialize the mandatory data of the Wfk datastructure
358 : : !@wfk_t
359 : 9096 : Wfk%rw_mode = WFK_READMODE
360 : 9096 : Wfk%chunk_bsize = WFK_CHUNK_BSIZE
361 [ - + ]: 9096 : Wfk%fname = fname
362 : :
363 : : ! Master checks the existence of data file
364 [ + + ]: 9096 : if (wfk%my_rank == wfk%master) then
365 [ - + ]: 9064 : if (.not. file_exists(fname)) then
366 : : ! Trick needed to run Abinit test suite in netcdf mode.
367 [ # # ]: 0 : if (file_exists(nctk_ncify(fname))) then
368 : 0 : write(std_out,"(3a)")"- File: ",trim(fname)," does not exist but found netcdf file with similar name."
369 : 0 : Wfk%fname = nctk_ncify(fname)
370 : : end if
371 [ # # ]: 0 : if (.not. file_exists(Wfk%fname)) then
372 [ # # ]: 0 : ABI_ERROR('Missing data file: '//TRIM(Wfk%fname))
373 : : end if
374 : : end if
375 : : end if
376 : 9096 : call xmpi_bcast(wfk%fname, wfk%master, comm, ierr)
377 : :
378 : : !TODO: owfk%get_mem_mb()
379 : :
380 : 9096 : Wfk%formeig = formeig
381 : 9096 : Wfk%iomode = iomode
382 [ + - ]: 9096 : if (endswith(fname, ".nc")) wfk%iomode = IO_MODE_ETSF
383 : : ! This to test the different versions.
384 : : !wfk%iomode = IO_MODE_MPI
385 : : !if (.not. endswith(fname, ".nc") .and. xmpi_comm_size == 1) wfk%iomode == IO_MODE_FORTRAN
386 : :
387 : : ! Reads fform and the Header.
388 : 9096 : call wfk%Hdr%from_fname(fname, wfk%fform,comm)
389 [ - + ]: 9096 : ABI_CHECK(Wfk%fform /= 0, "fform == 0")
390 : :
391 [ - + ]: 9096 : if (Wfk%debug) call Wfk%Hdr%echo(Wfk%fform, 4, unit=std_out)
392 : :
393 : : ! Copy the header if required.
394 [ + + ]: 9096 : if (present(Hdr_out)) call Wfk%Hdr%copy(Hdr_out)
395 : :
396 : : ! Useful dimensions
397 [ + + ]: 432869 : Wfk%mband = MAXVAL(Wfk%Hdr%nband)
398 : 9096 : Wfk%nkpt = Wfk%Hdr%nkpt
399 : 9096 : Wfk%nsppol = Wfk%Hdr%nsppol
400 : 9096 : Wfk%nspinor = Wfk%Hdr%nspinor
401 : :
402 [ - + + - : 36384 : ABI_MALLOC(Wfk%nband, (Wfk%nkpt,Wfk%nsppol))
- + + - +
- + - - +
- + - + ]
403 [ + + + - : 470564 : Wfk%nband = RESHAPE(Wfk%Hdr%nband, (/Wfk%nkpt,Wfk%nsppol/))
+ - - + -
- + + +
+ ]
404 : :
405 : 9096 : ierr=0
406 : 9096 : select case (wfk%iomode)
407 : : case (IO_MODE_FORTRAN)
408 : : ! All processors see a local Fortran binary file.
409 : : ! Each node opens the file, skip the header and set f90_fptr.
410 : 0 : Wfk%fh = funt
411 [ # # ]: 0 : if (open_file(Wfk%fname,msg,unit=Wfk%fh,form="unformatted", status="old", action="read") /= 0) then
412 : 0 : ABI_ERROR(msg)
413 : : end if
414 : :
415 : : ! Precompute number of records for Fortran IO.
416 : 0 : call wfk_compute_offsets(Wfk)
417 : :
418 : 0 : call hdr_skip(Wfk%fh,ierr)
419 [ # # ]: 0 : ABI_CHECK(ierr==0, "hdr_skip returned ierr! /= 0")
420 [ # # ]: 0 : Wfk%f90_fptr = [1,1,REC_NPW]
421 : :
422 : : #ifdef HAVE_MPI_IO
423 : : case (IO_MODE_MPI)
424 : 0 : call MPI_FILE_OPEN(Wfk%comm, Wfk%fname, MPI_MODE_RDONLY, xmpio_info, Wfk%fh, mpierr)
425 : 0 : ABI_CHECK_MPI(mpierr, "MPI_FILE_OPEN")
426 : : !call MPI_FILE_SET_VIEW(Wfk%fh,origin,MPI_BYTE,MPI_BYTE,'native',xmpio_info,mpierr)
427 : :
428 : 0 : call hdr_mpio_skip(Wfk%fh,fform,Wfk%hdr_offset)
429 : : ! Precompute offsets for MPI-IO access
430 [ # # ]: 0 : if (Wfk%hdr_offset > 0) then
431 : 0 : call wfk_compute_offsets(Wfk)
432 : : else
433 : 0 : ABI_ERROR("hdr_offset <=0")
434 : : end if
435 [ # # ]: 0 : if (Wfk%debug) then
436 : : !print *, 'checking offsets upon open_read : ', trim(Wfk%fname)
437 : 0 : offset = Wfk%hdr_offset
438 [ # # ]: 0 : call hdr_bsize_frecords(Wfk%Hdr,Wfk%formeig,nfrec,bsize_frecords)
439 : 0 : call xmpio_check_frmarkers(Wfk%fh,offset,xmpio_collective,nfrec,bsize_frecords,ierr)
440 : : end if
441 : : #endif
442 : :
443 : : case (IO_MODE_ETSF)
444 [ - + ]: 9096 : NCF_CHECK(nctk_open_read(wfk%fh, wfk%fname, wfk%comm))
445 : :
446 : : case default
447 [ - - + - ]: 9096 : ABI_ERROR(sjoin('Wrong or unsupported iomode:', itoa(wfk%iomode)))
448 : : end select
449 : :
450 : : DBG_EXIT("COLL")
451 : :
452 [ - + ]: 27288 : end subroutine wfk_open_read
453 : : !!***
454 : :
455 : : !----------------------------------------------------------------------
456 : :
457 : : !!****f* m_wfk/wfk_open_write
458 : : !! NAME
459 : : !! wfk_open_write
460 : : !!
461 : : !! FUNCTION
462 : : !! Open the WFK file in write mode.
463 : : !!
464 : : !! INPUTS
465 : : !! fname = Name of the file
466 : : !! formeig = 0 for GS wavefunctions, 1 for RF wavefunctions.
467 : : !! iomode = access mode
468 : : !! funt = Fortran unit numer for Only used if iomode == IO_MODE_FORTRAN
469 : : !! comm = MPI communicator (used for MPI-IO)
470 : : !! [write_hdr]=True if the header should be written (default)
471 : : !! [write_frm]=True if the fortran record markers should be written (default). Only if Fortran binary file.
472 : : !!
473 : : !! OUTPUT
474 : : !! Wfk<class(wfk_t)> = WFK handler initialized and set in write mode
475 : : !!
476 : : !! SOURCE
477 : :
478 : 1898 : subroutine wfk_open_write(Wfk, Hdr, fname, formeig, iomode, funt, comm, &
479 : : write_hdr, write_frm) ! optional
480 : :
481 : : !Arguments ------------------------------------
482 : : !scalars
483 : : class(wfk_t),intent(out) :: Wfk
484 : : type(hdr_type),intent(in) :: Hdr
485 : : character(len=*),intent(in) :: fname
486 : : integer,intent(in) :: iomode,comm,formeig,funt
487 : : logical,optional,intent(in) :: write_hdr,write_frm
488 : :
489 : : !Local variables-------------------------------
490 : : !scalars
491 : : integer :: mpierr,ierr, hdroffset(1)
492 : : real(dp) :: cpu,wall,gflops
493 : : logical :: do_write_frm,do_write_hdr
494 : : character(len=500) :: msg
495 : : #ifdef HAVE_MPI_IO
496 : : integer :: fform,nfrec,sc_mode
497 : : integer(XMPI_OFFSET_KIND) :: offset
498 : 1898 : integer(XMPI_OFFSET_KIND),allocatable :: bsize_frecords(:)
499 : : #endif
500 : : integer :: ncerr
501 : : !************************************************************************
502 : :
503 : : DBG_ENTER("COLL")
504 : :
505 [ + + ]: 1898 : do_write_hdr = .TRUE.; if (present(write_hdr)) do_write_hdr = write_hdr
506 [ + + ]: 1898 : do_write_frm = .TRUE.; if (present(write_frm)) do_write_frm = write_frm
507 : :
508 : : !Initialize mandatory data of the Wfk datastructure
509 : 1898 : Wfk%rw_mode = WFK_WRITEMODE
510 : 1898 : Wfk%chunk_bsize = WFK_CHUNK_BSIZE
511 : :
512 [ - + ]: 1898 : Wfk%fname = fname
513 : 1898 : Wfk%formeig = formeig
514 [ + + ]: 1898 : Wfk%iomode = iomode; if (endswith(fname, ".nc")) wfk%iomode = IO_MODE_ETSF
515 : : ! This to test the different versions.
516 : : !wfk%iomode = IO_MODE_MPI; if (.not. endswith(fname, ".nc") .and. xmpi_comm_size == 1) wfk%iomode == IO_MODE_FORTRAN
517 : :
518 : 1898 : Wfk%comm = comm
519 : 1898 : Wfk%master = 0
520 : 1898 : Wfk%my_rank = xmpi_comm_rank(comm)
521 : 1898 : Wfk%nproc = xmpi_comm_size(comm)
522 : 1898 : Wfk%fform = 2
523 : :
524 : : ! Copy the header
525 : 1898 : call Hdr%copy(Wfk%Hdr)
526 : :
527 : : ! Master writes fform and the Header (write it afterwards if IO_MODE_ETSF)
528 [ + + + - : 1898 : if (Wfk%my_rank==Wfk%master .and. do_write_hdr .and. iomode /= IO_MODE_ETSF) then
+ + ]
529 : 5 : call Wfk%Hdr%write_to_fname(Wfk%fname, Wfk%fform)
530 [ - + ]: 5 : if (Wfk%debug) call Wfk%Hdr%echo(Wfk%fform, 4, unit=std_out)
531 : : end if
532 : 1898 : call xmpi_barrier(Wfk%comm)
533 : :
534 : : ! Useful dimensions
535 [ + + ]: 118651 : Wfk%mband = MAXVAL(Wfk%Hdr%nband)
536 : 1898 : Wfk%nkpt = Wfk%Hdr%nkpt
537 : 1898 : Wfk%nsppol = Wfk%Hdr%nsppol
538 : 1898 : Wfk%nspinor = Wfk%Hdr%nspinor
539 : :
540 [ - + + - : 7592 : ABI_MALLOC(Wfk%nband, (Wfk%nkpt,Wfk%nsppol))
- + + - +
- + - - +
- + - + ]
541 [ + + + - : 126405 : Wfk%nband = RESHAPE(Wfk%Hdr%nband, [Wfk%nkpt, Wfk%nsppol])
+ - - + -
- + + +
+ ]
542 : :
543 : 1898 : ierr = 0
544 : :
545 : 1898 : select case (wfk%iomode)
546 : : case (IO_MODE_FORTRAN)
547 [ # # ]: 0 : ABI_CHECK(wfk%nproc == 1, "Cannot use Fortran-IO to write WFK file with nprocs > 1")
548 : 0 : Wfk%fh = funt
549 [ # # ]: 0 : if (open_file(Wfk%fname,msg,unit=Wfk%fh,form="unformatted", status="unknown", action="readwrite") /= 0) then
550 : 0 : ABI_ERROR(msg)
551 : : end if
552 : :
553 : : ! Precompute number of records for Fortran IO.
554 : 0 : call wfk_compute_offsets(Wfk)
555 : :
556 : 0 : call hdr_skip(Wfk%fh,ierr)
557 [ # # ]: 0 : Wfk%f90_fptr = [1, 1, REC_NPW]
558 : :
559 : : #ifdef HAVE_MPI_IO
560 : : case (IO_MODE_MPI)
561 : 5 : call cwtime(cpu, wall, gflops, "start")
562 : :
563 : : ! FIXME: mode flags should be rationalized
564 : : !call MPI_FILE_OPEN(Wfk%comm, Wfk%fname, MPI_MODE_CREATE + MPI_MODE_WRONLY, xmpio_info, Wfk%fh, mpierr)
565 : : !call MPI_FILE_OPEN(Wfk%comm, Wfk%fname, MPI_MODE_CREATE + MPI_MODE_RDWR, xmpio_info, Wfk%fh, mpierr)
566 : 5 : call MPI_FILE_OPEN(Wfk%comm, Wfk%fname, MPI_MODE_RDWR, xmpio_info, Wfk%fh, mpierr)
567 : 5 : ABI_CHECK_MPI(mpierr, "MPI_FILE_OPEN")
568 : :
569 : : !call MPI_FILE_SET_VIEW(Wfk%fh,origin,MPI_BYTE,MPI_BYTE,'native',xmpio_info,mpierr)
570 : : ! TODO
571 : : !%% call MPI_File_set_size(Wfk%fh, MPI_Offset size, mpierr)
572 : : !ABI_CHECK_MPI(mpierr, "MPI_FILE_SET_SIZE")
573 : :
574 [ + + ]: 10 : hdroffset = -1
575 [ + - ]: 5 : if (Wfk%my_rank==Wfk%master) then
576 : 5 : call hdr_mpio_skip(Wfk%fh,fform,Wfk%hdr_offset)
577 [ - + ]: 5 : ABI_CHECK(fform == Wfk%fform,"fform != Wfk%fform")
578 : : !call wfk%Hdr%echo(wfk%fform, 4, unit=std_out)
579 [ + + ]: 10 : hdroffset = Wfk%hdr_offset
580 : : end if
581 : 5 : call xmpi_bcast(hdroffset, Wfk%master, Wfk%comm, ierr)
582 : 5 : Wfk%hdr_offset = hdroffset(1)
583 : :
584 : : ! Precompute offsets for MPI-IO access
585 [ + - ]: 5 : if (Wfk%hdr_offset > 0) then
586 : 5 : call wfk_compute_offsets(Wfk)
587 : : else
588 : 0 : ABI_ERROR("hdr_offset <=0")
589 : : end if
590 : 5 : call cwtime_report(" FILE_OPEN", cpu, wall, gflops)
591 : :
592 : : ! Write Fortran record markers.
593 [ + - ]: 5 : if (do_write_frm) then
594 : 5 : call cwtime(cpu, wall, gflops, "start")
595 [ - + ]: 5 : call hdr_bsize_frecords(Wfk%Hdr,Wfk%formeig,nfrec,bsize_frecords)
596 : :
597 : 5 : sc_mode = xmpio_collective
598 : 5 : offset = Wfk%hdr_offset
599 : :
600 : 5 : if (sc_mode == xmpio_collective) then
601 : 5 : call xmpio_write_frmarkers(Wfk%fh,offset,sc_mode,nfrec,bsize_frecords,ierr)
602 : : else
603 : : ierr = 0
604 : : if (Wfk%my_rank == Wfk%master) then
605 : : call xmpio_write_frmarkers(Wfk%fh,offset,xmpio_single,nfrec,bsize_frecords,ierr)
606 : : end if
607 : : end if
608 [ - + ]: 5 : ABI_CHECK(ierr == 0, "xmpio_write_frmarkers returned ierr!=0")
609 : :
610 : : !call MPI_FILE_SYNC(Wfk%fh,mpierr)
611 : : !ABI_CHECK_MPI(mpierr, "FILE_SYNC")
612 : :
613 [ - + ]: 5 : if (Wfk%debug) then
614 : 0 : call xmpio_check_frmarkers(Wfk%fh,offset,sc_mode,nfrec,bsize_frecords,ierr)
615 [ # # ]: 0 : ABI_CHECK(ierr == 0, "xmpio_check_frmarkers returned ierr!=0")
616 : : end if
617 : :
618 [ - + ]: 5 : ABI_FREE(bsize_frecords)
619 : 5 : call cwtime_report(" write_frmarkers", cpu, wall, gflops)
620 : : end if
621 : : #endif
622 : :
623 : : CASE (IO_MODE_ETSF)
624 : : !NCF_CHECK(nctk_open_modify(wfk%fh, wfk%fname, wfk%comm))
625 : :
626 [ + - ]: 1893 : if (nctk_has_mpiio) then
627 : : #ifdef HAVE_NETCDF_MPI
628 : : ncerr = nf90_create(wfk%fname, cmode=ior(ior(nf90_netcdf4, nf90_mpiio), nf90_write), &
629 : 1893 : comm=wfk%comm, info=xmpio_info, ncid=wfk%fh)
630 [ - + ]: 1893 : NCF_CHECK_MSG(ncerr, sjoin("nf90_create: ", wfk%fname))
631 : : #else
632 : : ABI_ERROR("You should not be here")
633 : : #endif
634 : : else
635 [ # # ]: 0 : if (wfk%nproc > 1) then
636 : 0 : ABI_ERROR("Your netcdf library does not support MPI-IO. Cannot write WFK file with nprocs > 1")
637 : : end if
638 : :
639 : 0 : ncerr = nf90_create(wfk%fname, nf90_write, wfk%fh)
640 [ # # ]: 0 : NCF_CHECK_MSG(ncerr, sjoin("nf90_create: ", wfk%fname))
641 : : end if
642 : :
643 : 1893 : call wfk_ncdef_dims_vars(wfk%fh, hdr, wfk%fform, write_hdr=.True.)
644 [ - + ]: 1893 : NCF_CHECK(nctk_def_basedims(wfk%fh))
645 : :
646 : : ! Switch to data mode.
647 [ - + ]: 1893 : NCF_CHECK(nctk_set_datamode(wfk%fh))
648 : :
649 : : case default
650 [ - + + - ]: 1903 : ABI_ERROR(sjoin('Wrong/unsupported iomode: ', itoa(wfk%iomode)))
651 : : end select
652 : :
653 : : DBG_EXIT("COLL")
654 : :
655 [ + - - + ]: 3796 : end subroutine wfk_open_write
656 : : !!***
657 : :
658 : : !----------------------------------------------------------------------
659 : :
660 : : !!****f* m_wfk/wfk_close
661 : : !! NAME
662 : : !! wfk_close
663 : : !!
664 : : !! FUNCTION
665 : : !! Close the wavefunction file handler and release the memory allocated
666 : : !! Delete the file if `delete` is True. Default: False
667 : : !!
668 : : !! SOURCE
669 : :
670 : 12434 : subroutine wfk_close(Wfk, delete)
671 : :
672 : : !Arguments ------------------------------------
673 : : !scalars
674 : : class(wfk_t),intent(inout) :: Wfk
675 : : logical,optional,intent(in) :: delete
676 : :
677 : : !Local variables-------------------------------
678 : : !scalars
679 : : integer :: ierr
680 : : !character(len=500) :: msg
681 : : #ifdef HAVE_MPI_IO
682 : : integer :: mpierr, nfrec
683 : 12434 : integer(XMPI_OFFSET_KIND),allocatable :: bsize_frecords(:)
684 : : #endif
685 : : ! *************************************************************************
686 : :
687 : : DBG_ENTER("COLL")
688 : :
689 : : ! Close the file only if it was open.
690 [ + + ]: 12434 : if (wfk%rw_mode /= WFK_NOMODE) then
691 : 10994 : Wfk%rw_mode = WFK_NOMODE
692 : :
693 : 10994 : select case (Wfk%iomode)
694 : : case (IO_MODE_FORTRAN)
695 : 0 : close(wfk%fh)
696 : :
697 : : #ifdef HAVE_MPI_IO
698 : : case (IO_MODE_MPI)
699 : 5 : call MPI_FILE_CLOSE(Wfk%fh, mpierr)
700 : 5 : ABI_CHECK_MPI(mpierr, "FILE_CLOSE!")
701 : :
702 [ - + - - ]: 5 : if (Wfk%debug .and. Wfk%my_rank == Wfk%master) then
703 : : ! Check the fortran records.
704 : 0 : call MPI_FILE_OPEN(xmpi_comm_self, Wfk%fname, MPI_MODE_RDONLY, xmpio_info, Wfk%fh, mpierr)
705 : 0 : ABI_CHECK_MPI(mpierr, "MPI_FILE_OPEN")
706 : 0 : call hdr_bsize_frecords(Wfk%Hdr,Wfk%formeig,nfrec,bsize_frecords)
707 : 0 : call xmpio_check_frmarkers(Wfk%fh,Wfk%hdr_offset,xmpio_single,nfrec,bsize_frecords,ierr)
708 [ # # ]: 0 : ABI_CHECK(ierr==0,"xmpio_check_frmarkers returned ierr!=0")
709 [ # # ]: 0 : ABI_FREE(bsize_frecords)
710 : 0 : call MPI_FILE_CLOSE(Wfk%fh,mpierr)
711 : 0 : ABI_CHECK_MPI(mpierr, "FILE_CLOSE!")
712 : : end if
713 : : #endif
714 : :
715 : : case (IO_MODE_ETSF)
716 : : !NCF_CHECK(nf90_sync(wfk%fh))
717 [ - + ]: 10989 : NCF_CHECK(nf90_close(wfk%fh))
718 : :
719 : : case default
720 [ - + + - ]: 10994 : ABI_ERROR(sjoin('Wrong/unsupported value of iomode: ', itoa(Wfk%iomode)))
721 : : end select
722 : : end if
723 : :
724 : : ! Free memory.
725 : 12434 : call Wfk%Hdr%free()
726 : :
727 [ + + ]: 12434 : ABI_SFREE(Wfk%nband)
728 [ - + ]: 12434 : ABI_SFREE(Wfk%recn_ks)
729 [ + + ]: 12434 : ABI_SFREE(Wfk%offset_ks)
730 : :
731 [ - + ]: 12434 : if (present(delete)) then
732 [ # # ]: 0 : if (delete) call delete_file(wfk%fname, ierr)
733 : : end if
734 : :
735 : : DBG_EXIT("COLL")
736 : :
737 [ - + ]: 12434 : end subroutine wfk_close
738 : : !!***
739 : :
740 : : !----------------------------------------------------------------------
741 : :
742 : : !!****f* m_wfk/wfk_print
743 : : !! NAME
744 : : !! wfk_print
745 : : !!
746 : : !! FUNCTION
747 : : !! Print information on the object.
748 : : !!
749 : : !! INPUTS
750 : : !! wfk<class(wfk_t)> = WFK handler
751 : : !! [header]=String to be printed as header for additional info.
752 : : !! [unit]=Unit number for output. Defaults to std_out
753 : : !! [prtvol]=Verbosity level
754 : : !!
755 : : !! SOURCE
756 : :
757 : 0 : subroutine wfk_print(wfk,unit,header,prtvol)
758 : :
759 : : !Arguments ------------------------------------
760 : : !scalars
761 : : class(wfk_t),intent(inout) :: wfk
762 : : integer,optional,intent(in) :: unit,prtvol
763 : : character(len=*),optional,intent(in) :: header
764 : :
765 : : !Local variables-------------------------------
766 : : integer,parameter :: rdwr4=4
767 : : integer :: my_unt,my_prtvol
768 : : character(len=500) :: msg
769 : : ! *************************************************************************
770 : :
771 : 0 : my_unt = std_out; if (present(unit)) my_unt = unit
772 : 0 : my_prtvol = 0; if (present(prtvol)) my_prtvol = prtvol
773 : :
774 : 0 : msg=' ==== Info on the wfk_t object ==== '
775 [ # # # # : 0 : if (present(header)) msg=' ==== '//trim(adjustl(header))//' ==== '
# # ]
776 : 0 : call wrtout(my_unt,msg)
777 : 0 : call wrtout(my_unt, sjoin(" iomode = ",itoa(wfk%iomode)))
778 : :
779 : 0 : call wfk%hdr%echo(wfk%fform, rdwr4 ,unit=my_unt)
780 : :
781 [ # # ]: 0 : end subroutine wfk_print
782 : : !!***
783 : :
784 : : !----------------------------------------------------------------------
785 : :
786 : : !!****f* m_wfk/wfk_validate_ks
787 : : !! NAME
788 : : !! wfk_validate_ks
789 : : !!
790 : : !! FUNCTION
791 : : !! Validate the k-point, the spin index and, optionally, the band index.
792 : : !! Return non-zero value if error.
793 : : !!
794 : : !! INPUTS
795 : : !! wfk<class(wfk_t)> = WFK handler
796 : : !! ik_ibz=k-point index.
797 : : !! spin=Spin index.
798 : : !! [band]=Band index.
799 : : !!
800 : : !! SOURCE
801 : :
802 : 2148146 : integer function wfk_validate_ks(wfk, ik_ibz, spin, band) result(ierr)
803 : :
804 : : !Arguments ------------------------------------
805 : : !scalars
806 : : integer,intent(in) :: ik_ibz, spin
807 : : integer,optional,intent(in) :: band
808 : : class(wfk_t),intent(in) :: wfk
809 : :
810 : : !Local variables-------------------------------
811 : : !scalars
812 : : character(len=500) :: msg
813 : : ! *************************************************************************
814 : 2148146 : ierr = 0
815 : :
816 [ + - - + ]: 2148146 : if (ik_ibz <= 0 .or. ik_ibz > wfk%nkpt) then
817 : 0 : ierr = ierr + 1
818 : 0 : write(msg, '(2(a,i0))')'ik_ibz = ',ik_ibz,' whereas it should be between 1 and ',wfk%nkpt
819 : 0 : ABI_WARNING(msg)
820 : : end if
821 : :
822 [ + - - + ]: 2148146 : if (spin <= 0 .or. spin > wfk%nsppol) then
823 : 0 : ierr = ierr + 1
824 : 0 : write(msg, '(2(a,i0))')'spin = ',spin,' whereas it should be between 1 and ',wfk%nsppol
825 : 0 : ABI_WARNING(msg)
826 : : end if
827 : :
828 [ + + ]: 2148146 : if (present(band)) then
829 [ - + ]: 1091555 : if (band <=0) then
830 : 0 : ierr = ierr + 1
831 : 0 : ABI_WARNING(sjoin('Negative band index: band = ',itoa(band)))
832 : : end if
833 : :
834 : : ! Don't touch nband array if wrong indices.
835 [ + - + - : 1091555 : if (spin > 0 .and. spin <= wfk%nsppol .and. ik_ibz > 0 .and. ik_ibz <= wfk%nkpt) then
+ - + - ]
836 [ - + ]: 1091555 : if (band > wfk%nband(ik_ibz, spin)) then
837 : 0 : ierr = ierr + 1
838 : 0 : write(msg, '(2(a,i0))')'band = ',band,' whereas it should be between 1 and ',wfk%nband(ik_ibz,spin)
839 : 0 : ABI_WARNING(msg)
840 : : end if
841 : : end if
842 : : end if
843 : :
844 : : !if (ierr /= 0) then
845 : : ! ABI_ERROR("Wrong (ik_ibz, spin) args, Aborting now")
846 : : !end if
847 : :
848 : 2148146 : end function wfk_validate_ks
849 : : !!***
850 : :
851 : : !----------------------------------------------------------------------
852 : :
853 : : !!****f* m_wfk/wfk_findk
854 : : !! NAME
855 : : !! wfk_findk
856 : : !!
857 : : !! FUNCTION
858 : : !! Find the index of the k-point in the WKF file. umklapp vectors are not allowed.
859 : : !! Return -1 if not found.
860 : : !!
861 : : !! INPUTS
862 : : !! wfk<class(wfk_t)> = WFK handler initialized and set in read mode
863 : : !! kpt(3)=k-point in reduced coordinates.
864 : : !! [ktol]=Optional tolerance for k-point comparison.
865 : : !! For each reduced direction the absolute difference between the coordinates must be less that ktol
866 : : !!
867 : : !! SOURCE
868 : :
869 : 568487 : integer pure function wfk_findk(wfk, kpt, ktol) result(ikpt)
870 : :
871 : : !Arguments ------------------------------------
872 : : !scalars
873 : : real(dp),optional,intent(in) :: ktol
874 : : class(wfk_t),intent(in) :: wfk
875 : : !arrays
876 : : real(dp),intent(in) :: kpt(3)
877 : :
878 : : !Local variables-------------------------------
879 : : !scalars
880 : : integer :: ik
881 : : real(dp) :: my_ktol
882 : : ! *************************************************************************
883 : :
884 [ - + ]: 568487 : my_ktol = 0.0001_dp; if (present(ktol)) my_ktol = ktol
885 : :
886 : : !TODO: replace with krank type and routines, probably save mapping on init of the wfk object
887 : 568487 : ikpt = -1
888 [ + - ]: 71146059 : do ik=1,wfk%hdr%nkpt
889 [ + + + + : 81191462 : if (all(abs(wfk%hdr%kptns(:, ik) - kpt) < my_ktol)) then
+ + ]
890 : : ikpt = ik; exit
891 : : end if
892 : : end do
893 : :
894 : 568487 : end function wfk_findk
895 : : !!***
896 : :
897 : : !----------------------------------------------------------------------
898 : :
899 : : !!****f* m_wfk/wfk_ncdef_dims_vars
900 : : !! NAME
901 : : !! wfk_ncdef_dims_vars
902 : : !!
903 : : !! FUNCTION
904 : : !! Write the heeder, fform as well as the etsf-io dimensions and variables.
905 : : !!
906 : : !! INPUTS
907 : : !! ncid=netcdf file handler.
908 : : !! hdr<hdr_tyep>=Abinit header
909 : : !! fform=File type format of the header
910 : : !! [write_hdr]=True if the header should be written (default)
911 : : !! [iskss]=True if this is a KSS file (activate kdependent=No)
912 : : !!
913 : : !! SOURCE
914 : :
915 : 4574 : subroutine wfk_ncdef_dims_vars(ncid, hdr, fform, write_hdr, iskss)
916 : :
917 : : !Arguments ------------------------------------
918 : : !scalars
919 : : integer,intent(in) :: ncid,fform
920 : : type(hdr_type),intent(in) :: hdr
921 : : logical,optional,intent(in) :: write_hdr,iskss
922 : :
923 : : !Local variables-------------------------------
924 : : !scalars
925 : : character(len=500) :: title,history
926 : : logical :: do_write_hdr,my_iskss
927 : : integer :: ivar,mpw,ncerr
928 : : ! *************************************************************************
929 : :
930 [ + + ]: 4574 : do_write_hdr = .True.; if (present(write_hdr)) do_write_hdr = write_hdr
931 [ + + ]: 4574 : my_iskss = .False.; if (present(iskss)) my_iskss = iskss
932 [ + - ]: 4574 : if (do_write_hdr) then
933 [ - + ]: 4574 : NCF_CHECK(hdr%ncwrite(ncid, fform, nc_define=.True.))
934 : : end if
935 : :
936 : : ! Add the etsf header.
937 [ + - ]: 4574 : title = sjoin("WFK file generated by Abinit, version: ", abinit_version)
938 [ + + + - ]: 4574 : if (my_iskss) title = sjoin("KSS file generated by Abinit, version: ", abinit_version)
939 [ + - ]: 4574 : history = sjoin("Generated on: ", asctime())
940 [ - + ]: 4574 : NCF_CHECK(nctk_add_etsf_header(ncid, title=title, history=history))
941 : :
942 [ + + ]: 152968 : mpw = MAXVAL(hdr%npwarr)
943 : : ncerr = nctk_def_dims(ncid, [&
944 [ + + ]: 13722 : nctkdim_t("real_or_complex_coefficients", 2), nctkdim_t("max_number_of_coefficients", mpw)])
945 [ - + ]: 4574 : NCF_CHECK(ncerr)
946 : :
947 : : ! Define kg_k
948 : : ncerr = nctk_def_arrays(ncid, [&
949 : : nctkarr_t("reduced_coordinates_of_plane_waves", "int", &
950 : : "number_of_reduced_dimensions, max_number_of_coefficients, number_of_kpoints")&
951 [ + + ]: 9148 : ])
952 [ - + ]: 4574 : NCF_CHECK(ncerr)
953 : :
954 [ - + ]: 4574 : NCF_CHECK(nf90_inq_varid(ncid, "reduced_coordinates_of_plane_waves", ivar))
955 [ + + ]: 4574 : if (my_iskss) then
956 [ - + ]: 3 : NCF_CHECK(nf90_put_att(ncid, ivar, "k_dependent", "no"))
957 : : else
958 [ - + ]: 4571 : NCF_CHECK(nf90_put_att(ncid, ivar, "k_dependent", "yes"))
959 : : end if
960 : :
961 : : ncerr = nctk_def_arrays(ncid, [&
962 : : nctkarr_t("eigenvalues", "dp", "max_number_of_states, number_of_kpoints, number_of_spins") &
963 [ + + ]: 9148 : ])
964 [ - + ]: 4574 : NCF_CHECK(ncerr)
965 [ - + ]: 4574 : NCF_CHECK(nctk_set_atomic_units(ncid, "eigenvalues"))
966 : :
967 : : ncerr = nctk_def_arrays(ncid, [&
968 : : nctkarr_t("h1_matrix_elements", "dp", "two, max_number_of_states, max_number_of_states, number_of_kpoints, number_of_spins") &
969 [ + + ]: 9148 : ])
970 [ - + ]: 4574 : NCF_CHECK(ncerr)
971 [ - + ]: 4574 : NCF_CHECK(nctk_set_atomic_units(ncid, "h1_matrix_elements"))
972 : :
973 : : ncerr = nctk_def_arrays(ncid, nctkarr_t("coefficients_of_wavefunctions", "dp", &
974 : : "real_or_complex_coefficients, max_number_of_coefficients, number_of_spinor_components, &
975 : 4574 : &max_number_of_states, number_of_kpoints, number_of_spins"))
976 [ - + ]: 4574 : NCF_CHECK(ncerr)
977 : :
978 : : !NF90_DEF_VAR_FILL(INTEGER NCID, INTEGER VARID, INTEGER NO_FILL, FILL_VALUE)
979 : : !NCF_CHECK(nf90_inq_varid(ncid, "coefficients_of_wavefunctions", ivar))
980 : : !NCF_CHECK(nf90_def_var_fill(ncid, ivar, 0, -one))
981 : :
982 : 4574 : end subroutine wfk_ncdef_dims_vars
983 : : !!***
984 : :
985 : : !----------------------------------------------------------------------
986 : :
987 : : !!****f* m_wfk/wfk_compare
988 : : !! NAME
989 : : !! wfk_compare
990 : : !!
991 : : !! FUNCTION
992 : : !! Test two wfk_t objects for consistency. Return non-zero value if test fails.
993 : : !!
994 : : !! INPUTS
995 : : !! wfk1, wfk2 <class(wfk_t)> = WFK handlers to be compared
996 : : !!
997 : : !! OUTPUT
998 : : !! ierr
999 : : !!
1000 : : !! SOURCE
1001 : :
1002 : 20 : integer function wfk_compare(wfk1, wfk2) result(ierr)
1003 : :
1004 : : !Arguments ------------------------------------
1005 : : !scalars
1006 : : class(wfk_t),intent(in) :: wfk1, wfk2
1007 : :
1008 : : !Local variables-------------------------------
1009 : : !scalars
1010 : : integer :: restart,restartpaw
1011 : : !character(len=500) :: msg
1012 : : !************************************************************************
1013 : :
1014 : 20 : ierr = 0
1015 : :
1016 : 20 : ierr=wfk1%hdr%compare(wfk2%hdr)
1017 : :
1018 : : ! Test basic dimensions
1019 : : !if (wfk1%hdr%nsppol /= wfk2%hdr%nsppol) then
1020 : : ! ierr = ierr + 1; ABI_WARNING("Different nsppol")
1021 : : !end if
1022 : : !if (wfk1%hdr%nspinor /= wfk2%hdr%nspinor) then
1023 : : ! ierr = ierr + 1; ABI_WARNING("Different nspinor")
1024 : : !end if
1025 : : !if (wfk1%hdr%nspden /= wfk2%hdr%nspden) then
1026 : : ! ierr = ierr + 1; ABI_WARNING("Different nspden")
1027 : : !end if
1028 : : !if (wfk1%hdr%nkpt /= wfk2%hdr%nkpt) then
1029 : : ! ierr = ierr + 1; ABI_WARNING("Different nkpt")
1030 : : !end if
1031 [ - + ]: 20 : if (wfk1%formeig /= wfk2%formeig) then
1032 : 0 : ierr = ierr + 1; ABI_WARNING("Different formeig")
1033 : : end if
1034 : : !if (wfk1%hdr%usepaw /= wfk2%hdr%usepaw) then
1035 : : ! ierr = ierr + 1; ABI_WARNING("Different usepaw")
1036 : : !end if
1037 : : !if (wfk1%hdr%ntypat /= wfk2%hdr%ntypat) then
1038 : : ! ierr = ierr + 1; ABI_WARNING("Different ntypat")
1039 : : !end if
1040 : : !if (wfk1%hdr%natom /= wfk2%hdr%natom) then
1041 : : ! ierr = ierr + 1; ABI_WARNING("Different natom")
1042 : : !end if
1043 : : !if (wfk1%hdr%fform /= wfk2%hdr%fform) then
1044 : : ! ierr = ierr + 1; ABI_WARNING("Different fform")
1045 : : !end if
1046 : :
1047 : : ! Return immediately if important dimensions are not equal.
1048 [ + - ]: 20 : if (ierr /= 0) return
1049 : :
1050 : : ! Test important arrays (rprimd is not tested)
1051 : : !if (any(wfk1%hdr%typat /= wfk2%hdr%typat)) then
1052 : : ! ierr = ierr + 1; ABI_WARNING("Different typat")
1053 : : !end if
1054 : : !if (any(wfk1%hdr%npwarr /= wfk2%hdr%npwarr)) then
1055 : : ! ierr = ierr + 1; ABI_WARNING("Different npwarr array")
1056 : : !end if
1057 [ + + + + : 1694 : if (any(wfk1%nband /= wfk2%nband)) then
+ - - + ]
1058 : 0 : ierr = ierr + 1; ABI_WARNING("Different nband array")
1059 : : end if
1060 : : !if (any(abs(wfk1%hdr%kptns - wfk2%hdr%kptns) > tol6)) then
1061 : : ! ierr = ierr + 1; ABI_WARNING("Different kptns array")
1062 : : !end if
1063 : :
1064 : : ! Call hdr_check to get a nice diff of the header but don't check restart and restartpaw.
1065 : 20 : call hdr_check(wfk1%fform,wfk2%fform,wfk1%hdr,wfk2%hdr,"PERS",restart,restartpaw)
1066 : :
1067 : 20 : end function wfk_compare
1068 : : !!***
1069 : : !----------------------------------------------------------------------
1070 : :
1071 : : !!****f* m_wfk/wfk_read_band_block
1072 : : !! NAME
1073 : : !! wfk_read_band_block
1074 : : !!
1075 : : !! FUNCTION
1076 : : !! Read a block of contiguous bands at a given (k-point, spin)
1077 : : !!
1078 : : !! INPUTS
1079 : : !! Wfk<class(wfk_t)>= WFK file handler object.
1080 : : !! band_block(2)=Initial and final band index.
1081 : : !! ik_ibz=Index of the k-point in the IBZ.
1082 : : !! spin=Spin index
1083 : : !! sc_mode= MPI-IO option
1084 : : !! xmpio_single ==> for reading by current proc.
1085 : : !! xmpio_collective ==> for collective reading in wfk%comm (use it wisely!)
1086 : : !!
1087 : : !! OUTPUTS
1088 : : !! [kg_k=(:,:)] = G-vectors
1089 : : !! [eig_k(:)] = Eigenvectors
1090 : : !! [cg_k(:,:)] = Fourier coefficients
1091 : : !!
1092 : : !! NOTES
1093 : : !! The output arrays eig_k and occ_k contain the *full* set of eigenvalues and occupation
1094 : : !! factors stored in the file and are dimensioned with wfk%mband.
1095 : : !!
1096 : : !! SOURCE
1097 : :
1098 : 1056591 : subroutine wfk_read_band_block(Wfk, band_block, ik_ibz, spin, sc_mode, &
1099 [ + + + - : 1145843 : kg_k, cg_k, eig_k, occ_k) ! Optional
- + + + +
- - + ]
1100 : :
1101 : : !Arguments ------------------------------------
1102 : : !scalars
1103 : : integer,intent(in) :: ik_ibz,spin,sc_mode
1104 : : class(wfk_t),intent(inout) :: Wfk
1105 : : !arrays
1106 : : integer,intent(in) :: band_block(2)
1107 : : integer,intent(out), DEV_CONTARRD optional :: kg_k(:,:) ! (3,npw_k)
1108 : : real(dp),intent(out), DEV_CONTARRD optional :: cg_k(:,:) ! (2,npw_k*nspinor*nband)
1109 : : real(dp),intent(inout),optional :: eig_k((2*Wfk%mband)**Wfk%formeig*Wfk%mband)
1110 : : real(dp),intent(out),optional :: occ_k(Wfk%mband)
1111 : :
1112 : : !Local variables-------------------------------
1113 : : !scalars
1114 : : integer :: ierr,npw_disk,nspinor_disk,nband_disk,band
1115 : : integer :: nband_disk_keep
1116 : : integer :: ipw,my_bcount,npwso,npw_tot_disk,nb_block,base
1117 : : integer :: npw_read,nspinor_read,nband_read
1118 : : character(len=500) :: msg,errmsg
1119 : : !arrays
1120 : 1056591 : real(dp),contiguous, pointer :: tmp_eigk(:),tmp_occk(:)
1121 : : #ifdef HAVE_MPI_IO
1122 : : integer :: mpierr,bufsz,gkk_type,cgblock_type
1123 : : integer(XMPI_OFFSET_KIND) :: my_offset,my_offpad
1124 : : integer :: sizes(2),subsizes(2),starts(2),types(2)
1125 : : #endif
1126 : : integer :: kg_varid,eig_varid,occ_varid,cg_varid,ncerr,h1_varid,idx,ib1,ib2
1127 : 1056591 : real(dp),allocatable :: h1mat(:,:,:)
1128 : : !************************************************************************
1129 : :
1130 : : DBG_ENTER("COLL")
1131 : :
1132 : 0 : ABI_CHECK_IEQ(Wfk%rw_mode, WFK_READMODE, "Wfk must be in READMODE")
1133 : :
1134 [ - + ]: 1056591 : if (wfk_validate_ks(wfk, ik_ibz, spin) /= 0) then
1135 : 0 : ABI_ERROR("Wrong (ik_ibz, spin) args, Aborting now")
1136 : : end if
1137 : :
1138 : : ! Look before you leap.
1139 : 1056591 : npw_disk = Wfk%Hdr%npwarr(ik_ibz)
1140 : 1056591 : nspinor_disk = Wfk%nspinor
1141 : :
1142 : 1056591 : nband_disk = Wfk%nband(ik_ibz,spin)
1143 : : ! there are several cases here, reading in fewer than mband bands,
1144 : : ! or possibly more than you have allocated, and truncating
1145 : : ! nband_disk_keep could be used to distinguish these cases
1146 : 1056591 : nband_disk_keep = nband_disk
1147 [ + + ]: 1056591 : if (present(occ_k)) then
1148 : 89252 : nband_disk_keep = min(nband_disk, size(occ_k))
1149 : : end if
1150 [ + + ]: 1056591 : if (present(eig_k)) then
1151 [ + + ]: 214395 : if (Wfk%formeig == 0) then
1152 : 105399 : nband_disk_keep = min(nband_disk_keep, size(eig_k))
1153 [ + - ]: 108996 : else if (Wfk%formeig == 1) then
1154 : 108996 : nband_disk_keep = min(nband_disk_keep, int(sqrt(size(eig_k)/two)))
1155 : : end if
1156 : : end if
1157 : :
1158 : 1056591 : nb_block = (band_block(2) - band_block(1) + 1)
1159 [ - + ]: 1056591 : ABI_CHECK(nb_block > 0, "nband <=0")
1160 : 1056591 : npw_tot_disk = npw_disk * nspinor_disk * nb_block
1161 : :
1162 [ + + ]: 1056591 : if (present(kg_k)) then
1163 [ - + ]: 93020 : ABI_CHECK(SIZE(kg_k,DIM=2) >= npw_disk,"kg_k too small")
1164 [ + + + + ]: 73771820 : kg_k = zero
1165 : : end if
1166 [ + + ]: 1056591 : if (present(cg_k)) then
1167 [ - + ]: 1010785 : ABI_CHECK(SIZE(cg_k, DIM=2) >= npw_tot_disk,"cg_k too small")
1168 [ + + + + ]: 1050970444 : cg_k = zero
1169 : : end if
1170 : :
1171 [ + + ]: 1056591 : if (present(eig_k)) then
1172 [ + + ]: 214395 : if (Wfk%formeig==0) then
1173 [ - + ]: 105399 : ABI_CHECK(SIZE(eig_k) >= nband_disk, "GS eig_k too small")
1174 [ + - ]: 108996 : else if (Wfk%formeig==1) then
1175 [ - + ]: 108996 : ABI_CHECK(SIZE(eig_k) >= 2*nband_disk**2, "DFPT eig_k too small")
1176 : : else
1177 : 0 : ABI_ERROR("formeig != [0,1]")
1178 : : end if
1179 : : end if
1180 : :
1181 [ + + ]: 1056591 : if (present(occ_k)) then
1182 : : !ABI_CHECK(SIZE(occ_k) <= nband_disk, "GS occ_k too large, not enough data on disk")
1183 [ - + ]: 89252 : if (Wfk%formeig==1) then
1184 : 0 : ABI_ERROR("occ_k cannot be used when formeig ==1")
1185 : : end if
1186 : : end if
1187 : :
1188 : 1056591 : select case (Wfk%iomode)
1189 : : case (IO_MODE_FORTRAN)
1190 : :
1191 : : ! Rewind the file to have the correct (k,s) block (if needed)
1192 : 0 : call wfk_seek(Wfk,ik_ibz,spin)
1193 : : !
1194 : : ! Read the first record: npw, nspinor, nband_disk
1195 [ # # ]: 0 : read(Wfk%fh, err=10, iomsg=errmsg) npw_read, nspinor_read, nband_read
1196 : :
1197 [ # # # # : 0 : if (any( [npw_read, nspinor_read, nband_read] /= [npw_disk, nspinor_disk, nband_disk])) then
# # ]
1198 : 0 : write(msg,"(a,6(i0,2x))")"Mismatch between (npw, nspinor, nband) read from WFK and those found in HDR ",&
1199 : 0 : npw_read, nspinor_read, nband_read, npw_disk, nspinor_disk, nband_disk
1200 : 0 : ABI_ERROR(msg)
1201 : : end if
1202 : :
1203 : : ! The second record: (k+G) vectors
1204 [ # # ]: 0 : if (present(kg_k)) then
1205 [ # # ]: 0 : read(Wfk%fh, err=10, iomsg=errmsg) kg_k(1:3,1:npw_disk)
1206 : : else
1207 [ # # ]: 0 : read(Wfk%fh, err=10, iomsg=errmsg) ! kg_k(1:3,1:npw_disk)
1208 : : end if
1209 : :
1210 : 0 : select case (Wfk%formeig)
1211 : : case (0)
1212 : : ! The third record: eigenvalues and occupation factors.
1213 : : ! write(unitwf) (eigen(iband),iband=1,nband_disk),(occ(iband),iband=1,nband_disk)
1214 [ # # ]: 0 : if (present(eig_k) .or. present(occ_k)) then
1215 [ # # # # : 0 : ABI_MALLOC(tmp_eigk, (nband_disk))
# # # # #
# # # ]
1216 [ # # # # : 0 : ABI_MALLOC(tmp_occk, (nband_disk))
# # # # ]
1217 : :
1218 [ # # # # : 0 : read(Wfk%fh, err=10, iomsg=errmsg) tmp_eigk, tmp_occk
# # ]
1219 : :
1220 [ # # ]: 0 : if (present(eig_k)) then
1221 [ # # ]: 0 : eig_k = zero
1222 [ # # ]: 0 : eig_k(1:nband_disk_keep) = tmp_eigk(1:nband_disk_keep)
1223 : : end if
1224 [ # # ]: 0 : if (present(occ_k)) then
1225 [ # # ]: 0 : occ_k = zero
1226 [ # # ]: 0 : occ_k(1:nband_disk_keep) = tmp_occk(1:nband_disk_keep)
1227 : : end if
1228 : :
1229 [ # # ]: 0 : ABI_FREE(tmp_eigk)
1230 [ # # ]: 0 : ABI_FREE(tmp_occk)
1231 : :
1232 : : else
1233 [ # # ]: 0 : read(Wfk%fh, err=10, iomsg=errmsg) ! eig_k(1:nband_disk), occ_k(1:nband_k)
1234 : : end if
1235 : :
1236 : : ! Fourth record with the wave-functions.
1237 [ # # ]: 0 : if (present(cg_k)) then
1238 : : npwso = npw_disk*nspinor_disk
1239 : : my_bcount = 0
1240 [ # # ]: 0 : do band=1,nband_disk
1241 [ # # # # ]: 0 : if (band >= band_block(1) .and. band <= band_block(2)) then
1242 : 0 : ipw = my_bcount * npwso
1243 : 0 : my_bcount = my_bcount + 1
1244 [ # # ]: 0 : read(Wfk%fh, err=10, iomsg=errmsg) cg_k(1:2,ipw+1:ipw+npwso)
1245 : : else
1246 [ # # ]: 0 : read(Wfk%fh, err=10, iomsg=errmsg) ! cg_k(1:2,ipw+1:ipw+npwso)
1247 : : end if
1248 : : end do
1249 : :
1250 : : else
1251 [ # # ]: 0 : do band=1,nband_disk
1252 [ # # ]: 0 : read(Wfk%fh, err=10, iomsg=errmsg) ! cg_k(1:2,ipw+1:ipw+npwso)
1253 : : end do
1254 : : end if
1255 : :
1256 : : case (1)
1257 : : ! formeig 1 for DFPT WF file
1258 : : npwso = npw_disk*nspinor_disk
1259 : : my_bcount = 0
1260 [ # # ]: 0 : do band=1,nband_disk
1261 : :
1262 [ # # ]: 0 : if (present(eig_k)) then
1263 : : ! Read column matrix of size (2*nband_k)
1264 : 0 : base = 2*(band-1)*nband_disk
1265 [ # # ]: 0 : read(Wfk%fh, err=10, iomsg=errmsg) eig_k(base+1:base+2*nband_disk)
1266 : : else
1267 [ # # ]: 0 : read(Wfk%fh, err=10, iomsg=errmsg ) ! eig_k(2*nband_disk)
1268 : : end if
1269 : :
1270 [ # # # # : 0 : if (present(cg_k) .and. (band >= band_block(1) .and. band <= band_block(2)) ) then
# # ]
1271 : 0 : ipw = my_bcount * npwso
1272 : 0 : my_bcount = my_bcount + 1
1273 [ # # ]: 0 : read(Wfk%fh, err=10, iomsg=errmsg) cg_k(1:2,ipw+1:ipw+npwso)
1274 : : else
1275 [ # # ]: 0 : read(Wfk%fh, err=10, iomsg=errmsg) ! cg_k(1:2,ipw+1:ipw+npwso)
1276 : : end if
1277 : : end do
1278 : :
1279 : : case default
1280 [ # # # ]: 0 : ABI_ERROR("formeig != [0,1]")
1281 : : end select
1282 : :
1283 : : ! Reached the end of the (k,s) block. Update f90_fptr
1284 [ # # ]: 0 : if (ik_ibz < Wfk%nkpt) then
1285 [ # # ]: 0 : Wfk%f90_fptr = [ik_ibz+1,spin,REC_NPW]
1286 : : else
1287 [ # # ]: 0 : ABI_CHECK(ik_ibz == wfk%nkpt, "ik_ibz != nkpt")
1288 [ # # ]: 0 : if (spin==Wfk%nsppol) then
1289 [ # # ]: 0 : Wfk%f90_fptr = FPTR_EOF ! EOF condition
1290 : : else
1291 [ # # ]: 0 : Wfk%f90_fptr = [1,spin+1,REC_NPW]
1292 : : end if
1293 : : end if
1294 : :
1295 : : #ifdef HAVE_MPI_IO
1296 : : case (IO_MODE_MPI)
1297 [ # # ]: 0 : if (present(kg_k)) then
1298 : 0 : my_offset = Wfk%offset_ks(ik_ibz,spin,REC_KG) + xmpio_bsize_frm
1299 : :
1300 [ # # # # : 0 : call mpio_read_kg_k(Wfk%fh,my_offset,npw_disk,sc_mode,kg_k,mpierr)
# # # # #
# ]
1301 : 0 : ABI_CHECK_MPI(mpierr, "reading kg")
1302 : : end if
1303 : :
1304 : : ! formeig=0 => Read both eig and occ in tmp_eigk
1305 : : ! formeig=1 => Read (nband_k,nband_k) matrix of complex numbers.
1306 : 1056591 : select case (Wfk%formeig)
1307 : : case (0)
1308 [ # # ]: 0 : if (present(eig_k) .or. present(occ_k)) then
1309 : 0 : my_offset = Wfk%offset_ks(ik_ibz,spin,REC_EIG) + xmpio_bsize_frm
1310 : :
1311 : 0 : call mpio_read_eigocc_k(Wfk%fh,my_offset,nband_disk,Wfk%formeig,sc_mode,tmp_eigk,mpierr)
1312 : 0 : ABI_CHECK_MPI(mpierr, "reading eigocc")
1313 : :
1314 [ # # ]: 0 : if (present(eig_k)) then
1315 [ # # ]: 0 : eig_k(1:nband_disk_keep) = tmp_eigk(1:nband_disk_keep)
1316 : : end if
1317 [ # # ]: 0 : if (present(occ_k)) then
1318 [ # # ]: 0 : occ_k(1:nband_disk_keep) = tmp_eigk(nband_disk+1:nband_disk+nband_disk_keep)
1319 : : end if
1320 : :
1321 [ # # ]: 0 : ABI_FREE(tmp_eigk)
1322 : : end if
1323 : :
1324 [ # # ]: 0 : if (present(cg_k)) then
1325 : 0 : my_offset = Wfk%offset_ks(ik_ibz,spin,REC_CG)
1326 [ # # ]: 0 : sizes = [npw_disk*nspinor_disk, nband_disk]
1327 [ # # ]: 0 : subsizes = [npw_disk*nspinor_disk, band_block(2)-band_block(1)+1]
1328 : 0 : bufsz = 2 * npw_disk * nspinor_disk * nb_block
1329 [ # # ]: 0 : starts = [1, band_block(1)]
1330 : :
1331 : : call mpiotk_read_fsuba_dp2D(Wfk%fh,my_offset,sizes,subsizes,starts,bufsz,cg_k,&
1332 [ # # # # : 0 : wfk%chunk_bsize,sc_mode,Wfk%comm,ierr)
# # # # #
# ]
1333 [ # # ]: 0 : ABI_CHECK(ierr==0,"Fortran record too big")
1334 : : end if
1335 : :
1336 : : case (1)
1337 [ # # ]: 0 : if (present(eig_k)) then
1338 [ # # ]: 0 : sizes = [nband_disk, npw_disk*nspinor_disk]
1339 : 0 : types = [MPI_DOUBLE_COMPLEX, MPI_DOUBLE_COMPLEX]
1340 : :
1341 : 0 : call xmpio_create_fstripes(nband_disk,sizes,types,gkk_type,my_offpad,mpierr)
1342 : 0 : ABI_CHECK_MPI(mpierr, "xmpio_create_fstripes")
1343 : :
1344 : 0 : my_offset = Wfk%offset_ks(ik_ibz,spin,REC_EIG) + my_offpad
1345 : :
1346 : 0 : call MPI_FILE_SET_VIEW(Wfk%fh,my_offset,MPI_BYTE,gkk_type,'native',xmpio_info,mpierr)
1347 : 0 : ABI_CHECK_MPI(mpierr, "SET_VIEW")
1348 : 0 : call MPI_TYPE_FREE(gkk_type,mpierr)
1349 : 0 : ABI_CHECK_MPI(mpierr, "TYPE_FREE")
1350 : :
1351 : 0 : bufsz = nband_disk**2
1352 : :
1353 [ # # ]: 0 : if (sc_mode==xmpio_collective) then
1354 : 0 : call MPI_FILE_READ_ALL(Wfk%fh,eig_k,bufsz,MPI_DOUBLE_COMPLEX,MPI_STATUS_IGNORE,mpierr)
1355 [ # # ]: 0 : else if (sc_mode==xmpio_single) then
1356 : 0 : call MPI_FILE_READ(Wfk%fh,eig_k,bufsz,MPI_DOUBLE_COMPLEX,MPI_STATUS_IGNORE,mpierr)
1357 : : else
1358 : 0 : ABI_ERROR("Wrong sc_mode")
1359 : : end if
1360 : 0 : ABI_CHECK_MPI(mpierr, "FILE_READ")
1361 : : end if
1362 : :
1363 [ # # ]: 0 : if (present(cg_k)) then
1364 : 0 : types = [MPI_DOUBLE_COMPLEX, MPI_DOUBLE_COMPLEX]
1365 [ # # ]: 0 : sizes = [npw_disk*nspinor_disk, nband_disk]
1366 : :
1367 : 0 : call xmpio_create_fstripes(nb_block,sizes,types,cgblock_type,my_offpad,mpierr)
1368 : 0 : ABI_CHECK_MPI(mpierr, "xmpio_create_fstripes")
1369 : :
1370 : : ! Increment my_offset to account for previous eigen and cg records if band_block(1) != 1
1371 : 0 : my_offset = Wfk%offset_ks(ik_ibz,spin,REC_CG) + my_offpad
1372 : : my_offset = my_offset + (band_block(1) - 1) * ( &
1373 : : (2*npw_disk*wfk%nspinor*xmpi_bsize_dp + 2*xmpio_bsize_frm) + &
1374 : 0 : (2*nband_disk*xmpi_bsize_dp + 2*xmpio_bsize_frm) )
1375 : :
1376 : 0 : call MPI_FILE_SET_VIEW(Wfk%fh,my_offset,MPI_BYTE,cgblock_type,'native',xmpio_info,mpierr)
1377 : 0 : ABI_CHECK_MPI(mpierr, "SET_VIEW")
1378 : :
1379 : 0 : call MPI_TYPE_FREE(cgblock_type,mpierr)
1380 : 0 : ABI_CHECK_MPI(mpierr, "TYPE_FREE")
1381 : :
1382 : 0 : bufsz = npw_disk * nspinor_disk * nb_block
1383 : :
1384 [ # # ]: 0 : if (sc_mode==xmpio_collective) then
1385 [ # # ]: 0 : call MPI_FILE_READ_ALL(Wfk%fh,cg_k,bufsz,MPI_DOUBLE_COMPLEX,MPI_STATUS_IGNORE,mpierr)
1386 [ # # ]: 0 : else if (sc_mode==xmpio_single) then
1387 [ # # ]: 0 : call MPI_FILE_READ(Wfk%fh,cg_k,bufsz,MPI_DOUBLE_COMPLEX,MPI_STATUS_IGNORE,mpierr)
1388 : : else
1389 : 0 : ABI_ERROR("Wrong sc_mode")
1390 : : end if
1391 : 0 : ABI_CHECK_MPI(mpierr, "FILE_READ")
1392 : : end if
1393 : :
1394 : : case default
1395 [ # # # ]: 0 : ABI_ERROR("formeig != [0,1]")
1396 : : end select
1397 : : #endif
1398 : :
1399 : : case (IO_MODE_ETSF)
1400 [ + + ]: 1056591 : if (present(kg_k)) then
1401 : : ! Read the reduced_coordinates_of_plane_waves for this k point.
1402 [ - + ]: 93020 : NCF_CHECK(nf90_inq_varid(wfk%fh, "reduced_coordinates_of_plane_waves", kg_varid))
1403 [ - + - - ]: 93020 : if (sc_mode == xmpio_collective .and. wfk%nproc > 1) then
1404 [ # # ]: 0 : NCF_CHECK(nctk_set_collective(wfk%fh, kg_varid))
1405 : : end if
1406 [ + + + + ]: 651140 : ncerr = nf90_get_var(wfk%fh, kg_varid, kg_k, start=[1,1,ik_ibz], count=[3,npw_disk,1])
1407 [ - + ]: 93020 : NCF_CHECK(ncerr)
1408 : : end if
1409 : :
1410 [ + + ]: 1056591 : if (Wfk%formeig==0) then
1411 : : ! Read eigenvalues and occupations.
1412 [ + + ]: 105416 : if (present(eig_k)) then
1413 [ - + ]: 105399 : NCF_CHECK(nf90_inq_varid(wfk%fh, "eigenvalues", eig_varid))
1414 [ - + - - ]: 105399 : if (sc_mode == xmpio_collective .and. wfk%nproc > 1) then
1415 [ # # ]: 0 : NCF_CHECK(nctk_set_collective(wfk%fh, eig_varid))
1416 : : end if
1417 [ + + + + ]: 737793 : ncerr = nf90_get_var(wfk%fh, eig_varid, eig_k, start=[1,ik_ibz,spin], count=[nband_disk_keep,1,1])
1418 [ - + ]: 105399 : NCF_CHECK(ncerr)
1419 : : end if
1420 : :
1421 [ + + ]: 105416 : if (present(occ_k)) then
1422 [ - + ]: 89252 : NCF_CHECK(nf90_inq_varid(wfk%fh, "occupations", occ_varid))
1423 [ - + - - ]: 89252 : if (sc_mode == xmpio_collective .and. wfk%nproc > 1) then
1424 [ # # ]: 0 : NCF_CHECK(nctk_set_collective(wfk%fh, occ_varid))
1425 : : end if
1426 [ + + + + ]: 624764 : ncerr = nf90_get_var(wfk%fh, occ_varid, occ_k, start=[1,ik_ibz,spin], count=[nband_disk,1,1])
1427 [ - + ]: 89252 : NCF_CHECK_MSG(ncerr, "getting occ_k")
1428 : : end if
1429 : :
1430 : : else ! formeig == 1
1431 : :
1432 [ + + ]: 951175 : if (present(eig_k)) then
1433 : : ! Read h1 matrix elements. The netcdf array has shape:
1434 : : ! [complex, max_number_of_states, max_number_of_states, number_of_kpoints, number_of_spins]
1435 [ - + + - : 435984 : ABI_MALLOC(h1mat, (2, wfk%mband, wfk%mband))
- + + - +
- + - - +
- + ]
1436 [ - + ]: 108996 : NCF_CHECK(nf90_inq_varid(wfk%fh, "h1_matrix_elements", h1_varid))
1437 [ + + - + ]: 108996 : if (sc_mode == xmpio_collective .and. wfk%nproc > 1) then
1438 [ # # ]: 0 : NCF_CHECK(nctk_set_collective(wfk%fh, h1_varid))
1439 : : end if
1440 : : ncerr = nf90_get_var(wfk%fh, h1_varid, h1mat, start=[1,1,1,ik_ibz,spin], &
1441 [ + + + + ]: 1198956 : count=[2, wfk%mband, wfk%mband, 1, 1])
1442 [ - + ]: 108996 : NCF_CHECK_MSG(ncerr, "getting h1mat_k")
1443 : :
1444 : : ! For legacy reasons, I have to pack nband_k**2 elements in the first positions in eig_k
1445 : : ! This is important only if nband(:) depends on k i.e. mband != nband_k
1446 : : idx=1
1447 [ + + ]: 611695 : do ib2=1,nband_disk
1448 [ + + ]: 4316244 : do ib1=1,nband_disk
1449 [ + + ]: 11113647 : eig_k(idx:idx+1) = h1mat(:2,ib1,ib2)
1450 : 4207248 : idx=idx+2
1451 : : end do
1452 : : end do
1453 [ - + ]: 108996 : ABI_FREE(h1mat)
1454 : : end if
1455 : : end if
1456 : :
1457 [ + + ]: 1056591 : if (present(cg_k)) then
1458 : : ! Read the nb_block bands starting from band_block(1)
1459 : : ! The coefficients_of_wavefunctions on file have shape [cplex, mpw, nspinor, mband, nkpt, nsppol]
1460 [ - + ]: 1010785 : NCF_CHECK(nf90_inq_varid(wfk%fh, "coefficients_of_wavefunctions", cg_varid))
1461 [ + + - + ]: 1010785 : if (sc_mode == xmpio_collective .and. wfk%nproc > 1) then
1462 [ # # ]: 0 : NCF_CHECK(nctk_set_collective(wfk%fh, cg_varid))
1463 : : end if
1464 : :
1465 : : ncerr = nf90_get_var(wfk%fh, cg_varid, cg_k, start=[1,1,1,band_block(1),ik_ibz,spin], &
1466 [ + + + + ]: 13140205 : count=[2,npw_disk,wfk%nspinor,nb_block,1,1])
1467 [ - + ]: 1010785 : NCF_CHECK_MSG(ncerr, "getting cg_k")
1468 : : end if
1469 : :
1470 : : case default
1471 [ - - + - ]: 1056591 : ABI_ERROR(sjoin('Wrong/unsupported iomode: ', itoa(Wfk%iomode)))
1472 : : end select
1473 : :
1474 : : DBG_EXIT("COLL")
1475 : :
1476 : 1056591 : return
1477 : :
1478 : : ! Handle Fortran IO error
1479 : : 10 continue
1480 : 0 : ABI_ERROR(errmsg)
1481 : :
1482 [ + + + + : 3259025 : end subroutine wfk_read_band_block
- + - - -
+ ]
1483 : : !!***
1484 : :
1485 : : !----------------------------------------------------------------------
1486 : :
1487 : : !!****f* m_wfk/wfk_read_bks
1488 : : !! NAME
1489 : : !! wfk_read_bks
1490 : : !!
1491 : : !! FUNCTION
1492 : : !! Read the wavefunction and, optionally, the *DFPT* matrix elements
1493 : : !! for a given (band, k-point, spin).
1494 : : !!
1495 : : !! INPUTS
1496 : : !! Wfk<class(wfk_t)>=WFK file handler.
1497 : : !! band=Band index
1498 : : !! ik_ibz=Index of the k-point in the IBZ.
1499 : : !! spin=Spin index
1500 : : !! sc_mode= MPI-IO option
1501 : : !! xmpio_single ==> for reading by current proc.
1502 : : !! xmpio_collective ==> for collective reading.
1503 : : !!
1504 : : !! OUTPUTS
1505 : : !! cg_bks(2,npw_k*nspinor) = Fourier coefficients of the wavefunction
1506 : : !! [eig1_bks(2*wfk%mband)] = Matrix elements of the DFPT H1 Hamiltonian at the specified (k, spin).
1507 : : !!
1508 : : !! SOURCE
1509 : :
1510 [ - + ]: 1091555 : subroutine wfk_read_bks(wfk, band, ik_ibz, spin, sc_mode, cg_bks, eig1_bks)
1511 : :
1512 : : !Arguments ------------------------------------
1513 : : !scalars
1514 : : integer,intent(in) :: band,ik_ibz,spin,sc_mode
1515 : : class(wfk_t),intent(inout) :: wfk
1516 : : !arrays
1517 : : real(dp),DEV_CONTARRD intent(out) :: cg_bks(:,:)
1518 : : real(dp),optional,intent(inout) :: eig1_bks(2*wfk%mband)
1519 : :
1520 : : !Local variables-------------------------------
1521 : : !scalars
1522 : : integer :: start,ib1,nspinor_disk,npw_disk,nband_disk !ierr,
1523 : : #ifdef HAVE_MPI_IO
1524 : : integer :: mpierr,bufsz,gkk_type !,cg_type
1525 : : integer(XMPI_OFFSET_KIND) :: my_offset,my_offpad
1526 : : integer :: sizes(2),types(2)
1527 : : #endif
1528 : : integer :: h1_varid,cg_varid,ncerr
1529 : : character(len=500) :: errmsg
1530 : : !arrays
1531 : 1091555 : real(dp),allocatable :: all_eigk(:)
1532 : : !************************************************************************
1533 : :
1534 [ - + ]: 1091555 : if (wfk_validate_ks(wfk, ik_ibz, spin, band=band) /= 0) then
1535 : 0 : ABI_ERROR("Wrong (ik_ibz, spin, band) args, Aborting now")
1536 : : end if
1537 : 1091555 : npw_disk = wfk%Hdr%npwarr(ik_ibz)
1538 : 1091555 : nband_disk = wfk%nband(ik_ibz, spin)
1539 : 1091555 : nspinor_disk = wfk%nspinor
1540 : : !cg_bks = one; if (present(eig1_bks)) eig1_bks = zero ; return
1541 : :
1542 [ + + ]: 1091555 : if (.not. present(eig1_bks)) then
1543 [ + + ]: 2512569 : call wfk%read_band_block([band, band], ik_ibz, spin, sc_mode, cg_k=cg_bks)
1544 : 837523 : return
1545 : :
1546 : : else
1547 [ - + ]: 254032 : ABI_CHECK(wfk%formeig==1, "formeig must be 1 if eig1_bks is present")
1548 [ - + ]: 254032 : ABI_CHECK(size(cg_bks, dim=2) >= npw_disk*wfk%nspinor,"cg_bks too small")
1549 [ - + ]: 254032 : ABI_CHECK(size(eig1_bks) >= 2*nband_disk, "eig1_bks too small")
1550 : :
1551 : : if (.False.) then
1552 : : !if (.True.) then
1553 : : ! Due to the API of wfk_read_band_block, we have to read the full set of eigenvalues
1554 : : ! and then extract the relevant band
1555 : : ! TODO: Should write another routine to avoid doing that.
1556 : : ABI_MALLOC(all_eigk, (2*wfk%mband**2))
1557 : : call wfk%read_band_block([band, band], ik_ibz, spin, sc_mode, cg_k=cg_bks, eig_k=all_eigk)
1558 : :
1559 : : ! Find the index of the slice.
1560 : : ! Remember that data in all_eigk does not have a constant stride if nband_disk != mband
1561 : : start = (band-1)*2*nband_disk
1562 : :
1563 : : !write(std_out,*)size(eig1_bks), nband_disk
1564 : : eig1_bks(1:2*nband_disk) = all_eigk(start+1:start+2*nband_disk)
1565 : : ABI_FREE(all_eigk)
1566 : :
1567 : : else
1568 : : ! Improved version
1569 : 254032 : select case (wfk%iomode)
1570 : : case (IO_MODE_FORTRAN)
1571 : : ! This code is not optimal because I'm rewinding the (k, s) block
1572 : : ! at each call but I'm not gonna spend time on this because I should
1573 : : ! refactor a lot of stuff. Use MPI-IO or HDF5!
1574 : 0 : call wfk_seek(wfk,ik_ibz,spin)
1575 : :
1576 : : ! Read the first record: npw, nspinor, nband_disk
1577 [ # # ]: 0 : read(Wfk%fh, err=10, iomsg=errmsg) !npw_read, nspinor_read, nband_read
1578 : : ! The second record: (k+G) vectors
1579 [ # # ]: 0 : read(wfk%fh, err=10, iomsg=errmsg) ! kg_k(1:3,1:npw_disk)
1580 : :
1581 [ # # ]: 0 : do ib1=1,nband_disk
1582 [ # # ]: 0 : if (ib1 /= band) then
1583 [ # # ]: 0 : read(Wfk%fh, err=10, iomsg=errmsg) ! eig_k(base+1:base+2*nband_disk)
1584 [ # # ]: 0 : read(Wfk%fh, err=10, iomsg=errmsg) ! cg_k(1:2,ipw+1:ipw+npwso)
1585 : : else
1586 : : if (present(eig1_bks)) then
1587 [ # # ]: 0 : read(wfk%fh, err=10, iomsg=errmsg) eig1_bks(1:2*nband_disk)
1588 : : else
1589 : : read(wfk%fh, err=10, iomsg=errmsg)
1590 : : end if
1591 [ # # ]: 0 : read(wfk%fh, err=10, iomsg=errmsg) cg_bks(:,:npw_disk*wfk%nspinor)
1592 : : end if
1593 : : end do
1594 : :
1595 : : ! Reached the end of the (k,s) block. Update f90_fptr
1596 : 0 : call wfk_update_f90ptr(wfk, ik_ibz, spin)
1597 : :
1598 : : #ifdef HAVE_MPI_IO
1599 : : case (IO_MODE_MPI)
1600 : : ! MPI-IO operations are done with file views even for contiguous data of the same type.
1601 : : ! See NOTES at the beginning of this module.
1602 : :
1603 [ # # ]: 0 : sizes = [nband_disk, npw_disk*nspinor_disk]
1604 : 0 : types = [MPI_DOUBLE_COMPLEX, MPI_DOUBLE_COMPLEX]
1605 : :
1606 : 0 : call xmpio_create_fstripes(1,sizes,types,gkk_type,my_offpad,mpierr)
1607 : 0 : ABI_CHECK_MPI(mpierr, "xmpio_create_fstripes")
1608 : :
1609 : : !call MPI_TYPE_CONTIGUOUS(nband_disk,MPI_DOUBLE_COMPLEX,gkk_type,mpierr)
1610 : : !ABI_CHECK_MPI(mpierr, "type_contigous")
1611 : : !call MPI_TYPE_COMMIT(gkk_type,mpierr)
1612 : : !ABI_CHECK_MPI(mpierr, "mpi_commit")
1613 : : !my_offpad = 0
1614 : :
1615 : : ! Increment my_offset to account for previous (iband -1) bands.
1616 : 0 : my_offset = wfk%offset_ks(ik_ibz,spin,REC_EIG) + my_offpad
1617 : : my_offset = my_offset + (band - 1) * ( &
1618 : : (2*npw_disk*wfk%nspinor*xmpi_bsize_dp + 2*xmpio_bsize_frm) + &
1619 : 0 : (2*nband_disk*xmpi_bsize_dp + 2*xmpio_bsize_frm) )
1620 : :
1621 : : #if 1
1622 : 0 : bufsz = nband_disk
1623 [ # # ]: 0 : if (sc_mode==xmpio_collective) then
1624 : 0 : call MPI_FILE_READ_AT_ALL(wfk%fh,my_offset,eig1_bks,bufsz,MPI_DOUBLE_COMPLEX,MPI_STATUS_IGNORE,mpierr)
1625 : : else
1626 : 0 : call MPI_FILE_READ_AT(wfk%fh,my_offset,eig1_bks,bufsz,MPI_DOUBLE_COMPLEX,MPI_STATUS_IGNORE,mpierr)
1627 : : end if
1628 : :
1629 : : ! Read the cg_ks(G)
1630 : : ! Increment my_offset to account for the previous eigen and cg records of (iband-1) bands.
1631 : 0 : my_offset = wfk%offset_ks(ik_ibz,spin,REC_CG) + xmpio_bsize_frm
1632 : : my_offset = my_offset + (band - 1) * ( &
1633 : : (2*npw_disk*wfk%nspinor*xmpi_bsize_dp + 2*xmpio_bsize_frm) + &
1634 : 0 : (2*nband_disk*xmpi_bsize_dp + 2*xmpio_bsize_frm) )
1635 : :
1636 : 0 : bufsz = npw_disk * nspinor_disk
1637 [ # # ]: 0 : if (sc_mode==xmpio_collective) then
1638 [ # # ]: 0 : call MPI_FILE_READ_AT_ALL(wfk%fh,my_offset,cg_bks,bufsz,MPI_DOUBLE_COMPLEX,MPI_STATUS_IGNORE,mpierr)
1639 : : else
1640 [ # # ]: 0 : call MPI_FILE_READ_AT(wfk%fh,my_offset,cg_bks,bufsz,MPI_DOUBLE_COMPLEX,MPI_STATUS_IGNORE,mpierr)
1641 : : end if
1642 : :
1643 : : #else
1644 : : call MPI_FILE_SET_VIEW(wfk%fh,my_offset,MPI_BYTE,gkk_type,'native',xmpio_info,mpierr)
1645 : : ABI_CHECK_MPI(mpierr, "SET_VIEW")
1646 : : call MPI_TYPE_FREE(gkk_type, mpierr)
1647 : : ABI_CHECK_MPI(mpierr, "TYPE_FREE")
1648 : :
1649 : : bufsz = nband_disk
1650 : : if (sc_mode==xmpio_collective) then
1651 : : call MPI_FILE_READ_ALL(wfk%fh,eig1_bks,bufsz,MPI_DOUBLE_COMPLEX,MPI_STATUS_IGNORE,mpierr)
1652 : : else if (sc_mode==xmpio_single) then
1653 : : call MPI_FILE_READ(wfk%fh,eig1_bks,bufsz,MPI_DOUBLE_COMPLEX,MPI_STATUS_IGNORE,mpierr)
1654 : : else
1655 : : ABI_ERROR("Wrong sc_mode")
1656 : : end if
1657 : : ABI_CHECK_MPI(mpierr, "FILE_READ")
1658 : :
1659 : : ! Read the cg_ks(G)
1660 : : ! Increment my_offset to account for the previous eigen and cg records of (iband-1) bands.
1661 : : my_offset = wfk%offset_ks(ik_ibz,spin,REC_CG) + xmpio_bsize_frm
1662 : : my_offset = my_offset + (band - 1) * ( &
1663 : : (2*npw_disk*wfk%nspinor*xmpi_bsize_dp + 2*xmpio_bsize_frm) + &
1664 : : (2*nband_disk*xmpi_bsize_dp + 2*xmpio_bsize_frm) )
1665 : :
1666 : : call MPI_TYPE_CONTIGUOUS(npw_disk*nspinor_disk,MPI_DOUBLE_COMPLEX,cg_type,mpierr)
1667 : : ABI_CHECK_MPI(mpierr, "type_contigous")
1668 : : call MPI_TYPE_COMMIT(cg_type,mpierr)
1669 : : ABI_CHECK_MPI(mpierr, "mpi_commit")
1670 : :
1671 : : call MPI_FILE_SET_VIEW(wfk%fh,my_offset,MPI_BYTE,cg_type,'native',xmpio_info,mpierr)
1672 : : ABI_CHECK_MPI(mpierr, "SET_VIEW")
1673 : : call MPI_TYPE_FREE(cg_type, mpierr)
1674 : : ABI_CHECK_MPI(mpierr, "MPI_TYPE_FREE")
1675 : :
1676 : : bufsz = npw_disk * nspinor_disk
1677 : : if (sc_mode==xmpio_collective) then
1678 : : call MPI_FILE_READ_ALL(wfk%fh,cg_bks,bufsz,MPI_DOUBLE_COMPLEX,MPI_STATUS_IGNORE,mpierr)
1679 : : else if (sc_mode==xmpio_single) then
1680 : : call MPI_FILE_READ(wfk%fh,cg_bks,bufsz,MPI_DOUBLE_COMPLEX,MPI_STATUS_IGNORE,mpierr)
1681 : : else
1682 : : ABI_ERROR("Wrong sc_mode")
1683 : : end if
1684 : : ABI_CHECK_MPI(mpierr, "FILE_READ")
1685 : : #endif
1686 : : #endif
1687 : :
1688 : : case (IO_MODE_ETSF)
1689 : : ! Read h1 matrix elements. The netcdf array has shape:
1690 : : ! [complex, max_number_of_states, max_number_of_states, number_of_kpoints, number_of_spins]
1691 [ - + ]: 254032 : NCF_CHECK(nf90_inq_varid(wfk%fh, "h1_matrix_elements", h1_varid))
1692 [ - + - - ]: 254032 : if (sc_mode == xmpio_collective .and. wfk%nproc > 1) then
1693 [ # # ]: 0 : NCF_CHECK(nctk_set_collective(wfk%fh, h1_varid))
1694 : : end if
1695 [ + + + + ]: 2794352 : ncerr = nf90_get_var(wfk%fh, h1_varid, eig1_bks, start=[1,1,band,ik_ibz,spin], count=[2, nband_disk, 1, 1, 1])
1696 [ - + ]: 254032 : NCF_CHECK_MSG(ncerr, "getting h1mat_k")
1697 : :
1698 : : ! Read the wavefunction. The coefficients_of_wavefunctions on file have shape:
1699 : : ! [cplex, mpw, nspinor, mband, nkpt, nsppol]
1700 [ - + ]: 254032 : NCF_CHECK(nf90_inq_varid(wfk%fh, "coefficients_of_wavefunctions", cg_varid))
1701 [ - + - - ]: 254032 : if (sc_mode == xmpio_collective .and. wfk%nproc > 1) then
1702 [ # # ]: 0 : NCF_CHECK(nctk_set_collective(wfk%fh, cg_varid))
1703 : : end if
1704 : :
1705 : : ncerr = nf90_get_var(wfk%fh, cg_varid, cg_bks, start=[1,1,1,band,ik_ibz,spin], &
1706 [ + + + + ]: 3302416 : count=[2,npw_disk,wfk%nspinor,1,1,1])
1707 [ - + ]: 254032 : NCF_CHECK_MSG(ncerr, "getting cg_k")
1708 : :
1709 : : case default
1710 [ - - + - ]: 254032 : ABI_ERROR(sjoin('Wrong value for iomode:', itoa(Wfk%iomode)))
1711 : : end select
1712 : : end if
1713 : :
1714 : : end if
1715 : :
1716 : : return
1717 : :
1718 : : ! Handle Fortran IO error
1719 : : 10 continue
1720 : 0 : ABI_ERROR(errmsg)
1721 : :
1722 [ + + ]: 1091555 : end subroutine wfk_read_bks
1723 : : !!***
1724 : :
1725 : : !!****f* m_wfk/wfk_write_band_block
1726 : : !! NAME
1727 : : !! wfk_write_band_block
1728 : : !!
1729 : : !! FUNCTION
1730 : : !! Write a block of contigous bands.
1731 : : !!
1732 : : !! INPUTS
1733 : : !! Wfk<class(wfk_t)>=
1734 : : !! band_block(2)=Initial and final band index.
1735 : : !! ik_ibz=Index of the k-point in the IBZ.
1736 : : !! spin=Spin index
1737 : : !! sc_mode= MPI-IO option
1738 : : !! xmpio_single ==> for writing by current proc.
1739 : : !! xmpio_collective ==> for collective writing.
1740 : : !! [kg_k=(:,:)] = G-vectors
1741 : : !! [cg_k(:,:)] = Fourier coefficients
1742 : : !! [eig_k(:)] = Eigenvalues (dimensioned with wfk%mband, see below)
1743 : : !! [occ_k(:)] = Occupancies ((dimensioned with wfk%mband, see below)
1744 : : !!
1745 : : !! SOURCE
1746 : :
1747 : 350259 : subroutine wfk_write_band_block(Wfk, band_block, ik_ibz, spin, sc_mode, &
1748 [ + - + - : 234094 : kg_k, cg_k, eig_k, occ_k) ! Optional
- + + - +
- - + ]
1749 : :
1750 : : !Arguments ------------------------------------
1751 : : !scalars
1752 : : class(wfk_t),intent(inout) :: Wfk
1753 : : integer,intent(in) :: ik_ibz,spin,sc_mode
1754 : : !arrays
1755 : : integer,intent(in) :: band_block(2)
1756 : : integer,intent(in),optional :: kg_k(:,:) ! (3, npw_k)
1757 : : real(dp),intent(in),optional :: cg_k(:,:) ! (2, npw_k*nspinor*nband)
1758 : : real(dp),intent(in),optional :: eig_k((2*Wfk%mband)**Wfk%formeig*Wfk%mband)
1759 : : real(dp),intent(in),optional :: occ_k(Wfk%mband)
1760 : :
1761 : : !Local variables-------------------------------
1762 : : !scalars
1763 : : integer :: npw_disk,nspinor_disk,nband_disk,band
1764 : : integer :: ipw,my_bcount,npwso,npw_tot,nb_block,base
1765 : : character(len=500) :: errmsg !msg,
1766 : : real(dp) :: cpu, wall, gflops
1767 : : !arrays
1768 : 116753 : real(dp),contiguous, pointer :: tmp_eigk(:)
1769 : : !real(dp), allocatable :: eig_buffer(:), cg_buffer(:,:)
1770 : : #ifdef HAVE_MPI_IO
1771 : : integer :: mpierr,bufsz,recnpw_type,gkk_type,cgblock_type
1772 : : integer(XMPI_OFFSET_KIND) :: my_offset,my_offpad
1773 : : integer :: sizes(2),subsizes(2),starts(2),dims(3),types(2)
1774 : : !integer(XMPI_OFFSET_KIND),allocatable :: bsize_frecords(:)
1775 : : #endif
1776 : : integer :: kg_varid,eig_varid,occ_varid,cg_varid,ncerr,h1_varid
1777 : : !************************************************************************
1778 : :
1779 : : DBG_ENTER("COLL")
1780 : 0 : ABI_CHECK_IEQ(Wfk%rw_mode, WFK_WRITEMODE, "Wfk must be in WRITEMODE")
1781 : :
1782 : 116753 : call cwtime(cpu, wall, gflops, "start")
1783 : :
1784 : : ! Look before you leap.
1785 : 116753 : npw_disk = Wfk%Hdr%npwarr(ik_ibz)
1786 : 116753 : nspinor_disk = Wfk%nspinor
1787 : 116753 : nband_disk = Wfk%nband(ik_ibz,spin)
1788 : 116753 : nb_block = (band_block(2) - band_block(1) + 1)
1789 : 116753 : npw_tot = npw_disk * nspinor_disk * nb_block
1790 : :
1791 : : ! MG: We don't need to allocate memory if we want to skip records.
1792 : : ! Plain read without variable will do the job.
1793 : : !ABI_MALLOC (eig_buffer, (2*nband_disk))
1794 : : !ABI_MALLOC (cg_buffer, (2,npw_disk*nspinor_disk))
1795 : :
1796 [ + - ]: 116753 : if (PRESENT(kg_k)) then
1797 [ - + ]: 116753 : ABI_CHECK_IGEQ(SIZE(kg_k, DIM=2), npw_disk, "kg_k too small")
1798 : : end if
1799 : :
1800 [ + - ]: 116753 : if (PRESENT(cg_k)) then
1801 [ - + ]: 116753 : ABI_CHECK_IGEQ(SIZE(cg_k, DIM=2), npw_tot, "cg_k too small")
1802 : : end if
1803 : :
1804 [ + - ]: 116753 : if (PRESENT(eig_k)) then
1805 [ + + ]: 116753 : if (Wfk%formeig == 0) then
1806 [ - + ]: 588 : ABI_CHECK_IGEQ(SIZE(eig_k), nband_disk, "GS eig_k too small")
1807 [ - + ]: 588 : ABI_CHECK(PRESENT(occ_k), "both eig_k and occ_k must be present")
1808 [ + - ]: 116165 : else if (Wfk%formeig == 1) then
1809 [ - + ]: 116165 : ABI_CHECK_IGEQ(SIZE(eig_k), 2*nband_disk**2, "DFPT eig_k too small")
1810 : : else
1811 : 0 : ABI_ERROR("formeig != [0,1]")
1812 : : end if
1813 : : end if
1814 : :
1815 [ - + ]: 116165 : if (PRESENT(occ_k)) then
1816 [ - + ]: 588 : ABI_CHECK_IGEQ(SIZE(occ_k), nband_disk, "GS eig_k too small")
1817 [ - + ]: 588 : ABI_CHECK(PRESENT(eig_k), "both eig_k and occ_k must be present")
1818 [ - + ]: 588 : ABI_CHECK(Wfk%formeig == 0, "formeig /=0 with occ_k in input!")
1819 : : end if
1820 : :
1821 : 116753 : select case (Wfk%iomode)
1822 : : case (IO_MODE_FORTRAN)
1823 : :
1824 : : ! Rewind the file to have the correct (k,s) block (if needed)
1825 : 0 : call wfk_seek(Wfk,ik_ibz,spin)
1826 : :
1827 : : ! Write the first record: npw, nspinor, nband_disk
1828 [ # # ]: 0 : write(Wfk%fh, err=10, iomsg=errmsg) npw_disk, nspinor_disk, nband_disk
1829 : :
1830 : : ! The second record: (k+G) vectors
1831 [ # # ]: 0 : if (PRESENT(kg_k)) then
1832 [ # # ]: 0 : write(Wfk%fh, err=10, iomsg=errmsg) kg_k(1:3,1:npw_disk)
1833 : : else
1834 [ # # ]: 0 : read(Wfk%fh, err=10, iomsg=errmsg) ! kg_k(1:3,1:npw_disk)
1835 : : end if
1836 : :
1837 : : ! The third record: eigenvalues occupation factors and wavefunctions.
1838 : 0 : select case (Wfk%formeig)
1839 : : case (0)
1840 : : !write(unitwf) (eigen(iband),iband=1,nband_disk),(occ(iband),iband=1,nband_disk)
1841 : :
1842 [ # # ]: 0 : if (present(eig_k) .and. present(occ_k)) then
1843 [ # # ]: 0 : write(Wfk%fh, err=10, iomsg=errmsg) eig_k(1:nband_disk), occ_k(1:nband_disk)
1844 : : else
1845 : 0 : ABI_ERROR("Not coded")
1846 [ # # ]: 0 : write(Wfk%fh, err=10, iomsg=errmsg) ! eig_k(1:nband_disk), occ_k(1:nband_disk)
1847 : : end if
1848 : :
1849 : : ! The wave-functions.
1850 [ # # ]: 0 : if (present(cg_k)) then
1851 : 0 : npwso = npw_disk*nspinor_disk
1852 : : ! fast forward the bands which are not mine
1853 : : ! could do in a single read, but need to check if cg_k is big enough as a buffer
1854 : : ! e.g. for band_block(1)=100 and band_block(2)=105
1855 [ # # ]: 0 : do band=1,band_block(1)-1
1856 [ # # ]: 0 : read(Wfk%fh, err=10, iomsg=errmsg) ! cg_buffer(1:2,1:npwso)
1857 : : end do
1858 : :
1859 : : ! MJV 2021/02: I think my coding is correct - the previous one would only accept band_block(:) = 1,nband_disk
1860 : 0 : my_bcount = 0
1861 [ # # ]: 0 : do band=band_block(1), band_block(2)
1862 : 0 : ipw = my_bcount * npwso
1863 : 0 : my_bcount = my_bcount + 1
1864 [ # # ]: 0 : write(Wfk%fh, err=10, iomsg=errmsg) cg_k(1:2,ipw+1:ipw+npwso)
1865 : : end do
1866 : :
1867 : : else
1868 : 0 : ABI_ERROR("cg_k must be present!")
1869 [ # # ]: 0 : do band=1,nband_disk
1870 [ # # ]: 0 : write(Wfk%fh, err=10, iomsg=errmsg) ! cg_k(1:2,ipw+1:ipw+npwso)
1871 : : end do
1872 : : end if
1873 : :
1874 : : case (1)
1875 : : ! Write column of matrix of total size (2*nband_k**2)
1876 : : ! And the wave-functions.
1877 : 0 : npwso = npw_disk*nspinor_disk
1878 : :
1879 : : ! fast forward the bands which are not mine
1880 : : ! could do in a single read, but need to check if cg_k is big enough as a buffer
1881 : : ! e.g. for band_block(1)=100 and band_block(2)=105
1882 [ # # ]: 0 : do band=1, band_block(1)-1
1883 [ # # ]: 0 : read(Wfk%fh, err=10, iomsg=errmsg) ! eig_buffer(1:2*nband_disk)
1884 [ # # ]: 0 : read(Wfk%fh, err=10, iomsg=errmsg) ! cg_buffer(1:2,1:npwso)
1885 : : end do
1886 : :
1887 : 0 : my_bcount = 0
1888 [ # # ]: 0 : do band=band_block(1),band_block(2)
1889 : 0 : base = 2*(band-1)*nband_disk
1890 : : !NB: interleaves the arrays eig_k and cg_k in the RF case with formeig 1
1891 [ # # # # ]: 0 : write(Wfk%fh, err=10, iomsg=errmsg) eig_k(base+1:base+2*nband_disk)
1892 : : ! MJV 2021/02: I think my coding is correct - the previous one would only accept band_block(:) = 1,nband_disk
1893 : 0 : ipw = my_bcount * npwso
1894 : 0 : my_bcount = my_bcount + 1
1895 [ # # # # ]: 0 : write(Wfk%fh, err=10, iomsg=errmsg) cg_k(1:2,ipw+1:ipw+npwso)
1896 : : end do
1897 : :
1898 : : case default
1899 [ # # # ]: 0 : ABI_ERROR("formeig != [0,1]")
1900 : : end select
1901 : :
1902 : : ! Reached the end of the (k,s) block. Update f90_fptr
1903 : 0 : call wfk_update_f90ptr(wfk, ik_ibz, spin)
1904 : :
1905 : : #ifdef HAVE_MPI_IO
1906 : : case (IO_MODE_MPI)
1907 : : ! record 1 npw, nspinor, nband of length 3
1908 : 30 : my_offset = Wfk%offset_ks(ik_ibz,spin,REC_NPW)
1909 : :
1910 : : ! bsize_rec(1) = 3 * xmpi_bsize_int
1911 : : ! call xmpio_write_frmarkers(Wfk%fh,my_offset,sc_mode,1,bsize_rec,mpierr)
1912 : : ! ABI_CHECK(mpierr==0,"mpierr!=0")
1913 : :
1914 : 30 : my_offset = Wfk%offset_ks(ik_ibz,spin,REC_NPW) + xmpio_bsize_frm
1915 : :
1916 : 30 : call MPI_TYPE_CONTIGUOUS(3, MPI_INTEGER, recnpw_type, mpierr)
1917 : 30 : ABI_CHECK_MPI(mpierr, "writing REC_NPW")
1918 : :
1919 : 30 : call MPI_TYPE_COMMIT(recnpw_type, mpierr)
1920 : 30 : ABI_CHECK_MPI(mpierr, "writing REC_NPW")
1921 : :
1922 : : ! NB: This is a collection operation so all proch in wfk%comm must call the routine.
1923 : 30 : call MPI_FILE_SET_VIEW(Wfk%fh, my_offset, MPI_BYTE, recnpw_type, 'native', xmpio_info, mpierr)
1924 : 30 : ABI_CHECK_MPI(mpierr, "writing REC_NPW")
1925 : :
1926 : 30 : call MPI_TYPE_FREE(recnpw_type, mpierr)
1927 : 30 : ABI_CHECK_MPI(mpierr, "writing REC_NPW")
1928 : :
1929 [ + + ]: 120 : dims = [npw_disk, nspinor_disk, nband_disk]
1930 : :
1931 [ - + ]: 30 : if (sc_mode == xmpio_collective) then
1932 : 0 : call MPI_FILE_WRITE_ALL(Wfk%fh, dims, SIZE(dims), MPI_INTEGER, MPI_STATUS_IGNORE, mpierr)
1933 [ + - ]: 30 : else if (sc_mode == xmpio_single) then
1934 : 30 : call MPI_FILE_WRITE(Wfk%fh, dims, SIZE(dims), MPI_INTEGER, MPI_STATUS_IGNORE, mpierr)
1935 : : else
1936 : 0 : ABI_ERROR("Wrong sc_mode")
1937 : : end if
1938 : 30 : ABI_CHECK_MPI(mpierr, "writing REC_NPW")
1939 : :
1940 : : !----------------------------------------------------------------------------
1941 : : ! record 2 kg
1942 [ + - ]: 30 : if (present(kg_k)) then
1943 : 30 : my_offset = Wfk%offset_ks(ik_ibz,spin,REC_KG)
1944 : :
1945 : : ! bsize_rec(1) = 3 * npw_disk * xmpi_bsize_int
1946 : : ! call xmpio_write_frmarkers(Wfk%fh,my_offset,sc_mode,1,bsize_rec,mpierr)
1947 : 30 : my_offset = Wfk%offset_ks(ik_ibz,spin,REC_KG) + xmpio_bsize_frm
1948 : :
1949 [ - + - - : 30 : call mpio_write_kg_k(Wfk%fh, my_offset, npw_disk, sc_mode, kg_k, mpierr)
- - - - -
+ ]
1950 : 30 : ABI_CHECK_MPI(mpierr, "mpio_write_kg_k")
1951 : : end if
1952 : :
1953 [ + - ]: 30 : if (Wfk%formeig==0) then
1954 : : !----------------------------------------------------------------------------
1955 : : ! record 3 eigk occk
1956 [ + - ]: 30 : if (present(eig_k) .and. present(occ_k)) then
1957 : 30 : my_offset = Wfk%offset_ks(ik_ibz,spin,REC_EIG)
1958 : :
1959 : : ! bsize_rec(1) = 2 * nband_disk * xmpi_bsize_dp
1960 : : ! call xmpio_write_frmarkers(Wfk%fh,my_offset,sc_mode,1,bsize_rec,mpierr)
1961 : :
1962 : : !TODO: check if we need 2*bsize_frm here
1963 : 30 : my_offset = Wfk%offset_ks(ik_ibz,spin,REC_EIG) + xmpio_bsize_frm
1964 : : !
1965 : : ! Write both eig and occ in tmp_eigk
1966 : 30 : bufsz = 2*nband_disk
1967 [ - + + - : 90 : ABI_MALLOC(tmp_eigk, (bufsz))
+ - + - -
+ - + ]
1968 : :
1969 [ + + ]: 270 : tmp_eigk(1:nband_disk) = eig_k(1:nband_disk)
1970 [ + + ]: 270 : tmp_eigk(nband_disk+1:) = occ_k(1:nband_disk)
1971 : :
1972 : 30 : call mpio_write_eigocc_k(Wfk%fh, my_offset, nband_disk, Wfk%formeig, sc_mode, tmp_eigk, mpierr)
1973 : 30 : ABI_CHECK_MPI(mpierr, "mpio_write_eigocc_k")
1974 : :
1975 [ - + ]: 60 : ABI_FREE(tmp_eigk)
1976 : : end if
1977 : :
1978 : : !----------------------------------------------------------------------------
1979 : : ! record 4 cg
1980 [ + - ]: 30 : if (present(cg_k)) then
1981 : : !TODO: in principle these markers are written when the file is opened, no need here.
1982 : : !ABI_MALLOC(bsize_frecords, (nb_block))
1983 : : !bsize_frecords = 2 * npw_disk * nspinor_disk * xmpi_bsize_dp
1984 : : !! TODO: why 2*frm size here? Each band cg is a single record!
1985 : : !my_offset = Wfk%offset_ks(ik_ibz,spin,REC_CG) + (band_block(1)-1) * (bsize_frecords(1) + 2*xmpio_bsize_frm)
1986 : : !call xmpio_write_frmarkers(Wfk%fh,my_offset,sc_mode,nb_block,bsize_frecords,mpierr)
1987 : : !ABI_CHECK(mpierr==0,"mpierr!=0")
1988 : : !ABI_FREE(bsize_frecords)
1989 : : !print *, "Writing cg"
1990 : :
1991 : 30 : my_offset = Wfk%offset_ks(ik_ibz,spin,REC_CG)
1992 [ + + ]: 90 : sizes = [npw_disk*nspinor_disk, nband_disk]
1993 [ + + ]: 90 : subsizes = [npw_disk*nspinor_disk, band_block(2)-band_block(1)+1]
1994 : 30 : bufsz = 2 * npw_disk * nspinor_disk * nb_block
1995 [ + + ]: 90 : starts = [1, band_block(1)]
1996 : :
1997 [ - + - - : 30 : call mpiotk_write_fsuba_dp2D(Wfk%fh,my_offset,sizes,subsizes,starts,bufsz,cg_k,Wfk%chunk_bsize,sc_mode,Wfk%comm,mpierr)
- - - - -
+ ]
1998 [ - + ]: 30 : ABI_CHECK(mpierr == 0, "mpierr != 0")
1999 : : end if
2000 : :
2001 [ # # ]: 0 : else if (Wfk%formeig == 1) then
2002 : :
2003 : : !----------------------------------------------------------------------------
2004 : : ! record 3 eigk occk
2005 [ # # ]: 0 : if (present(eig_k)) then
2006 : 0 : types = [MPI_DOUBLE_COMPLEX, MPI_DOUBLE_COMPLEX]
2007 [ # # ]: 0 : sizes = [nband_disk, npw_disk*nspinor_disk]
2008 : :
2009 : 0 : call xmpio_create_fstripes(nband_disk,sizes,types,gkk_type,my_offpad,mpierr)
2010 : 0 : ABI_CHECK_MPI(mpierr, "xmpio_create_fstripes")
2011 : :
2012 : 0 : my_offset = Wfk%offset_ks(ik_ibz,spin,REC_EIG) + my_offpad
2013 : :
2014 : 0 : call MPI_FILE_SET_VIEW(Wfk%fh,my_offset,MPI_BYTE,gkk_type,'native',xmpio_info,mpierr)
2015 : 0 : ABI_CHECK_MPI(mpierr, "SET_VIEW")
2016 : :
2017 : 0 : call MPI_TYPE_FREE(gkk_type,mpierr)
2018 : 0 : ABI_CHECK_MPI(mpierr, "TYPE_FREE")
2019 : :
2020 : : ! NB: bufsz is not 2*nband**2 because we use COMPLEX below
2021 : 0 : bufsz = nband_disk**2
2022 : :
2023 [ # # ]: 0 : if (sc_mode == xmpio_collective) then
2024 : 0 : call MPI_FILE_WRITE_ALL(Wfk%fh,eig_k,bufsz,MPI_DOUBLE_COMPLEX,MPI_STATUS_IGNORE,mpierr)
2025 [ # # ]: 0 : else if (sc_mode == xmpio_single) then
2026 : 0 : call MPI_FILE_WRITE(Wfk%fh,eig_k,bufsz,MPI_DOUBLE_COMPLEX,MPI_STATUS_IGNORE,mpierr)
2027 : : else
2028 : 0 : ABI_ERROR("Wrong sc_mode")
2029 : : end if
2030 : :
2031 : 0 : ABI_CHECK_MPI(mpierr, "FILE_WRITE")
2032 : : end if
2033 : :
2034 : : !----------------------------------------------------------------------------
2035 : : ! record 4 cg
2036 [ # # ]: 0 : if (present(cg_k)) then
2037 : : !ABI_CHECK(band_block(1)==1,"band_block(1) !=1 not coded")
2038 : :
2039 : 0 : types = [MPI_DOUBLE_COMPLEX, MPI_DOUBLE_COMPLEX]
2040 : : !sizes = [npw_disk*nspinor_disk, band_block(2)-band_block(1)]
2041 [ # # ]: 0 : sizes = [npw_disk*nspinor_disk, nband_disk]
2042 : :
2043 : 0 : call xmpio_create_fstripes(nb_block,sizes,types,cgblock_type,my_offpad,mpierr)
2044 : 0 : ABI_CHECK_MPI(mpierr, "xmpio_create_fstripes")
2045 : :
2046 : : ! TODO: check that the following offset is correct
2047 : : ! check that the 4 * xmpio_bsize_frm is correct: 1 record marker for eigen and 1 for cg in principle!
2048 : : ! even if the cg is followed by 2 frm, and eig 1, then it should be 3, not 4
2049 : : my_offset = Wfk%offset_ks(ik_ibz,spin,REC_CG) + my_offpad &
2050 : : + (band_block(1)-1) * (2 * nband_disk * xmpi_bsize_dp &
2051 : : + 2 * npw_disk * nspinor_disk * xmpi_bsize_dp &
2052 : 0 : + 4 * xmpio_bsize_frm)
2053 : :
2054 : 0 : call MPI_FILE_SET_VIEW(Wfk%fh,my_offset,MPI_BYTE,cgblock_type,'native',xmpio_info,mpierr)
2055 : 0 : ABI_CHECK_MPI(mpierr, "SET_VIEW")
2056 : :
2057 : 0 : call MPI_TYPE_FREE(cgblock_type,mpierr)
2058 : 0 : ABI_CHECK_MPI(mpierr, "TYPE_FREE")
2059 : :
2060 : 0 : bufsz = npw_disk * nspinor_disk * nb_block
2061 [ # # ]: 0 : if (sc_mode == xmpio_collective) then
2062 [ # # ]: 0 : call MPI_FILE_WRITE_ALL(Wfk%fh,cg_k,bufsz,MPI_DOUBLE_COMPLEX,MPI_STATUS_IGNORE,mpierr)
2063 [ # # ]: 0 : else if (sc_mode == xmpio_single) then
2064 [ # # ]: 0 : call MPI_FILE_WRITE (Wfk%fh,cg_k,bufsz,MPI_DOUBLE_COMPLEX,MPI_STATUS_IGNORE,mpierr)
2065 : : else
2066 : 0 : ABI_ERROR("Wrong sc_mode")
2067 : : end if
2068 : 0 : ABI_CHECK_MPI(mpierr, "FILE_WRITE")
2069 : : end if
2070 : :
2071 : : else
2072 : 0 : ABI_ERROR("formeig not in [0,1]")
2073 : : end if
2074 : : #endif
2075 : :
2076 : : case (IO_MODE_ETSF)
2077 [ + - ]: 116723 : if (present(kg_k)) then
2078 : : ! Write the reduced_coordinates_of_plane_waves for this k point.
2079 [ - + ]: 116723 : NCF_CHECK(nf90_inq_varid(wfk%fh, "reduced_coordinates_of_plane_waves", kg_varid))
2080 [ + + + + ]: 116723 : if (sc_mode == xmpio_collective .and. wfk%nproc > 1) then
2081 [ - + ]: 34108 : NCF_CHECK(nctk_set_collective(wfk%fh, kg_varid))
2082 : : end if
2083 [ + + + + ]: 817061 : ncerr = nf90_put_var(wfk%fh, kg_varid, kg_k, start=[1,1,ik_ibz], count=[3,npw_disk,1])
2084 [ - + ]: 116723 : NCF_CHECK_MSG(ncerr, "putting kg_k")
2085 : : !NCF_CHECK(nf90_sync(wfk%fh))
2086 : : end if
2087 : :
2088 : : ! Write eigenvalues and occupation factors.
2089 [ + + ]: 116723 : if (Wfk%formeig == 0) then
2090 : :
2091 [ + - ]: 558 : if (present(eig_k)) then
2092 [ - + ]: 558 : NCF_CHECK(nf90_inq_varid(wfk%fh, "eigenvalues", eig_varid))
2093 [ - + - - ]: 558 : if (sc_mode == xmpio_collective .and. wfk%nproc > 1) then
2094 [ # # ]: 0 : NCF_CHECK(nctk_set_collective(wfk%fh, eig_varid))
2095 : : end if
2096 : : !print *, "Putting eigenvalues for ik_ibz,spin, nband_disk", ik_ibz,spin, nband_disk
2097 [ + + + + ]: 3906 : ncerr = nf90_put_var(wfk%fh, eig_varid, eig_k, start=[1,ik_ibz,spin], count=[nband_disk,1,1])
2098 [ - + ]: 558 : NCF_CHECK_MSG(ncerr, "putting eig_k")
2099 : : !NCF_CHECK(nf90_sync(wfk%fh))
2100 : : end if
2101 : :
2102 [ + - ]: 558 : if (present(occ_k)) then
2103 [ - + ]: 558 : NCF_CHECK(nf90_inq_varid(wfk%fh, "occupations", occ_varid))
2104 [ - + - - ]: 558 : if (sc_mode == xmpio_collective .and. wfk%nproc > 1) then
2105 [ # # ]: 0 : NCF_CHECK(nctk_set_collective(wfk%fh, occ_varid))
2106 : : end if
2107 [ + + + + ]: 3906 : ncerr = nf90_put_var(wfk%fh, occ_varid, occ_k, start=[1,ik_ibz,spin], count=[nband_disk,1,1])
2108 [ - + ]: 558 : NCF_CHECK_MSG(ncerr, "putting occ_k")
2109 : : end if
2110 : :
2111 [ + - ]: 116165 : else if (Wfk%formeig == 1) then
2112 [ - + ]: 116165 : if (present(occ_k)) then
2113 : 0 : ABI_ERROR("Don't pass occ_k when formeig==1 and ETSF-IO")
2114 : : end if
2115 [ + - ]: 116165 : if (present(eig_k)) then
2116 : : !ABI_WARNING("Don't pass eig_k when formeig==1 and ETSF-IO")
2117 [ - + ]: 116165 : NCF_CHECK(nf90_inq_varid(wfk%fh, "h1_matrix_elements", h1_varid))
2118 [ + - + + ]: 116165 : if (sc_mode == xmpio_collective .and. wfk%nproc > 1) then
2119 [ - + ]: 34108 : NCF_CHECK(nctk_set_collective(wfk%fh, h1_varid))
2120 : : end if
2121 [ + + + + ]: 1277815 : ncerr = nf90_put_var(wfk%fh, h1_varid, eig_k, start=[1,1,1,ik_ibz,spin], count=[2, nband_disk, nband_disk, 1, 1])
2122 [ - + ]: 116165 : NCF_CHECK_MSG(ncerr, "puting h1mat_k")
2123 : : end if
2124 : :
2125 : : else
2126 : 0 : ABI_ERROR("formeig != [0,1]")
2127 : : end if
2128 : :
2129 [ + - ]: 116723 : if (present(cg_k)) then
2130 : : ! Write the nb_block bands starting from band_block(1)
2131 : : ! The coefficients_of_wavefunctions on file have shape [cplex, mpw, nspinor, mband, nkpt, nsppol]
2132 [ - + ]: 116723 : NCF_CHECK(nf90_inq_varid(wfk%fh, "coefficients_of_wavefunctions", cg_varid))
2133 [ + + + + ]: 116723 : if (sc_mode == xmpio_collective .and. wfk%nproc > 1) then
2134 [ - + ]: 34108 : NCF_CHECK(nctk_set_collective(wfk%fh, cg_varid))
2135 : : end if
2136 : :
2137 : : ncerr = nf90_put_var(wfk%fh, cg_varid, cg_k, start=[1,1,1,band_block(1),ik_ibz,spin], &
2138 [ + + + + ]: 1517399 : count=[2, npw_disk, wfk%nspinor, nb_block, 1, 1])
2139 [ - + ]: 116723 : NCF_CHECK_MSG(ncerr, "putting cg_k")
2140 : : end if
2141 : :
2142 : : case default
2143 [ - + + - ]: 116753 : ABI_ERROR(sjoin('Wrong value of iomode:', itoa(Wfk%iomode)))
2144 : : end select
2145 : :
2146 : : !ABI_FREE(eig_buffer)
2147 : : !ABI_FREE(cg_buffer)
2148 : :
2149 : 116753 : call cwtime_report(" wfk_write_band_block", cpu, wall, gflops)
2150 : : DBG_EXIT("COLL")
2151 : :
2152 : 116753 : return
2153 : :
2154 : : ! Handle Fortran IO error
2155 : : 10 continue
2156 : 0 : ABI_ERROR(errmsg)
2157 : :
2158 [ + - + + : 234094 : end subroutine wfk_write_band_block
- + ]
2159 : : !!***
2160 : :
2161 : : !----------------------------------------------------------------------
2162 : :
2163 : : !!****f* m_wfk/wfk_read_bmask
2164 : : !! NAME
2165 : : !! wfk_read_bmask
2166 : : !!
2167 : : !! FUNCTION
2168 : : !! Read a set of bands at a given k-point, spin. The bands to be read
2169 : : !! are specified by the logical mask `bmask`.
2170 : : !!
2171 : : !! INPUTS
2172 : : !! Wfk<class(wfk_t)>=
2173 : : !! ik_ibz=Index of the k-point in the IBZ.
2174 : : !! spin=Spin index
2175 : : !! sc_mode= MPI-IO option
2176 : : !! xmpio_single ==> for reading by current proc.
2177 : : !! xmpio_collective ==> for collective reading.
2178 : : !!
2179 : : !! OUTPUTS
2180 : : !! [kg_k=(:,:)] = G-vectors
2181 : : !! [cg_k(:,:)] = Fourier coefficients
2182 : : !! [eig_k(:)] = Eigenvectors
2183 : : !! [occ_k(:)] = Occupation
2184 : : !!
2185 : : !! NOTES
2186 : : !! The output arrays eig_k and occ_k contain the *full* set of eigenvalues and occupation
2187 : : !! factors stored in the file and are dimensioned with wfk%mband.
2188 : : !!
2189 : : !! SOURCE
2190 : :
2191 [ # # # # : 0 : subroutine wfk_read_bmask(Wfk, bmask, ik_ibz, spin, sc_mode, kg_k, cg_k, eig_k, occ_k)
# # # # #
# # # ]
2192 : :
2193 : : !Arguments ------------------------------------
2194 : : !scalars
2195 : : integer,intent(in) :: ik_ibz,spin,sc_mode
2196 : : class(wfk_t),intent(inout) :: Wfk
2197 : : !arrays
2198 : : logical,intent(in) :: bmask(Wfk%mband)
2199 : : integer,intent(out), DEV_CONTARRD optional :: kg_k(:,:) !(3,npw_k)
2200 : : real(dp),intent(out), DEV_CONTARRD optional :: cg_k(:,:) !(2,npw_k*nspinor*nband)
2201 : : real(dp),intent(out),optional :: eig_k((2*Wfk%mband)**Wfk%formeig*Wfk%mband)
2202 : : real(dp),intent(out),optional :: occ_k(Wfk%mband)
2203 : :
2204 : : !Local variables-------------------------------
2205 : : !scalars
2206 : : integer :: npw_disk,nspinor_disk,nband_disk,ipw,my_bcount,cnt,npwso,npw_tot,pt1,pt2,band
2207 : : integer :: npw_read,nspinor_read,nband_read,nb_tot,ncount,my_bcnt,my_maxb,base,nb, ierr
2208 : : character(len=500) :: msg,errmsg
2209 : : !arrays
2210 : 0 : real(dp),contiguous, pointer :: tmp_eigk(:),tmp_occk(:)
2211 : : integer :: mpierr,cgscatter_type,cg_type,method,block,nblocks,nbxblock
2212 : : integer :: bstart,bstop,bufsz,ugsz,brest,max_nband
2213 : : integer(XMPI_OFFSET_KIND) :: my_offset,base_ofs,my_offpad
2214 : : integer :: band_block(2),sizes(2),subsizes(2),starts(2),types(2)
2215 : 0 : integer,allocatable :: block_length(:),block_type(:)
2216 : 0 : integer(XMPI_ADDRESS_KIND),allocatable :: block_displ(:)
2217 : 0 : real(dp),allocatable :: buffer(:,:)
2218 : : integer :: kg_varid,eig_varid,occ_varid,cg_varid,ncerr
2219 : 0 : integer,allocatable :: blocks(:,:)
2220 : : !************************************************************************
2221 : :
2222 : : DBG_ENTER("COLL")
2223 : :
2224 : 0 : ABI_CHECK_IEQ(Wfk%rw_mode, WFK_READMODE, "Wfk must be in READMODE")
2225 : :
2226 : : !do band=1,wfk%mband
2227 : : ! if (.not. bmask(band)) continue
2228 : : ! if (wfk_validate_ks(wfk, ik_ibz, spin, band=band) /= 0) then
2229 : : ! ABI_ERROR("Wrong (ik_ibz, spin, band) args, Aborting now")
2230 : : ! end if
2231 : : !end if
2232 : :
2233 : : ! Look before you leap.
2234 : 0 : npw_disk = Wfk%Hdr%npwarr(ik_ibz)
2235 : 0 : nspinor_disk = Wfk%nspinor
2236 : 0 : nband_disk = Wfk%nband(ik_ibz,spin)
2237 [ # # # # ]: 0 : nb_tot = COUNT(bmask)
2238 : 0 : npw_tot = npw_disk * nspinor_disk * nb_tot
2239 : :
2240 [ # # ]: 0 : if (present(kg_k)) then
2241 [ # # ]: 0 : ABI_CHECK((SIZE(kg_k,DIM=2) >= npw_disk),"kg_k too small")
2242 : : end if
2243 : :
2244 [ # # ]: 0 : if (present(cg_k)) then
2245 [ # # ]: 0 : ABI_CHECK(SIZE(cg_k, DIM=2) >= npw_tot, "Too small cg_k")
2246 : : end if
2247 : :
2248 [ # # ]: 0 : if (present(eig_k)) then
2249 [ # # ]: 0 : if (Wfk%formeig==0) then
2250 [ # # ]: 0 : ABI_CHECK(SIZE(eig_k) >= nband_disk, "GS eig_k too small")
2251 [ # # ]: 0 : else if (Wfk%formeig==1) then
2252 [ # # ]: 0 : ABI_CHECK(SIZE(eig_k) >= 2*nband_disk**2, "DFPT eig_k too small")
2253 : : else
2254 : 0 : ABI_ERROR("formeig != [0,1]")
2255 : : end if
2256 : : end if
2257 : :
2258 [ # # ]: 0 : if (present(occ_k)) then
2259 [ # # ]: 0 : ABI_CHECK(Wfk%formeig==0,"occ_k with formeig != 0")
2260 [ # # ]: 0 : ABI_CHECK(SIZE(occ_k) >= nband_disk, "GS eig_k too small")
2261 : : end if
2262 : :
2263 : 0 : select case (Wfk%iomode)
2264 : : case (IO_MODE_FORTRAN)
2265 : :
2266 : : ! Rewind the file to have the correct (k,s) block (if needed)
2267 : 0 : call wfk_seek(Wfk, ik_ibz, spin)
2268 : :
2269 : : ! Read the first record: npw, nspinor, nband_disk
2270 [ # # ]: 0 : read(Wfk%fh, err=10, iomsg=errmsg) npw_read, nspinor_read, nband_read
2271 : :
2272 [ # # # # : 0 : if (any([npw_read, nspinor_read, nband_read] /= [npw_disk, nspinor_disk, nband_disk])) then
# # ]
2273 : 0 : write(msg,"(a,6(i0,2x))")"Mismatch between (npw, nspinor, nband) read from WFK and those found in HDR ",&
2274 : 0 : npw_read, nspinor_read, nband_read, npw_disk, nspinor_disk, nband_disk
2275 : 0 : ABI_ERROR(msg)
2276 : : end if
2277 : :
2278 : : ! The second record: (k+G) vectors
2279 [ # # ]: 0 : if (present(kg_k)) then
2280 [ # # ]: 0 : read(Wfk%fh, err=10, iomsg=errmsg) kg_k(1:3,1:npw_disk)
2281 : : else
2282 [ # # ]: 0 : read(Wfk%fh, err=10, iomsg=errmsg) ! kg_k(1:3,1:npw_disk)
2283 : : end if
2284 : :
2285 : : ! The third record: eigenvalues and occupation factors.
2286 [ # # ]: 0 : if (Wfk%formeig == 0) then
2287 : :
2288 [ # # ]: 0 : if (present(eig_k) .or. present(occ_k)) then
2289 [ # # # # : 0 : ABI_MALLOC(tmp_eigk, (nband_disk))
# # # # #
# # # ]
2290 [ # # # # : 0 : ABI_MALLOC(tmp_occk, (nband_disk))
# # # # ]
2291 : :
2292 [ # # # # : 0 : read(Wfk%fh, err=10, iomsg=errmsg) tmp_eigk, tmp_occk
# # ]
2293 : :
2294 [ # # # # ]: 0 : if (present(eig_k)) eig_k = tmp_eigk
2295 [ # # # # ]: 0 : if (present(occ_k)) occ_k = tmp_occk
2296 [ # # ]: 0 : ABI_FREE(tmp_eigk)
2297 [ # # ]: 0 : ABI_FREE(tmp_occk)
2298 : :
2299 : : else
2300 [ # # ]: 0 : read(Wfk%fh, err=10, iomsg=errmsg) ! eig_k(1:nband_disk)
2301 : : end if
2302 : :
2303 : : ! The wave-functions.
2304 [ # # ]: 0 : if (present(cg_k)) then
2305 : : npwso = npw_disk*nspinor_disk
2306 : : my_bcount = 0
2307 [ # # ]: 0 : do band=1,nband_disk
2308 [ # # ]: 0 : if (bmask(band)) then
2309 : 0 : ipw = my_bcount * npwso
2310 : 0 : my_bcount = my_bcount + 1
2311 [ # # ]: 0 : read(Wfk%fh, err=10, iomsg=errmsg) cg_k(1:2,ipw+1:ipw+npwso)
2312 : : else
2313 [ # # ]: 0 : read(Wfk%fh, err=10, iomsg=errmsg) ! cg_k(1:2,ipw+1:ipw+npwso)
2314 : : end if
2315 : : end do
2316 : :
2317 : : else
2318 [ # # ]: 0 : do band=1,nband_disk
2319 [ # # ]: 0 : read(Wfk%fh, err=10, iomsg=errmsg) ! cg_k(1:2,ipw+1:ipw+npwso)
2320 : : end do
2321 : : end if
2322 : :
2323 [ # # ]: 0 : else if (Wfk%formeig == 1) then
2324 : : ! Read matrix of size (2*nband_k**2)
2325 : : npwso = npw_disk*nspinor_disk
2326 : : my_bcount = 0
2327 : :
2328 [ # # ]: 0 : do band=1,nband_disk
2329 : 0 : base = 2*(band-1)*nband_disk
2330 [ # # ]: 0 : if (present(eig_k)) then
2331 [ # # ]: 0 : read(Wfk%fh, err=10, iomsg=errmsg) eig_k(base+1:base+2*nband_disk)
2332 : : else
2333 [ # # ]: 0 : read(Wfk%fh, err=10, iomsg=errmsg) ! eig_k(base+1:base+2*nband_disk)
2334 : : end if
2335 : :
2336 [ # # # # ]: 0 : if (bmask(band) .and. present(cg_k)) then
2337 : 0 : ipw = my_bcount * npwso
2338 : 0 : my_bcount = my_bcount + 1
2339 [ # # ]: 0 : read(Wfk%fh, err=10, iomsg=errmsg) cg_k(1:2,ipw+1:ipw+npwso)
2340 : : else
2341 [ # # ]: 0 : read(Wfk%fh, err=10, iomsg=errmsg) ! cg_k(1:2,ipw+1:ipw+npwso)
2342 : : end if
2343 : : end do
2344 : :
2345 : : else
2346 : 0 : ABI_ERROR("formeig != [0,1]")
2347 : : end if
2348 : :
2349 : : ! Reached the end of the (k,s) block. Update f90_fptr
2350 : 0 : call wfk_update_f90ptr(wfk, ik_ibz, spin)
2351 : :
2352 : : #ifdef HAVE_MPI_IO
2353 : : case (IO_MODE_MPI)
2354 [ # # ]: 0 : if (present(kg_k)) then
2355 : 0 : my_offset = Wfk%offset_ks(ik_ibz,spin,REC_KG) + xmpio_bsize_frm
2356 : :
2357 [ # # # # : 0 : call mpio_read_kg_k(Wfk%fh,my_offset,npw_disk,sc_mode,kg_k,mpierr)
# # # # #
# ]
2358 : 0 : ABI_CHECK_MPI(mpierr, "mpio_read_kg_k")
2359 : : end if
2360 : :
2361 : : ! The third record: eigenvalues and occupation factors.
2362 [ # # ]: 0 : if (present(eig_k) .or. present(occ_k)) then
2363 : 0 : my_offset = Wfk%offset_ks(ik_ibz,spin,REC_EIG) + xmpio_bsize_frm
2364 : : !
2365 : : ! formeig=0 => Read both eig and occ in tmp_eigk.
2366 : : ! formeig=1 => Read (nband_k,nband_k) matrix of complex numbers.
2367 : : !
2368 : 0 : call mpio_read_eigocc_k(Wfk%fh,my_offset,nband_disk,Wfk%formeig,sc_mode,tmp_eigk,mpierr)
2369 : 0 : ABI_CHECK_MPI(mpierr, "mpio_read_eigocc")
2370 : :
2371 [ # # ]: 0 : if (Wfk%formeig == 0) then
2372 [ # # # # ]: 0 : if (present(eig_k)) eig_k(1:nband_disk) = tmp_eigk(1:nband_disk)
2373 [ # # # # ]: 0 : if (present(occ_k)) occ_k(1:nband_disk) = tmp_eigk(nband_disk+1:)
2374 [ # # ]: 0 : else if (Wfk%formeig == 1) then
2375 [ # # # # ]: 0 : if (present(eig_k)) eig_k(1:2*nband_disk**2) = tmp_eigk(1:2*nband_disk**2)
2376 : : else
2377 : 0 : ABI_ERROR("formeig not in [0,1]")
2378 : : end if
2379 : :
2380 [ # # ]: 0 : ABI_FREE(tmp_eigk)
2381 : : end if
2382 : :
2383 [ # # ]: 0 : if (present(cg_k)) then
2384 : 0 : method = 0
2385 : :
2386 : 0 : select case (method)
2387 : : case (0)
2388 : : ! DATA SIEVING:
2389 : : ! read max_nband states in chuncks of nbxblock, then extract my states according to bmask.
2390 : : !
2391 : : ! MAX number of bands read by the procs in the communicator
2392 : 0 : my_maxb = nband_disk
2393 [ # # ]: 0 : do band=nband_disk,1,-1
2394 [ # # ]: 0 : if (bmask(band)) then
2395 : 0 : my_maxb = band
2396 : 0 : EXIT
2397 : : end if
2398 : : end do
2399 : 0 : call xmpi_max(my_maxb, max_nband, Wfk%comm, mpierr)
2400 : : !max_nband = nband_disk
2401 : : !
2402 : : ! MPI-IO crashes if we try to read a large number of bands in a single call.
2403 : 0 : nbxblock = max_nband
2404 [ # # ]: 0 : if ((two * npw_disk *nspinor_disk * nbxblock * xmpi_bsize_dp) > Wfk%chunk_bsize) then
2405 : 0 : nbxblock = Wfk%chunk_bsize / (2*npw_disk*nspinor_disk*xmpi_bsize_dp)
2406 [ # # ]: 0 : if (nbxblock == 0) nbxblock = 50
2407 : : end if
2408 : : !nbxblock = 2
2409 : :
2410 : 0 : nblocks = max_nband / nbxblock
2411 : 0 : brest = MOD(max_nband, nbxblock)
2412 [ # # ]: 0 : if (brest /= 0) nblocks = nblocks + 1
2413 : :
2414 : : !write(std_out, *) "full_size:", 2 * npw_disk *nspinor_disk *nbxblock * xmpi_bsize_dp, Wfk%chunk_bsize
2415 : : !write(std_out,*)"in buffered bmask with nblocks:", nblocks, ", nbxblock: ", nbxblock
2416 : :
2417 : 0 : base_ofs = Wfk%offset_ks(ik_ibz, spin, REC_CG)
2418 [ # # ]: 0 : sizes = [npw_disk * nspinor_disk, nband_disk]
2419 : :
2420 : 0 : my_bcnt = 0 ! index of my band in cg_k
2421 [ # # ]: 0 : do block=1,nblocks
2422 : 0 : bstart = 1 + (block-1) * nbxblock
2423 : 0 : bstop = bstart + nbxblock - 1
2424 : 0 : if (bstop > max_nband) bstop = max_nband
2425 : 0 : nb = bstop - bstart + 1
2426 : :
2427 : : ! Allocate and read the buffer
2428 : : ! Note that in the API calls we mix real and complex.
2429 : : ! bufsz is the size in terms of complex numbers.
2430 [ # # ]: 0 : band_block = [bstart, bstop]
2431 : 0 : ugsz = npw_disk*nspinor_disk
2432 : 0 : bufsz = ugsz * (bstop - bstart + 1)
2433 : : !write(std_out,*)" bstart, bstop:", band_block
2434 [ # # # # : 0 : ABI_MALLOC_OR_DIE(buffer, (2, bufsz), ierr)
# # # # #
# # # #
# ]
2435 : :
2436 : : ! Read the cg_ks(G). different versions depending on formeig
2437 [ # # ]: 0 : if (wfk%formeig == 0) then
2438 [ # # ]: 0 : subsizes = [npw_disk*nspinor_disk, band_block(2)-band_block(1)+1]
2439 [ # # ]: 0 : starts = [1, bstart]
2440 : :
2441 : : call mpiotk_read_fsuba_dp2D(Wfk%fh,base_ofs,sizes,subsizes,starts,&
2442 : 0 : 2 * bufsz,buffer,Wfk%chunk_bsize,sc_mode,Wfk%comm,mpierr)
2443 [ # # ]: 0 : ABI_CHECK(mpierr == 0, "Fortran record too big")
2444 : :
2445 : : ! New version based: master reads and broadcasts the buffer.
2446 : : !if (wfk%my_rank == 0) then
2447 : : ! call mpiotk_read_fsuba_dp2D(Wfk%fh,base_ofs,sizes,subsizes,starts,&
2448 : : ! 2 * bufsz,buffer,Wfk%chunk_bsize,xmpio_single,wfk%comm,mpierr)
2449 : : ! ABI_CHECK(mpierr == 0, "Fortran record too big")
2450 : : !end if
2451 : : !call xmpi_bcast(buffer, 0, wfk%comm, ierr)
2452 : :
2453 [ # # ]: 0 : else if (wfk%formeig == 1) then
2454 : :
2455 : : ! Increment my_offset to account for the previous eigen and cg records of (iband-1) bands.
2456 : 0 : my_offset = wfk%offset_ks(ik_ibz,spin,REC_CG) + xmpio_bsize_frm
2457 : : my_offset = my_offset + (bstart - 1) * ( &
2458 : : (2*npw_disk*wfk%nspinor*xmpi_bsize_dp + 2*xmpio_bsize_frm) + &
2459 : 0 : (2*nband_disk*xmpi_bsize_dp + 2*xmpio_bsize_frm) )
2460 : :
2461 [ # # ]: 0 : sizes = [npw_disk*nspinor_disk, nband_disk]
2462 : 0 : types = [MPI_DOUBLE_COMPLEX, MPI_DOUBLE_COMPLEX]
2463 : :
2464 : 0 : call xmpio_create_fstripes(nb,sizes,types,cg_type,my_offpad,mpierr)
2465 : 0 : ABI_CHECK_MPI(mpierr, "xmpio_create_fstripes")
2466 : :
2467 : 0 : call MPI_FILE_SET_VIEW(wfk%fh,my_offset,MPI_BYTE,cg_type,'native',xmpio_info,mpierr)
2468 : 0 : ABI_CHECK_MPI(mpierr, "SET_VIEW")
2469 : 0 : call MPI_TYPE_FREE(cg_type,mpierr)
2470 : 0 : ABI_CHECK_MPI(mpierr, "TYPE_FREE")
2471 : :
2472 [ # # ]: 0 : if (sc_mode == xmpio_collective) then
2473 : 0 : call MPI_FILE_READ_ALL(wfk%fh,buffer,bufsz,MPI_DOUBLE_COMPLEX,MPI_STATUS_IGNORE,mpierr)
2474 [ # # ]: 0 : else if (sc_mode == xmpio_single) then
2475 : 0 : call MPI_FILE_READ(wfk%fh,buffer,bufsz,MPI_DOUBLE_COMPLEX,MPI_STATUS_IGNORE,mpierr)
2476 : : else
2477 : 0 : ABI_ERROR("Wrong sc_mode")
2478 : : end if
2479 : 0 : ABI_CHECK_MPI(mpierr, "FILE_READ")
2480 : : end if
2481 : :
2482 : : ! Extract my bands from buffer.
2483 [ # # ]: 0 : do band=bstart,bstop
2484 [ # # ]: 0 : if (bmask(band)) then
2485 : 0 : my_bcnt = my_bcnt + 1
2486 : 0 : pt1 = 1 + (my_bcnt - 1) * ugsz
2487 : 0 : pt2 = 1 + (band - bstart) * ugsz
2488 [ # # # # ]: 0 : cg_k(:,pt1:pt1+ugsz-1) = buffer(:,pt2:pt2+ugsz-1)
2489 : : end if
2490 : : end do
2491 : :
2492 [ # # ]: 0 : ABI_FREE(buffer)
2493 : : end do
2494 : :
2495 : : case (1, 2)
2496 : : ABI_CHECK(wfk%formeig == 0, "formeig == 1 not coded")
2497 : : call MPI_TYPE_CONTIGUOUS(npw_disk*nspinor_disk,MPI_DOUBLE_COMPLEX,cg_type,mpierr)
2498 : : ABI_CHECK_MPI(mpierr, "type_contigous")
2499 : :
2500 : : if (method == 1) then
2501 : : ncount = nb_tot
2502 : : ABI_MALLOC(block_length, (ncount+2))
2503 : : ABI_MALLOC(block_type, (ncount+2))
2504 : : ABI_MALLOC(block_displ, (ncount+2))
2505 : :
2506 : : block_length(1)=1
2507 : : block_displ (1)=0
2508 : : block_type (1)=MPI_LB
2509 : :
2510 : : my_bcount = 1
2511 : : do band=1,Wfk%mband
2512 : : if (bmask(band)) then
2513 : : my_bcount = my_bcount + 1
2514 : : block_length(my_bcount) = 1
2515 : : block_type(my_bcount) = cg_type
2516 : : block_displ(my_bcount) = xmpio_bsize_frm + &
2517 : : (band-1) * (2*npw_disk*nspinor_disk*xmpi_bsize_dp + 2*xmpio_bsize_frm)
2518 : : end if
2519 : : end do
2520 : :
2521 : : block_length(ncount+2) = 1
2522 : : block_displ (ncount+2) = block_displ(my_bcount)
2523 : : block_type (ncount+2) = MPI_UB
2524 : :
2525 : : else if (method == 2) then
2526 : : ! this file view is not efficient but it's similar to the
2527 : : ! one used in wff_readwrite. Let's see if MPI-IO likes it!
2528 : : ncount = nb_tot* nspinor_disk * npw_disk
2529 : :
2530 : : ABI_MALLOC(block_length, (ncount+2))
2531 : : ABI_MALLOC(block_type, (ncount+2))
2532 : : ABI_MALLOC(block_displ, (ncount+2))
2533 : :
2534 : : block_length(1)=1
2535 : : block_displ (1)=0
2536 : : block_type (1)=MPI_LB
2537 : : !
2538 : : ! The view starts at REC_CG
2539 : : cnt = 1
2540 : : do band=1,Wfk%mband
2541 : : if (bmask(band)) then
2542 : : base_ofs = xmpio_bsize_frm + &
2543 : : (band-1) * (2*npw_disk*nspinor_disk*xmpi_bsize_dp + 2*xmpio_bsize_frm)
2544 : : do ipw=1,npw_disk*nspinor_disk
2545 : : cnt = cnt + 1
2546 : : block_length(cnt) = 1
2547 : : block_type(cnt) = MPI_DOUBLE_COMPLEX
2548 : : block_displ(cnt) = base_ofs + 2*(ipw-1)*xmpi_bsize_dp
2549 : : end do
2550 : : end if
2551 : : end do
2552 : :
2553 : : block_length(ncount+2) = 1
2554 : : block_displ (ncount+2) = block_displ(cnt)
2555 : : block_type (ncount+2) = MPI_UB
2556 : : end if
2557 : :
2558 : : call xmpio_type_struct(ncount+2,block_length,block_displ,block_type,cgscatter_type,mpierr)
2559 : : ABI_CHECK_MPI(mpierr, "type_struct")
2560 : :
2561 : : ABI_FREE(block_length)
2562 : : ABI_FREE(block_type)
2563 : : ABI_FREE(block_displ)
2564 : :
2565 : : call MPI_TYPE_FREE(cg_type, mpierr)
2566 : : ABI_CHECK_MPI(mpierr, "MPI_TYPE_FREE")
2567 : :
2568 : : my_offset = Wfk%offset_ks(ik_ibz,spin,REC_CG)
2569 : :
2570 : : call MPI_FILE_SET_VIEW(Wfk%fh, my_offset, MPI_BYTE, cgscatter_type, 'native', xmpio_info, mpierr)
2571 : : ABI_CHECK_MPI(mpierr, "SET_VIEW")
2572 : :
2573 : : call MPI_TYPE_FREE(cgscatter_type, mpierr)
2574 : : ABI_CHECK_MPI(mpierr, "MPI_TYPE_FREE")
2575 : :
2576 : : call MPI_FILE_READ_ALL(Wfk%fh, cg_k, npw_tot, MPI_DOUBLE_COMPLEX, MPI_STATUS_IGNORE, mpierr)
2577 : : ABI_CHECK_MPI(mpierr, "FILE_READ_ALL")
2578 : :
2579 : : case default
2580 : 0 : ABI_ERROR("Wrong method")
2581 : : end select
2582 : : end if
2583 : : #endif
2584 : :
2585 : : case (IO_MODE_ETSF)
2586 [ # # ]: 0 : ABI_CHECK(wfk%formeig == 0, "formeig != 0 not coded")
2587 : : !write(std_out,*)"bmask: ",bmask
2588 : :
2589 : : ! TODO: extract routines (see other similar calls)
2590 [ # # ]: 0 : if (present(kg_k)) then
2591 : : ! Read the reduced_coordinates_of_plane_waves for this k point.
2592 [ # # ]: 0 : NCF_CHECK(nf90_inq_varid(wfk%fh, "reduced_coordinates_of_plane_waves", kg_varid))
2593 [ # # # # ]: 0 : if (sc_mode == xmpio_collective .and. wfk%nproc > 1) then
2594 [ # # ]: 0 : NCF_CHECK(nctk_set_collective(wfk%fh, kg_varid))
2595 : : end if
2596 : :
2597 [ # # # # ]: 0 : ncerr = nf90_get_var(wfk%fh, kg_varid, kg_k, start=[1,1,ik_ibz], count=[3,npw_disk,1])
2598 [ # # ]: 0 : NCF_CHECK(ncerr)
2599 : : end if
2600 : :
2601 : : ! Read eigenvalues and occupations.
2602 [ # # ]: 0 : if (Wfk%formeig==0) then
2603 [ # # ]: 0 : if (present(eig_k)) then
2604 [ # # ]: 0 : NCF_CHECK(nf90_inq_varid(wfk%fh, "eigenvalues", eig_varid))
2605 [ # # # # ]: 0 : if (sc_mode == xmpio_collective .and. wfk%nproc > 1) then
2606 [ # # ]: 0 : NCF_CHECK(nctk_set_collective(wfk%fh, eig_varid))
2607 : : end if
2608 : :
2609 [ # # # # ]: 0 : ncerr = nf90_get_var(wfk%fh, eig_varid, eig_k, start=[1,ik_ibz,spin], count=[nband_disk,1,1])
2610 [ # # ]: 0 : NCF_CHECK(ncerr)
2611 : : end if
2612 : :
2613 [ # # ]: 0 : if (present(occ_k)) then
2614 [ # # ]: 0 : NCF_CHECK(nf90_inq_varid(wfk%fh, "occupations", occ_varid))
2615 [ # # # # ]: 0 : if (sc_mode == xmpio_collective .and. wfk%nproc > 1) then
2616 [ # # ]: 0 : NCF_CHECK(nctk_set_collective(wfk%fh, occ_varid))
2617 : : end if
2618 : :
2619 [ # # # # ]: 0 : ncerr = nf90_get_var(wfk%fh, occ_varid, occ_k, start=[1,ik_ibz,spin], count=[nband_disk,1,1])
2620 [ # # ]: 0 : NCF_CHECK_MSG(ncerr, "getting occ_k")
2621 : : end if
2622 : : else
2623 : 0 : ABI_ERROR("formeig !=0 not compatible with ETSF-IO")
2624 : : end if
2625 : :
2626 [ # # ]: 0 : if (present(cg_k)) then
2627 : : ! The coefficients_of_wavefunctions on file have shape [cplex, mpw, nspinor, mband, nkpt, nsppol]
2628 [ # # ]: 0 : NCF_CHECK(nf90_inq_varid(wfk%fh, "coefficients_of_wavefunctions", cg_varid))
2629 : : ! TODO: Collective
2630 : : !if (sc_mode == xmpio_collective .and. wfk%nproc > 1) then
2631 : : ! NCF_CHECK(nctk_set_collective(wfk%fh, cg_varid))
2632 : : !end if
2633 : : #if 0
2634 : : ! Simple and very inefficient version for debugging.
2635 : : ipw = 1
2636 : : do band=1,wfk%mband
2637 : : if (.not. bmask(band)) cycle
2638 : : ncerr = nf90_get_var(wfk%fh, cg_varid, cg_k(:,ipw:), start=[1,1,1,band,ik_ibz,spin], &
2639 : : count=[2,npw_disk,wfk%nspinor,1,1,1])
2640 : : NCF_CHECK_MSG(ncerr, "getting cg_k block")
2641 : : ipw = ipw + wfk%nspinor * npw_disk
2642 : : end do
2643 : : #else
2644 : : ! Read bands in blocks defined by bmask.
2645 : : ! be careful when in collective mode because processors may call the routine with nblocks==0
2646 : : ! The coefficients_of_wavefunctions on file have shape [cplex, mpw, nspinor, mband, nkpt, nsppol]
2647 : 0 : call mask2blocks(bmask, nblocks, blocks)
2648 : : !ABI_CHECK(nblocks /= 0, "nblocks==0")
2649 : :
2650 : 0 : ipw = 1
2651 [ # # ]: 0 : do block=1,nblocks
2652 [ # # ]: 0 : band_block = blocks(:,block)
2653 : 0 : nb = band_block(2) - band_block(1) + 1
2654 : : ncerr = nf90_get_var(wfk%fh, cg_varid, cg_k(:,ipw:), start=[1,1,1,band_block(1),ik_ibz,spin], &
2655 [ # # # # ]: 0 : count=[2,npw_disk,wfk%nspinor,nb,1,1])
2656 [ # # ]: 0 : NCF_CHECK_MSG(ncerr, "getting cg_k block")
2657 : 0 : ipw = ipw + wfk%nspinor * npw_disk * nb
2658 : : end do
2659 [ # # ]: 0 : ABI_FREE(blocks)
2660 : : #endif
2661 : :
2662 : : ! Prototype for collective version.
2663 : : !min_band = lfind(bmask); if min_
2664 : : !max_band = lfind(bmask, back=.True.) ! n+1
2665 : : !! TODO: xmpi_min_max
2666 : : !call xmpi_max(my_min_band, min_band, comm_cell, ierr)
2667 : : !call xmpi_min(my_min_band, max_band, comm_cell, ierr)
2668 : : !nb = max_band - min_band + 1
2669 : : !ncalls = nb /
2670 : :
2671 : : !NCF_CHECK(nf90_var_par_access(ncid, cg_varid, nf90_collective))
2672 : : !do block=1,nblocks
2673 : : ! ! The coefficients_of_wavefunctions on file have shape [cplex, mpw, nspinor, mband, nkpt, nsppol]
2674 : : ! ncerr = nf90_get_var(wfk%fh, cg_varid, cg_k, start=[1,1,1,band_block(1),ik_ibz,spin], &
2675 : : ! count=[2,npw_disk,wfk%nspinor,band_block(2)-band_block(1)+1,1,1])
2676 : : ! NCF_CHECK_MSG(ncerr, "getting cg_k block")
2677 : : ! do band=band_start,band_end
2678 : : ! if (.not. bmask(band)) cycle
2679 : : ! cg_k(:,:) =
2680 : : ! end do
2681 : : !end do
2682 : : end if
2683 : :
2684 : : case default
2685 [ # # # # ]: 0 : ABI_ERROR(sjoin('Wrong/unsupported value of iomode: ', itoa(wfk%iomode)))
2686 : : end select
2687 : :
2688 : : DBG_EXIT("COLL")
2689 : :
2690 : 0 : return
2691 : :
2692 : : ! Handle Fortran IO error
2693 : : 10 continue
2694 : 0 : ABI_ERROR(errmsg)
2695 : :
2696 [ # # # # : 0 : end subroutine wfk_read_bmask
# # # # #
# ]
2697 : : !!***
2698 : :
2699 : : !----------------------------------------------------------------------
2700 : :
2701 : : !!****f* m_wfk/wfk_read_ebands
2702 : : !! NAME
2703 : : !! wfk_read_ebands
2704 : : !!
2705 : : !! FUNCTION
2706 : : !! Read the GS eigenvalues and return ebands_t object.
2707 : : !!
2708 : : !! INPUTS
2709 : : !! path=WFK file name
2710 : : !! comm=MPI communicator
2711 : : !!
2712 : : !! OUTPUTS
2713 : : !! ebands<ebands_t>=GS band-structure.
2714 : : !! [out_hdr]=Abinit header.
2715 : : !!
2716 : : !! SOURCE
2717 : :
2718 : 113 : type(ebands_t) function wfk_read_ebands(path, comm, out_hdr) result(ebands)
2719 : :
2720 : : !Arguments ------------------------------------
2721 : : !scalars
2722 : : character(len=*),intent(in) :: path
2723 : : integer,intent(in) :: comm
2724 : : type(hdr_type),optional,intent(inout) :: out_hdr ! ifort and others are buggy for optional intent(out) structured types
2725 : :
2726 : : !Local variables-------------------------------
2727 : : !scalars
2728 : 113 : type(hdr_type) :: hdr
2729 : : !arrays
2730 : 113 : real(dp),pointer :: eigen(:,:,:)
2731 : : !************************************************************************
2732 : :
2733 : 113 : call wfk_read_eigenvalues(path, eigen, hdr, comm)
2734 [ + + - + ]: 8338 : call ebands%from_hdr(hdr, maxval(hdr%nband), eigen)
2735 [ + + ]: 113 : if (present(out_hdr)) call hdr%copy(out_hdr)
2736 : :
2737 [ - + ]: 113 : ABI_FREE(eigen)
2738 : 113 : call hdr%free()
2739 : :
2740 [ - + - + : 226 : end function wfk_read_ebands
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - -
- - - - -
- - - - -
- - ]
2741 : : !!***
2742 : :
2743 : : !----------------------------------------------------------------------
2744 : :
2745 : : !!****f* m_wfk/wfk_read_eigk
2746 : : !! NAME
2747 : : !! wfk_read_eigk
2748 : : !!
2749 : : !! FUNCTION
2750 : : !! Helper function to read all the eigenvalues for a given (k-point,spin)
2751 : : !!
2752 : : !! INPUTS
2753 : : !! Wfk<class(wfk_t)>= WFK file handler
2754 : : !! ik_ibz=Index of the k-point in the IBZ.
2755 : : !! spin=spin index
2756 : : !! sc_mode= MPI-IO option
2757 : : !! xmpio_single ==> for reading by current proc.
2758 : : !! xmpio_collective ==> for collective reading.
2759 : : !!
2760 : : !! OUTPUTS
2761 : : !! eig_k(1:nband_k) = GS Eigenvalues for the given (k,s)
2762 : : !! occ_k(1:nband_k) = Occupation factors for the given (k,s)
2763 : : !!
2764 : : !! NOTES
2765 : : !! The buffers eig_k and occ_k are dimensions with wfk%mband. The routine
2766 : : !! will fill the first nband_k positions with data read from file where
2767 : : !! nband_k is the number of bands on file i.e. wfk%nband(ik_ibz,spin)
2768 : : !!
2769 : : !! SOURCE
2770 : :
2771 : 15678 : subroutine wfk_read_eigk(Wfk,ik_ibz,spin,sc_mode,eig_k,occ_k)
2772 : :
2773 : : !Arguments ------------------------------------
2774 : : !scalars
2775 : : integer,intent(in) :: ik_ibz,spin,sc_mode
2776 : : class(wfk_t),intent(inout) :: Wfk
2777 : : !arrays
2778 : : real(dp),intent(out) :: eig_k((2*Wfk%mband)**Wfk%formeig*Wfk%mband)
2779 : : real(dp),optional,intent(out) :: occ_k(Wfk%mband)
2780 : :
2781 : : !Local variables-------------------------------
2782 : : !scalars
2783 : : integer,parameter :: band_block00(2) = [0, 0]
2784 : : !************************************************************************
2785 : :
2786 [ - + ]: 15678 : if (present(occ_k)) then
2787 [ # # ]: 0 : ABI_CHECK(Wfk%formeig == 0, "formeig !=0")
2788 : 0 : call wfk%read_band_block(band_block00,ik_ibz,spin,sc_mode,eig_k=eig_k,occ_k=occ_k)
2789 : : else
2790 : 15678 : call wfk%read_band_block(band_block00,ik_ibz,spin,sc_mode,eig_k=eig_k)
2791 : : end if
2792 : :
2793 : 15678 : end subroutine wfk_read_eigk
2794 : : !!***
2795 : :
2796 : : !----------------------------------------------------------------------
2797 : :
2798 : : !!****f* m_wfk/wfk_read_eigenvalues
2799 : : !! NAME
2800 : : !! wfk_read_eigenvalues
2801 : : !!
2802 : : !! FUNCTION
2803 : : !! Read all the GS eigenvalues stored in the WFK file fname.
2804 : : !!
2805 : : !! INPUTS
2806 : : !! fname=Name of the file
2807 : : !! comm=MPI communicator.
2808 : : !!
2809 : : !! OUTPUTS
2810 : : !! eigen = In input: nullified pointer
2811 : : !! In output: eigen(mband,nkpt,nsppol) contains the GS eigevalues.
2812 : : !! Hdr_out<hdr_type>=The header of the file
2813 : : !!
2814 : : !! SOURCE
2815 : :
2816 [ - + - + : 510 : subroutine wfk_read_eigenvalues(fname, eigen, Hdr_out, comm, occ)
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - - - -
- - - - -
- - - -
- ]
2817 : :
2818 : : !Arguments ------------------------------------
2819 : : !scalars
2820 : : integer,intent(in) :: comm
2821 : : character(len=*),intent(in) :: fname
2822 : : type(hdr_type),intent(out) :: Hdr_out
2823 : : !arrays
2824 : : !TODO: Replace pointers with allocatable.
2825 : : real(dp),pointer :: eigen(:,:,:)
2826 : : real(dp),pointer,optional :: occ(:,:,:)
2827 : :
2828 : : !Local variables-------------------------------
2829 : : !scalars
2830 : : integer,parameter :: master = 0, formeig0 = 0
2831 : : integer :: ik_ibz,spin,my_rank,ierr,iomode,funt,sc_mode,mband
2832 : : real(dp) :: cpu, wall, gflops, cpu_io, wall_io, gflops_io
2833 [ + + - + ]: 2040 : type(wfk_t) :: Wfk
2834 : : !************************************************************************
2835 : :
2836 : 510 : call cwtime(cpu, wall, gflops, "start")
2837 : 510 : my_rank = xmpi_comm_rank(comm)
2838 : 510 : iomode = iomode_from_fname(fname)
2839 : :
2840 : : ! Should not do this but it seems that read_eigk with IO_MODE_MPI is very inefficient when
2841 : : ! we read files with lots of k-points.
2842 [ - + ]: 510 : if (iomode == IO_MODE_MPI) iomode = IO_MODE_FORTRAN
2843 : :
2844 : 510 : call wrtout(std_out, sjoin(" Reading eigenvalues from:", fname, ", with iomode:", iomode2str(iomode)))
2845 : :
2846 [ + + ]: 510 : if (my_rank == master) then
2847 : : ! Master reads and broadcasts
2848 : 450 : call cwtime(cpu_io, wall_io, gflops_io, "start")
2849 : :
2850 : : ! Open the file.
2851 : 450 : sc_mode = xmpio_single
2852 : 450 : funt = get_unit()
2853 : 450 : call wfk%open_read(fname, formeig0, iomode, funt, xmpi_comm_self, Hdr_out=Hdr_out)
2854 : :
2855 : : ! Read the eigenvalues and optionally the occupation factors.
2856 [ - + + - : 2250 : ABI_MALLOC(eigen, (Wfk%mband, Wfk%nkpt, Wfk%nsppol))
- + + - -
+ + - + -
+ - - + -
+ ]
2857 [ + + + + : 192540 : eigen = HUGE(zero)
+ + ]
2858 [ - + ]: 450 : if (present(occ)) then
2859 [ # # # # : 0 : ABI_MALLOC(occ, (Wfk%mband, Wfk%nkpt, Wfk%nsppol))
# # # # #
# # # # #
# # ]
2860 [ # # # # : 0 : occ = HUGE(zero)
# # ]
2861 : : end if
2862 : :
2863 [ + + ]: 907 : do spin=1,Wfk%nsppol
2864 [ + + ]: 12015 : do ik_ibz=1,Wfk%nkpt
2865 [ - + ]: 11565 : if (present(occ)) then
2866 [ # # # # ]: 0 : call wfk%read_eigk(ik_ibz, spin, sc_mode, eigen(:,ik_ibz,spin), occ_k=occ(:,ik_ibz,spin))
2867 : : else
2868 [ - + ]: 11108 : call wfk%read_eigk(ik_ibz, spin, sc_mode, eigen(:,ik_ibz,spin))
2869 : : end if
2870 : : end do
2871 : : end do
2872 : :
2873 : : ! Close the file.
2874 : 450 : call wfk%close()
2875 : 900 : call cwtime_report(" wfk_read_eigenvalues_io", cpu_io, wall_io, gflops_io)
2876 : : end if
2877 : :
2878 : : ! Broadcast data
2879 [ + + ]: 510 : if (xmpi_comm_size(comm) > 1) then
2880 : 90 : call Hdr_out%bcast(master, my_rank, comm)
2881 [ + + ]: 1086 : mband = MAXVAL(Hdr_out%nband)
2882 [ + + ]: 90 : if (my_rank /= master) then
2883 [ - + + - : 300 : ABI_MALLOC(eigen, (mband, Hdr_out%nkpt, Hdr_out%nsppol))
- + + - -
+ + - + -
+ - - + -
+ ]
2884 [ - + ]: 60 : if (present(occ)) then
2885 [ # # # # : 0 : ABI_MALLOC(occ, (mband, Hdr_out%nkpt, Hdr_out%nsppol))
# # # # #
# # # # #
# # ]
2886 : : end if
2887 : : end if
2888 : 90 : call xmpi_bcast(eigen, master, comm, ierr)
2889 [ - + ]: 90 : if (present(occ)) call xmpi_bcast(occ, master, comm, ierr)
2890 : : end if
2891 : :
2892 : 510 : call cwtime_report(" wfk_read_eigenvalues", cpu, wall, gflops)
2893 : :
2894 [ - + - + : 510 : end subroutine wfk_read_eigenvalues
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - -
- - - - -
- - - - -
- - - + -
+ - + ]
2895 : : !!***
2896 : :
2897 : : !----------------------------------------------------------------------
2898 : :
2899 : : !!****f* m_wfk/wfk_read_my_kptbands
2900 : : !! NAME
2901 : : !! wfk_read_my_kptbands
2902 : : !!
2903 : : !! FUNCTION
2904 : : !! Fill a cg (kg, eigen, occ) array with wavefunctions in a given BZ
2905 : : !! based on a distribution of k, b, s attributed to present processor
2906 : : !!
2907 : : !! INPUTS
2908 : : !! inpath_ = file name
2909 : : !! distrb_flags = logical mask for band, k, spins on this processor
2910 : : !! comm = mpi communicator
2911 : : !! formeig = flag for GS or response function format of eigenvalues
2912 : : !! istwfk_in = reciprocal space storage (reduced PW sphere or not)
2913 : : !! kptns_in = requested k points, to be extracted from file or completed
2914 : : !! nkpt_in = number of requested k
2915 : : !! npwarr = array of number of plane waves at each k
2916 : : !! istwfk_in = storage flag for plane waves
2917 : : !! mcg = max size of cg array
2918 : : !! mband_in = max number of bands over all k
2919 : : !! mband_mem_in = max number of bands stored on each processor
2920 : : !! nkpt_in = total number of k-points
2921 : : !! nspinor_in = number of spinor components 1 or 2
2922 : : !! nsppol_in = number of spin polarization channels
2923 : : !! usepaw_in = enable PAW or not? (1/0)
2924 : : !!
2925 : : !! OUTPUT
2926 : : !! cg = plane wave coefficients
2927 : : !! kg = plane wave coordinates
2928 : : !! eigen = eigenvectors at all bands and my k
2929 : : !! occ = occupations of all bands at my k
2930 : : !! pawrhoij = PAW matrix elements in projectors
2931 : : !!
2932 : : !! SOURCE
2933 : :
2934 : 7814 : subroutine wfk_read_my_kptbands(inpath_, distrb_flags, comm, ecut_eff_in, &
2935 : 3907 : formeig, istwfk_in, kptns_in, mcg, mband_in, mband_mem_in, mkmem_in, mpw_in, &
2936 : 3907 : natom_in, nkpt_in, npwarr, nspinor_in, nsppol_in, usepaw_in, &
2937 : 7193 : cg, kg, eigen, occ, pawrhoij, ask_accurate_)
2938 : :
2939 : : !Arguments ------------------------------------
2940 : : !scalars
2941 : : integer, intent(in) :: comm, nkpt_in, formeig
2942 : : integer, intent(in) :: mcg, mpw_in, mkmem_in
2943 : : integer, intent(in) :: mband_in, mband_mem_in, natom_in, nspinor_in, nsppol_in, usepaw_in
2944 : : real(dp), intent(in) :: ecut_eff_in
2945 : : !=dtset%ecut*(dtset%dilatmx)**2 ! ecut * dilatmx**2
2946 : : !arrays
2947 : : integer, intent(in) :: istwfk_in(nkpt_in)
2948 : : integer, intent(in) :: npwarr(nkpt_in)
2949 : : character(len=fnlen), intent(in) :: inpath_
2950 : : logical, intent(in) :: distrb_flags(nkpt_in,mband_in,nsppol_in)
2951 : : real(dp), intent(in),target :: kptns_in(3,nkpt_in)
2952 : : real(dp), intent(out) :: cg(2,mcg)
2953 : : integer, intent(out), optional :: kg(3,mpw_in*mkmem_in)
2954 : : real(dp), intent(out), optional :: eigen(mband_in*(2*mband_in)**formeig*nkpt_in*nsppol_in)
2955 : : real(dp), intent(out), optional :: occ(mband_in*nkpt_in*nsppol_in)
2956 : : type(pawrhoij_type),intent(inout),optional,target :: pawrhoij(natom_in)
2957 : : integer, intent(in), optional :: ask_accurate_
2958 : :
2959 : : !Local variables-------------------------------
2960 : : !scalars
2961 : : integer,parameter :: formeig0 = 0, master = 0
2962 : : integer :: spin,ikf,ik_disk,nband_k,mpw_disk,mband,nspinor
2963 : : integer :: iomode,nsppol,isym,itimrev
2964 : : integer :: npw_disk,npw_kf,istwf_disk,istwf_kf
2965 : : integer :: ikpt,ii,jj,kk,ll,iqst,nqst
2966 : : integer :: ibdoff, ierr, my_rank
2967 : : integer :: wfk_unt, iband, nband_me, nband_me_disk
2968 : : integer :: nband_me_saved, iband_saved
2969 : : integer :: spin_saved, spin_sym
2970 : : integer :: mpierr
2971 : : integer :: ask_accurate, sppoldbl
2972 : : real(dp) :: cpu, wall, gflops
2973 : : real(dp) :: ecut_eff_disk
2974 : : real(dp) :: dksqmax
2975 : : character(len=fnlen) :: inpath
2976 : : logical :: isirred_kf
2977 : : logical :: needthisk
2978 : : logical :: convnsppol1to2
2979 [ + + ]: 15628 : type(wfk_t),target :: wfk_disk
2980 [ + + + + : 246141 : type(crystal_t) :: cryst
+ + + + +
+ + + + +
+ + + + +
+ ]
2981 : : !arrays
2982 : : integer :: g0(3),work_ngfft(18),gmax_disk(3),gmax_kf(3),gmax(3)
2983 : 3907 : integer,allocatable :: kg_kf(:,:), icg(:,:), ikg(:), ibdeig(:,:), ibdocc(:,:)
2984 : 3907 : integer,allocatable :: symrelT(:,:,:)
2985 : 3907 : integer,allocatable :: rbz2disk(:,:),kg_disk(:,:),iperm(:),rbz2disk_sort(:)
2986 : : real(dp) :: kf(3),k_disk(3), ksym(3)
2987 : 7814 : real(dp),allocatable :: cg_disk(:,:),eig_disk(:),occ_disk(:),work(:,:,:,:)
2988 : : ! *************************************************************************
2989 : :
2990 : 3907 : call cwtime(cpu, wall, gflops, "start")
2991 : :
2992 : 3907 : my_rank = xmpi_comm_rank(comm)
2993 : :
2994 : : ! Master checks the existence of data file
2995 [ + + ]: 3907 : if (my_rank == master) then
2996 : 3405 : inpath = inpath_
2997 [ + - ]: 3405 : if (.not. file_exists(inpath)) then
2998 : : ! Trick needed to run Abinit test suite in netcdf mode.
2999 [ + - ]: 3405 : if (file_exists(nctk_ncify(inpath))) then
3000 : 3405 : write(std_out,"(3a)")"- File: ",trim(inpath)," does not exist but found netcdf file with similar name."
3001 : 6810 : inpath = nctk_ncify(inpath)
3002 : : end if
3003 [ - + ]: 3405 : if (.not. file_exists(inpath)) then
3004 [ # # ]: 0 : ABI_ERROR('Missing data file: '//TRIM(inpath))
3005 : : end if
3006 : : end if
3007 : : end if
3008 : :
3009 : 3907 : call xmpi_bcast(inpath, master, comm, ierr)
3010 : 3907 : call wrtout(std_out, sjoin(" About to read wavefunctions from:", inpath))
3011 : :
3012 : : ! now attack the cg reading
3013 : 3907 : iomode = iomode_from_fname(inpath)
3014 : 3907 : wfk_unt = get_unit()
3015 : :
3016 : : ! TODO: this still does not read in parallel properly:
3017 : : ! if I use xmpi_comm_self only the mother thread gets eigen and cg
3018 : : ! if I use comm and MPIO_stuff then it hangs on this call
3019 : : ! if I impose FORTRAN_IO and xmpio_single it complains the file is already opened by another proc
3020 : : ABI_UNUSED(comm)
3021 : 3907 : call wfk_disk%open_read(inpath, formeig, iomode, wfk_unt, xmpi_comm_self)
3022 : :
3023 [ + - + + ]: 1705626 : if(present(eigen)) eigen = zero
3024 [ + + + + ]: 1277357 : if(present(occ)) occ = zero
3025 [ - + - - : 3907 : if(present(kg)) kg = 0
- - ]
3026 : :
3027 : : ! this initialization is needed in case we read a file with fewer bands and only fill part of cg
3028 [ + + + + ]: 866875879 : cg = zero
3029 : :
3030 : : ! ABI_CHECK(wfk_disk%mband >= mband_in, "input mband too large for this file")
3031 : 3907 : mband = wfk_disk%mband;
3032 [ - + ]: 3907 : ABI_CHECK(wfk_disk%nspinor == nspinor_in, "input nspinor does not agree with file")
3033 : 3907 : nspinor = wfk_disk%nspinor
3034 : : !checks: impose each individual nband conserved wrt disk?
3035 : :
3036 [ - + ]: 3907 : ABI_CHECK(wfk_disk%nsppol <= nsppol_in, "nsppol can not decrease when reading from disk")
3037 : : !ABI_CHECK(wfk_disk%nsppol == nsppol_in, "nsppol does not agree with file")
3038 : 3907 : nsppol = nsppol_in;
3039 : 3907 : convnsppol1to2=.false.
3040 [ + + ]: 3907 : if (wfk_disk%nsppol < nsppol_in) convnsppol1to2 = .true.
3041 : :
3042 : : ! NB: npw can differ as can istwfk
3043 [ + + ]: 99577 : mpw_disk = maxval(wfk_disk%Hdr%npwarr)
3044 : 3907 : ecut_eff_disk = wfk_disk%hdr%ecut_eff ! ecut * dilatmx**2
3045 : :
3046 [ - + + - : 11721 : ABI_MALLOC(kg_disk, (3, mpw_disk))
+ - + - -
+ - + ]
3047 [ - + + - : 11721 : ABI_MALLOC(cg_disk, (2, mpw_disk*nspinor*mband_mem_in))
+ - + - -
+ - + ]
3048 [ - + + - : 11721 : ABI_MALLOC(eig_disk, ((2*mband)**wfk_disk%formeig*mband) )
+ - + - -
+ - + ]
3049 [ - + + - : 11721 : ABI_MALLOC(occ_disk, (mband))
+ - + - -
+ - + ]
3050 : :
3051 : 3907 : itimrev = kpts_timrev_from_kptopt(wfk_disk%hdr%kptopt)
3052 : 3907 : cryst = wfk_disk%hdr%get_crystal(itimrev + 1)
3053 : :
3054 : 3907 : sppoldbl = 1
3055 [ - + + - : 11721 : ABI_MALLOC (rbz2disk, (sppoldbl*nkpt_in, 6))
+ - + - -
+ - + ]
3056 : :
3057 [ - + + - : 11721 : ABI_MALLOC (symrelT, (3,3,cryst%nsym))
+ - + - -
+ - + ]
3058 : : ! TODO: from Matteo, this should be symrel straight, not transposed. Perhaps the logic in mapkptsets is transposed?
3059 [ + + ]: 79736 : do isym=1,cryst%nsym
3060 [ + + + + ]: 989684 : symrelT(:,:,isym) = transpose(cryst%symrel(:,:,isym))
3061 : : end do
3062 : :
3063 : 3907 : ask_accurate=1
3064 [ + + ]: 3907 : if (present(ask_accurate_)) ask_accurate=ask_accurate_
3065 : :
3066 : : ! Use listkk instead of rank-based routines since in DFPT we may receive a k+q mesh
3067 : : ! with q along a path --> max_linear_density in krank becomes large e.g. 1440
3068 : : ! and the computation of the rank overflows.
3069 : : ! Note also that ctgk_rotate assumes use_symrec=False and symrel in input.
3070 : : call listkk(dksqmax, cryst%gmet, rbz2disk, wfk_disk%hdr%kptns, kptns_in, wfk_disk%hdr%nkpt, nkpt_in, cryst%nsym, &
3071 : 3907 : sppoldbl, cryst%symafm, cryst%symrel, cryst%timrev-1, xmpi_comm_self, use_symrec=.False.)
3072 : :
3073 : : !call xmpi_barrier(comm)
3074 [ + + ]: 3907 : if (ask_accurate == 1) then
3075 [ - + ]: 3890 : ABI_CHECK(dksqmax < tol8, sjoin("WFK file read but k-points too far from requested set, dksqmax:", ftoa(dksqmax)))
3076 : : end if
3077 : :
3078 : : ! More efficienct algorithm based on random access IO:
3079 : : ! For each point in the irred disk set:
3080 : : ! - Read wavefunctions from wfk_disk
3081 : : ! - For each k-point in the star of kpt_disk:
3082 : : ! - Rotate wavefunctions in G-space to get the k-point in the requested BZ.
3083 : : ! - save kbz data.
3084 : :
3085 : : ! Construct sorted mapping RBZ --> irred kdisk set, to speedup qbz search below.
3086 [ - + + - : 11721 : ABI_MALLOC(iperm, (nkpt_in))
+ - + - -
+ - + ]
3087 [ - + + - : 7814 : ABI_MALLOC(rbz2disk_sort, (nkpt_in))
- + - + ]
3088 [ - + + + : 845246 : iperm = [(ii, ii=1,nkpt_in)]
+ - + + +
- - + - -
+ + ]
3089 [ - + + + ]: 286958 : rbz2disk_sort = rbz2disk(:,1)
3090 : 3907 : call sort_int(nkpt_in, rbz2disk_sort, iperm)
3091 : :
3092 : : ! prepare offsets for k-points, which could arrive in a random order from the irred k
3093 : : ! these are valid in the output arrays, not in the disk file
3094 : : !TODO: if nband_me is not constant over the k-points, this becomes a huge pain to predict...
3095 [ - + + - : 15628 : ABI_MALLOC(icg, (nkpt_in,nsppol))
- + + - +
- + - - +
- + ]
3096 [ - + + - : 7814 : ABI_MALLOC(ikg, (nkpt_in))
- + - + ]
3097 [ - + + - : 11721 : ABI_MALLOC(ibdeig, (nkpt_in,nsppol))
- + + - -
+ - + ]
3098 [ - + + - : 11721 : ABI_MALLOC(ibdocc, (nkpt_in,nsppol))
- + + - -
+ - + ]
3099 [ + + + + ]: 290078 : icg = 0
3100 [ + + ]: 283051 : ikg = 0
3101 [ + + + + ]: 290078 : ibdeig = 0
3102 [ + + + + ]: 290078 : ibdocc = 0
3103 : 3907 : ii = 0
3104 : 3907 : kk = 0
3105 : 3907 : ll = 0
3106 [ + + ]: 8060 : do spin=1,nsppol
3107 : : jj = 0
3108 [ + + ]: 290078 : do ikpt=1,nkpt_in
3109 : 282018 : ik_disk = rbz2disk(ikpt,1)
3110 : :
3111 : : ! conversion of single spin AFM wfk file to full 2 component one in memory
3112 : 282018 : spin_sym=spin
3113 [ + + ]: 282018 : if (convnsppol1to2) spin_sym=1
3114 : : ! this allows for reading fewer bands from disk than the disk version of nband
3115 : 282018 : nband_k = min(wfk_disk%nband(ik_disk,spin_sym), mband_in)
3116 : 282018 : ibdeig(ikpt,spin) = kk
3117 : 282018 : ibdocc(ikpt,spin) = ll
3118 : 282018 : kk = kk+nband_k*(2*nband_k)**formeig
3119 : 282018 : ll = ll+nband_k
3120 : :
3121 [ + + + + : 576826 : if (.not. any(distrb_flags(ikpt,:,spin))) cycle
+ + ]
3122 : : ! TODO: this does not take into account variable nband(ik)
3123 : 225794 : icg(ikpt,spin) = ii
3124 : 225794 : ikg(ikpt) = jj
3125 : : ! this allows for variable nband_k < mband_mem
3126 : 225794 : ii = ii+min(nband_k,mband_mem_in)*npwarr(ikpt)*nspinor_in
3127 : 286171 : jj = jj+npwarr(ikpt)
3128 : : end do
3129 : : end do
3130 : :
3131 : : ! main loop reading in wfk and spinning them out to all kptns_in which need them
3132 : :
3133 : : ! MG TODO: I believe this is not the most efficient way to implement the IO algorithm
3134 : : ! One might have only the master proc reading all the (ik_ibz, spin, mband) states
3135 : : ! perhaps blocking on the band dimension to reduce memory and then broadcast the block of bands.
3136 : : ! At this point, each proc rotates the wavefunctions and store it in memory if these states are needed.
3137 : :
3138 [ + + ]: 8058 : do spin=1,nsppol
3139 : : ! for nsppol=1 input and nsppol=2 run, no need to continue the spin loop
3140 [ + + ]: 4153 : if (convnsppol1to2 .and. spin > 1) exit
3141 : :
3142 [ + + ]: 106522 : do ik_disk=1,wfk_disk%hdr%nkpt
3143 [ + + ]: 393856 : k_disk = wfk_disk%hdr%kptns(:, ik_disk)
3144 : :
3145 : : ! this allows for reading fewer bands from disk than the maximum
3146 : 98464 : nband_k = min(wfk_disk%nband(ik_disk,spin), mband_in)
3147 : 98464 : istwf_disk = wfk_disk%hdr%istwfk(ik_disk)
3148 : 98464 : npw_disk = wfk_disk%hdr%npwarr(ik_disk)
3149 : :
3150 : : ! Find number of symmetric k-points associated to ik_disk
3151 : 98464 : nqst = 0
3152 : 98464 : needthisk=.false.
3153 : : iqst = 0
3154 : : ! scan to the first point which uses this kdisk
3155 [ + + ]: 11107329 : do iqst = 1, nkpt_in
3156 [ + + ]: 11107329 : if (rbz2disk_sort(iqst) == ik_disk) exit
3157 : : end do
3158 : : ! how many equivalent k? Could be 0, and we will not necessarily use them all if their bands are on other cpus
3159 [ + + ]: 380480 : do ii=iqst, nkpt_in
3160 [ + + ]: 371475 : if (rbz2disk_sort(ii) /= ik_disk) exit
3161 : 282016 : nqst = nqst + 1
3162 [ + + + + : 576824 : if (any(distrb_flags(iperm(ii),:,spin))) needthisk=.true.
+ + ]
3163 [ + + + + : 675288 : if (convnsppol1to2 .and. any(distrb_flags(iperm(ii),:,nsppol+1-spin))) needthisk=.true.
+ + ]
3164 : : end do ! loop over equivalent k
3165 : :
3166 : : ! do we need the present kdisk, or one of its images?
3167 : : ! TODO: check if the eigenvalues are correct all the same
3168 [ + + ]: 98464 : if (.not. needthisk) cycle
3169 : :
3170 [ + - - + ]: 89347 : ABI_CHECK(nqst > 0 .and. rbz2disk_sort(iqst) == ik_disk, "Wrong iqst")
3171 : :
3172 : : ! loop over equivalent images found in rbz set for current k_disk point
3173 : : iband_saved = -1
3174 : : nband_me_saved = -1
3175 [ + + ]: 370848 : do jj=0,nqst-1
3176 : 277350 : ikf = iperm(iqst+jj)
3177 [ - + ]: 277350 : ABI_CHECK(ik_disk == rbz2disk(ikf,1), "ik_disk !/ ind qq(1)")
3178 : :
3179 [ + + ]: 1109400 : kf = kptns_in(:,ikf)
3180 : 277350 : istwf_kf = istwfk_in(ikf)
3181 : 277350 : npw_kf = npwarr(ikf)
3182 : :
3183 [ + + ]: 658874 : do spin_sym = 1, nsppol
3184 [ + + ]: 283060 : if (.not. convnsppol1to2 .and. spin_sym /= spin) cycle
3185 : :
3186 : : ! how many bands in memory for this cpu_
3187 [ + + + + ]: 1859399 : nband_me = count(distrb_flags(ikf,:,spin_sym))
3188 : : ! no need to put wfk at this k for this processor into memory
3189 [ + + ]: 277352 : if (nband_me == 0) cycle
3190 : :
3191 : : ! find starting band index
3192 [ + - ]: 226106 : do iband = 1, nband_k
3193 [ + + ]: 226106 : if (distrb_flags(ikf,iband,spin_sym)) exit
3194 : : end do
3195 : : ! check bands are contiguous in distrb_flags for this ikf and find first band needed, iband
3196 [ - + ]: 225794 : if (.not. distrb_flags(ikf,iband+nband_me-1,spin_sym)) then
3197 : 0 : ABI_ERROR("wfk_read_my_kptbands: bands not contiguous in distrb_flags")
3198 : : end if
3199 : :
3200 : : ! if nband_me goes beyond the end of the bands on disk, just read those we have
3201 : 225794 : nband_me_disk = min(nband_k,nband_me)
3202 : :
3203 : : ! In parallel, iband+nband_me-1 could be larger than mband_disk
3204 : : ! we want to limit nband_me_disk in that case too, just for the last band procs
3205 [ + + ]: 225794 : if (iband+nband_me-1 > nband_k) then
3206 : 9 : nband_me_disk = nband_k+1-iband
3207 : : end if
3208 : :
3209 : : ! may need to re-read if for a different equivalent k if I need other bands
3210 [ + + - + ]: 225794 : if (iband /= iband_saved .or. nband_me_disk /= nband_me_saved .or. spin /= spin_saved) then
3211 [ + + ]: 89347 : if (formeig > 0) then
3212 : : call wfk_disk%read_band_block([iband,iband+nband_me_disk-1],ik_disk,spin,xmpio_single,&
3213 [ + + ]: 483 : kg_k=kg_disk,cg_k=cg_disk,eig_k=eig_disk)
3214 : : else
3215 : : call wfk_disk%read_band_block([iband,iband+nband_me_disk-1],ik_disk,spin,xmpio_single,&
3216 [ + + ]: 267558 : kg_k=kg_disk,cg_k=cg_disk,eig_k=eig_disk,occ_k=occ_disk)
3217 : : end if
3218 : : ! in nsppol=1 nspden=2 case the occupations are doubled
3219 [ + + ]: 89347 : if (convnsppol1to2) then
3220 [ + + ]: 4 : occ_disk = half * occ_disk
3221 : : end if
3222 : : iband_saved = iband
3223 : : nband_me_saved = nband_me_disk
3224 : : spin_saved = spin
3225 : : end if
3226 : :
3227 : : ! reset isym for each spin_sym
3228 : 225794 : isym = rbz2disk(ikf,2)
3229 : : ! there is a first time reversal possible from the irred set found above to the kptns in input.
3230 : : ! a second possible time reversal if the irred k is not explicitly in the disk file, but only it's time reversed image
3231 : 225794 : itimrev = rbz2disk(ikf,6)
3232 [ + + ]: 903176 : g0 = rbz2disk(ikf,3:5) ! IS(k_disk) + g0 = k_bz
3233 : :
3234 : : ! complete the spin down wfk with an AFM symop
3235 [ + + ]: 225794 : if (spin_sym /= spin) then
3236 : : ! try next symop to find afm operation to get the spin component we want
3237 [ + - ]: 4 : do isym = 1, cryst%nsym
3238 [ + + ]: 4 : if (cryst%symafm(isym) == 1) cycle
3239 [ + + + + : 50 : ksym = matmul(symrelT(:,:,isym), k_disk)
+ + + + +
- ]
3240 [ + + - + ]: 8 : if (sum(abs(ksym-kf)) < tol8) exit
3241 : : end do
3242 [ - + ]: 2 : ABI_CHECK(isym <= cryst%nsym, "did not find the AFM symop I need to get isppol=2 wave functions from disk")
3243 : : end if
3244 : :
3245 [ + + + + : 756414 : isirred_kf = (isym == 1 .and. itimrev == 0 .and. all(g0 == 0) .and. cryst%symafm(isym) == 1)
+ + + + -
+ ]
3246 [ + - ]: 225794 : if (present(eigen)) then
3247 : 225794 : ibdoff = ibdeig(ikf,spin_sym)+(iband-1)*(2*nband_k)**formeig
3248 : : eigen(ibdoff+1:ibdoff+nband_me_disk*(2*nband_k)**formeig) = &
3249 [ + + ]: 1571197 : eig_disk((iband-1)*(2*nband_k)**formeig+1:(iband-1+nband_me_disk)*(2*nband_k)**formeig)
3250 : : end if
3251 [ + + ]: 225794 : if (present(occ)) then
3252 : 181079 : ibdoff = ibdocc(ikf,spin_sym)+(iband-1)
3253 [ + + ]: 1224565 : occ(ibdoff+1:ibdoff+nband_me_disk) = occ_disk(iband:iband-1+nband_me_disk)
3254 : : end if
3255 : :
3256 : : ! The test on npwarr is needed because we may change istwfk e.g. gamma.
3257 [ + + + + ]: 503144 : if (isirred_kf .and. wfk_disk%hdr%npwarr(ik_disk) == npwarr(ikf)) then
3258 [ - + ]: 80316 : if (present(kg)) then
3259 [ # # # # ]: 0 : kg(:,ikg(ikf)+1:ikg(ikf)+npw_kf) = kg_disk (:,1:npw_kf)
3260 : : end if
3261 : : cg(:,icg(ikf,spin_sym)+1:icg(ikf,spin_sym)+npw_kf*nband_me_disk*nspinor_in) = &
3262 [ + + + + ]: 459174021 : cg_disk(:,1:npw_kf*nband_me_disk*nspinor_in)
3263 : : else
3264 : : ! Compute G-sphere centered on kf
3265 [ - + ]: 145478 : call get_kg(kf,istwf_kf,ecut_eff_in,cryst%gmet,npw_kf,kg_kf)
3266 : : ! npw found for the present sphere must be equal to size of array for output
3267 [ - + ]: 145478 : ABI_CHECK(npw_kf == npwarr(ikf), "Wrong npw_kf")
3268 : :
3269 [ - + ]: 145478 : if (present(kg)) then
3270 [ # # # # ]: 0 : kg(:,ikg(ikf)+1:ikg(ikf)+npw_kf) = kg_kf (:,1:npw_kf)
3271 : : end if
3272 : :
3273 : : ! FFT box must enclose the two spheres centered on kdisk and kf
3274 [ + - + + : 73320410 : gmax_disk = maxval(abs(kg_disk(:,1:npw_disk)), dim=2)
+ + ]
3275 [ + - + + : 75708090 : gmax_kf = maxval(abs(kg_kf), dim=2)
+ + ]
3276 [ + + ]: 581912 : do ii=1,3
3277 : 581912 : gmax(ii) = max(gmax_disk(ii), gmax_kf(ii))
3278 : : end do
3279 [ + + ]: 581912 : gmax = 2*gmax + 1
3280 : 145478 : call ngfft_seq(work_ngfft, gmax)
3281 [ - + + - : 207740390 : ABI_CALLOC(work, (2, work_ngfft(4),work_ngfft(5),work_ngfft(6)))
- + + - -
+ + - + -
+ - - + -
+ + + + +
+ + + + ]
3282 : :
3283 : : ! Rotate nband_k wavefunctions (output in cg)
3284 : : call cgtk_rotate(cryst,k_disk,isym,itimrev,g0,nspinor,nband_me_disk,&
3285 : : npw_disk,kg_disk,npw_kf,kg_kf,istwf_disk,istwf_kf,cg_disk,&
3286 : : cg(:,icg(ikf,spin_sym)+1:icg(ikf,spin_sym)+npw_kf*nband_me_disk*nspinor_in),&
3287 : 145478 : work_ngfft,work)
3288 : :
3289 [ - + ]: 145478 : ABI_FREE(work)
3290 [ - + ]: 145478 : ABI_FREE(kg_kf)
3291 : : end if
3292 : : end do ! spin_sym
3293 : : end do ! equiv kpt jj
3294 : : end do ! kpt disk
3295 : : end do ! sppol
3296 : :
3297 : : ! this sums over the whole kpt communicator, so also the band procs.
3298 : : ! need to 0 out bands which are not mine
3299 [ + - ]: 3907 : if(present(eigen)) call xmpi_sum(eigen,comm,mpierr)
3300 [ + + ]: 3907 : if(present(occ)) call xmpi_sum(occ,comm,mpierr)
3301 [ - + ]: 3907 : if(present(kg)) call xmpi_sum(kg,comm,mpierr)
3302 : :
3303 [ + + + - ]: 3907 : if(present(pawrhoij) .and. usepaw_in==1) call pawrhoij_copy(wfk_disk%hdr%pawrhoij,pawrhoij)
3304 : :
3305 [ - + ]: 3907 : ABI_FREE(icg)
3306 [ - + ]: 3907 : ABI_FREE(ikg)
3307 [ - + ]: 3907 : ABI_FREE(ibdeig)
3308 [ - + ]: 3907 : ABI_FREE(ibdocc)
3309 [ - + ]: 3907 : ABI_FREE(symrelT)
3310 [ - + ]: 3907 : ABI_FREE(iperm)
3311 [ - + ]: 3907 : ABI_FREE(rbz2disk_sort)
3312 [ - + ]: 3907 : ABI_FREE(rbz2disk)
3313 [ - + ]: 3907 : ABI_FREE(kg_disk)
3314 [ - + ]: 3907 : ABI_FREE(cg_disk)
3315 [ - + ]: 3907 : ABI_FREE(eig_disk)
3316 [ - + ]: 3907 : ABI_FREE(occ_disk)
3317 : :
3318 : 3907 : call cryst%free()
3319 : 3907 : call wfk_disk%close()
3320 : :
3321 : 3907 : call cwtime_report(" wfk_read_my_kptbands:", cpu, wall, gflops)
3322 : :
3323 [ + - + + : 18798 : end subroutine wfk_read_my_kptbands
- + + + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - - - -
- - - - -
- - - - -
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + ]
3324 : : !!***
3325 : :
3326 : : !----------------------------------------------------------------------
3327 : :
3328 : : !!****f* m_wfk/wfk_write_my_kptbands
3329 : : !! NAME
3330 : : !! wfk_write_my_kptbands
3331 : : !!
3332 : : !! FUNCTION
3333 : : !! From a cg (kg, eigen, occ) array write the corresponding file
3334 : : !! distributed bands on all procs, not just k-points
3335 : : !!
3336 : : !! INPUTS
3337 : : !! outpath_ = file name
3338 : : !! distrb_flags = logical mask for band, k, spins on this processor
3339 : : !! comm = mpi communicator
3340 : : !! formeig = flag for GS or response function format of eigenvalues
3341 : : !! kptns_in = requested k points, to be extracted from file or completed
3342 : : !! nkpt_in = number of requested k
3343 : : !! npwarr = array of number of plane waves at each k
3344 : : !! cg = plane wave coefficients
3345 : : !! kg = plane wave coordinates
3346 : : !! eigen = eigenvectors at all bands and my k
3347 : : !! occ = occupations of all bands at my k
3348 : : !!
3349 : : !! OUTPUT
3350 : : !! writes to file
3351 : : !!
3352 : : !! SOURCE
3353 : :
3354 : 1888 : subroutine wfk_write_my_kptbands(outpath_, distrb_flags, comm, formeig, hdr,&
3355 : : iomode_, mband_in, mband_mem_in, mkmem_in, mpw_in, nkpt_in, nspinor_in, nsppol_in, &
3356 : 1888 : cg_in, kg_in, eigen, occ)
3357 : :
3358 : : !Arguments ------------------------------------
3359 : : !scalars
3360 : : integer, intent(in) :: comm, nkpt_in, formeig, iomode_
3361 : : integer, intent(in) :: mband_in,mband_mem_in,mpw_in, nspinor_in, nsppol_in
3362 : : integer, intent(in) :: mkmem_in
3363 : : type(hdr_type),intent(in) :: hdr
3364 : : !arrays
3365 : : character(len=fnlen), intent(in) :: outpath_
3366 : : logical, intent(in) :: distrb_flags(nkpt_in,mband_in,nsppol_in)
3367 : :
3368 : : real(dp), intent(in), target :: cg_in(2,mpw_in*nspinor_in*mband_mem_in*mkmem_in*nsppol_in)
3369 : : integer, intent(in), target :: kg_in(3,mpw_in*mkmem_in)
3370 : : real(dp), intent(in) :: eigen((mband_in*(2*mband_in)**formeig)*nkpt_in*nsppol_in)
3371 : : real(dp), intent(in),optional :: occ(mband_in*nkpt_in*nsppol_in)
3372 : :
3373 : : !Local variables-------------------------------
3374 : : !scalars
3375 : : integer :: spin,ik_rbz,nband_k, npw_k, iomode, wfk_unt, iband, nband_me, ii,jj,kk,ll
3376 : 1888 : integer, allocatable :: icg(:,:), ikg(:), ibdeig(:,:), ibdocc(:,:)
3377 : 1888 : integer, contiguous, pointer :: kg(:,:)
3378 : : character(len=fnlen) :: outpath
3379 : : real(dp) :: cpu, wall, gflops
3380 : 1888 : real(dp), contiguous, pointer :: cg(:,:)
3381 [ + + ]: 7552 : type(wfk_t),target :: wfk_disk
3382 : : ! *************************************************************************
3383 : :
3384 : 1888 : call cwtime(cpu, wall, gflops, "start")
3385 : :
3386 : : ! if iomode ncdf check that outpath has the correct termination
3387 : 1888 : outpath = outpath_
3388 : 1888 : iomode = iomode_
3389 [ + - + - ]: 1888 : if (iomode==IO_MODE_ETSF .and. .not. endswith(outpath, ".nc")) then
3390 : 1888 : outpath = nctk_ncify(outpath)
3391 : : else
3392 : : ! adjust for mpiio if needed
3393 : 0 : iomode = iomode_from_fname(outpath)
3394 : : end if
3395 : :
3396 : 1888 : wfk_unt = get_unit()
3397 : 1888 : wfk_disk%debug = .true.
3398 : 1888 : call wfk_disk%open_write(hdr,outpath,formeig,iomode,wfk_unt,comm) !xmpi_comm_self)
3399 : :
3400 : : ! no kpt on this proc, make local dummies for cg and kg
3401 [ - + ]: 1888 : if (mkmem_in == 0) then
3402 [ # # # # : 0 : ABI_MALLOC(cg, (2,mpw_in))
# # # # #
# # # ]
3403 [ # # # # : 0 : ABI_MALLOC(kg, (3,mpw_in))
# # # # #
# # # ]
3404 : : else
3405 : 1888 : cg => cg_in
3406 : 1888 : kg => kg_in
3407 : : end if
3408 : :
3409 [ - + + - : 7552 : ABI_MALLOC(icg, (nkpt_in,nsppol_in))
- + + - +
- + - - +
- + ]
3410 [ - + + - : 5664 : ABI_MALLOC(ikg, (nkpt_in))
+ - + - -
+ - + ]
3411 [ - + + - : 5664 : ABI_MALLOC(ibdeig, (nkpt_in,nsppol_in))
- + + - -
+ - + ]
3412 [ - + + - : 5664 : ABI_MALLOC(ibdocc, (nkpt_in,nsppol_in))
- + + - -
+ - + ]
3413 [ + + + + ]: 120103 : icg = 0
3414 [ + + ]: 116401 : ikg = 0
3415 [ + + + + ]: 120103 : ibdeig = 0
3416 [ + + + + ]: 120103 : ibdocc = 0
3417 : 1888 : ii = 0
3418 : 1888 : kk = 0
3419 : 1888 : ll = 0
3420 [ + + ]: 3938 : do spin=1,nsppol_in
3421 : 2050 : jj = 0
3422 [ + + ]: 120103 : do ik_rbz=1,nkpt_in
3423 : : ! this allows for reading fewer bands from disk than the disk version of nband
3424 : 116165 : nband_k = hdr%nband(ik_rbz+(spin-1)*hdr%nkpt)
3425 : 116165 : ibdeig(ik_rbz,spin) = kk
3426 : 116165 : ibdocc(ik_rbz,spin) = ll
3427 : 116165 : kk = kk+nband_k*(2*nband_k)**formeig
3428 : 116165 : ll = ll+nband_k
3429 : :
3430 [ + + + + : 240079 : if (.not. any(distrb_flags(ik_rbz,:,spin))) cycle
+ + ]
3431 : : ! TODO: this does not take into account variable nband(ik)
3432 : 92461 : icg(ik_rbz,spin) = ii
3433 : 92461 : ikg(ik_rbz) = jj
3434 : : ! this allows for variable nband_k < mband_mem
3435 : 92461 : ii = ii+min(nband_k,mband_mem_in)*hdr%npwarr(ik_rbz)*nspinor_in
3436 : 118215 : jj = jj+hdr%npwarr(ik_rbz)
3437 : : end do
3438 : : end do
3439 : :
3440 [ + + ]: 3938 : do spin=1,nsppol_in
3441 [ + + ]: 120103 : do ik_rbz=1,nkpt_in
3442 : :
3443 : 116165 : nband_k = hdr%nband(ik_rbz+(spin-1)*hdr%nkpt)
3444 : 116165 : npw_k = hdr%npwarr(ik_rbz)
3445 : :
3446 : : ! even if I do not have any bands to run, go through the mpio calls to avoid deadlocks
3447 : : ! if (.not. any(distrb_flags(ik_rbz,:,spin))) then
3448 : : ! ibdeig = ibdeig + nband_k*(2*nband_k)**formeig
3449 : : ! ibdocc = ibdocc + nband_k
3450 : : ! cycle
3451 : : ! end if
3452 : :
3453 : : ! in case nband is not constant with k this creates chaos in the file writing
3454 : : ! as distrb_flags is allocated for mband, and true
3455 [ + + + + ]: 749423 : nband_me = min(count(distrb_flags(ik_rbz,:,spin)), nband_k)
3456 [ + + ]: 116165 : if (nband_me == 0) then
3457 : : iband = 1 ! does write_band_block accept the range [1,0]?
3458 : : else
3459 [ + - ]: 92695 : do iband = 1, nband_k
3460 [ + + ]: 92695 : if (distrb_flags(ik_rbz,iband,spin)) exit
3461 : : end do
3462 : : !TODO: check all nband_me entries in distrib_flags - the distribution could be random but with iband+nband_me-1 .true.
3463 [ + - ]: 92461 : if (.not. distrb_flags(ik_rbz,iband+nband_me-1,spin)) then
3464 : 0 : ABI_ERROR("wfk_write_my_kptbands: bands not contiguous in distrb_flags")
3465 : : end if
3466 : : end if
3467 : :
3468 [ - + ]: 118215 : if (present(occ)) then
3469 : : call wfk_disk%write_band_block([iband,iband+nband_me-1],ik_rbz,spin,xmpio_collective,&
3470 : : kg_k=kg(:,ikg(ik_rbz)+1:ikg(ik_rbz)+npw_k), &
3471 : : cg_k=cg(:,icg(ik_rbz,spin)+1:icg(ik_rbz,spin)+npw_k*nband_me*nspinor_in),&
3472 : : eig_k=eigen(ibdeig(ik_rbz,spin)+1:ibdeig(ik_rbz,spin)+nband_k*(2*nband_k)**formeig), &
3473 [ # # ]: 0 : occ_k=occ(ibdocc(ik_rbz,spin)+1:ibdocc(ik_rbz,spin)+nband_k))
3474 : : else
3475 : : call wfk_disk%write_band_block([iband,iband+nband_me-1],ik_rbz,spin,xmpio_collective,&
3476 : : kg_k=kg(:,ikg(ik_rbz)+1:ikg(ik_rbz)+npw_k), &
3477 : : cg_k=cg(:,icg(ik_rbz,spin)+1:icg(ik_rbz,spin)+npw_k*nband_me*nspinor_in),&
3478 [ + + ]: 348495 : eig_k=eigen(ibdeig(ik_rbz,spin)+1:ibdeig(ik_rbz,spin)+nband_k*(2*nband_k)**formeig))
3479 : : end if
3480 : :
3481 : : end do ! kpt
3482 : : end do ! sppol
3483 : :
3484 : 1888 : call wfk_disk%close()
3485 : :
3486 : 1888 : call cwtime_report(" wfk_write_my_kptbands. ", cpu, wall, gflops)
3487 : :
3488 [ - + ]: 1888 : ABI_FREE(icg)
3489 [ - + ]: 1888 : ABI_FREE(ikg)
3490 [ - + ]: 1888 : ABI_FREE(ibdeig)
3491 [ - + ]: 1888 : ABI_FREE(ibdocc)
3492 [ - + ]: 1888 : if (mkmem_in == 0) then
3493 [ # # ]: 0 : ABI_FREE(cg)
3494 [ # # ]: 0 : ABI_FREE(kg)
3495 : : end if
3496 : :
3497 [ - + - + : 7552 : end subroutine wfk_write_my_kptbands
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - -
- - - - -
- - - - -
- - - + -
+ - + ]
3498 : : !!***
3499 : :
3500 : : !----------------------------------------------------------------------
3501 : :
3502 : : !!****f* m_wfk/wfk_write_h1mat
3503 : : !! NAME
3504 : : !! wfk_write_h1mat
3505 : : !!
3506 : : !! FUNCTION
3507 : : !! Write all H1 matrix elements in the WFK file fname.
3508 : : !!
3509 : : !! INPUTS
3510 : : !!
3511 : : !! OUTPUTS
3512 : : !!
3513 : : !! SOURCE
3514 : :
3515 : 0 : subroutine wfk_write_h1mat(Wfk,sc_mode,eigen)
3516 : :
3517 : : !Arguments ------------------------------------
3518 : : !scalars
3519 : : integer,intent(in) :: sc_mode
3520 : : class(wfk_t),intent(inout) :: Wfk
3521 : : !arrays
3522 : : real(dp),intent(in) :: eigen(2*Wfk%mband**2*Wfk%nkpt*Wfk%nsppol)
3523 : :
3524 : : !Local variables-------------------------------
3525 : : !scalars
3526 : : integer :: spin,ik_ibz,nband_k,ptr
3527 : : !arrays
3528 : : integer,parameter :: band_block00(2)=[0,0]
3529 : : !************************************************************************
3530 : :
3531 : 0 : ptr=1
3532 [ # # ]: 0 : do spin=1,Wfk%nsppol
3533 [ # # ]: 0 : do ik_ibz=1,Wfk%nkpt
3534 : 0 : nband_k = Wfk%nband(ik_ibz,spin)
3535 : 0 : call wfk%write_band_block(band_block00,ik_ibz,spin,sc_mode,eig_k=eigen(ptr:))
3536 : 0 : ptr = ptr + 2*nband_k**2
3537 : : end do
3538 : : end do
3539 : :
3540 : 0 : end subroutine wfk_write_h1mat
3541 : : !!***
3542 : :
3543 : : !----------------------------------------------------------------------
3544 : :
3545 : : !!****f* m_wfk/wfk_read_h1mat
3546 : : !! NAME
3547 : : !! wfk_read_h1mat
3548 : : !!
3549 : : !! FUNCTION
3550 : : !! Read all H1 matrix elements in the WFK file fname inside the MPI communicator comm.
3551 : : !!
3552 : : !! INPUTS
3553 : : !! path=File name
3554 : : !! comm=MPI communicator.
3555 : : !!
3556 : : !! OUTPUTS
3557 : : !! eigen(2*hdr_out%mband**2*hdr_out%nkpt*hdr_out%nsppol)=Array with the matrix elements of H1
3558 : : !! packed in the first positions. The array is allocated by the procedure.
3559 : : !!
3560 : : !! Hdr_out<hdr_type>=The header of the file
3561 : : !!
3562 : : !! SOURCE
3563 : :
3564 [ # # # # : 0 : subroutine wfk_read_h1mat(fname, eigen, hdr_out, comm)
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # #
# ]
3565 : :
3566 : : !Arguments ------------------------------------
3567 : : !scalars
3568 : : character(len=*),intent(in) :: fname
3569 : : integer,intent(in) :: comm
3570 : : type(hdr_type),intent(out) :: Hdr_out
3571 : : !arrays
3572 : : real(dp),allocatable,intent(out) :: eigen(:)
3573 : :
3574 : : !Local variables-------------------------------
3575 : : !scalars
3576 : : integer,parameter :: master=0,formeig1=1
3577 : : integer :: spin,ik_ibz,nband_k,ptr,ierr,iomode,mband,my_rank
3578 [ # # # # ]: 0 : type(wfk_t) :: wfk
3579 : : !arrays
3580 : : integer,parameter :: band_block00(2)=[0,0]
3581 : : !************************************************************************
3582 : :
3583 : 0 : my_rank = xmpi_comm_rank(comm)
3584 : :
3585 [ # # ]: 0 : if (my_rank==master) then
3586 : : ! Open the file.
3587 : 0 : iomode = iomode_from_fname(fname)
3588 : 0 : call wfk%open_read(fname, formeig1, iomode, get_unit(), xmpi_comm_self, hdr_out=hdr_out)
3589 : :
3590 : : ! Read h1 mat and pack them in the first positions.
3591 [ # # # # : 0 : ABI_MALLOC(eigen, (2*wfk%mband**2*wfk%nkpt*wfk%nsppol))
# # # # #
# # # # #
# # ]
3592 : :
3593 : 0 : ptr=1
3594 [ # # ]: 0 : do spin=1,wfk%nsppol
3595 [ # # ]: 0 : do ik_ibz=1,wfk%nkpt
3596 : 0 : nband_k = wfk%nband(ik_ibz,spin)
3597 : 0 : call wfk_read_band_block(wfk, band_block00, ik_ibz, spin, xmpio_single, eig_k=eigen(ptr:))
3598 : 0 : ptr = ptr + 2*nband_k**2
3599 : : end do
3600 : : end do
3601 : :
3602 : 0 : call wfk%close()
3603 : : end if
3604 : :
3605 : : ! Broadcast data
3606 [ # # ]: 0 : if (xmpi_comm_size(comm) > 1) then
3607 : 0 : call hdr_out%bcast(master, my_rank, comm)
3608 : :
3609 [ # # ]: 0 : mband = maxval(Hdr_out%nband)
3610 [ # # ]: 0 : if (my_rank/=master) then
3611 [ # # # # : 0 : ABI_MALLOC(eigen, (2*mband**2*hdr_out%nkpt*hdr_out%nsppol))
# # # # #
# # # # #
# # ]
3612 : : end if
3613 : 0 : call xmpi_bcast(eigen,master,comm,ierr)
3614 : : end if
3615 : :
3616 [ # # # # : 0 : end subroutine wfk_read_h1mat
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # ]
3617 : : !!***
3618 : :
3619 : : !----------------------------------------------------------------------
3620 : :
3621 : : !!****f* m_wfk/wfk_rewind
3622 : : !! NAME
3623 : : !! wfk_rewind
3624 : : !!
3625 : : !! FUNCTION
3626 : : !! Rewind the file, skip the header and modifies Wfk%f90_fptr $
3627 : : !! Mainly used for debugging purposes when IO_MODE_FORTRAN is used.
3628 : : !!
3629 : : !! SOURCE
3630 : :
3631 : : subroutine wfk_rewind(wfk)
3632 : :
3633 : : !Arguments ------------------------------------
3634 : : class(wfk_t),intent(inout) :: wfk
3635 : :
3636 : : !Local variables-------------------------------
3637 : : integer :: ierr
3638 : : ! *************************************************************************
3639 : :
3640 : : select case (wfk%iomode)
3641 : : case (IO_MODE_FORTRAN)
3642 : : rewind(wfk%fh)
3643 : : call hdr_skip(wfk%fh,ierr)
3644 : : ABI_CHECK(ierr==0, "hdr_skip returned ierr! /= 0")
3645 : : wfk%f90_fptr = [1,1,REC_NPW]
3646 : :
3647 : : case default
3648 : : ABI_ERROR("should not be called when wfk%iomode /= IO_MODE_FORTRAN")
3649 : : end select
3650 : :
3651 : : end subroutine wfk_rewind
3652 : : !!***
3653 : :
3654 : : !----------------------------------------------------------------------
3655 : :
3656 : : !!****f* m_wfk/wfk_seek
3657 : : !! NAME
3658 : : !! wfk_seek
3659 : : !!
3660 : : !! FUNCTION
3661 : : !! Move the internal file pointer so that it points to the
3662 : : !! block (ik_ibz, spin). Needed only if iomode==IO_MODE_FORTRAN
3663 : : !!
3664 : : !! INPUTS
3665 : : !! ik_ibz,spin = (k-point,spin) indices
3666 : : !!
3667 : : !! SIDE EFFECTS
3668 : : !! Wfk<class(wfk_t)> : modifies Wfk%f90_fptr and the internal F90 file pointer.
3669 : : !!
3670 : : !! SOURCE
3671 : :
3672 : 0 : subroutine wfk_seek(Wfk,ik_ibz,spin)
3673 : :
3674 : : !Arguments ------------------------------------
3675 : : integer,intent(in) :: ik_ibz,spin
3676 : : class(wfk_t),intent(inout) :: Wfk
3677 : :
3678 : : !Local variables-------------------------------
3679 : : integer :: ierr,ik_fpt,spin_fpt,recn_wanted,recn_fpt,rec_type
3680 : : character(len=500) :: msg
3681 : : ! *************************************************************************
3682 : :
3683 : 0 : select case (Wfk%iomode)
3684 : : case (IO_MODE_FORTRAN)
3685 : : !
3686 : : ! Find the position inside the file.
3687 [ # # # # : 0 : if (ALL(Wfk%f90_fptr==FPTR_EOF)) then ! handle the EOF condition
# # ]
3688 [ # # ]: 0 : if (Wfk%debug) call wrtout(std_out,"EOF condition","PERS")
3689 : 0 : recn_fpt = Wfk%recn_eof
3690 : : else
3691 : 0 : ik_fpt = Wfk%f90_fptr(1)
3692 : 0 : spin_fpt = Wfk%f90_fptr(2)
3693 : 0 : rec_type = Wfk%f90_fptr(3)
3694 : 0 : recn_fpt = Wfk%recn_ks(ik_fpt,spin_fpt, rec_type)
3695 : : end if
3696 : 0 : recn_wanted = Wfk%recn_ks(ik_ibz,spin, REC_NPW)
3697 : :
3698 [ # # ]: 0 : if (Wfk%debug) then
3699 : 0 : write(msg,'(a,3(i0,2x))')"seeking ik_ibz, spin, recn_wanted-recn_fpt: ",ik_ibz,spin,recn_wanted - recn_fpt
3700 : 0 : call wrtout(std_out,msg,"PERS")
3701 : : end if
3702 : :
3703 : 0 : call mvrecord(Wfk%fh, (recn_wanted - recn_fpt) ,ierr)
3704 [ # # ]: 0 : ABI_CHECK(ierr == 0, "error in mvrecord")
3705 : :
3706 [ # # ]: 0 : Wfk%f90_fptr = [ik_ibz, spin, REC_NPW]
3707 : :
3708 : : case default
3709 [ # # ]: 0 : ABI_ERROR("should not be called when Wfk%iomode /= IO_MODE_FORTRAN")
3710 : : end select
3711 : :
3712 : 0 : end subroutine wfk_seek
3713 : : !!***
3714 : :
3715 : : !----------------------------------------------------------------------
3716 : :
3717 : : !!****f* m_wfk/wfk_update_f90ptr
3718 : : !! NAME
3719 : : !! wfk_update_f90ptr
3720 : : !!
3721 : : !! FUNCTION
3722 : : !! Update wfk%f90_ptr. Used if wfk%iomode == IO_MODE_FORTRAN.
3723 : : !!
3724 : : !! INPUTS
3725 : : !! ik_ibz=K-point index,
3726 : : !! spin=Spin index.
3727 : : !!
3728 : : !! SOURCE
3729 : :
3730 : 0 : subroutine wfk_update_f90ptr(wfk, ik_ibz, spin)
3731 : :
3732 : : !Arguments ------------------------------------
3733 : : class(wfk_t),intent(inout) :: wfk
3734 : : integer,intent(in) :: ik_ibz,spin
3735 : : ! *************************************************************************
3736 : :
3737 [ # # ]: 0 : if (ik_ibz < wfk%nkpt) then
3738 [ # # ]: 0 : wfk%f90_fptr = [ik_ibz+1,spin,REC_NPW]
3739 : : else
3740 [ # # ]: 0 : ABI_CHECK(ik_ibz == wfk%nkpt, "ik_ibz != nkpt")
3741 [ # # ]: 0 : if (spin == wfk%nsppol) then
3742 [ # # ]: 0 : wfk%f90_fptr = FPTR_EOF ! EOF condition
3743 : : else
3744 [ # # ]: 0 : wfk%f90_fptr = [1,spin+1,REC_NPW]
3745 : : end if
3746 : : end if
3747 : :
3748 : 0 : end subroutine wfk_update_f90ptr
3749 : : !!***
3750 : :
3751 : : !----------------------------------------------------------------------
3752 : :
3753 : : !!****f* m_wfkfile/wfk_compute_offsets
3754 : : !! NAME
3755 : : !! wfk_compute_offsets
3756 : : !!
3757 : : !! FUNCTION
3758 : : !! Compute the offsets corresponding to the different sections of the file (G-vectors, eigenvalues, u(G).
3759 : : !! Needed only for Fortran-IO or MPI-IO.
3760 : : !!
3761 : : !! SOURCE
3762 : :
3763 : 5 : subroutine wfk_compute_offsets(Wfk)
3764 : :
3765 : : !Arguments ------------------------------------
3766 : : class(wfk_t),intent(inout) :: Wfk
3767 : :
3768 : : !Local variables-------------------------------
3769 : : !scalars
3770 : : integer :: spin,ik_ibz,npw_k,nband_k,bsize_frm,mpi_type_frm,base !,band
3771 : : integer(XMPI_OFFSET_KIND) :: offset
3772 : : ! this variable is needed to force arithmetic in the right kind
3773 : : ! and avoid integer overflows with large nband npw.
3774 : : ! TODO: check if same is needed elsewhere for offsets
3775 : : integer(XMPI_OFFSET_KIND) :: increment
3776 : : ! *************************************************************************
3777 : :
3778 : 5 : select case (Wfk%iomode)
3779 : : case (IO_MODE_FORTRAN)
3780 : : ! Compute record number for Fortran IO
3781 [ # # # # : 0 : ABI_MALLOC(Wfk%recn_ks, (Wfk%nkpt,Wfk%nsppol,REC_NUM))
# # # # #
# # # # #
# # # # #
# ]
3782 : :
3783 : : ! We start to count the number of Fortran records from the end of the Header
3784 : : ! Hence recn gives the relative position from the header, it's not an absolute position.
3785 : 0 : base = 0
3786 [ # # ]: 0 : do spin=1,Wfk%nsppol
3787 [ # # ]: 0 : do ik_ibz=1,Wfk%nkpt
3788 : 0 : nband_k = Wfk%nband(ik_ibz,spin)
3789 : 0 : Wfk%recn_ks(ik_ibz,spin, REC_NPW) = base + 1
3790 : 0 : Wfk%recn_ks(ik_ibz,spin, REC_KG) = base + 2
3791 : 0 : Wfk%recn_ks(ik_ibz,spin, REC_EIG) = base + 3
3792 : 0 : Wfk%recn_ks(ik_ibz,spin, REC_CG) = base + 4
3793 : 0 : base = Wfk%recn_ks(ik_ibz,spin,REC_CG)
3794 [ # # ]: 0 : if (Wfk%formeig==0) then
3795 : : ! add records for each cg (iband), and account for offset of 1 added for REC_NPW
3796 : : !TODO check if variable nband(k) works here
3797 : 0 : base = base + nband_k - 1
3798 [ # # ]: 0 : else if (Wfk%formeig==1) then
3799 : : ! add records for each eig1(:,iband) and cg (iband), and account for offset of 1 added for REC_NPW
3800 : 0 : base = base + 2*(nband_k-1)
3801 : : else
3802 : 0 : ABI_ERROR("formeig != [0,1]")
3803 : : end if
3804 : : end do
3805 : : end do
3806 : :
3807 : : ! Save EOF position
3808 : 0 : Wfk%recn_eof = base + 1
3809 : :
3810 : : case (IO_MODE_MPI)
3811 : : ! Compute offsets for MPI-IO.
3812 [ - + + - : 25 : ABI_MALLOC(Wfk%offset_ks, (Wfk%nkpt,Wfk%nsppol,REC_NUM))
- + + - +
- + - + -
- + - + -
+ ]
3813 : :
3814 : 5 : bsize_frm = xmpio_bsize_frm ! Byte length of the Fortran record marker.
3815 : 5 : mpi_type_frm = xmpio_mpi_type_frm ! MPI type of the record marker.
3816 : :
3817 : : ! The offset of the Header. TODO
3818 : : ! hdr_offset(Hdr)
3819 : 5 : offset = Wfk%hdr_offset
3820 : :
3821 [ + + ]: 10 : do spin=1,Wfk%nsppol
3822 [ + + ]: 40 : do ik_ibz=1,Wfk%nkpt
3823 : 30 : npw_k = Wfk%Hdr%npwarr(ik_ibz)
3824 : 30 : nband_k = Wfk%nband(ik_ibz,spin)
3825 : : !---------------------------------------------------------------------------
3826 : : ! First record: npw, nspinor, nband_disk
3827 : : !---------------------------------------------------------------------------
3828 : 30 : Wfk%offset_ks(ik_ibz,spin,REC_NPW) = offset
3829 : :
3830 [ + - ]: 30 : if (Wfk%Hdr%headform>=40) then
3831 : : ! npw, nspinor, nband_disk
3832 : 30 : offset = offset + 3*xmpi_bsize_int + 2*bsize_frm
3833 : : else
3834 : 0 : ABI_ERROR("Old headforms < 40 are not supported")
3835 : : end if
3836 : 30 : Wfk%offset_ks(ik_ibz,spin,REC_KG) = offset
3837 : :
3838 : : !---------------------------------------------------------------------------
3839 : : ! Second record: (k+G) vectors
3840 : : ! kg_k(1:3,1:npw_k)
3841 : : !---------------------------------------------------------------------------
3842 : 30 : offset = offset + 3*npw_k*xmpi_bsize_int + 2*bsize_frm
3843 : 30 : Wfk%offset_ks(ik_ibz,spin,REC_EIG) = offset
3844 : : !
3845 : : !---------------------------------------------------------------------------
3846 : : ! Third record: eigenvalues
3847 : : !---------------------------------------------------------------------------
3848 [ + - ]: 35 : if (Wfk%formeig==0) then
3849 : : ! eigen(1:nband_k), occ(1:nband_k)
3850 : : !offset = offset + 2*Wfk%mband*xmpi_bsize_dp + 2*bsize_frm
3851 : 30 : offset = offset + 2*nband_k*xmpi_bsize_dp + 2*bsize_frm
3852 : 30 : Wfk%offset_ks(ik_ibz,spin,REC_CG) = offset
3853 : :
3854 : : !---------------------------------------------------------------------------
3855 : : ! Fourth record: Wavefunction coefficients
3856 : : !---------------------------------------------------------------------------
3857 : : ! do band=1,nband_k; write(unitwf) cg_k(1:2,npw_k*nspinor); end do
3858 : : !offset = offset + Wfk%mband * (2*npw_k*Wfk%nspinor*xmpi_bsize_dp + 2*bsize_frm)
3859 : 30 : increment = 2*npw_k*Wfk%nspinor*xmpi_bsize_dp + 2*bsize_frm
3860 : 30 : increment = nband_k * increment
3861 : 30 : offset = offset + increment
3862 : : !offset = offset + nband_k * (2*npw_k*Wfk%nspinor*xmpi_bsize_dp + 2*bsize_frm)
3863 : :
3864 [ # # ]: 0 : else if (Wfk%formeig==1) then
3865 : : ! read(unitwf) eigen(2*nband_k)
3866 : : !Wfk%offset_ks(ik_ibz,spin,REC_CG) = offset + 2*Wfk%mband*xmpi_bsize_dp + 2*bsize_frm
3867 : 0 : Wfk%offset_ks(ik_ibz,spin,REC_CG) = offset + 2*nband_k*xmpi_bsize_dp + 2*bsize_frm
3868 : :
3869 : : !---------------------------------------------------------------------------
3870 : : ! Fourth record: Wavefunction coefficients
3871 : : !---------------------------------------------------------------------------
3872 : : increment = (2*npw_k*Wfk%nspinor*xmpi_bsize_dp + 2*bsize_frm) + &
3873 : 0 : (2*nband_k*xmpi_bsize_dp + 2*bsize_frm)
3874 : : !Wfk%mband * (2*npw_k*Wfk%nspinor*xmpi_bsize_dp + 2*bsize_frm) + &
3875 : : !Wfk%mband * (2*Wfk%mband*xmpi_bsize_dp + 2*bsize_frm)
3876 : 0 : increment = nband_k * increment
3877 : 0 : offset = offset + increment
3878 : :
3879 : : else
3880 : 0 : ABI_ERROR("Wrong formeig")
3881 : : end if
3882 : :
3883 : : end do ! ik_ibz
3884 : : end do ! spin
3885 : :
3886 : : ! Save EOF offset
3887 : 5 : Wfk%offset_eof = offset
3888 : :
3889 : : ! Check for possible wraparound errors.
3890 [ - + - + : 170 : if (ANY(Wfk%offset_ks <= 0) .or. Wfk%offset_eof < 0) then
+ + + + +
+ - + - -
+ ]
3891 : 0 : ABI_ERROR("Found negative offset. File too large for MPI-IO!!!")
3892 : : end if
3893 : : end select
3894 : :
3895 [ - + ]: 5 : if (Wfk%debug) call wfk_show_offsets(Wfk)
3896 : :
3897 : 5 : end subroutine wfk_compute_offsets
3898 : : !!***
3899 : :
3900 : : !----------------------------------------------------------------------
3901 : :
3902 : : !!****f* m_wfkfile/wfk_show_offsets
3903 : : !! NAME
3904 : : !! wfk_show_offsets
3905 : : !!
3906 : : !! FUNCTION
3907 : : !! Print the offsets.
3908 : : !!
3909 : : !! SOURCE
3910 : :
3911 : 0 : subroutine wfk_show_offsets(Wfk)
3912 : :
3913 : : !Arguments ------------------------------------
3914 : : class(wfk_t),intent(inout) :: Wfk
3915 : :
3916 : : !Local variables-------------------------------
3917 : : !scalars
3918 : : integer :: spin,ik_ibz
3919 : : ! *************************************************************************
3920 : :
3921 : 0 : select case (Wfk%iomode)
3922 : :
3923 : : case (IO_MODE_FORTRAN)
3924 : 0 : write(std_out,*)"Record number relative to the header."
3925 [ # # ]: 0 : do spin=1,Wfk%nsppol
3926 [ # # ]: 0 : do ik_ibz=1,Wfk%nkpt
3927 : : write(std_out,"(a,2(i0,2x),a,4(a,i0,a))") &
3928 : 0 : "(ik_ibz, spin) ",ik_ibz,spin,ch10, &
3929 : 0 : " recn(REC_NPW): ",Wfk%recn_ks(ik_ibz,spin,REC_NPW),ch10,&
3930 : 0 : " recn(REC_KG) : ",Wfk%recn_ks(ik_ibz,spin,REC_KG), ch10,&
3931 : 0 : " recn(REC_EIG): ",Wfk%recn_ks(ik_ibz,spin,REC_EIG),ch10,&
3932 : 0 : " recn(REC_CG) : ",Wfk%recn_ks(ik_ibz,spin,REC_CG),ch10
3933 : : end do
3934 : : end do
3935 : :
3936 : 0 : write(std_out,"(a,i0)")"EOS position: ",Wfk%recn_eof
3937 : :
3938 : : case (IO_MODE_MPI)
3939 : 0 : write(std_out,"(a,i0)")"hdr_offset ",Wfk%hdr_offset
3940 : :
3941 [ # # ]: 0 : do spin=1,Wfk%nsppol
3942 [ # # ]: 0 : do ik_ibz=1,Wfk%nkpt
3943 : : write(std_out,"(a,2(i0,2x),a,4(a,i0,a))") &
3944 : 0 : "(ik_ibz, spin) ",ik_ibz,spin,ch10, &
3945 : 0 : " offset(REC_NPW): ",Wfk%offset_ks(ik_ibz,spin,REC_NPW),ch10,&
3946 : 0 : " offset(REC_KG) : ",Wfk%offset_ks(ik_ibz,spin,REC_KG), ch10,&
3947 : 0 : " offset(REC_EIG): ",Wfk%offset_ks(ik_ibz,spin,REC_EIG),ch10,&
3948 : 0 : " offset(REC_CG) : ",Wfk%offset_ks(ik_ibz,spin,REC_CG),ch10
3949 : : end do ! ik_ibz
3950 : : end do ! spin
3951 : : !
3952 : : ! Write EOF position
3953 [ # # # ]: 0 : write(std_out,"(a,i0)")"offset_eof ",Wfk%offset_eof
3954 : : end select
3955 : :
3956 : 0 : end subroutine wfk_show_offsets
3957 : : !!***
3958 : :
3959 : : !----------------------------------------------------------------------
3960 : :
3961 : : !!****f* m_wfk/mpio_read_kg_k
3962 : : !! NAME
3963 : : !! mpio_read_kg_k
3964 : : !!
3965 : : !! FUNCTION
3966 : : !! Helper functions to read the G-vectors with MPI-IO
3967 : : !!
3968 : : !! INPUTS
3969 : : !! sc_mode= MPI-IO option
3970 : : !! xmpio_single ==> for reading by current proc.
3971 : : !! xmpio_collective ==> for collective reading.
3972 : : !!
3973 : : !! OUTPUTS
3974 : : !! kg_k=(3,npw_disk) = G-vectors
3975 : : !! mpierr=MPI error status (error check is delegated to the caller)
3976 : : !!
3977 : : !! SOURCE
3978 : :
3979 : : #ifdef HAVE_MPI_IO
3980 : :
3981 : 0 : subroutine mpio_read_kg_k(fh,offset,npw_disk,sc_mode,kg_k,mpierr)
3982 : :
3983 : : !Arguments ------------------------------------
3984 : : !scalars
3985 : : integer,intent(in) :: fh,npw_disk,sc_mode
3986 : : integer(XMPI_OFFSET_KIND),intent(in) :: offset
3987 : : integer,intent(out) :: mpierr
3988 : : !arrays
3989 : : integer,intent(out) :: kg_k(3,npw_disk)
3990 : :
3991 : : !Local variables-------------------------------
3992 : : !scalars
3993 : : integer :: kg_k_type,ncount,myfh
3994 : : integer(XMPI_OFFSET_KIND) :: my_offset
3995 : : !************************************************************************
3996 : :
3997 : : ! Workarounds for XLF
3998 : 0 : myfh = fh
3999 : 0 : ncount = 3*npw_disk
4000 : 0 : my_offset = offset
4001 : :
4002 : 0 : call MPI_TYPE_CONTIGUOUS(ncount, MPI_INTEGER, kg_k_type, mpierr)
4003 [ # # ]: 0 : ABI_HANDLE_MPIERR(mpierr)
4004 : :
4005 : 0 : call MPI_TYPE_COMMIT(kg_k_type,mpierr)
4006 [ # # ]: 0 : ABI_HANDLE_MPIERR(mpierr)
4007 : :
4008 : 0 : call MPI_FILE_SET_VIEW(myfh,my_offset,MPI_BYTE,kg_k_type,'native',xmpio_info,mpierr)
4009 [ # # ]: 0 : ABI_HANDLE_MPIERR(mpierr)
4010 : :
4011 [ # # ]: 0 : if (sc_mode==xmpio_collective) then
4012 : 0 : call MPI_FILE_READ_ALL(myfh,kg_k,ncount,MPI_INTEGER,MPI_STATUS_IGNORE,mpierr)
4013 [ # # ]: 0 : else if (sc_mode==xmpio_single) then
4014 : : !call MPI_File_seek(myfh, 0, MPI_SEEK_SET,mpierr)
4015 : 0 : call MPI_FILE_READ(myfh,kg_k,ncount,MPI_INTEGER, MPI_STATUS_IGNORE,mpierr)
4016 : : else
4017 : 0 : ABI_ERROR("Wrong sc_mode")
4018 : : end if
4019 : :
4020 [ # # ]: 0 : ABI_HANDLE_MPIERR(mpierr)
4021 : :
4022 : 0 : call MPI_TYPE_FREE(kg_k_type,mpierr)
4023 [ # # ]: 0 : ABI_HANDLE_MPIERR(mpierr)
4024 : :
4025 : : end subroutine mpio_read_kg_k
4026 : : #endif
4027 : : !!***
4028 : :
4029 : : !----------------------------------------------------------------------
4030 : :
4031 : : !!****f* m_wfk/mpio_write_kg_k
4032 : : !! NAME
4033 : : !! mpio_write_kg_k
4034 : : !!
4035 : : !! FUNCTION
4036 : : !! Helper function to write the G-vectors with MPI-IO
4037 : : !!
4038 : : !! INPUTS
4039 : : !! sc_mode= MPI-IO option
4040 : : !! xmpio_single ==> for writing by current proc.
4041 : : !! xmpio_collective ==> for collective write.
4042 : : !! kg_k=(3,npw_disk) = G-vectors
4043 : : !!
4044 : : !! OUTPUTS
4045 : : !! mpierr=MPI error status (error check is delegated to the caller)
4046 : : !!
4047 : : !! SOURCE
4048 : :
4049 : : #ifdef HAVE_MPI_IO
4050 : :
4051 : 30 : subroutine mpio_write_kg_k(fh,offset,npw_disk,sc_mode,kg_k,mpierr)
4052 : :
4053 : : !Arguments ------------------------------------
4054 : : !scalars
4055 : : integer,intent(in) :: fh,npw_disk,sc_mode
4056 : : integer(XMPI_OFFSET_KIND),intent(in) :: offset
4057 : : integer,intent(out) :: mpierr
4058 : : !arrays
4059 : : integer,intent(in) :: kg_k(3,npw_disk)
4060 : :
4061 : : !Local variables-------------------------------
4062 : : !scalars
4063 : : integer :: myfh,kg_k_type,ncount
4064 : : integer(XMPI_OFFSET_KIND) :: my_offset
4065 : : !************************************************************************
4066 : :
4067 : : DBG_ENTER("COLL")
4068 : :
4069 : : ! Workarounds for XLF
4070 : 30 : myfh = fh
4071 : 30 : ncount = 3*npw_disk
4072 : 30 : my_offset = offset
4073 : :
4074 : 30 : call MPI_TYPE_CONTIGUOUS(ncount, MPI_INTEGER, kg_k_type, mpierr)
4075 [ + - ]: 30 : ABI_HANDLE_MPIERR(mpierr)
4076 : :
4077 : 30 : call MPI_TYPE_COMMIT(kg_k_type,mpierr)
4078 [ + - ]: 30 : ABI_HANDLE_MPIERR(mpierr)
4079 : :
4080 : 30 : call MPI_FILE_SET_VIEW(myfh,my_offset,MPI_BYTE,kg_k_type,'native',xmpio_info,mpierr)
4081 [ + - ]: 30 : ABI_HANDLE_MPIERR(mpierr)
4082 : :
4083 : 30 : call MPI_TYPE_FREE(kg_k_type,mpierr)
4084 [ + - ]: 30 : ABI_HANDLE_MPIERR(mpierr)
4085 : :
4086 [ - + ]: 30 : if (sc_mode==xmpio_collective) then
4087 : 0 : call MPI_FILE_WRITE_ALL(myfh,kg_k,ncount,MPI_INTEGER,MPI_STATUS_IGNORE,mpierr)
4088 [ + - ]: 30 : else if (sc_mode==xmpio_single) then
4089 : 30 : call MPI_FILE_WRITE(myfh,kg_k,ncount,MPI_INTEGER,MPI_STATUS_IGNORE,mpierr)
4090 : : else
4091 : 0 : ABI_ERROR("Wrong sc_mode")
4092 : : end if
4093 : :
4094 [ + - ]: 30 : ABI_HANDLE_MPIERR(mpierr)
4095 : :
4096 : : DBG_EXIT("COLL")
4097 : :
4098 : : end subroutine mpio_write_kg_k
4099 : : #endif
4100 : : !!***
4101 : :
4102 : : !----------------------------------------------------------------------
4103 : :
4104 : : !!****f* m_wfk/mpio_read_eigocc_k
4105 : : !! NAME
4106 : : !! mpio_read_eigocc_k
4107 : : !!
4108 : : !! FUNCTION
4109 : : !! Helper functions to read the eigenvalues and the occupations with MPI-IO
4110 : : !!
4111 : : !! INPUTS
4112 : : !! fh
4113 : : !! offset
4114 : : !! nband_disk
4115 : : !! formeig
4116 : : !! sc_mode= MPI-IO option
4117 : : !! xmpio_single ==> for reading by current proc.
4118 : : !! xmpio_collective ==> for collective reading.
4119 : : !!
4120 : : !! OUTPUTS
4121 : : !! buffer(:)
4122 : : !! mpierr=MPI error status.
4123 : : !!
4124 : : !! SOURCE
4125 : :
4126 : : #ifdef HAVE_MPI_IO
4127 : :
4128 : 0 : subroutine mpio_read_eigocc_k(fh,offset,nband_disk,formeig,sc_mode,buffer,mpierr)
4129 : :
4130 : : !Arguments ------------------------------------
4131 : : !scalars
4132 : : integer,intent(in) :: fh,nband_disk,formeig,sc_mode
4133 : : integer(XMPI_OFFSET_KIND),intent(in) :: offset
4134 : : integer,intent(out) :: mpierr
4135 : : !arrays
4136 : : real(dp),contiguous, pointer :: buffer(:)
4137 : :
4138 : : !Local variables-------------------------------
4139 : : !scalars
4140 : : integer :: myfh,bufsz,gkk_type,eneocc_type
4141 : : integer(XMPI_OFFSET_KIND) :: my_offset,my_offpad !,fmarker
4142 : : !arrays
4143 : : integer :: sizes(2),subsizes(2),starts(2)
4144 : : !************************************************************************
4145 : :
4146 : : ! Workaround for XLF
4147 : 0 : myfh = fh
4148 : :
4149 : 0 : SELECT CASE (formeig)
4150 : : CASE (0)
4151 : : !
4152 : : ! Read both eig and occ in buffer
4153 : 0 : bufsz = 2*nband_disk
4154 : 0 : my_offset = offset
4155 [ # # # # : 0 : ABI_MALLOC(buffer, (bufsz))
# # # # #
# # # ]
4156 : :
4157 : 0 : call MPI_TYPE_CONTIGUOUS(bufsz, MPI_DOUBLE_PRECISION, eneocc_type, mpierr)
4158 [ # # ]: 0 : ABI_HANDLE_MPIERR(mpierr)
4159 : :
4160 : 0 : call MPI_TYPE_COMMIT(eneocc_type,mpierr)
4161 [ # # ]: 0 : ABI_HANDLE_MPIERR(mpierr)
4162 : :
4163 : 0 : call MPI_FILE_SET_VIEW(myfh, my_offset, MPI_BYTE, eneocc_type, 'native', xmpio_info, mpierr)
4164 [ # # ]: 0 : ABI_HANDLE_MPIERR(mpierr)
4165 : :
4166 : 0 : call MPI_TYPE_FREE(eneocc_type,mpierr)
4167 [ # # ]: 0 : ABI_HANDLE_MPIERR(mpierr)
4168 : :
4169 [ # # ]: 0 : if (sc_mode==xmpio_collective) then
4170 : 0 : call MPI_FILE_READ_ALL(myfh,buffer,bufsz,MPI_DOUBLE_PRECISION,MPI_STATUS_IGNORE,mpierr)
4171 [ # # ]: 0 : else if (sc_mode==xmpio_single) then
4172 : 0 : call MPI_FILE_READ(myfh,buffer,bufsz,MPI_DOUBLE_PRECISION,MPI_STATUS_IGNORE,mpierr)
4173 : : else
4174 : 0 : ABI_ERROR("Wrong sc_mode")
4175 : : end if
4176 [ # # ]: 0 : ABI_HANDLE_MPIERR(mpierr)
4177 : :
4178 : : CASE (1)
4179 : : ! Read the (nband_k,nband_k) matrix with the (complex) GKK matrix elements.
4180 : 0 : bufsz = (nband_disk**2)
4181 [ # # ]: 0 : sizes = [nband_disk, nband_disk]
4182 [ # # ]: 0 : subsizes = [nband_disk, nband_disk]
4183 : 0 : starts = [1, 1]
4184 : :
4185 [ # # # # : 0 : ABI_MALLOC(buffer, (2*bufsz))
# # # # #
# # # #
# ]
4186 : :
4187 : : !my_offset = offset - xmpio_bsize_frm
4188 : : !call xmpio_read_dp(myfh,my_offset,sc_mode,2*nband_disk,buffer,fmarker,mpierr)
4189 : : !write(std_out,*)buffer(1:2*nband_disk)
4190 : : !ABI_ERROR("Done")
4191 : :
4192 : 0 : call xmpio_create_fsubarray_2D(sizes,subsizes,starts,MPI_DOUBLE_COMPLEX,gkk_type,my_offpad,mpierr)
4193 [ # # ]: 0 : ABI_HANDLE_MPIERR(mpierr)
4194 : :
4195 : : ! TODO: Rationalize the offsets
4196 : 0 : my_offset = offset + my_offpad - xmpio_bsize_frm
4197 : :
4198 : 0 : call MPI_FILE_SET_VIEW(myfh,my_offset,MPI_BYTE,gkk_type,'native',xmpio_info,mpierr)
4199 [ # # ]: 0 : ABI_HANDLE_MPIERR(mpierr)
4200 : :
4201 : 0 : call MPI_TYPE_FREE(gkk_type, mpierr)
4202 [ # # ]: 0 : ABI_HANDLE_MPIERR(mpierr)
4203 : :
4204 [ # # ]: 0 : if (sc_mode==xmpio_collective) then
4205 : 0 : call MPI_FILE_READ_ALL(myfh,buffer,bufsz,MPI_DOUBLE_COMPLEX,MPI_STATUS_IGNORE,mpierr)
4206 [ # # ]: 0 : else if (sc_mode==xmpio_single) then
4207 : 0 : call MPI_FILE_READ(myfh,buffer,bufsz,MPI_DOUBLE_COMPLEX,MPI_STATUS_IGNORE,mpierr)
4208 : : else
4209 : 0 : ABI_ERROR("Wrong sc_mode")
4210 : : end if
4211 [ # # ]: 0 : ABI_HANDLE_MPIERR(mpierr)
4212 : :
4213 : : CASE DEFAULT
4214 [ # # # ]: 0 : ABI_ERROR("formeig not in [0,1]")
4215 : : END SELECT
4216 : :
4217 : : end subroutine mpio_read_eigocc_k
4218 : : #endif
4219 : : !!***
4220 : :
4221 : : !----------------------------------------------------------------------
4222 : :
4223 : : !!****f* m_wfk/mpio_write_eigocc_k
4224 : : !! NAME
4225 : : !! mpio_write_eigocc_k
4226 : : !!
4227 : : !! FUNCTION
4228 : : !! Helper functions to write the eigenvalues and the occupations with MPI-IO
4229 : : !!
4230 : : !! INPUTS
4231 : : !! fh
4232 : : !! offset
4233 : : !! nband_disk
4234 : : !! formeig
4235 : : !! sc_mode= MPI-IO option
4236 : : !! xmpio_single ==> for writing by current proc.
4237 : : !! xmpio_collective ==> for collective write.
4238 : : !!
4239 : : !! OUTPUTS
4240 : : !! buffer(:)
4241 : : !! mpierr=MPI error status.
4242 : : !!
4243 : : !! SOURCE
4244 : :
4245 : : #ifdef HAVE_MPI_IO
4246 : :
4247 [ - + ]: 30 : subroutine mpio_write_eigocc_k(fh,offset,nband_disk,formeig,sc_mode,buffer,mpierr)
4248 : :
4249 : : !Arguments ------------------------------------
4250 : : !scalars
4251 : : integer,intent(in) :: fh,nband_disk,formeig,sc_mode
4252 : : integer(XMPI_OFFSET_KIND),intent(in) :: offset
4253 : : integer,intent(out) :: mpierr
4254 : : !arrays
4255 : : real(dp),intent(in) :: buffer(:)
4256 : :
4257 : : !Local variables-------------------------------
4258 : : !scalars
4259 : : integer :: bufsz,gkk_type,eneocc_type,myfh
4260 : : integer(XMPI_OFFSET_KIND) :: my_offset,my_offpad
4261 : : !arrays
4262 : : integer :: sizes(2),subsizes(2),starts(2)
4263 : : !************************************************************************
4264 : :
4265 : : ! Workaround for XLF
4266 : 30 : myfh = fh
4267 : :
4268 : 60 : SELECT CASE (formeig)
4269 : : CASE (0)
4270 : : !
4271 : : ! write both eig and occ in buffer
4272 : 30 : my_offset = offset
4273 : :
4274 : 30 : bufsz = 2*nband_disk
4275 [ - + ]: 30 : ABI_CHECK(SIZE(buffer) >= bufsz, "buffer too small")
4276 : :
4277 : 30 : call MPI_TYPE_CONTIGUOUS(bufsz, MPI_DOUBLE_PRECISION, eneocc_type, mpierr)
4278 [ + - ]: 30 : ABI_HANDLE_MPIERR(mpierr)
4279 : :
4280 : 30 : call MPI_TYPE_COMMIT(eneocc_type,mpierr)
4281 [ + - ]: 30 : ABI_HANDLE_MPIERR(mpierr)
4282 : :
4283 : 30 : call MPI_FILE_SET_VIEW(myfh,my_offset,MPI_BYTE,eneocc_type,'native',xmpio_info,mpierr)
4284 [ + - ]: 30 : ABI_HANDLE_MPIERR(mpierr)
4285 : :
4286 : 30 : call MPI_TYPE_FREE(eneocc_type,mpierr)
4287 [ + - ]: 30 : ABI_HANDLE_MPIERR(mpierr)
4288 : :
4289 [ - + ]: 30 : if (sc_mode==xmpio_collective) then
4290 [ # # ]: 0 : call MPI_FILE_WRITE_ALL(myfh,buffer,bufsz,MPI_DOUBLE_PRECISION,MPI_STATUS_IGNORE,mpierr)
4291 [ + - ]: 30 : else if (sc_mode==xmpio_single) then
4292 [ - + ]: 30 : call MPI_FILE_WRITE(myfh,buffer,bufsz,MPI_DOUBLE_PRECISION,MPI_STATUS_IGNORE,mpierr)
4293 : : else
4294 : 0 : ABI_ERROR("Wrong sc_mode")
4295 : : end if
4296 [ + - ]: 30 : ABI_HANDLE_MPIERR(mpierr)
4297 : :
4298 : : CASE (1)
4299 : : !ABI_ERROR("formeig ==1 with MPI-IO not tested")
4300 : : ! write the (nband_k,nband_k) matrix with the (complex) GKK matrix elements.
4301 : 0 : bufsz = (nband_disk**2)
4302 [ # # ]: 0 : sizes = [nband_disk, nband_disk]
4303 [ # # ]: 0 : subsizes = [nband_disk, nband_disk]
4304 : 0 : starts = [1, 1]
4305 : :
4306 [ # # ]: 0 : ABI_CHECK(SIZE(buffer) >= bufsz, "buffer too small")
4307 : :
4308 : 0 : call xmpio_create_fsubarray_2D(sizes,subsizes,starts,MPI_DOUBLE_COMPLEX,gkk_type,my_offpad,mpierr)
4309 [ # # ]: 0 : ABI_HANDLE_MPIERR(mpierr)
4310 : :
4311 : : ! TODO: Rationalize the offsets
4312 : 0 : my_offset = offset + my_offpad - xmpio_bsize_frm
4313 : :
4314 : 0 : call MPI_FILE_SET_VIEW(myfh,my_offset,MPI_BYTE,gkk_type,'native',xmpio_info,mpierr)
4315 [ # # ]: 0 : ABI_HANDLE_MPIERR(mpierr)
4316 : :
4317 : 0 : call MPI_TYPE_FREE(gkk_type, mpierr)
4318 [ # # ]: 0 : ABI_HANDLE_MPIERR(mpierr)
4319 : :
4320 [ # # ]: 0 : if (sc_mode==xmpio_collective) then
4321 [ # # ]: 0 : call MPI_FILE_WRITE_ALL(myfh,buffer,bufsz,MPI_DOUBLE_COMPLEX,MPI_STATUS_IGNORE,mpierr)
4322 [ # # ]: 0 : else if (sc_mode==xmpio_single) then
4323 [ # # ]: 0 : call MPI_FILE_WRITE(myfh,buffer,bufsz,MPI_DOUBLE_COMPLEX,MPI_STATUS_IGNORE,mpierr)
4324 : : else
4325 : 0 : ABI_ERROR("Wrong sc_mode")
4326 : : end if
4327 [ # # ]: 0 : ABI_HANDLE_MPIERR(mpierr)
4328 : :
4329 : : CASE DEFAULT
4330 [ + - - ]: 30 : ABI_ERROR("formeig not in [0,1]")
4331 : : END SELECT
4332 : :
4333 : : end subroutine mpio_write_eigocc_k
4334 : : !!***
4335 : : #endif
4336 : :
4337 : : !----------------------------------------------------------------------
4338 : :
4339 : : !!****f* m_wfk/wfk_to_bz
4340 : : !! NAME
4341 : : !! wfk_to_bz
4342 : : !!
4343 : : !! FUNCTION
4344 : : !! Generate a new WFK file with wavefunctions in the full BZ and istwfk==1
4345 : : !! Mainly used to interface ABINIT with other codes that cannot handle symmetries e.g. lobster
4346 : : !!
4347 : : !! INPUTS
4348 : : !! in_path = Input WFK file
4349 : : !! dtset <dataset_type>=all input variables for this dataset
4350 : : !! psps <pseudopotential_type>=all the information about psps
4351 : : !! pawtab(ntypat*usepaw) <type(pawtab_type)>=paw tabulated starting data
4352 : : !! out_path = Output WFK file.
4353 : : !!
4354 : : !! OUTPUT
4355 : : !! Output is written to file out_path
4356 : : !! hdr_bz: header of the WFK file in the full BZ
4357 : : !! ebands_bz: Electron energies in the full BZ
4358 : : !!
4359 : : !! NOTES
4360 : : !! - This routine should be called by a single processor.
4361 : : !! - Only GS WFK files are supported (formeig==0)
4362 : : !!
4363 : : !! SOURCE
4364 : :
4365 [ - + - + : 3 : subroutine wfk_to_bz(in_path, dtset, psps, pawtab, out_path, hdr_bz, ebands_bz)
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - - - -
- - - - -
- - - - -
- + - + -
+ - + - +
- + - + -
+ - + - +
- + ]
4366 : :
4367 : : !Arguments ------------------------------------
4368 : : !scalars
4369 : : character(len=*),intent(in) :: in_path,out_path
4370 : : type(pseudopotential_type),intent(in) :: psps
4371 : : type(dataset_type),intent(in) :: dtset
4372 : : type(hdr_type),intent(out) :: hdr_bz
4373 : : type(ebands_t),target,intent(out) :: ebands_bz
4374 : : !arrays
4375 : : type(pawtab_type),intent(in) :: pawtab(dtset%ntypat*psps%usepaw)
4376 : :
4377 : : !Local variables-------------------------------
4378 : : !scalars
4379 : : integer,parameter :: formeig0=0,kptopt3=3
4380 : : integer :: spin,ikf,ik_ibz,nband_k,mpw_ki,mpw_kf,mband,nspinor,nkfull
4381 : : integer :: in_iomode,nsppol,nkibz,out_iomode,isym,itimrev
4382 : : integer :: npw_ki,npw_kf,istwf_ki,istwf_kf,ii,jj,iqst,nqst
4383 : : real(dp) :: ecut_eff,dksqmax,cpu,wall,gflops
4384 : : character(len=500) :: msg
4385 : : character(len=fnlen) :: my_inpath
4386 : : logical :: isirred_kf
4387 : : logical,parameter :: force_istwfk1=.True.
4388 [ + + ]: 12 : type(wfk_t),target :: iwfk
4389 [ + + ]: 12 : type(wfk_t) :: owfk
4390 [ + + + + : 189 : type(crystal_t) :: cryst
+ + + + +
+ + + + +
+ + + + +
+ ]
4391 : : type(hdr_type),pointer :: ihdr
4392 : 3 : type(ebands_t) :: ebands_ibz
4393 : 3 : type(wvl_internal_type) :: dummy_wvl
4394 : : !arrays
4395 : : integer :: g0(3),work_ngfft(18),gmax_ki(3),gmax_kf(3),gmax(3)
4396 : 9 : integer,allocatable :: bz2ibz(:,:),kg_ki(:,:),kg_kf(:,:),iperm(:),bz2ibz_sort(:)
4397 : : real(dp) :: kf(3),kibz(3)
4398 [ - + ]: 6 : real(dp),allocatable :: cg_ki(:,:),cg_kf(:,:),eig_ki(:),occ_ki(:),work(:,:,:,:)
4399 : 3 : real(dp), contiguous, pointer :: kfull(:,:)
4400 : : ! *************************************************************************
4401 : :
4402 [ + - + - : 3 : if (all(dtset%kptrlatt == 0)) then
- + - + ]
4403 : : write(msg,"(5a)")&
4404 : 0 : "Cannot produce full WFK file because kptrlatt == 0",ch10, &
4405 : 0 : "Please use nkgpt and shiftk to define a homogeneous k-mesh.",ch10,&
4406 : 0 : "Returning to caller"
4407 : 0 : ABI_WARNING(msg)
4408 : 0 : return
4409 : : end if
4410 : :
4411 : 3 : call cwtime(cpu, wall, gflops, "start")
4412 [ - + ]: 3 : my_inpath = in_path
4413 : :
4414 [ - + ]: 3 : if (nctk_try_fort_or_ncfile(my_inpath, msg) /= 0) then
4415 : 0 : ABI_ERROR(msg)
4416 : : end if
4417 : 3 : call wrtout(std_out, sjoin(" Converting:", my_inpath, "to full BZ", out_path))
4418 : :
4419 : 3 : in_iomode = iomode_from_fname(my_inpath)
4420 [ - + - + : 3 : ebands_ibz = wfk_read_ebands(my_inpath, xmpi_comm_self)
- + - + -
+ - + - +
- + - + -
+ - + ]
4421 : :
4422 : : ! Open input file, extract dimensions and allocate workspace arrays.
4423 : 3 : call iwfk%open_read(my_inpath, formeig0, in_iomode, get_unit(), xmpi_comm_self)
4424 : 3 : ihdr => iwfk%hdr
4425 : :
4426 [ + + ]: 29 : mband = iwfk%mband; mpw_ki = maxval(iwfk%Hdr%npwarr); nkibz = iwfk%nkpt
4427 : 3 : nsppol = iwfk%nsppol; nspinor = iwfk%nspinor
4428 : 3 : ecut_eff = iwfk%hdr%ecut_eff ! ecut * dilatmx**2
4429 : :
4430 [ - + + - : 9 : ABI_MALLOC(kg_ki, (3, mpw_ki))
+ - + - -
+ - + -
+ ]
4431 [ - + + - : 9 : ABI_MALLOC(cg_ki, (2, mpw_ki*nspinor*mband))
+ - + - -
+ - + -
+ ]
4432 [ - + + - : 9 : ABI_MALLOC(eig_ki, ((2*mband)**iwfk%formeig*mband) )
+ - + - -
+ - + ]
4433 [ - + + - : 9 : ABI_MALLOC(occ_ki, (mband))
+ - + - -
+ - + ]
4434 : :
4435 [ - + - + : 3 : cryst = iwfk%hdr%get_crystal()
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + ]
4436 : :
4437 : : ! Build new header for owfk. This is the most delicate part since all the arrays in hdr_full
4438 : : ! that depend on k-points must be consistent with kfull and nkfull.
4439 [ - + ]: 3 : call ebands_ibz%expandk(cryst, ecut_eff, force_istwfk1, dksqmax, bz2ibz, ebands_bz)
4440 : :
4441 [ - + ]: 3 : if (dksqmax > tol12) then
4442 : : write(msg, '(3a,es16.6,4a)' )&
4443 : 0 : 'At least one of the k points could not be generated from a symmetrical one.',ch10,&
4444 : 0 : 'dksqmax=',dksqmax,ch10,&
4445 : 0 : 'Action: check your WFK file and k-point input variables',ch10,&
4446 : 0 : ' (e.g. kptopt or shiftk might be wrong in the present dataset or the preparatory one.'
4447 : 0 : ABI_ERROR(msg)
4448 : : end if
4449 : :
4450 : 3 : nkfull = ebands_bz%nkpt
4451 : 3 : kfull => ebands_bz%kptns
4452 : :
4453 : : ! Build new header and update pawrhoij.
4454 : : call hdr_bz%init_lowlvl(ebands_bz,psps,pawtab,dummy_wvl,abinit_version,&
4455 : : ihdr%pertcase,ihdr%natom,ihdr%nsym,ihdr%nspden,ihdr%ecut,dtset%pawecutdg,ihdr%ecutsm,dtset%dilatmx,&
4456 : : ihdr%intxc,ihdr%ixc,ihdr%stmbias,ihdr%usewvl,dtset%pawcpxocc,dtset%pawspnorb,dtset%ngfft,dtset%ngfftdg,ihdr%so_psp,&
4457 : : ihdr%qptn,cryst%rprimd,cryst%xred,ihdr%symrel,ihdr%tnons,ihdr%symafm,ihdr%typat,ihdr%amu,ihdr%icoulomb,&
4458 : : kptopt3,dtset%nelect,dtset%ne_qFD,dtset%nh_qFD,dtset%ivalence,dtset%cellcharge(1),&
4459 : : dtset%kptrlatt_orig,dtset%kptrlatt,&
4460 : 3 : dtset%nshiftk_orig,dtset%nshiftk,dtset%shiftk_orig,dtset%shiftk)
4461 : :
4462 [ + + ]: 3 : if (psps%usepaw == 1) call pawrhoij_copy(iwfk%hdr%pawrhoij, hdr_bz%pawrhoij)
4463 : :
4464 : 3 : out_iomode = iomode_from_fname(out_path)
4465 : 3 : call owfk%open_write(hdr_bz, out_path, iwfk%formeig, out_iomode, get_unit(), xmpi_comm_self)
4466 : :
4467 : : ! workspace array for BZ wavefunction block.
4468 [ + + ]: 387 : mpw_kf = maxval(ebands_bz%npwarr)
4469 [ - + + - : 9 : ABI_MALLOC(cg_kf, (2,mpw_kf*nspinor*mband))
+ - + - -
+ - + -
+ ]
4470 : :
4471 [ - + ]: 3 : if (out_iomode == IO_MODE_FORTRAN) then
4472 : 0 : call wrtout(std_out,"Using (slow) Fortran IO version to generate full WFK file", do_flush=.True.)
4473 : :
4474 : : ! Fortran IO does not support random access hence the external loop is on the k-points in the full BZ.
4475 : : !
4476 : : ! For each point in the BZ:
4477 : : ! - Find symmetric k-point in the IBZ and read IBZ wavefunctions from iwfk
4478 : : ! - Rotate wavefunctions in G-space and write kbz data
4479 : : !
4480 : : ! Inefficient since we are reading the same IBZ block several times.
4481 [ # # ]: 0 : do spin=1,nsppol
4482 [ # # ]: 0 : do ikf=1,nkfull
4483 [ # # ]: 0 : ik_ibz = bz2ibz(ikf,1); isym = bz2ibz(ikf,2); itimrev = bz2ibz(ikf,6); g0 = bz2ibz(ikf,3:5) ! IS(k_ibz) + g0 = k_bz
4484 [ # # # # : 0 : isirred_kf = (isym == 1 .and. itimrev == 0 .and. all(g0 == 0))
# # # # ]
4485 : :
4486 : 0 : nband_k = iwfk%nband(ik_ibz,spin)
4487 [ # # ]: 0 : kf = kfull(:,ikf)
4488 [ # # ]: 0 : kibz = ebands_ibz%kptns(:,ik_ibz)
4489 : :
4490 : 0 : istwf_ki = iwfk%hdr%istwfk(ik_ibz)
4491 : 0 : istwf_kf = owfk%hdr%istwfk(ikf)
4492 : 0 : npw_ki = iwfk%hdr%npwarr(ik_ibz)
4493 : :
4494 : : ! Read IBZ data.
4495 : : call iwfk%read_band_block([1,nband_k],ik_ibz,spin,xmpio_single,&
4496 [ # # ]: 0 : kg_k=kg_ki,cg_k=cg_ki,eig_k=eig_ki,occ_k=occ_ki)
4497 : :
4498 : : ! The test on npwarr is needed because we may change istwfk e.g. gamma.
4499 [ # # # # ]: 0 : if (isirred_kf .and. iwfk%hdr%npwarr(ik_ibz) == owfk%hdr%npwarr(ikf)) then
4500 : :
4501 : : call owfk%write_band_block([1,nband_k],ikf,spin,xmpio_single,&
4502 [ # # ]: 0 : kg_k=kg_ki,cg_k=cg_ki,eig_k=eig_ki,occ_k=occ_ki)
4503 : :
4504 : : else
4505 : : ! Compute G-sphere centered on kf
4506 [ # # ]: 0 : call get_kg(kf,istwf_kf,ecut_eff,cryst%gmet,npw_kf,kg_kf)
4507 [ # # ]: 0 : ABI_CHECK(npw_kf == owfk%hdr%npwarr(ikf), "Wrong npw_kf")
4508 : :
4509 : : ! FFT box must enclose the two spheres centered on ki and kf
4510 [ # # # # : 0 : gmax_ki = maxval(abs(kg_ki(:,1:npw_ki)), dim=2)
# # ]
4511 [ # # # # : 0 : gmax_kf = maxval(abs(kg_kf), dim=2)
# # ]
4512 [ # # ]: 0 : do ii=1,3
4513 : 0 : gmax(ii) = max(gmax_ki(ii), gmax_kf(ii))
4514 : : end do
4515 [ # # ]: 0 : gmax = 2*gmax + 1
4516 : 0 : call ngfft_seq(work_ngfft, gmax)
4517 [ # # # # : 0 : ABI_CALLOC(work, (2, work_ngfft(4),work_ngfft(5),work_ngfft(6)))
# # # # #
# # # # #
# # # # #
# # # # #
# # # # ]
4518 : :
4519 : : ! Rotate nband_k wavefunctions (output in cg_kf)
4520 : : call cgtk_rotate(cryst,kibz,isym,itimrev,g0,nspinor,nband_k,&
4521 : 0 : npw_ki,kg_ki,npw_kf,kg_kf,istwf_ki,istwf_kf,cg_ki,cg_kf,work_ngfft,work)
4522 : :
4523 [ # # ]: 0 : ABI_FREE(work)
4524 : :
4525 : : ! Write data
4526 : : call owfk%write_band_block([1,nband_k],ikf,spin,xmpio_single,&
4527 [ # # ]: 0 : kg_k=kg_kf,cg_k=cg_kf,eig_k=eig_ki,occ_k=occ_ki)
4528 : :
4529 [ # # ]: 0 : ABI_FREE(kg_kf)
4530 : : end if
4531 : : end do
4532 : : end do
4533 : :
4534 : : else
4535 : : !
4536 : : ! More efficienct algorithm based on random access IO:
4537 : : ! For each point in the IBZ:
4538 : : ! - Read wavefunctions from iwfk
4539 : : ! - For each k-point in the star of kpt_ibz:
4540 : : ! - Rotate wavefunctions in G-space to get the k-point in the full BZ.
4541 : : ! - Write kbz data to file.
4542 [ - + ]: 3 : if (out_iomode == IO_MODE_MPI) call wrtout(std_out," Using MPI-IO to generate full WFK file", do_flush=.True.)
4543 [ + - ]: 3 : if (out_iomode == IO_MODE_ETSF) call wrtout(std_out, "Using Netcdf-IO to generate full WFK file", do_flush=.True.)
4544 : :
4545 : : ! Construct sorted mapping BZ --> IBZ to speedup qbz search below.
4546 [ - + + - : 9 : ABI_MALLOC(iperm, (nkfull))
+ - + - -
+ - + ]
4547 [ - + + - : 6 : ABI_MALLOC(bz2ibz_sort, (nkfull))
- + - + ]
4548 [ - + + + : 1158 : iperm = [(ii, ii=1,nkfull)]
+ - + + +
- - + - -
+ + ]
4549 [ + - - + : 390 : bz2ibz_sort = bz2ibz(:,1)
- - + + ]
4550 : 3 : call sort_int(nkfull, bz2ibz_sort, iperm)
4551 : :
4552 [ + + ]: 6 : do spin=1,nsppol
4553 : 3 : iqst = 0
4554 [ + + ]: 32 : do ik_ibz=1,iwfk%nkpt
4555 : 26 : nband_k = iwfk%nband(ik_ibz,spin)
4556 [ + + ]: 104 : kibz = ebands_ibz%kptns(:,ik_ibz)
4557 : 26 : istwf_ki = iwfk%hdr%istwfk(ik_ibz)
4558 : 26 : npw_ki = iwfk%hdr%npwarr(ik_ibz)
4559 : :
4560 : : call iwfk%read_band_block([1,nband_k],ik_ibz,spin,xmpio_single,&
4561 [ + + ]: 78 : kg_k=kg_ki,cg_k=cg_ki,eig_k=eig_ki,occ_k=occ_ki)
4562 : :
4563 : : ! Find number of symmetric q-points associated to ik_ibz
4564 : 26 : nqst = 0
4565 [ + + ]: 410 : do ii=iqst+1,nkfull
4566 [ + + ]: 407 : if (bz2ibz_sort(ii) /= ik_ibz) exit
4567 : 410 : nqst = nqst + 1
4568 : : end do
4569 [ + - - + ]: 26 : ABI_CHECK(nqst > 0 .and. bz2ibz_sort(iqst+1) == ik_ibz, "Wrong iqst")
4570 : :
4571 [ + + ]: 413 : do jj=1,nqst
4572 : 384 : iqst = iqst + 1
4573 : 384 : ikf = iperm(iqst)
4574 [ - + ]: 384 : ABI_CHECK(ik_ibz == bz2ibz(ikf,1), "ik_ibz !/ ind qq(1)")
4575 : :
4576 [ + + ]: 1536 : isym = bz2ibz(ikf,2); itimrev = bz2ibz(ikf,6); g0 = bz2ibz(ikf,3:5) ! IS(k_ibz) + g0 = k_bz
4577 [ + + + + : 1260 : isirred_kf = (isym == 1 .and. itimrev == 0 .and. all(g0 == 0))
+ + + - -
+ ]
4578 : :
4579 [ + + ]: 1536 : kf = kfull(:,ikf)
4580 : 384 : istwf_kf = owfk%hdr%istwfk(ikf)
4581 : :
4582 : : ! The test on npwarr is needed because we may change istwfk e.g. gamma.
4583 [ + + + + ]: 410 : if (isirred_kf .and. iwfk%hdr%npwarr(ik_ibz) == owfk%hdr%npwarr(ikf)) then
4584 : :
4585 : : call owfk%write_band_block([1,nband_k],ikf,spin,xmpio_single,&
4586 [ + + ]: 60 : kg_k=kg_ki,cg_k=cg_ki,eig_k=eig_ki,occ_k=occ_ki)
4587 : :
4588 : : else
4589 : : ! Compute G-sphere centered on kf
4590 [ - + ]: 364 : call get_kg(kf,istwf_kf,ecut_eff,cryst%gmet,npw_kf,kg_kf)
4591 [ - + ]: 364 : ABI_CHECK(npw_kf == owfk%hdr%npwarr(ikf), "Wrong npw_kf")
4592 : :
4593 : : ! FFT box must enclose the two spheres centered on ki and kf
4594 [ + - + + : 361036 : gmax_ki = maxval(abs(kg_ki(:,1:npw_ki)), dim=2)
+ + ]
4595 [ + - + + : 366868 : gmax_kf = maxval(abs(kg_kf), dim=2)
+ + ]
4596 [ + + ]: 1456 : do ii=1,3
4597 : 1456 : gmax(ii) = max(gmax_ki(ii), gmax_kf(ii))
4598 : : end do
4599 [ + + ]: 1456 : gmax = 2*gmax + 1
4600 : 364 : call ngfft_seq(work_ngfft, gmax)
4601 [ - + + - : 897504 : ABI_CALLOC(work, (2, work_ngfft(4),work_ngfft(5),work_ngfft(6)))
- + + - -
+ + - + -
+ - - + -
+ + + + +
+ + + + ]
4602 : :
4603 : : ! Rotate nband_k wavefunctions (output in cg_kf)
4604 : : call cgtk_rotate(cryst,kibz,isym,itimrev,g0,nspinor,nband_k,&
4605 : 364 : npw_ki,kg_ki,npw_kf,kg_kf,istwf_ki,istwf_kf,cg_ki,cg_kf,work_ngfft,work)
4606 : :
4607 [ - + ]: 364 : ABI_FREE(work)
4608 : :
4609 : : ! Write data
4610 : : call owfk%write_band_block([1,nband_k],ikf,spin,xmpio_single,&
4611 [ + + ]: 1092 : kg_k=kg_kf,cg_k=cg_kf,eig_k=eig_ki,occ_k=occ_ki)
4612 : :
4613 [ - + ]: 364 : ABI_FREE(kg_kf)
4614 : : end if
4615 : : end do
4616 : : end do
4617 : : end do
4618 : :
4619 [ - + ]: 3 : ABI_FREE(iperm)
4620 [ - + ]: 3 : ABI_FREE(bz2ibz_sort)
4621 : : end if
4622 : :
4623 : 3 : call cwtime_report(sjoin(" FULL_WFK written to: ", out_path), cpu, wall, gflops)
4624 : :
4625 [ - + ]: 3 : ABI_FREE(kg_ki)
4626 [ - + ]: 3 : ABI_FREE(cg_ki)
4627 [ - + ]: 3 : ABI_FREE(eig_ki)
4628 [ - + ]: 3 : ABI_FREE(occ_ki)
4629 [ - + ]: 3 : ABI_FREE(bz2ibz)
4630 [ - + ]: 3 : ABI_FREE(cg_kf)
4631 : :
4632 : 3 : call cryst%free()
4633 : 3 : call ebands_ibz%free()
4634 : 3 : call iwfk%close()
4635 : 3 : call owfk%close()
4636 : :
4637 [ - + - + : 12 : end subroutine wfk_to_bz
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - -
- - - - -
- - - - -
- - - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
- - - - -
- - - - -
- - - - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + -
+ ]
4638 : : !!***
4639 : :
4640 : : !----------------------------------------------------------------------
4641 : :
4642 : : !!****f* m_wfk/wfk_nc2fort
4643 : : !! NAME
4644 : : !! wfk_nc2fort
4645 : : !!
4646 : : !! FUNCTION
4647 : : !! Convert a netcdf WFK file (nc_path) to a Fortran WFK file (fort_path).
4648 : : !!
4649 : : !! NOTES
4650 : : !! - This routine should be called by a single processor.
4651 : : !! - Only GS WFK files are supported (formeig==0)
4652 : : !!
4653 : : !! SOURCE
4654 : :
4655 : 0 : subroutine wfk_nc2fort(nc_path, fort_path)
4656 : :
4657 : : !Arguments ------------------------------------
4658 : : !scalars
4659 : : character(len=*),intent(in) :: nc_path,fort_path
4660 : :
4661 : : !Local variables-------------------------------
4662 : : !scalars
4663 : : integer :: ik,spin,mband,mpw,nband_k
4664 [ # # # # ]: 0 : type(wfk_t) :: iwfk,owfk
4665 : : !arrays
4666 : : integer,parameter :: formeig0=0
4667 : : integer,allocatable :: kg_k(:,:)
4668 : 0 : real(dp),allocatable :: cg_k(:,:),eig_k(:),occ_k(:)
4669 : : ! *************************************************************************
4670 : :
4671 : 0 : call wrtout(std_out, sjoin("Converting:", nc_path, "to", fort_path))
4672 : :
4673 : : ! Open input file, extract dimensions and allocate workspace arrays.
4674 : 0 : call iwfk%open_read(nc_path, formeig0, IO_MODE_ETSF, get_unit(), xmpi_comm_self)
4675 : :
4676 [ # # ]: 0 : mpw = maxval(iwfk%hdr%npwarr); mband = iwfk%mband
4677 [ # # # # : 0 : ABI_MALLOC(kg_k, (3, mpw))
# # # # #
# # # ]
4678 [ # # # # : 0 : ABI_MALLOC(cg_k, (2, mpw*iwfk%nspinor*mband))
# # # # #
# # # ]
4679 [ # # # # : 0 : ABI_MALLOC(eig_k, ((2*mband)**iwfk%formeig*mband) )
# # # # #
# # # ]
4680 [ # # # # : 0 : ABI_MALLOC(occ_k, (mband))
# # # # #
# # # ]
4681 : :
4682 : : ! Open output file.
4683 : 0 : call owfk%open_write(iwfk%hdr,fort_path,formeig0,IO_MODE_FORTRAN,get_unit(),xmpi_comm_self)
4684 : :
4685 [ # # ]: 0 : do spin=1,iwfk%nsppol
4686 [ # # ]: 0 : do ik=1,iwfk%nkpt
4687 : 0 : nband_k = iwfk%nband(ik,spin)
4688 : :
4689 : : call iwfk%read_band_block([1,nband_k],ik,spin,xmpio_single,&
4690 [ # # ]: 0 : kg_k=kg_k,cg_k=cg_k,eig_k=eig_k,occ_k=occ_k)
4691 : :
4692 : : call owfk%write_band_block([1,nband_k],ik,spin,xmpio_single,&
4693 [ # # ]: 0 : kg_k=kg_k,cg_k=cg_k,eig_k=eig_k,occ_k=occ_k)
4694 : : end do
4695 : : end do
4696 : :
4697 [ # # ]: 0 : ABI_FREE(kg_k)
4698 [ # # ]: 0 : ABI_FREE(cg_k)
4699 [ # # ]: 0 : ABI_FREE(eig_k)
4700 [ # # ]: 0 : ABI_FREE(occ_k)
4701 : :
4702 : 0 : call iwfk%close()
4703 : 0 : call owfk%close()
4704 : :
4705 [ # # # # : 0 : end subroutine wfk_nc2fort
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # #
# ]
4706 : : !!***
4707 : :
4708 : : !----------------------------------------------------------------------
4709 : :
4710 : : !!****f* m_wfk/wfk_prof
4711 : : !! NAME
4712 : : !! wfk_prof
4713 : : !!
4714 : : !! FUNCTION
4715 : : !! Profiling tool for IO routines
4716 : : !!
4717 : : !! INPUTS
4718 : : !! wfk_fname=Filename
4719 : : !! formeig=0 for GS file, 1 for DFPT file
4720 : : !! nband=Number of bands to read.
4721 : : !! comm=MPI communicator
4722 : : !!
4723 : : !! SOURCE
4724 : :
4725 : 0 : subroutine wfk_prof(wfk_fname, formeig, nband, comm)
4726 : :
4727 : : !Arguments ------------------------------------
4728 : : integer,intent(in) :: nband,formeig,comm
4729 : : character(len=*),intent(in) :: wfk_fname
4730 : :
4731 : : !Local variables-------------------------------
4732 : : !scalars
4733 : : integer,parameter :: rdwr1=1,master=0,optkg1=1,option1=1,tim_rwwf0=0,icg0=0,headform0=0
4734 : : integer :: iomode,wfk_unt,ik_ibz,spin,ierr,ii,option,mband
4735 : : integer :: npw_disk,nband_disk,mcg,fform,nband_read,sc_mode,my_rank,nproc
4736 : : real(dp) :: cpu,wall,gflops
4737 : : character(len=500) :: msg
4738 : 0 : type(hdr_type) :: Hdr
4739 [ # # ]: 0 : type(wfk_t) :: Wfk
4740 : : type(wffile_type) :: wff
4741 : 0 : type(MPI_type) :: MPI_enreg_seq
4742 : : !arrays
4743 : : !integer,parameter :: io_modes(2) = (/IO_MODE_FORTRAN, IO_MODE_MPI/)
4744 : : integer,parameter :: io_modes(1) = (/IO_MODE_MPI/)
4745 : : integer :: ngfft(18)
4746 : 0 : logical,allocatable :: my_bmask(:)
4747 : 0 : integer,allocatable :: kg_k(:,:)
4748 : 0 : real(dp),allocatable :: eig_k(:),cg_k(:,:),occ_k(:)
4749 : : ! *************************************************************************
4750 : :
4751 : 0 : my_rank = xmpi_comm_rank(comm); nproc = xmpi_comm_size(comm)
4752 : 0 : sc_mode = xmpio_collective
4753 : :
4754 : 0 : call hdr%from_fname(wfk_fname, fform, comm)
4755 : :
4756 : : ! nband_read is the max number of bands we can read from this file.
4757 : 0 : nband_read = nband
4758 [ # # ]: 0 : if (nband_read <= 0) then
4759 [ # # ]: 0 : nband_read = minval(hdr%nband)
4760 : 0 : call wrtout(std_out, sjoin("nband == 0 --> Setting nband_read to:",itoa(nband_read)))
4761 : : end if
4762 [ # # # # ]: 0 : if (nband_read > minval(hdr%nband)) then
4763 [ # # ]: 0 : nband_read = minval(hdr%nband)
4764 : 0 : call wrtout(std_out, sjoin("nband > hdr%nband --> Setting nband_read to:",itoa(nband_read)))
4765 : : end if
4766 : :
4767 : 0 : wfk_unt = get_unit()
4768 : :
4769 [ # # ]: 0 : do ii=1,SIZE(io_modes)
4770 : 0 : iomode = io_modes(ii)
4771 : : !do option=1,3
4772 [ # # ]: 0 : do option=1,3,2
4773 : 0 : write(std_out,*)"iomode, option",iomode,option
4774 : 0 : call cwtime(cpu,wall,gflops,"start")
4775 : :
4776 : 0 : select case (option)
4777 : : case (1)
4778 : 0 : call wfk%open_read(wfk_fname, formeig, iomode, wfk_unt, comm)
4779 : :
4780 [ # # ]: 0 : do spin=1,Hdr%nsppol
4781 [ # # ]: 0 : do ik_ibz=1,Hdr%nkpt
4782 : 0 : npw_disk = Hdr%npwarr(ik_ibz)
4783 : 0 : nband_disk = Wfk%nband(ik_ibz,spin)
4784 : :
4785 : 0 : mcg = npw_disk*Hdr%nspinor*nband_read
4786 : :
4787 [ # # # # : 0 : ABI_MALLOC(eig_k,((2*Wfk%mband)**formeig*Wfk%mband))
# # # # #
# # # ]
4788 [ # # # # : 0 : ABI_MALLOC(occ_k,(Wfk%mband))
# # # # #
# # # ]
4789 : :
4790 [ # # # # : 0 : ABI_MALLOC(kg_k,(3,npw_disk))
# # # # #
# # # #
# ]
4791 [ # # # # : 0 : ABI_MALLOC_OR_DIE(cg_k,(2,mcg), ierr)
# # # # #
# # # # #
# # # # ]
4792 : :
4793 : : ! Read the block of bands for this (k,s).
4794 : : call wfk%read_band_block([1,nband_read],ik_ibz,spin,xmpio_collective,&
4795 [ # # ]: 0 : kg_k=kg_k,cg_k=cg_k,eig_k=eig_k,occ_k=occ_k)
4796 : :
4797 [ # # ]: 0 : ABI_FREE(eig_k)
4798 [ # # ]: 0 : ABI_FREE(occ_k)
4799 [ # # ]: 0 : ABI_FREE(kg_k)
4800 [ # # ]: 0 : ABI_FREE(cg_k)
4801 : : end do !ik_ibz
4802 : : end do !spin
4803 : :
4804 : 0 : call wfk%close()
4805 : :
4806 : : case (2)
4807 : 0 : call wfk%open_read(wfk_fname, formeig, iomode, wfk_unt, comm)
4808 : :
4809 [ # # ]: 0 : do spin=1,Hdr%nsppol
4810 [ # # ]: 0 : do ik_ibz=1,Hdr%nkpt
4811 : 0 : npw_disk = Hdr%npwarr(ik_ibz)
4812 : 0 : nband_disk = Hdr%nband(ik_ibz+(spin-1)*Hdr%nkpt)
4813 : :
4814 [ # # # # : 0 : ABI_MALLOC(my_bmask,(MAXVAL(Hdr%nband)))
# # # # #
# # # #
# ]
4815 [ # # # # ]: 0 : my_bmask=.False.; my_bmask(1:nband_read) = .True.
4816 : :
4817 [ # # # # : 0 : ABI_MALLOC(eig_k,((2*nband_disk)**formeig*nband_disk))
# # # # #
# # # ]
4818 [ # # # # : 0 : ABI_MALLOC(kg_k,(3,npw_disk))
# # # # #
# # # #
# ]
4819 [ # # # # : 0 : ABI_MALLOC(occ_k,(nband_disk))
# # # # #
# # # ]
4820 : :
4821 [ # # # # ]: 0 : mcg = npw_disk*Hdr%nspinor*COUNT(my_bmask)
4822 [ # # # # : 0 : ABI_MALLOC_OR_DIE(cg_k,(2,mcg), ierr)
# # # # #
# # # # #
# # # # ]
4823 : :
4824 : 0 : call wfk%read_bmask(my_bmask,ik_ibz,spin,sc_mode,kg_k=kg_k,cg_k=cg_k,eig_k=eig_k,occ_k=occ_k)
4825 : : !call wfk%read_band_block((/1,nband_read/),ik_ibz,spin,sc_mode,kg_k=kg_k,cg_k=cg_k,eig_k=eig_k,occ_k=occ_k)
4826 : :
4827 [ # # ]: 0 : ABI_FREE(my_bmask)
4828 [ # # ]: 0 : ABI_FREE(eig_k)
4829 [ # # ]: 0 : ABI_FREE(occ_k)
4830 [ # # ]: 0 : ABI_FREE(kg_k)
4831 [ # # ]: 0 : ABI_FREE(cg_k)
4832 : : end do !ik_ibz
4833 : : end do !spin
4834 : :
4835 : 0 : call wfk%close()
4836 : :
4837 : : case (3)
4838 : : !Fake MPI_type for the sequential part.
4839 [ # # ]: 0 : ngfft(1:6) = (/12,12,12,13,13,13/)
4840 : 0 : call initmpi_seq(MPI_enreg_seq)
4841 : 0 : call MPI_enreg_seq%distribfft%init_seq('c',ngfft(2),ngfft(3),'all')
4842 : 0 : call MPI_enreg_seq%distribfft%init_seq('f',ngfft(2),ngfft(3),'all')
4843 : :
4844 : 0 : call WffOpen(iomode,comm,wfk_fname,ierr,wff,master,my_rank,wfk_unt) !,spaceComm_mpiio) ! optional argument
4845 [ # # ]: 0 : ABI_CHECK(ierr==0,"ierr!=0")
4846 : :
4847 : 0 : call Hdr%free()
4848 : 0 : call hdr_io(fform,Hdr,1,wff)
4849 : 0 : call WffKg(wff,optkg1)
4850 : :
4851 [ # # ]: 0 : do spin=1,Hdr%nsppol
4852 [ # # ]: 0 : do ik_ibz=1,Hdr%nkpt
4853 : :
4854 : 0 : npw_disk = Hdr%npwarr(ik_ibz)
4855 : 0 : nband_disk = Hdr%nband(ik_ibz+(spin-1)*Hdr%nkpt)
4856 : :
4857 [ # # ]: 0 : mband = MAXVAL(Hdr%nband)
4858 : 0 : mcg = npw_disk*Hdr%nspinor*nband_read
4859 : :
4860 [ # # # # : 0 : ABI_MALLOC(eig_k,((2*mband)**formeig*mband))
# # # # #
# # # ]
4861 [ # # # # : 0 : ABI_MALLOC(occ_k,(mband))
# # # # #
# # # ]
4862 : :
4863 [ # # # # : 0 : ABI_MALLOC(kg_k,(3,optkg1*npw_disk))
# # # # #
# # # #
# ]
4864 [ # # # # : 0 : ABI_MALLOC_OR_DIE(cg_k,(2,mcg), ierr)
# # # # #
# # # # #
# # # # ]
4865 : : !
4866 : : ! Read the block of bands for this (k,s).
4867 : : call rwwf(cg_k,eig_k,formeig,headform0,icg0,ik_ibz,spin,kg_k,mband,mcg,MPI_enreg_seq,nband_read,&
4868 : 0 : nband_disk,npw_disk,Hdr%nspinor,occ_k,option1,optkg1,tim_rwwf0,Wff)
4869 : :
4870 [ # # ]: 0 : ABI_FREE(eig_k)
4871 [ # # ]: 0 : ABI_FREE(occ_k)
4872 [ # # ]: 0 : ABI_FREE(kg_k)
4873 [ # # ]: 0 : ABI_FREE(cg_k)
4874 : :
4875 : : end do !ik_ibz
4876 : : end do !spin
4877 : :
4878 : 0 : call WffClose(wff,ierr)
4879 : 0 : call destroy_mpi_enreg(MPI_enreg_seq)
4880 : :
4881 : : case default
4882 [ # # # # ]: 0 : ABI_ERROR("Wrong method")
4883 : : end select
4884 : :
4885 : 0 : call cwtime(cpu,wall,gflops,"stop")
4886 : : write(msg,'(3(a,i2),2(a,f8.2))')&
4887 : 0 : " iomode: ",iomode,", nproc: ",nproc,", option: ",option,", cpu: ",cpu,", wall:",wall
4888 : 0 : call wrtout(std_out, msg)
4889 : : !call cwtime_report(" FULL_WFK written to file. ", cpu, wall, gflops)
4890 : : end do
4891 : : end do
4892 : :
4893 : 0 : call Hdr%free()
4894 : :
4895 [ # # # # : 0 : end subroutine wfk_prof
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # #
# ]
4896 : : !!***
4897 : :
4898 : : !----------------------------------------------------------------------
4899 : :
4900 : : !!****f* m_wfk/wfk_create_wfkfile
4901 : : !! NAME
4902 : : !! wfk_create_wfkfile
4903 : : !!
4904 : : !! FUNCTION
4905 : : !!
4906 : : !! INPUTS
4907 : : !!
4908 : : !! SOURCE
4909 : :
4910 [ # # # # : 0 : subroutine wfk_create_wfkfile(wfk_fname, Hdr, iomode, formeig, Kvars, cwtimes, comm)
# # ]
4911 : :
4912 : : !Arguments ------------------------------------
4913 : : !scalars
4914 : : integer,intent(in) :: iomode,formeig,comm
4915 : : character(len=*),intent(in) :: wfk_fname
4916 : : !arrays
4917 : : real(dp),intent(out) :: cwtimes(2)
4918 : : type(hdr_type),intent(in) :: Hdr
4919 : : type(kvars_t),target,intent(out) :: Kvars(Hdr%nkpt)
4920 : :
4921 : : !Local variables-------------------------------
4922 : : !scalars
4923 : : integer :: nkpt,nsppol,nspinor,ierr,sc_mode
4924 : : integer :: ik_ibz,spin,funt,nband_k,npw_k,istwfk_k
4925 : : real(dp) :: cpu,wall,gflops,ucvol
4926 [ # # ]: 0 : type(wfk_t) :: Wfk
4927 : : !arrays
4928 : 0 : integer :: nband(Hdr%nkpt,Hdr%nsppol)
4929 : 0 : integer,contiguous, pointer :: kg_k(:,:)
4930 : : real(dp) :: kpoint(3),gmet(3,3),gprimd(3,3),rmet(3,3)
4931 : 0 : real(dp),allocatable :: cg_k(:,:),eig_k(:),occ_k(:)
4932 : : !************************************************************************
4933 : :
4934 : 0 : cwtimes = zero
4935 : :
4936 [ # # ]: 0 : nband = RESHAPE(Hdr%nband, [Hdr%nkpt, Hdr%nsppol])
4937 : 0 : nkpt = Hdr%nkpt
4938 : 0 : nsppol = Hdr%nsppol
4939 : 0 : nspinor = Hdr%nspinor
4940 : :
4941 : 0 : call metric(gmet,gprimd,dev_null,rmet,Hdr%rprimd,ucvol)
4942 : :
4943 : : ! Generate the G-vectors from input Hdr%ecut.
4944 [ # # ]: 0 : do ik_ibz=1,nkpt
4945 [ # # ]: 0 : kpoint = Hdr%kptns(:,ik_ibz)
4946 : 0 : istwfk_k = Hdr%istwfk(ik_ibz)
4947 [ # # ]: 0 : call get_kg(kpoint,istwfk_k,Hdr%ecut,gmet,npw_k,Kvars(ik_ibz)%kg_k)
4948 [ # # ]: 0 : ABI_CHECK(npw_k == Hdr%npwarr(ik_ibz),"npw_k != Hdr%npwarr(ik)")
4949 : : end do
4950 : :
4951 : : ! Open the file for writing.
4952 : 0 : sc_mode = xmpio_collective
4953 : :
4954 : 0 : call cwtime(cpu,wall,gflops,"start")
4955 : 0 : funt = get_unit()
4956 : :
4957 : 0 : call wfk%open_write(Hdr,wfk_fname,formeig,iomode,funt,comm,write_frm=.TRUE.)
4958 : :
4959 : 0 : call cwtime(cpu,wall,gflops,"stop")
4960 [ # # ]: 0 : cwtimes = cwtimes + [cpu, wall]
4961 : :
4962 [ # # ]: 0 : do spin=1,nsppol
4963 [ # # ]: 0 : do ik_ibz=1,nkpt
4964 : 0 : nband_k = nband(ik_ibz,spin)
4965 : 0 : npw_k = Hdr%npwarr(ik_ibz)
4966 [ # # # # : 0 : ABI_MALLOC(cg_k, (2,npw_k*nspinor*nband_k))
# # # # #
# # # #
# ]
4967 [ # # # # : 0 : ABI_MALLOC(eig_k, ((2*Wfk%mband)**formeig*Wfk%mband) )
# # # # #
# # # #
# ]
4968 [ # # # # : 0 : ABI_MALLOC(occ_k, (Wfk%mband))
# # # # #
# # # #
# ]
4969 : :
4970 : 0 : kg_k => Kvars(ik_ibz)%kg_k
4971 : : !
4972 : : ! Fill cg_k, eig_k, occ_k using a deterministic algorithm so that
4973 : : ! we can check the correctness of the reading.
4974 : 0 : call fill_or_check("fill",Hdr,Kvars(ik_ibz),ik_ibz,spin,formeig,kg_k,cg_k,eig_k,occ_k,ierr)
4975 [ # # ]: 0 : ABI_CHECK_IEQ(ierr, 0, "filling_or_check")
4976 : :
4977 : 0 : call cwtime(cpu,wall,gflops,"start")
4978 : :
4979 [ # # ]: 0 : call wfk%write_band_block([1,nband_k],ik_ibz,spin,sc_mode,kg_k=kg_k,cg_k=cg_k,eig_k=eig_k,occ_k=occ_k)
4980 : :
4981 : 0 : call cwtime(cpu,wall,gflops,"stop")
4982 [ # # ]: 0 : cwtimes = cwtimes + [cpu, wall]
4983 : :
4984 [ # # ]: 0 : ABI_FREE(cg_k)
4985 [ # # ]: 0 : ABI_FREE(eig_k)
4986 [ # # ]: 0 : ABI_FREE(occ_k)
4987 : : end do
4988 : : end do
4989 : :
4990 : : ! Close the file
4991 : 0 : call wfk%close()
4992 : :
4993 [ # # # # : 0 : end subroutine wfk_create_wfkfile
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # ]
4994 : : !!***
4995 : :
4996 : : !----------------------------------------------------------------------
4997 : :
4998 : : !!****f* m_wfk/wfk_check_wfkfile
4999 : : !! NAME
5000 : : !! wfk_check_wfkfile
5001 : : !!
5002 : : !! FUNCTION
5003 : : !!
5004 : : !! INPUTS
5005 : : !!
5006 : : !! SOURCE
5007 : :
5008 : 0 : subroutine wfk_check_wfkfile(wfk_fname,Hdr,iomode,method,formeig,Kvars,cwtimes,comm,ierr)
5009 : :
5010 : : !Arguments ------------------------------------
5011 : : !scalars
5012 : : integer,intent(in) :: iomode,formeig,comm,method
5013 : : integer,intent(out) :: ierr
5014 : : character(len=*),intent(in) :: wfk_fname
5015 : : !arrays
5016 : : real(dp),intent(out) :: cwtimes(2)
5017 : : type(hdr_type),intent(in) :: Hdr
5018 : : type(kvars_t),intent(in) :: Kvars(Hdr%nkpt)
5019 : :
5020 : : !Local variables-------------------------------
5021 : : !scalars
5022 : : integer :: nkpt,nsppol,nspinor,ik_ibz,spin,funt,nband_k,npw_k,sc_mode
5023 : : integer :: my_ierr,restart,restartpaw,is,ik,ntests,test,mband
5024 : : real(dp) :: cpu,wall,gflops
5025 : : character(len=500) :: msg
5026 [ # # ]: 0 : type(wfk_t) :: Wfk
5027 : : !arrays
5028 : 0 : integer :: nband(Hdr%nkpt,Hdr%nsppol),spins(Hdr%nsppol),kindices(Hdr%nkpt)
5029 : 0 : integer,allocatable :: kg_k(:,:)
5030 : 0 : real(dp),allocatable :: cg_k(:,:),eig_k(:),occ_k(:)
5031 : 0 : logical,allocatable :: bmask(:)
5032 : : !************************************************************************
5033 : :
5034 : : !write(msg,"(3a,i2)")"Checking file: ",TRIM(wfk_fname),", with iomode = ",iomode
5035 : : !call wrtout(std_out,msg,"COLL")
5036 : :
5037 : 0 : ierr = 0
5038 : 0 : cwtimes = zero
5039 : :
5040 [ # # ]: 0 : nband = RESHAPE(Hdr%nband, (/Hdr%nkpt,Hdr%nsppol/) )
5041 : 0 : nkpt = Hdr%nkpt
5042 : 0 : nsppol = Hdr%nsppol
5043 : 0 : nspinor = Hdr%nspinor
5044 : :
5045 : : ! Open the file for writing.
5046 : 0 : call cwtime(cpu,wall,gflops,"start")
5047 : 0 : funt = get_unit()
5048 : :
5049 : 0 : call wfk%open_read(wfk_fname, formeig, iomode, funt, comm)
5050 : 0 : mband = Wfk%mband
5051 : :
5052 : 0 : call cwtime(cpu,wall,gflops,"stop")
5053 [ # # ]: 0 : cwtimes = cwtimes + (/cpu,wall/)
5054 : :
5055 : 0 : ntests = 2
5056 : :
5057 [ # # ]: 0 : do test=1,ntests
5058 [ # # # # : 0 : spins = (/(spin, spin=1,Hdr%nsppol)/)
# # ]
5059 [ # # # # : 0 : kindices = (/(ik_ibz, ik_ibz=1,Hdr%nkpt)/)
# # ]
5060 : :
5061 [ # # ]: 0 : if (test==2) then ! Reverse the indices
5062 [ # # # # ]: 0 : spins = [(spin, spin=Hdr%nsppol,1,-1)]
5063 [ # # # # ]: 0 : kindices = [(ik_ibz, ik_ibz=Hdr%nkpt,1,-1)]
5064 : : end if
5065 : : !
5066 [ # # ]: 0 : do is=1,SIZE(spins)
5067 : 0 : spin = spins(is)
5068 [ # # ]: 0 : do ik=1,SIZE(kindices)
5069 : 0 : ik_ibz = kindices(ik)
5070 [ # # ]: 0 : if (Wfk%debug) call hdr_check(Wfk%fform,Wfk%fform,Hdr,Wfk%Hdr,"COLL",restart,restartpaw)
5071 : :
5072 : 0 : nband_k = nband(ik_ibz,spin)
5073 : 0 : npw_k = Hdr%npwarr(ik_ibz)
5074 : :
5075 [ # # # # : 0 : ABI_MALLOC(kg_k, (3,npw_k))
# # # # #
# # # #
# ]
5076 [ # # # # : 0 : ABI_MALLOC(cg_k, (2,npw_k*nspinor*nband_k))
# # # # #
# # # #
# ]
5077 [ # # # # : 0 : ABI_MALLOC(eig_k, ((2*mband)**Wfk%formeig*mband) )
# # # # #
# # # #
# ]
5078 [ # # # # : 0 : ABI_MALLOC(occ_k, (mband))
# # # # #
# # # #
# ]
5079 : : !
5080 : : !sc_mode = xmpio_collective
5081 : 0 : sc_mode = xmpio_single
5082 [ # # # # : 0 : ABI_MALLOC(bmask, (mband))
# # # # #
# # # ]
5083 [ # # ]: 0 : bmask = .FALSE.
5084 [ # # ]: 0 : bmask(1:nband_k) = .TRUE.
5085 : :
5086 : 0 : call cwtime(cpu,wall,gflops,"start")
5087 : :
5088 [ # # ]: 0 : if (method==0) then
5089 [ # # ]: 0 : call wfk%read_band_block((/1,nband_k/),ik_ibz,spin,sc_mode,kg_k=kg_k,cg_k=cg_k,eig_k=eig_k,occ_k=occ_k)
5090 [ # # ]: 0 : else if (method==1) then
5091 : 0 : call wfk%read_bmask(bmask,ik_ibz,spin,sc_mode,kg_k=kg_k,cg_k=cg_k,eig_k=eig_k,occ_k=occ_k)
5092 : : else
5093 : 0 : ABI_ERROR("Wrong method")
5094 : : end if
5095 : :
5096 : : !call wfk%read_eigk(ik_ibz,spin,sc_mode,eig_k)
5097 : : !write(std_out,*)"eig_k",eig_k
5098 : :
5099 : 0 : call cwtime(cpu,wall,gflops,"stop")
5100 [ # # ]: 0 : cwtimes = cwtimes + (/cpu,wall/)
5101 : :
5102 : : ! Check the correctness of the reading.
5103 : 0 : call fill_or_check("check",Hdr,Kvars(ik_ibz),ik_ibz,spin,formeig,kg_k,cg_k,eig_k,occ_k,my_ierr)
5104 : :
5105 [ # # ]: 0 : if (my_ierr /= 0) then
5106 : 0 : write(msg,"(a,i0)")"fill_or_check returned my_ierr: ",my_ierr
5107 : 0 : ierr = my_ierr
5108 : 0 : ABI_WARNING(msg)
5109 : : end if
5110 : :
5111 [ # # ]: 0 : ABI_FREE(kg_k)
5112 [ # # ]: 0 : ABI_FREE(cg_k)
5113 [ # # ]: 0 : ABI_FREE(eig_k)
5114 [ # # ]: 0 : ABI_FREE(occ_k)
5115 [ # # ]: 0 : ABI_FREE(bmask)
5116 : : end do
5117 : : end do
5118 : : end do ! test
5119 : :
5120 : : ! Close the file
5121 : 0 : call wfk%close()
5122 : :
5123 [ # # # # : 0 : end subroutine wfk_check_wfkfile
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# ]
5124 : : !!***
5125 : :
5126 : : !----------------------------------------------------------------------
5127 : :
5128 : : !!****f* m_wfk/fill_or_check
5129 : : !! NAME
5130 : : !! fill_or_check
5131 : : !!
5132 : : !! FUNCTION
5133 : : !!
5134 : : !! INPUTS
5135 : : !!
5136 : : !! SOURCE
5137 : :
5138 [ # # # # : 0 : subroutine fill_or_check(task,Hdr,Kvars,ik_ibz,spin,formeig,kg_k,cg_k,eig_k,occ_k,ierr)
# # # # ]
5139 : :
5140 : : !Arguments ------------------------------------
5141 : : !scalars
5142 : : integer,intent(in) :: ik_ibz,spin,formeig
5143 : : integer,intent(out) :: ierr
5144 : : character(len=*),intent(in) :: task
5145 : : !arrays
5146 : : integer,intent(in) :: kg_k(:,:)
5147 : : real(dp),intent(inout) :: cg_k(:,:),eig_k(:),occ_k(:)
5148 : : type(hdr_type),intent(in) :: Hdr
5149 : : type(kvars_t),intent(in) :: Kvars
5150 : :
5151 : : !Local variables-------------------------------
5152 : : !scalars
5153 : : integer :: nkpt,nsppol,nspinor,nband_k,npw_k,band,ipw,kspad,ii,base,idx,mpw,eigsz
5154 : : character(len=500) :: msg
5155 : : !arrays
5156 : 0 : integer,allocatable :: ref_kg_k(:,:)
5157 : 0 : real(dp),allocatable :: ref_eig_k(:),ref_occ_k(:),ref_cg_k(:,:)
5158 : : !************************************************************************
5159 : :
5160 : 0 : ierr = 0
5161 : 0 : nkpt = Hdr%nkpt
5162 : 0 : nsppol = Hdr%nsppol
5163 : 0 : nspinor = Hdr%nspinor
5164 : 0 : nband_k = Hdr%nband(ik_ibz + (spin-1)*nkpt)
5165 : 0 : npw_k = Hdr%npwarr(ik_ibz)
5166 : :
5167 [ # # # # : 0 : ABI_MALLOC(ref_kg_k,(3,npw_k))
# # # # #
# # # ]
5168 [ # # # # : 0 : ABI_MALLOC(ref_eig_k,((2*nband_k)**formeig*nband_k))
# # # # #
# # # ]
5169 [ # # # # : 0 : ABI_MALLOC(ref_occ_k,(nband_k))
# # # # #
# # # ]
5170 [ # # # # : 0 : ABI_MALLOC(ref_cg_k,(2,npw_k*nspinor*nband_k))
# # # # #
# # # ]
5171 : :
5172 [ # # # # : 0 : ref_kg_k = Kvars%kg_k
# # # # #
# # # # #
# # ]
5173 : :
5174 : : ! Pad values according to (k,s).
5175 : 0 : kspad = (spin-1)*nkpt + (ik_ibz-1) * nband_k
5176 : :
5177 [ # # ]: 0 : if (formeig==0) then
5178 : 0 : eigsz = nband_k
5179 [ # # ]: 0 : do band=1,nband_k
5180 : 0 : ref_eig_k(band) = half * (kspad + band)
5181 : 0 : ref_occ_k(band) = two * (kspad + band)
5182 : : end do
5183 [ # # ]: 0 : else if (formeig==1) then
5184 : 0 : eigsz = 2*nband_k**2
5185 : 0 : base=0
5186 [ # # ]: 0 : do band=1,nband_k
5187 [ # # ]: 0 : do ii=1,2*nband_k
5188 : 0 : idx = base + ii
5189 : 0 : ref_eig_k(idx) = ii*(kspad + band)
5190 : : end do
5191 : 0 : base = base + 2*nband_k
5192 : : end do
5193 : : end if
5194 : :
5195 : 0 : mpw = npw_k*nspinor*nband_k
5196 [ # # ]: 0 : do ipw=1,mpw
5197 : 0 : ref_cg_k(1,ipw) = ipw + kspad
5198 : 0 : ref_cg_k(2,ipw) = -ipw + kspad
5199 : : end do
5200 : :
5201 : : SELECT CASE (task)
5202 : : CASE ("fill")
5203 [ # # # # ]: 0 : cg_k(:,1:mpw) = ref_cg_k(:,1:mpw)
5204 [ # # ]: 0 : if (formeig==0) then
5205 [ # # ]: 0 : eig_k(1:nband_k) = ref_eig_k
5206 [ # # ]: 0 : occ_k(1:nband_k) = ref_occ_k
5207 : : else
5208 [ # # ]: 0 : eig_k(1:2*nband_k**2) = ref_eig_k
5209 : : end if
5210 : :
5211 : : CASE ("check")
5212 : :
5213 [ # # # # : 0 : if (ANY( ABS(cg_k(:,1:mpw) - ref_cg_k) > zero)) then
# # # # ]
5214 : 0 : ierr = ierr + 1
5215 : 0 : ABI_WARNING("Difference in cg_k")
5216 : : end if
5217 : :
5218 [ # # # # : 0 : if (ANY( ABS(kg_k - ref_kg_k) > zero)) then
# # # # ]
5219 : 0 : ierr = ierr + 2
5220 : 0 : ABI_WARNING("Difference in kg_k")
5221 : : !write(std_out,*)"ref_kg_k",ref_kg_k
5222 : : !write(std_out,*)"kg_k",kg_k
5223 : : end if
5224 : :
5225 [ # # # # : 0 : if (ANY( ABS(eig_k(1:eigsz) - ref_eig_k) > zero)) then
# # ]
5226 : 0 : ierr = ierr + 4
5227 : 0 : ABI_WARNING("Difference in eig_k")
5228 : : !write(std_out,*)"ref_eig_k",ref_eig_k
5229 : : !write(std_out,*)"eig_k",eig_k
5230 : : end if
5231 : :
5232 [ # # ]: 0 : if (formeig==0) then
5233 [ # # # # : 0 : if (ANY( ABS(occ_k(1:nband_k) - ref_occ_k) > zero)) then
# # ]
5234 : 0 : ierr = ierr + 8
5235 : 0 : ABI_WARNING("occ_k")
5236 : : !write(std_out,*)"ref_occ_k",ref_occ_k
5237 : : !write(std_out,*)"occ_k",occ_k
5238 : : end if
5239 : : end if
5240 : :
5241 : 0 : write(msg,"(a,3(i0,2x))")" (ik_ibz, spin, ierr) ",ik_ibz,spin,ierr
5242 [ # # ]: 0 : if (ierr/=0) then
5243 [ # # ]: 0 : ABI_WARNING(TRIM(msg)//": FAILED")
5244 : : else
5245 [ # # ]: 0 : call wrtout(std_out,TRIM(msg)//": OK")
5246 : : end if
5247 : :
5248 : : CASE DEFAULT
5249 [ # # # ]: 0 : ABI_ERROR("Wrong task")
5250 : : END SELECT
5251 : :
5252 [ # # ]: 0 : ABI_FREE(ref_kg_k)
5253 [ # # ]: 0 : ABI_FREE(ref_eig_k)
5254 [ # # ]: 0 : ABI_FREE(ref_occ_k)
5255 [ # # ]: 0 : ABI_FREE(ref_cg_k)
5256 : :
5257 : 0 : end subroutine fill_or_check
5258 : : !!***
5259 : :
5260 : : !----------------------------------------------------------------------
5261 : :
5262 : : !!****f* m_wfk/wfk_diff
5263 : : !! NAME
5264 : : !! wfk_diff
5265 : : !!
5266 : : !! FUNCTION
5267 : : !! Compare two WFK file for binary equality
5268 : : !!
5269 : : !! INPUTS
5270 : : !!
5271 : : !! SOURCE
5272 : :
5273 : 0 : subroutine wfk_diff(fname1,fname2,formeig,comm,ierr)
5274 : :
5275 : : !Arguments ------------------------------------
5276 : : integer,intent(in) :: formeig,comm
5277 : : integer,intent(out) :: ierr
5278 : : character(len=*),intent(in) :: fname1,fname2
5279 : :
5280 : : !Local variables-------------------------------
5281 : : !scalars
5282 : : integer,parameter :: master=0
5283 : : integer :: iomode1,iomode2,ik_ibz,spin,mband,nband_k
5284 : : integer :: npw_k,mcg,fform1,fform2,sc_mode,my_rank,nproc
5285 : : character(len=500) :: msg
5286 : 0 : type(hdr_type) :: Hdr1,Hdr2
5287 [ # # # # ]: 0 : type(wfk_t) :: Wfk1,Wfk2
5288 : : !arrays
5289 : 0 : integer,allocatable :: kg1_k(:,:),kg2_k(:,:)
5290 : 0 : real(dp),allocatable :: eig1_k(:),cg1_k(:,:),occ1_k(:)
5291 : 0 : real(dp),allocatable :: eig2_k(:),cg2_k(:,:),occ2_k(:)
5292 : : ! *************************************************************************
5293 : :
5294 [ # # # # ]: 0 : call wrtout(std_out, "wfk_diff: comparing "//TRIM(fname1)//" "//TRIM(fname2))
5295 : :
5296 : 0 : my_rank = xmpi_comm_rank(comm); nproc = xmpi_comm_size(comm)
5297 : 0 : sc_mode = xmpio_collective
5298 : :
5299 : 0 : call hdr1%from_fname(fname1,fform1,comm)
5300 : 0 : call hdr2%from_fname(fname2,fform2,comm)
5301 : :
5302 [ # # ]: 0 : ABI_CHECK(fform1==fform2,"fform1 != fform2")
5303 [ # # ]: 0 : ABI_CHECK(Hdr1%nsppol==Hdr2%nsppol,"nsppol1 != nsppol2")
5304 [ # # ]: 0 : ABI_CHECK(Hdr1%nspinor==Hdr2%nspinor,"nspinor1 != nspinor2")
5305 [ # # ]: 0 : ABI_CHECK(Hdr1%nkpt==Hdr2%nkpt,"nkpt1 != nkpt2")
5306 : : !call hdr_check(fform,fform0,hdr1,hdr2,"COLL",restart,restartpaw)
5307 : :
5308 : 0 : iomode1 = iomode_from_fname(fname1)
5309 : 0 : iomode2 = iomode_from_fname(fname1)
5310 [ # # ]: 0 : ABI_CHECK(iomode1==iomode2,"iomode1 != iomode2")
5311 : : !iomode1 = IO_MODE_FORTRAN
5312 : : !iomode2 = IO_MODE_MPI
5313 : :
5314 : 0 : call wfk1%open_read(fname1, formeig, iomode1, get_unit(), comm)
5315 : 0 : call wfk2%open_read(fname2, formeig, iomode2, get_unit(), comm)
5316 : :
5317 [ # # ]: 0 : if (wfk1%compare(wfk2) /= 0) then
5318 : 0 : ABI_ERROR("WFK files are not consistent. See above messages")
5319 : : end if
5320 : :
5321 : 0 : mband = Wfk1%mband
5322 [ # # ]: 0 : ABI_CHECK(mband==Wfk2%mband,"different mband")
5323 [ # # # # : 0 : ABI_CHECK(all(Wfk1%nband==Wfk2%nband),"different nband")
# # # # ]
5324 [ # # # # : 0 : ABI_CHECK(all(Wfk1%hdr%npwarr==Wfk2%hdr%npwarr),"different npwarr")
# # ]
5325 : :
5326 : 0 : ierr = 0
5327 [ # # ]: 0 : do spin=1,Wfk1%nsppol
5328 [ # # ]: 0 : do ik_ibz=1,Wfk1%nkpt
5329 : 0 : npw_k = Wfk1%Hdr%npwarr(ik_ibz)
5330 : 0 : nband_k = Wfk1%nband(ik_ibz,spin)
5331 [ # # ]: 0 : ABI_CHECK(npw_k ==Wfk2%Hdr%npwarr(ik_ibz),"different npw_k")
5332 [ # # ]: 0 : ABI_CHECK(nband_k==Wfk2%nband(ik_ibz,spin),"different nband_k")
5333 : :
5334 : 0 : mcg = npw_k*Hdr1%nspinor*nband_k
5335 : :
5336 [ # # # # : 0 : ABI_MALLOC(eig1_k,((2*mband)**formeig*mband))
# # # # #
# # # ]
5337 [ # # # # : 0 : ABI_MALLOC(occ1_k,(mband))
# # # # #
# # # #
# ]
5338 [ # # # # : 0 : ABI_MALLOC(kg1_k,(3,npw_k))
# # # # #
# # # #
# ]
5339 [ # # # # : 0 : ABI_MALLOC_OR_DIE(cg1_k,(2,mcg), ierr)
# # # # #
# # # #
# ]
5340 : :
5341 [ # # # # : 0 : ABI_MALLOC(eig2_k,((2*mband)**formeig*mband))
# # # # ]
5342 [ # # # # : 0 : ABI_MALLOC(occ2_k,(mband))
# # # # #
# ]
5343 [ # # # # : 0 : ABI_MALLOC(kg2_k,(3,npw_k))
# # # # #
# ]
5344 [ # # # # : 0 : ABI_MALLOC_OR_DIE(cg2_k,(2,mcg), ierr)
# # # # #
# ]
5345 : :
5346 : : ! Read the block of bands for this (k,s).
5347 [ # # ]: 0 : call wfk1%read_band_block([1, nband_k],ik_ibz,spin,sc_mode,kg_k=kg1_k,eig_k=eig1_k,occ_k=occ1_k) !, cg_k=cg1_k,
5348 [ # # ]: 0 : call wfk2%read_band_block([1, nband_k],ik_ibz,spin,sc_mode,kg_k=kg2_k,eig_k=eig2_k,occ_k=occ2_k) !, cg_k=cg2_k,
5349 : :
5350 [ # # # # : 0 : if (ANY( ABS(kg1_k - kg2_k) > zero)) then
# # # # ]
5351 : 0 : ierr = ierr + 2
5352 : 0 : ABI_WARNING("Difference in kg_k")
5353 : : !write(std_out,*)"kg1_k",kg1_k
5354 : : !write(std_out,*)"kg2_k",kg2_k
5355 : : end if
5356 : :
5357 [ # # # # : 0 : if (ANY( ABS(eig1_k - eig2_k) > zero)) then
# # ]
5358 : 0 : ierr = ierr + 4
5359 : 0 : ABI_WARNING("Difference in eig_k")
5360 : : !write(std_out,*)"eig1_k",eig1_k
5361 : : !write(std_out,*)"eig2_k",eig2_k
5362 : : end if
5363 : :
5364 [ # # ]: 0 : if (formeig==0) then
5365 [ # # # # : 0 : if (ANY( ABS(occ1_k - occ2_k) > zero)) then
# # ]
5366 : 0 : ierr = ierr + 8
5367 : 0 : ABI_WARNING("occ_k")
5368 : 0 : write(std_out,*)"occ1_k",occ1_k
5369 : 0 : write(std_out,*)"occ2_k",occ2_k
5370 : : end if
5371 : : end if
5372 : :
5373 [ # # # # : 0 : if (ANY( ABS(cg1_k - cg2_k) > zero)) then
# # # # ]
5374 : 0 : ierr = ierr + 1
5375 : 0 : ABI_WARNING("Difference in cg_k")
5376 : : end if
5377 : :
5378 : 0 : write(msg,"(a,3(i0,2x))")" (ik_ibz, spin, ierr) ",ik_ibz,spin,ierr
5379 [ # # ]: 0 : if (ierr/=0) then
5380 [ # # ]: 0 : ABI_WARNING(TRIM(msg)//": FAILED")
5381 : : else
5382 [ # # ]: 0 : call wrtout(std_out,TRIM(msg)//": OK")
5383 : : end if
5384 : :
5385 [ # # ]: 0 : ABI_FREE(eig1_k)
5386 [ # # ]: 0 : ABI_FREE(occ1_k)
5387 [ # # ]: 0 : ABI_FREE(kg1_k)
5388 [ # # ]: 0 : ABI_FREE(cg1_k)
5389 : :
5390 [ # # ]: 0 : ABI_FREE(eig2_k)
5391 [ # # ]: 0 : ABI_FREE(occ2_k)
5392 [ # # ]: 0 : ABI_FREE(kg2_k)
5393 [ # # ]: 0 : ABI_FREE(cg2_k)
5394 : : end do !ik_ibz
5395 : : end do !spin
5396 : :
5397 : 0 : call wfk1%close()
5398 : 0 : call wfk2%close()
5399 : :
5400 : 0 : call Hdr1%free()
5401 : 0 : call Hdr2%free()
5402 : :
5403 [ # # # # : 0 : end subroutine wfk_diff
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # #
# ]
5404 : : !!***
5405 : :
5406 : : !----------------------------------------------------------------------
5407 : :
5408 : : !!****f* m_wfk/wfk_klist2mesh
5409 : : !! NAME
5410 : : !! wfk_klist2mesh
5411 : : !!
5412 : : !! FUNCTION
5413 : : !! This routine receives a WFK file with u_k(G) given on a subset of k-points belonging to a k-mesh and
5414 : : !! generates a new WFK file with the complete list of k-points in the IBZ by filling the missing k-points with
5415 : : !! npw_k =1 and u(G=0) = zero.
5416 : : !!
5417 : : !! This routine is mainly used to prepare the computation of electron mobilities
5418 : : !! whose convergence with the k-point sampling is notoriously slow.
5419 : : !! Since only the electron/hole states close to the band edges contribute (say ~0.# eV),
5420 : : !! one can reduce significantly the computational cost of the NSCF run by computing
5421 : : !! a WFK file with kptopt == 0 and the explicit list of k-points located inside the pockets
5422 : : !! instead of computing all the k-points of the dense IBZ.
5423 : : !! Unfortunately, the EPH code expects a WFK on a k-mesh so we need to "convert" the initial WFK
5424 : : !! with the list of k-points to a new WFK file with k-points on the dense kmesh.
5425 : : !!
5426 : : !! INPUTS
5427 : : !! in_wfkpath = Input WFK file with k-point list.
5428 : : !! kerange_path = path to KERANGE.nc file.
5429 : : !! dtset <dataset_type>=all input variables for this dataset
5430 : : !! out_wfkpath = Output WFK file.
5431 : : !! comm = MPI communicator.
5432 : : !!
5433 : : !! OUTPUT
5434 : : !! Output is written to file out_wfkpath.
5435 : : !!
5436 : : !! NOTES
5437 : : !! Only GS WFK files are supported (formeig==0)
5438 : : !!
5439 : : !! SOURCE
5440 : :
5441 : 2 : subroutine wfk_klist2mesh(in_wfkpath, kerange_path, dtset, comm)
5442 : :
5443 : : !Arguments ------------------------------------
5444 : : !scalars
5445 : : character(len=*),intent(in) :: in_wfkpath, kerange_path
5446 : : type(dataset_type),intent(in) :: dtset
5447 : : integer,intent(in) :: comm
5448 : : !arrays
5449 : :
5450 : : !Local variables-------------------------------
5451 : : !scalars
5452 : : integer,parameter :: formeig0 = 0, master = 0
5453 : : integer :: spin, ikf, ikin, nband_k, mpw, mband, nspinor, ierr, fine_mband
5454 : : integer :: nsppol, iomode, npw_k, ii, my_rank, ncid, fform, fform_kerange
5455 : : real(dp) :: cpu, wall, gflops, mae_meV, merr
5456 : : character(len=500) :: msg
5457 : : character(len=fnlen) :: my_inpath, out_wfkpath
5458 [ + + ]: 8 : type(wfk_t),target :: iwfk
5459 [ + + ]: 8 : type(wfk_t) :: owfk
5460 [ + + + + : 126 : type(crystal_t) :: cryst
+ + + + +
+ + + + +
+ + + + +
+ ]
5461 : 2 : type(hdr_type) :: fine_hdr
5462 : : type(hdr_type),pointer :: ihdr
5463 : 4 : type(ebands_t) :: iwfk_ebands, fine_ebands
5464 : : !arrays
5465 : 2 : integer,allocatable :: kf2kin(:), kg_k(:,:) !, kshe_mask(:,:,:)
5466 : 4 : real(dp),allocatable :: cg_k(:,:), eig_k(:), occ_k(:), fine_eigen(:,:,:)
5467 : : ! *************************************************************************
5468 : :
5469 : 2 : call cwtime(cpu, wall, gflops, "start")
5470 : :
5471 : : ! IO section are executed by master only, all other procs wait for the new WFK before returning.
5472 [ - + ]: 2 : my_rank = xmpi_comm_rank(comm); if (my_rank /= master) goto 100
5473 : :
5474 : : ! Read interpolated ebands and kshe_mask from KERANGE file and build fine_ebands object.
5475 : : ! NOTE: KERANGE is written by sigtk_kpts_in_erange in m_sigtk module.
5476 [ - + ]: 2 : NCF_CHECK(nctk_open_read(ncid, kerange_path, xmpi_comm_self))
5477 : : ! Read header associated to the fine k-mesh
5478 : 2 : call fine_hdr%ncread(ncid, fform)
5479 : 2 : fform_kerange = fform_from_ext("KERANGE.nc")
5480 [ - + ]: 2 : ABI_CHECK(fform == fform_kerange, sjoin("Wrong fform. Got: ", itoa(fform), ", Expecting: ", itoa(fform_kerange)))
5481 : : ! Read eigenvalues and kmask
5482 [ + + ]: 176 : fine_mband = maxval(fine_hdr%nband)
5483 [ - + + - : 10 : ABI_MALLOC(fine_eigen, (fine_mband, fine_hdr%nkpt, fine_hdr%nsppol))
- + + - -
+ + - + -
+ - - + -
+ - + ]
5484 [ - + ]: 2 : NCF_CHECK(nf90_get_var(ncid, nctk_idname(ncid, "eigenvalues"), fine_eigen))
5485 : : !NCF_CHECK(nctk_get_dim(ncid, "nkpt_inerange", nkpt_inerage))
5486 : : !ABI_MALLOC(kshe_mask, (fine_hdr%nkpt, fine_hdr%nsppol, 2))
5487 : : !NCF_CHECK(nf90_get_var(ncid, nctk_idname(ncid, "kshe_mask"), kshe_mask))
5488 : : !ABI_MALLOC(krange2ibz, (nkpt_inerange))
5489 : : !NCF_CHECK(nf90_get_var(ncid, nctk_idname(ncid, "krange2ibz"), krange2ibz))
5490 : : !ABI_FREE(krange2ibz)
5491 [ - + ]: 2 : NCF_CHECK(nf90_close(ncid))
5492 : : ! Build fine_ebands
5493 : 2 : call fine_ebands%from_hdr(fine_hdr, fine_mband, fine_eigen)
5494 : : !call fine_ebands%print([std_out], header="SKW interpolated energies", prtvol=dtset%prtvol)
5495 [ - + ]: 2 : ABI_FREE(fine_eigen)
5496 : :
5497 : : if (my_rank == master) then
5498 : 2 : write(std_out, "(2a)")ch10, repeat("=", 92)
5499 : : !call wrtout([std_out, ab_out], msg)
5500 : 2 : write(std_out, "(a)")" Generating new WKF file with dense k-mesh:"
5501 : 2 : write(std_out, "(2a)")" Taking ab-initio wavefunctions with k-point list from WFK file: ", trim(in_wfkpath)
5502 : 2 : write(std_out, "(a)")" When the routine returns, this file will be replaced by a new one with the dense k-mesh"
5503 : 2 : write(std_out, "(2a)")" Taking eigenvalues and k-point tables from KERANGE file: ", trim(kerange_path)
5504 : 2 : write(std_out, "(a, 9(i0, 1x))")" fine_kptrlatt: ", fine_hdr%kptrlatt
5505 [ + + ]: 4 : do ii=1,fine_hdr%nshiftk
5506 : 4 : write(std_out, "(a, 3(f5.2, 1x))")" fine_shiftk: ", fine_hdr%shiftk(:, ii)
5507 : : end do
5508 : 2 : write(std_out, "(2a)")repeat("=", 92), ch10
5509 : : end if
5510 : :
5511 : : ! Open WFK file with k-point list, extract dimensions and allocate workspace arrays.
5512 [ - + ]: 2 : my_inpath = in_wfkpath
5513 [ - + ]: 2 : if (nctk_try_fort_or_ncfile(my_inpath, msg) /= 0) then
5514 : 0 : ABI_ERROR(msg)
5515 : : end if
5516 [ - + - + : 2 : iwfk_ebands = wfk_read_ebands(my_inpath, xmpi_comm_self)
- + - + -
+ - + - +
- + - + -
+ - + ]
5517 : : !call iwfk_ebands%print([std_out], header="iwfk_ebands", prtvol=dtset%prtvol)
5518 : :
5519 : 2 : iomode = iomode_from_fname(my_inpath)
5520 : 2 : call iwfk%open_read(my_inpath, formeig0, iomode, get_unit(), xmpi_comm_self)
5521 : :
5522 [ - + ]: 2 : if (my_rank == master .and. dtset%prtvol > 0) then
5523 : 0 : fform = 0
5524 : 0 : call iwfk%hdr%echo(fform, 3, unit=std_out, header="Header of iwfk file")
5525 : 0 : call fine_hdr%echo(fform, 3, unit=std_out, header="Header of fine_hdr")
5526 : : end if
5527 : :
5528 : 2 : ihdr => iwfk%hdr
5529 : 2 : mband = iwfk%mband; nsppol = iwfk%nsppol; nspinor = iwfk%nspinor
5530 : :
5531 [ - + - + : 2 : cryst = iwfk%hdr%get_crystal()
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + ]
5532 : :
5533 : : ! Find correspondence fine kmesh --> input WFK and handle possible mismatch
5534 : : !TODO: Write specialized routine wrapping listkk to find mapping without O(N2) scaling.
5535 [ - + + - : 6 : ABI_MALLOC(kf2kin, (fine_ebands%nkpt))
+ - + - -
+ - + ]
5536 [ + + ]: 176 : kf2kin = -1
5537 : : !call kpts_map(iwfk_ebands%nkpt, iwfk_ebands%kptns, fine_ebands%nkpt, fine_ebands%kptns, kf2kin, xmpi_comm_self)
5538 [ + + ]: 176 : do ikf=1,fine_ebands%nkpt
5539 [ + + ]: 1746 : do ii=1,iwfk_ebands%nkpt
5540 [ + + + + : 1957 : if (all(abs(fine_ebands%kptns(:, ikf) - iwfk_ebands%kptns(:, ii)) < tol12)) then
+ + ]
5541 : 17 : kf2kin(ikf) = ii; exit
5542 : : end if
5543 : : end do
5544 : : end do
5545 : :
5546 [ + + + + : 176 : if (count(kf2kin /= -1) /= iwfk_ebands%nkpt) then
- + ]
5547 : 0 : write(msg, "(2a, 2(a,i0))")"Something wrong in the computation of fine_mesh --> input_mesh table.",ch10, &
5548 [ # # # # ]: 0 : "Expecting: ", iwfk_ebands%nkpt, " matches, found: ", count(kf2kin /= -1)
5549 : 0 : ABI_ERROR(msg)
5550 : : end if
5551 : :
5552 : : ! Check weights (the list of k-points should be a subset of the kmesh specified by sigma_ngkpt).
5553 : 2 : ierr = 0
5554 [ + + ]: 176 : do ikf=1,fine_ebands%nkpt
5555 : 174 : ikin = kf2kin(ikf)
5556 [ + + ]: 174 : if (ikin == -1) cycle
5557 [ - + ]: 19 : if (abs(ihdr%wtk(ikin) - fine_ebands%wtk(ikf)) > tol12) then
5558 : 0 : ierr = ierr + 1
5559 [ # # ]: 0 : if (ierr <= 10) write(std_out, *) "ihdr%wtk:", ihdr%wtk(ikin), "fine_ebands%wtk", fine_ebands%wtk(ikf)
5560 : : end if
5561 : : end do
5562 [ - + ]: 2 : if (ierr /= 0) then
5563 : : write(msg, "(3a)") &
5564 : 0 : "Mismatch between input k-weights and weigths associated to the fine mesh. ", ch10, &
5565 : 0 : "Possible inconsistency between k-mesh defined by sigma_nshiftk and the list of k-points found in file."
5566 : 0 : ABI_ERROR(msg)
5567 : : end if
5568 : :
5569 : : ! TODO
5570 : : !fine_hdr%fermie ! EVOLVING variable
5571 : : !fine_hdr%residm ! EVOLVING variable
5572 : :
5573 : : ! Build new header for output WFK. This is the most delicate part since all the arrays in fine_hdr
5574 : : ! that depend on k-points must be consistent with the fine k-mesh.
5575 : 2 : mae_meV = zero
5576 [ + + ]: 176 : do ikf=1,fine_ebands%nkpt
5577 : 174 : ikin = kf2kin(ikf)
5578 : :
5579 [ + + ]: 176 : if (ikin == -1) then
5580 : : ! Set npwarr to 1 if k-point is not in input set to reduce file size.
5581 : 157 : fine_ebands%npwarr(ikf) = 1
5582 : 157 : fine_hdr%npwarr(ikf) = 1
5583 : : else
5584 : 17 : fine_ebands%npwarr(ikf) = iwfk_ebands%npwarr(ikin)
5585 : 17 : fine_hdr%npwarr(ikf) = iwfk_ebands%npwarr(ikin)
5586 : :
5587 : : ! Insert ab-initio eigenvalues in the SKW-interpolated fine k-mesh.
5588 [ + + ]: 34 : do spin=1,nsppol
5589 : 17 : nband_k = iwfk_ebands%nband(ikin + (spin - 1) * iwfk_ebands%nkpt)
5590 [ + - - + : 304 : merr = Ha_meV * maxval(abs(fine_ebands%eig(1:nband_k, ikf, spin) - iwfk_ebands%eig(1:nband_k, ikin, spin)))
- - + + ]
5591 : 17 : write(std_out, "(a, es12.4,a)")" MERR: ", merr, " (meV)"
5592 : : !if merr >
5593 : : !write(std_out, *)fine_ebands%eig(1:nband_k, ikf, spin) * Ha_eV
5594 : : !write(std_out, *)iwfk_ebands%eig(1:nband_k, ikin, spin) * Ha_eV
5595 : : !write(std_out, *) Ha_meV * (fine_ebands%eig(1:nband_k, ikf, spin) - iwfk_ebands%eig(1:nband_k, ikin, spin))
5596 : : !end if
5597 : 17 : mae_meV = max(mae_meV, merr)
5598 [ + + ]: 287 : fine_ebands%eig(1:nband_k, ikf, spin) = iwfk_ebands%eig(1:nband_k, ikin, spin)
5599 [ + + ]: 304 : fine_ebands%occ(1:nband_k, ikf, spin) = iwfk_ebands%occ(1:nband_k, ikin, spin)
5600 : : end do
5601 : : end if
5602 : :
5603 : : end do
5604 : :
5605 : : write(std_out, "(a, es12.4,a)") &
5606 : 2 : " Max error between SKW interpolated energies and ab-initio quantities:", mae_meV, " (meV)"
5607 : :
5608 : : !if (mae_meV > ten) then
5609 : : ! write(msg,"(2a,2(a,es12.4),a)") &
5610 : : ! "Large error in SKW interpolation!",ch10," MARE: ",mare, ", MAE: ", mae_meV, " (meV)"
5611 : : ! call wrtout(ab_out, msg)
5612 : : ! ABI_WARNING(msg)
5613 : : !end if
5614 : :
5615 : 2 : call fine_ebands%update_occ(dtset%spinmagntarget, prtvol=dtset%prtvol)
5616 : : !call pack_eneocc(nkpt, nsppol, mband, nband, bantot, array3d, vect)
5617 : : !fine_hdr%occ = reshape(fine_ebands%occ, fine_ebands%mband (1:nband_k, ikin, spin)
5618 [ + + ]: 4 : call fine_ebands%print([std_out], header="fine_ebands", prtvol=dtset%prtvol)
5619 : :
5620 [ + - ]: 2 : out_wfkpath = strcat(in_wfkpath, ".tmp")
5621 [ + - + - ]: 2 : if (iomode == IO_MODE_ETSF) out_wfkpath = strcat(out_wfkpath, ".nc")
5622 : 2 : call owfk%open_write(fine_hdr, out_wfkpath, iwfk%formeig, iomode, get_unit(), xmpi_comm_self)
5623 : :
5624 [ + - ]: 2 : if (iomode == IO_MODE_ETSF) then
5625 : : ! Add crystal structure and ebands if netcdf output.
5626 [ - + ]: 2 : NCF_CHECK(cryst%ncwrite(owfk%fh))
5627 [ - + ]: 2 : NCF_CHECK(fine_ebands%ncwrite(owfk%fh))
5628 : : end if
5629 : :
5630 : 2 : call fine_hdr%free()
5631 : :
5632 : : ! Allocate workspace arrays for wavefunction block.
5633 [ + + ]: 176 : mpw = maxval(fine_ebands%npwarr)
5634 [ - + + - : 6 : ABI_MALLOC(kg_k, (3, mpw))
+ - + - -
+ - + -
+ ]
5635 [ - + + - : 6 : ABI_MALLOC(cg_k, (2, mpw * nspinor * mband))
+ - + - -
+ - + -
+ ]
5636 [ - + + - : 6 : ABI_MALLOC(eig_k, ((2*mband)**iwfk%formeig * mband) )
+ - + - -
+ - + ]
5637 [ - + + - : 6 : ABI_MALLOC(occ_k, (mband))
+ - + - -
+ - + ]
5638 : :
5639 [ + + ]: 4 : do spin=1,nsppol
5640 [ + + ]: 178 : do ikf=1,fine_ebands%nkpt
5641 : 174 : ikin = kf2kin(ikf)
5642 : 174 : nband_k = owfk%nband(ikf, spin)
5643 : 174 : npw_k = owfk%hdr%npwarr(ikf)
5644 : :
5645 : : !cg_k = zero
5646 [ + + ]: 174 : if (ikin /= -1) then
5647 : :
5648 : : ! Consistency check
5649 [ - + ]: 17 : if (nband_k /= iwfk%nband(ikin, spin)) then
5650 : 0 : ABI_ERROR(sjoin("Mismatch in nband_k", itoa(nband_k), "/=", itoa(iwfk%nband(ikin, spin))))
5651 : : end if
5652 [ - + ]: 17 : if (npw_k /= iwfk%hdr%npwarr(ikin)) then
5653 : 0 : ABI_ERROR(sjoin("Mismatch in npw_k", itoa(npw_k), "/=", itoa(iwfk%hdr%npwarr(ikin))))
5654 : : end if
5655 [ - + ]: 17 : if (owfk%hdr%istwfk(ikf) /= iwfk%hdr%istwfk(ikin)) then
5656 : 0 : ABI_ERROR(sjoin("Mismatch in istwfk_k", itoa(owfk%hdr%istwfk(ikf)), "/=", itoa(iwfk%hdr%istwfk(ikin))))
5657 : : end if
5658 : :
5659 : : ! Read wavefunctions from input WFK file.
5660 [ + + ]: 51 : call iwfk%read_band_block([1, nband_k], ikin, spin, xmpio_single, kg_k=kg_k, cg_k=cg_k) !, eig_k=eig_k, occ_k=occ_k)
5661 : : else
5662 : : ! Fill wavefunctions with fake data (npw_k == 1)
5663 [ + + + + ]: 289365 : kg_k = 0
5664 [ + + + + ]: 3578617 : cg_k = zero
5665 : : end if
5666 : :
5667 : : ! Write (kpt, spin) block
5668 [ + + ]: 3364 : eig_k(1:nband_k) = fine_ebands%eig(1:nband_k, ikf, spin)
5669 [ + + ]: 3364 : occ_k(1:nband_k) = fine_ebands%occ(1:nband_k, ikf, spin)
5670 : :
5671 [ + + ]: 524 : call owfk%write_band_block([1, nband_k], ikf, spin, xmpio_single, kg_k=kg_k, cg_k=cg_k, eig_k=eig_k, occ_k=occ_k)
5672 : : end do
5673 : : end do
5674 : :
5675 : : ! Free memory
5676 [ - + ]: 2 : ABI_FREE(kg_k)
5677 [ - + ]: 2 : ABI_FREE(cg_k)
5678 [ - + ]: 2 : ABI_FREE(eig_k)
5679 [ - + ]: 2 : ABI_FREE(occ_k)
5680 [ - + ]: 2 : ABI_FREE(kf2kin)
5681 : : !ABI_FREE(kshe_mask)
5682 : :
5683 : 2 : call cryst%free()
5684 : 2 : call iwfk_ebands%free()
5685 : 2 : call fine_ebands%free()
5686 : 2 : call iwfk%close()
5687 : 2 : call owfk%close()
5688 : :
5689 : : ! Rename files, keep backup copy of input WFK file.
5690 : 2 : call delete_file(my_inpath, ierr)
5691 [ - + ]: 2 : ABI_CHECK(ierr == 0, sjoin("Cannot remove OLD file:", my_inpath))
5692 : : !ABI_CHECK(clib_rename(my_inpath, strcat(my_inpath, ".bkp")) == 0, "Failed to rename input WFK file.")
5693 [ - + ]: 2 : ABI_CHECK(clib_rename(out_wfkpath, my_inpath) == 0, "Failed to rename output WFK file.")
5694 : :
5695 : 0 : call cwtime_report(" WFK with fine k-mesh written to file.", cpu, wall, gflops)
5696 : :
5697 : : ! All procs wait here.
5698 : 2 : 100 call xmpi_barrier(comm)
5699 : :
5700 [ - + - + : 10 : end subroutine wfk_klist2mesh
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - -
- - - - -
- - - - -
- - - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
- - - - -
- - - - -
- - - - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - - - -
- - - - -
- - - - -
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + ]
5701 : : !!***
5702 : :
5703 : : !----------------------------------------------------------------------
5704 : :
5705 : : !!****f* m_wfk/wfk_check_symtab
5706 : : !! NAME
5707 : : !! wfk_check_symtab
5708 : : !!
5709 : : !! FUNCTION
5710 : : !!
5711 : : !! INPUTS
5712 : : !! in_wfkpath = Input WFK file generated with kptopt 3
5713 : : !! Only GS WFK files supported (formeig==0)
5714 : : !!
5715 : : !! SOURCE
5716 : :
5717 : 0 : subroutine wfk_check_symtab(in_wfkpath, comm)
5718 : :
5719 : : use m_krank, only : krank_t, get_ibz2bz, star_from_ibz_idx
5720 : : use m_kpts, only : kpts_ibz_from_kptrlatt, kpts_timrev_from_kptopt, kpts_map, kpts_map_print, kpts_pack_in_stars
5721 : : use m_cgtools, only : fxphas_and_cmp
5722 : :
5723 : : !Arguments ------------------------------------
5724 : : !scalars
5725 : : character(len=*),intent(in) :: in_wfkpath
5726 : : integer,intent(in) :: comm
5727 : :
5728 : : !Local variables-------------------------------
5729 : : !scalars
5730 : : integer,parameter :: formeig0 = 0, master = 0, kptopt1 = 1
5731 : : integer :: spin, nband_k, mpw, mband, nspinor, ik_ibz, ik_bz !, ierr, ikf
5732 : : integer :: nsppol, iomode, npw_kf, npw_ki, istwf_kf, istwf_ki, ii, my_rank, nkibz, nkbz, isym_k, trev_k, g0_k(3)
5733 : : logical :: isirr_k
5734 : : character(len=500) :: msg
5735 : : character(len=fnlen) :: my_inpath
5736 [ # # ]: 0 : type(wfk_t) :: wfk
5737 [ # # # # : 0 : type(crystal_t) :: cryst
# # # # #
# # # # #
# # # # #
# ]
5738 : 0 : type(krank_t) :: krank_ibz
5739 : 0 : type(ebands_t) :: ks_ebands
5740 : : !arrays
5741 : : integer :: work_ngfft(18), gmax(3), gmax_kf(3), gmax_ki(3)
5742 : 0 : integer,allocatable :: symrec_kbz2ibz(:,:), symrel_kbz2ibz(:,:), symrec_ibz2bz(:), symrel_ibz2bz(:), kg_kf(:,:), kg_ki(:,:)
5743 : : real(dp) :: ki(3), kf(3)
5744 : 0 : real(dp),allocatable :: kibz(:,:), kbz(:,:), wtk(:), cg_kf(:,:), cg_ki(:,:), cg_symrel(:,:), cg_symrec(:,:), work(:,:,:,:)
5745 : : ! *************************************************************************
5746 : :
5747 [ # # ]: 0 : my_rank = xmpi_comm_rank(comm); if (my_rank /= master) return
5748 : :
5749 : 0 : call wrtout(std_out, " In wfk_check_symtab")
5750 : :
5751 : : ! Open WFK file with k-point list, extract dimensions and allocate workspace arrays.
5752 [ # # ]: 0 : my_inpath = in_wfkpath
5753 [ # # ]: 0 : if (nctk_try_fort_or_ncfile(my_inpath, msg) /= 0) then
5754 : 0 : ABI_ERROR(msg)
5755 : : end if
5756 [ # # # # : 0 : ks_ebands = wfk_read_ebands(my_inpath, xmpi_comm_self)
# # # # #
# # # # #
# # # # #
# # # ]
5757 [ # # ]: 0 : ABI_CHECK_IEQ(ks_ebands%kptopt, 3, "kptopt should be 3")
5758 : :
5759 : 0 : iomode = iomode_from_fname(my_inpath)
5760 : 0 : call wfk%open_read(my_inpath, formeig0, iomode, get_unit(), xmpi_comm_self)
5761 : 0 : mband = wfk%mband; nsppol = wfk%nsppol; nspinor = wfk%nspinor
5762 : :
5763 [ # # # # : 0 : cryst = wfk%hdr%get_crystal()
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # ]
5764 : :
5765 : : ! Get IBZ with kptopt1 ! ks_ebands%kptopt
5766 : : call kpts_ibz_from_kptrlatt(cryst, ks_ebands%kptrlatt, kptopt1, ks_ebands%nshiftk, ks_ebands%shiftk, &
5767 [ # # # # : 0 : nkibz, kibz, wtk, nkbz, kbz) !, bz2ibz=bz2ibz)
# # ]
5768 : :
5769 [ # # # # : 0 : ABI_CHECK(all(abs(ks_ebands%kptns - kbz) < tol12), "Wrong kbz!")
# # # # ]
5770 : :
5771 : 0 : call krank_ibz%from_kptrlatt(nkibz, kibz, ks_ebands%kptrlatt, compute_invrank=.False.)
5772 : :
5773 : : ! Build symmetry tables using the two conventions.
5774 : :
5775 [ # # # # : 0 : ABI_MALLOC(symrec_kbz2ibz, (6, nkbz))
# # # # #
# # # ]
5776 [ # # ]: 0 : if (kpts_map("symrec", kptopt1, cryst, krank_ibz, nkbz, kbz, symrec_kbz2ibz) /= 0) then
5777 : 0 : ABI_ERROR("Cannot map kBZ to IBZ!")
5778 : : end if
5779 : : ! Index of IBZ k-point in the full BZ (used to access IBZ in the WFK)
5780 [ # # # # : 0 : ABI_MALLOC(symrec_ibz2bz, (nkibz))
# # # # #
# # # ]
5781 [ # # ]: 0 : do ik_bz=1,nkbz
5782 : 0 : ik_ibz = symrec_kbz2ibz(1,ik_bz); isym_k = symrec_kbz2ibz(2,ik_bz)
5783 [ # # ]: 0 : trev_k = symrec_kbz2ibz(6,ik_bz); g0_k = symrec_kbz2ibz(3:5,ik_bz)
5784 [ # # # # : 0 : isirr_k = (isym_k == 1 .and. trev_k == 0 .and. all(g0_k == 0))
# # # # ]
5785 : 0 : if (isirr_k) then
5786 : : !print *, "ik_bz, ik_ibz", ik_bz, ik_ibz
5787 : 0 : symrec_ibz2bz(ik_ibz) = ik_bz
5788 : : end if
5789 : : end do
5790 : :
5791 [ # # # # : 0 : ABI_MALLOC(symrel_kbz2ibz, (6, nkbz))
# # # # ]
5792 [ # # ]: 0 : if (kpts_map("symrel", kptopt1, cryst, krank_ibz, nkbz, kbz, symrel_kbz2ibz) /= 0) then
5793 : 0 : ABI_ERROR("Cannot map kBZ to IBZ!")
5794 : : end if
5795 : : ! Index of IBZ k-point in the full BZ (used to access IBZ in the WFK)
5796 [ # # # # : 0 : ABI_MALLOC(symrel_ibz2bz, (nkibz))
# # # # ]
5797 [ # # ]: 0 : do ik_bz=1,nkbz
5798 : 0 : ik_ibz = symrel_kbz2ibz(1,ik_bz); isym_k = symrel_kbz2ibz(2,ik_bz)
5799 [ # # ]: 0 : trev_k = symrel_kbz2ibz(6,ik_bz); g0_k = symrel_kbz2ibz(3:5,ik_bz)
5800 [ # # # # : 0 : isirr_k = (isym_k == 1 .and. trev_k == 0 .and. all(g0_k == 0))
# # # # ]
5801 : 0 : if (isirr_k) symrel_ibz2bz(ik_ibz) = ik_bz
5802 : : end do
5803 : :
5804 : : ! Allocate workspace arrays for wavefunction block.
5805 [ # # ]: 0 : mpw = maxval(ks_ebands%npwarr)
5806 [ # # # # : 0 : ABI_MALLOC(kg_kf, (3, mpw))
# # # # #
# # # #
# ]
5807 [ # # # # : 0 : ABI_MALLOC(kg_ki, (3, mpw))
# # # # #
# ]
5808 [ # # # # : 0 : ABI_MALLOC(cg_kf, (2, mpw * nspinor * mband))
# # # # #
# # # #
# ]
5809 [ # # # # : 0 : ABI_MALLOC(cg_ki, (2, mpw * nspinor * mband))
# # # # #
# ]
5810 [ # # # # : 0 : ABI_MALLOC(cg_symrel, (2, mpw * nspinor * mband))
# # # # ]
5811 [ # # # # : 0 : ABI_MALLOC(cg_symrec, (2, mpw * nspinor * mband))
# # # # ]
5812 : : !ABI_MALLOC(eig_k, ((2*mband)**wfk%formeig * mband) )
5813 : : !ABI_MALLOC(occ_k, (mband))
5814 : :
5815 [ # # ]: 0 : do spin=1,nsppol
5816 : : ! Note how we loop over the full BZ as this is what we have in the WFK file.
5817 [ # # ]: 0 : do ik_bz=1,nkbz
5818 : :
5819 : 0 : nband_k = wfk%nband(ik_bz, spin)
5820 : 0 : nband_k = min(4, nband_k)
5821 : :
5822 : : ! Read wavefunctions at full k.
5823 : 0 : npw_kf = wfk%hdr%npwarr(ik_bz)
5824 : 0 : istwf_kf = wfk%hdr%istwfk(ik_bz)
5825 : 0 : kf = ks_ebands%kptns(:, ik_bz)
5826 [ # # ]: 0 : call wfk%read_band_block([1, nband_k], ik_bz, spin, xmpio_single, cg_k=cg_kf, kg_k=kg_kf)
5827 : :
5828 : : ! -----------------------------------------------
5829 : : ! Build ik_bz from ik_ibz using symrel convention
5830 : : ! -----------------------------------------------
5831 : :
5832 : 0 : ik_ibz = symrel_kbz2ibz(1,ik_bz); isym_k = symrel_kbz2ibz(2,ik_bz)
5833 [ # # ]: 0 : trev_k = symrel_kbz2ibz(6,ik_bz); g0_k = symrel_kbz2ibz(3:5,ik_bz)
5834 [ # # # # : 0 : isirr_k = (isym_k == 1 .and. trev_k == 0 .and. all(g0_k == 0))
# # # # ]
5835 : :
5836 : : if (isirr_k) cycle
5837 : :
5838 : 0 : ii = symrel_ibz2bz(ik_ibz)
5839 [ # # ]: 0 : ki = ks_ebands%kptns(:, ii)
5840 : 0 : npw_ki = wfk%hdr%npwarr(ii)
5841 : 0 : istwf_ki = wfk%hdr%istwfk(ii)
5842 : : !write(std_out, *), "kf: ", trim(ktoa(kf)), "istwf_kf:", istwf_kf
5843 : : !write(std_out, *), "ki: ", trim(ktoa(ki)), "istwf_ki:", istwf_ki
5844 : : !ABI_CHECK_IEQ(istwf_ki, istwf_kf, "istwf_ki /= istwf_kf")
5845 : :
5846 [ # # ]: 0 : call wfk%read_band_block([1, nband_k], ii, spin, xmpio_single, cg_k=cg_ki, kg_k=kg_ki)
5847 : :
5848 : : ! FFT box must enclose the two spheres centered on kdisk and kf
5849 [ # # # # : 0 : gmax_kf = maxval(abs(kg_kf(:, 1:npw_kf)), dim=2)
# # ]
5850 [ # # # # : 0 : gmax_ki = maxval(abs(kg_ki(:, 1:npw_ki)), dim=2)
# # ]
5851 [ # # ]: 0 : do ii=1,3
5852 : 0 : gmax(ii) = max(gmax_kf(ii), gmax_ki(ii))
5853 : : end do
5854 [ # # ]: 0 : gmax = 2 * gmax + 1
5855 : 0 : call ngfft_seq(work_ngfft, gmax)
5856 [ # # # # : 0 : ABI_CALLOC(work, (2, work_ngfft(4), work_ngfft(5), work_ngfft(6)))
# # # # #
# # # # #
# # # # #
# # # # #
# # # # ]
5857 : :
5858 : : call cgtk_rotate(cryst, ki, isym_k, trev_k, g0_k, nspinor, nband_k, &
5859 : 0 : npw_ki, kg_ki, npw_kf, kg_kf, istwf_ki, istwf_kf, cg_ki, cg_symrel, work_ngfft, work)
5860 : :
5861 : : ! Compare cg_kf with cg_symrel taking into account a possible gauge.
5862 [ # # ]: 0 : if (.not. fxphas_and_cmp(npw_kf, nspinor, nband_k, istwf_kf, cg_kf, cg_symrel, ks_ebands%eig(:, ik_bz, spin), msg)) then
5863 : 0 : call wrtout(std_out, msg)
5864 : : end if
5865 : :
5866 : : ! -----------------------------------------------
5867 : : ! Build ik_bz from ik_ibz using symrec convention
5868 : : ! -----------------------------------------------
5869 : 0 : ik_ibz = symrec_kbz2ibz(1,ik_bz); isym_k = symrec_kbz2ibz(2,ik_bz)
5870 [ # # ]: 0 : trev_k = symrec_kbz2ibz(6,ik_bz); g0_k = symrec_kbz2ibz(3:5,ik_bz)
5871 : 0 : isirr_k = (isym_k == 1 .and. trev_k == 0 .and. all(g0_k == 0))
5872 : :
5873 : 0 : ii = symrec_ibz2bz(ik_ibz)
5874 [ # # ]: 0 : ki = ks_ebands%kptns(:, ii)
5875 : 0 : npw_ki = wfk%hdr%npwarr(ii)
5876 : 0 : istwf_ki = wfk%hdr%istwfk(ii)
5877 : : !write(std_out, *), "kf: ", trim(ktoa(kf)), "istwf_kf:", istwf_kf
5878 : : !write(std_out, *), "ki: ", trim(ktoa(ki)), "istwf_ki:", istwf_ki
5879 : : !ABI_CHECK_IEQ(istwf_ki, istwf_kf, "istwf_ki /= istwf_kf")
5880 : :
5881 [ # # ]: 0 : call wfk%read_band_block([1, nband_k], ii, spin, xmpio_single, cg_k=cg_ki, kg_k=kg_ki)
5882 : :
5883 : : !call cgtk_rotate_symrec(cryst, ki, isym_k, trev_k, g0_k, nspinor, nband_k, &
5884 : : ! npw_ki, kg_ki, npw_kf, kg_kf, istwf_ki, istwf_kf, cg_ki, cg_symrec, work_ngfft, work)
5885 : :
5886 : : ! Compare cg_kf with cg_symrel taking into account a possible gauge.
5887 : : !if (.not. fxphas_and_cmp(npw_kf, nspinor, nband_k, istwf_kf, cg_kf, cg_symrec, ks_ebands%eig(:, ik_bz, spin), msg)) then
5888 : : ! call wrtout(std_out, msg)
5889 : : !end if
5890 : :
5891 [ # # ]: 0 : ABI_FREE(work)
5892 : : end do
5893 : : end do
5894 : :
5895 : : ! Free memory
5896 [ # # ]: 0 : ABI_FREE(symrec_kbz2ibz)
5897 [ # # ]: 0 : ABI_FREE(symrel_kbz2ibz)
5898 [ # # ]: 0 : ABI_FREE(symrec_ibz2bz)
5899 [ # # ]: 0 : ABI_FREE(symrel_ibz2bz)
5900 [ # # ]: 0 : ABI_FREE(kibz)
5901 [ # # ]: 0 : ABI_FREE(kbz)
5902 [ # # ]: 0 : ABI_FREE(wtk)
5903 : 0 : call krank_ibz%free()
5904 : :
5905 [ # # ]: 0 : ABI_FREE(kg_kf)
5906 [ # # ]: 0 : ABI_FREE(cg_kf)
5907 [ # # ]: 0 : ABI_FREE(kg_ki)
5908 [ # # ]: 0 : ABI_FREE(cg_ki)
5909 [ # # ]: 0 : ABI_FREE(cg_symrel)
5910 [ # # ]: 0 : ABI_FREE(cg_symrec)
5911 : : ABI_SFREE(work)
5912 : : !ABI_FREE(eig_k)
5913 : : !ABI_FREE(occ_k)
5914 : :
5915 : 0 : call cryst%free()
5916 : 0 : call ks_ebands%free()
5917 : 0 : call wfk%close()
5918 : :
5919 [ # # # # : 0 : end subroutine wfk_check_symtab
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # ]
5920 : : !!***
5921 : :
5922 : : !----------------------------------------------------------------------
5923 : :
5924 [ - + - - : 3798 : end module m_wfk
+ + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - - - -
- - - - -
- - - - -
- + + - -
+ - + -
+ ]
5925 : : !!***
|
