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