Octopus
states_elec_restart.F90
Go to the documentation of this file.
1!! Copyright (C) 2002-2016 M. Marques, A. Castro, A. Rubio, G. Bertsch, X. Andrade
2!!
3!! This program is free software; you can redistribute it and/or modify
4!! it under the terms of the GNU General Public License as published by
5!! the Free Software Foundation; either version 2, or (at your option)
6!! any later version.
7!!
8!! This program is distributed in the hope that it will be useful,
9!! but WITHOUT ANY WARRANTY; without even the implied warranty of
10!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11!! GNU General Public License for more details.
12!!
13!! You should have received a copy of the GNU General Public License
14!! along with this program; if not, write to the Free Software
15!! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
16!! 02110-1301, USA.
17!!
18
19#include "global.h"
20
22
24#ifdef HAVE_ADIOS2
25 use adios2
26#endif
27 use batch_oct_m
29 use debug_oct_m
31 use global_oct_m
33 use, intrinsic :: iso_fortran_env
37 use loct_oct_m
38 use math_oct_m
39 use mesh_oct_m
43 use mpi_oct_m
47 use parser_oct_m
51 use smear_oct_m
52 use space_oct_m
57 use string_oct_m
58 use types_oct_m
60
61 implicit none
62
63
64 private
65 public :: &
77
78contains
79
80 ! ---------------------------------------------------------
81 subroutine states_elec_look_and_load(restart, namespace, space, st, mesh, kpoints, is_complex, packed)
82 type(restart_t), intent(in) :: restart
83 type(namespace_t), intent(in) :: namespace
84 class(space_t), intent(in) :: space
85 type(states_elec_t), target, intent(inout) :: st
86 class(mesh_t), intent(in) :: mesh
87 type(kpoints_t), intent(in) :: kpoints
88 logical, optional, intent(in) :: is_complex
89 logical, optional, intent(in) :: packed
90
91 integer :: nkpt, dim, nst, ierr
92 real(real64), allocatable :: new_occ(:,:)
93
95
96 !check how many wfs we have
97 call states_elec_look(restart, nkpt, dim, nst, ierr)
98 if (ierr /= 0) then
99 message(1) = "Unable to read states information."
100 call messages_fatal(1, namespace=namespace)
101 end if
102
103 if (st%parallel_in_states) then
104 message(1) = "Internal error: cannot use states_elec_look_and_load when parallel in states."
105 call messages_fatal(1, namespace=namespace)
106 end if
107
108 ! Resize st%occ, retaining information there
109 allocate(new_occ(1:nst, 1:st%nik))
110 new_occ(:,:) = m_zero
111 new_occ(1:min(nst, st%nst),:) = st%occ(1:min(nst, st%nst),:)
112 safe_deallocate_a(st%occ)
113 call move_alloc(new_occ, st%occ)
114
115 ! FIXME: This wrong, one cannot just change the number of states
116 ! without updating the internal structures, in the case of parallel in states.
117 ! I think it is right now without state parallelism.
118 st%nst = nst
119 st%st_start = 1
120 st%st_end = nst
121 st%lnst = nst
122
123 safe_deallocate_a(st%node)
124 safe_allocate(st%node(1:st%nst))
125 st%node(:) = 0
126
127 safe_deallocate_a(st%eigenval)
128 safe_allocate(st%eigenval(1:st%nst, 1:st%nik))
129 st%eigenval = huge(st%eigenval)
130
131 if (present(is_complex)) then
132 if (is_complex) then
133 call states_elec_allocate_wfns(st, mesh, type_cmplx, packed=optional_default(packed, .false.))
134 else
135 call states_elec_allocate_wfns(st, mesh, type_float, packed=optional_default(packed, .false.))
136 end if
137 else
138 ! allow states_elec_allocate_wfns to decide for itself whether complex or real needed
139 call states_elec_allocate_wfns(st, mesh, packed=optional_default(packed, .false.))
140 end if
141
142 if (st%d%ispin == spinors) then
143 safe_allocate(st%spin(1:3, 1:st%nst, 1:st%nik))
144 st%spin = m_zero
145 end if
146
147 ! load wavefunctions
148 call states_elec_load(restart, namespace, space, st, mesh, kpoints, ierr)
149 if (ierr /= 0) then
150 message(1) = "Unable to read wavefunctions."
151 call messages_fatal(1, namespace=namespace)
152 end if
153
155 end subroutine states_elec_look_and_load
156
157
158 ! ---------------------------------------------------------
159 subroutine states_elec_dump(restart, space, st, mesh, kpoints, ierr, iter, lr, verbose)
160 type(restart_t), intent(in) :: restart
161 class(space_t), intent(in) :: space
162 type(states_elec_t), target, intent(in) :: st
163 class(mesh_t), intent(in) :: mesh
164 type(kpoints_t), intent(in) :: kpoints
165 integer, intent(out) :: ierr
166 integer, optional, intent(in) :: iter
167 type(lr_t), optional, intent(in) :: lr
168 logical, optional, intent(in) :: verbose
169
170 integer :: iunit_wfns, iunit_occs, iunit_states
171 integer :: err, err2(2), ik, idir, ist, idim, itot
172 integer :: root(1:P_STRATEGY_MAX)
173 character(len=MAX_PATH_LEN) :: filename
174 character(len=500) :: lines(3)
175 logical :: lr_wfns_are_associated, should_write, verbose_
176 real(real64) :: kpoint(space%dim)
177 real(real64), allocatable :: dpsi(:)
178 complex(real64), allocatable :: zpsi(:)
179 integer :: restart_file_format
180
181 push_sub(states_elec_dump)
182
183 verbose_ = optional_default(verbose, .true.)
184
185 ierr = 0
186
187 if (restart%skip()) then
188 pop_sub(states_elec_dump)
189 return
190 end if
191
192 if (verbose_) then
193 message(1) = "Info: Writing states."
194 call print_date(trim(message(1))//' ')
195 end if
196
197 call profiling_in("RESTART_WRITE")
198
199 restart_file_format = restart%file_format_states
200 if (present(lr)) then
201 lr_wfns_are_associated = (allocated(lr%ddl_psi) .and. states_are_real(st)) .or. &
202 (allocated(lr%zdl_psi) .and. states_are_complex(st))
203 assert(lr_wfns_are_associated)
204 ! always use obf format for linear response
205 restart_file_format = option__restartfileformatstates__obf
206 end if
207
209
210 iunit_states = restart%open('states')
211 write(lines(1), '(a20,1i10)') 'nst= ', st%nst
212 write(lines(2), '(a20,1i10)') 'dim= ', st%d%dim
213 write(lines(3), '(a20,1i10)') 'nik= ', st%nik
214 call restart%write(iunit_states, lines, 3, err)
215 if (err /= 0) ierr = ierr + 1
216 call restart%close(iunit_states)
217
218
219 iunit_wfns = restart%open('wfns')
220 lines(1) = '# #k-point #st #dim filename'
221 if (states_are_real(st)) then
222 lines(2) = '%Real_Wavefunctions'
223 else
224 lines(2) = '%Complex_Wavefunctions'
225 end if
226 call restart%write(iunit_wfns, lines, 2, err)
227 if (err /= 0) ierr = ierr + 2
228
229
230 iunit_occs = restart%open('occs')
231 lines(1) = '# occupations | eigenvalue[a.u.] | Im(eigenvalue) [a.u.] | k-points | k-weights | filename | ik | ist | idim'
232 lines(2) = '%Occupations_Eigenvalues_K-Points'
233 call restart%write(iunit_occs, lines, 2, err)
234 if (err /= 0) ierr = ierr + 4
235
236
237 if (states_are_real(st)) then
238 safe_allocate(dpsi(1:mesh%np))
239 else
240 safe_allocate(zpsi(1:mesh%np))
241 end if
242
243 itot = 1
244 root = -1
245 err2 = 0
246 do ik = 1, st%nik
247 kpoint(1:space%dim) = &
248 kpoints%get_point(st%d%get_kpoint_index(ik), absolute_coordinates = .true.)
249
250 do ist = 1, st%nst
251 do idim = 1, st%d%dim
252 root(p_strategy_domains) = mod(itot - 1, mesh%mpi_grp%size)
253 write(filename,'(i10.10)') itot
255 write(lines(1), '(i8,a,i8,a,i8,3a)') ik, ' | ', ist, ' | ', idim, ' | "', trim(filename), '"'
256 call restart%write(iunit_wfns, lines, 1, err)
257 if (err /= 0) err2(1) = err2(1) + 1
258
259 write(lines(1), '(e23.16,a,e23.16)') st%occ(ist,ik), ' | ', st%eigenval(ist, ik)
260 write(lines(1), '(a,a,e23.16)') trim(lines(1)), ' | ', m_zero
261 do idir = 1, space%dim
262 write(lines(1), '(a,a,e23.16)') trim(lines(1)), ' | ', kpoint(idir)
263 end do
264 write(lines(1), '(a,a,e23.16,a,i10.10,3(a,i8))') trim(lines(1)), &
265 ' | ', st%kweights(ik), ' | ', itot, ' | ', ik, ' | ', ist, ' | ', idim
266 call restart%write(iunit_occs, lines, 1, err)
267 if (err /= 0) err2(1) = err2(1) + 1
268
269 should_write = st%st_start <= ist .and. ist <= st%st_end
270
271 if (restart_file_format == option__restartfileformatstates__obf) then
272 if (should_write) then
273 if (st%d%kpt%start <= ik .and. ik <= st%d%kpt%end) then
274 if (states_are_real(st)) then
275 if (.not. present(lr)) then
276 call states_elec_get_state(st, mesh, idim, ist, ik, dpsi)
277 call restart%write_mesh_function(filename, mesh, dpsi, err, root = root)
278 else
279 call restart%write_mesh_function(filename, mesh, &
280 lr%ddl_psi(:, idim, ist, ik), err, root = root)
281 end if
282 else
283 if (.not. present(lr)) then
284 call states_elec_get_state(st, mesh, idim, ist, ik, zpsi)
285 call restart%write_mesh_function(filename, mesh, zpsi, err, root = root)
286 else
287 call restart%write_mesh_function(filename, mesh, &
288 lr%zdl_psi(:, idim, ist, ik), err, root = root)
289 end if
290 end if
291 else
292 err = 0
293 end if
294 end if
295 if (err /= 0) err2(2) = err2(2) + 1
296 end if
297
298 itot = itot + 1
299 end do ! st%d%dim
300 end do ! st%nst
301 end do ! st%nik
302 if (err2(1) /= 0) ierr = ierr + 8
303 if (err2(2) /= 0) ierr = ierr + 16
304
305 safe_deallocate_a(dpsi)
306 safe_deallocate_a(zpsi)
307
308 if (restart_file_format == option__restartfileformatstates__adios2) then
309 if (present(lr)) then
310 ! this should never occur because we force obf format for linear response
311 call messages_not_implemented("ADIOS2 restart file format with linear response.")
312 end if
313 call states_elec_dump_adios2(restart, st, mesh, ierr)
314 end if
315
316 lines(1) = '%'
317 call restart%write(iunit_occs, lines, 1, err)
318 if (err /= 0) ierr = ierr + 32
319 call restart%write(iunit_wfns, lines, 1, err)
320 if (err /= 0) ierr = ierr + 64
321 if (present(iter)) then
322 write(lines(1),'(a,i7)') 'Iter = ', iter
323 call restart%write(iunit_wfns, lines, 1, err)
324 if (err /= 0) ierr = ierr + 128
325 end if
326
327 call restart%close(iunit_wfns)
328 call restart%close(iunit_occs)
329
330 if (verbose_) then
331 message(1) = "Info: Finished writing states."
332 call print_date(trim(message(1))//' ')
333 end if
334
336
337 call profiling_out("RESTART_WRITE")
338 pop_sub(states_elec_dump)
339 end subroutine states_elec_dump
340
341 ! ---------------------------------------------------------
342 subroutine states_elec_dump_adios2(restart, st, mesh, ierr)
343 type(restart_t), intent(in) :: restart
344 type(states_elec_t), target, intent(in) :: st
345 class(mesh_t), intent(in) :: mesh
346 integer, intent(out) :: ierr
347
348#ifdef HAVE_ADIOS2
349 type(adios2_adios) :: adios
350 type(adios2_io) :: io
351 type(adios2_variable) :: var, var_indices
352 type(adios2_attribute) :: attribute
353 type(adios2_engine) :: engine
354 integer :: adios2_type, ik, ib, ip, adios2_mode
355 integer(int64), allocatable :: global_indices(:)
356 class(wfs_elec_t), pointer :: psib
357#endif
359
360#ifdef HAVE_ADIOS2
361#ifdef HAVE_MPI
362 call adios2_init(adios, restart%mpi_grp%comm%MPI_VAL, ierr)
363#else
364 call adios2_init(adios, ierr)
365#endif
366 call check_error(.not. adios%valid .or. ierr /= adios2_error_none, "Problem initializing ADIOS2.")
367 call adios2_declare_io(io, adios, "writer", ierr)
368 call check_error(.not. io%valid .or. ierr /= adios2_error_none, "Problem initializing ADIOS2.")
369 ! do not compute min and max
370 call adios2_set_parameter(io, "StatsLevel", "0", ierr)
371 call check_error(ierr /= adios2_error_none, "Problem setting ADIOS2 parameter.")
372 ! open restart file
373 call adios2_open(engine, io, trim(restart%dir())//"/"//"wavefunctions.bp", adios2_mode_write, ierr)
374 call check_error(.not. engine%valid .or. ierr /= adios2_error_none, "Problem opening ADIOS2 restart file.")
375 if (states_are_real(st)) then
376 adios2_type = adios2_type_dp
377 else
378 adios2_type = adios2_type_complex_dp
379 end if
380 ! define one variable for all states
381 call adios2_define_variable(var, io, "wavefunctions", adios2_type, 3, &
382 [int(st%nst * st%d%dim, int64), int(mesh%np_global, int64), int(st%nik, int64)], & ! global size of wavefunctions
383 [0_int64, 0_int64, 0_int64], & ! local selection of the variable, overwritten by set_selection call below
384 [1_int64, 1_int64, 1_int64], &
385 adios2_variable_dims, ierr)
386 call check_error(.not. var%valid .or. ierr /= adios2_error_none, "Problem creating ADIOS2 variable (wavefunctions).")
387 ! save ParDomains in an attribute
388 call adios2_define_attribute(attribute, io, "ParDomains", mesh%mpi_grp%size, ierr)
389 call check_error(.not. attribute%valid .or. ierr /= adios2_error_none, "Problem creating ADIOS2 attribute (ParDomains).")
390 ! define one variable for all states
391 call adios2_define_variable(var_indices, io, "global_indices", adios2_type_integer8, 1, &
392 [int(mesh%np_global, int64)], & ! global size of array
393 [int(mesh%pv%xlocal-1, int64)], & ! local offset
394 [int(mesh%np, int64)], & ! local size
395 adios2_variable_dims, ierr)
396 call check_error(.not. var_indices%valid .or. ierr /= adios2_error_none, "Problem creating ADIOS2 variable (global_indices).")
397 ! save grid indices
398 safe_allocate(global_indices(mesh%np))
399 do ip = 1, mesh%np
400 global_indices(ip) = par_vec_local2global(mesh%pv, ip)
401 end do
402
403 call adios2_begin_step(engine, ierr)
404 call adios2_put(engine, var_indices, global_indices, ierr)
405
406 do ik = st%d%kpt%start, st%d%kpt%end
407 do ib = st%group%block_start, st%group%block_end
408 ! make sure we have a batch in BATCH_PACKED status
409 select case (st%group%psib(ib, ik)%status())
410 case (batch_not_packed)
411 safe_allocate(psib)
412 call st%group%psib(ib, ik)%copy_to(psib)
413 ! transform the unpacked batch to a packed batch on the CPU
414 call psib%do_pack(batch_packed)
415 ! we need to use sync mode in this case because we use a temporary batch
416 adios2_mode = adios2_mode_sync
417 case (batch_packed)
418 psib => st%group%psib(ib, ik)
419 adios2_mode = adios2_mode_deferred
421 safe_allocate(psib)
422 call st%group%psib(ib, ik)%copy_to(psib, copy_data=.true.)
423 ! copy to CPU
424 call psib%do_unpack(force=.true.)
425 ! make sure the batch is in packed state on the CPU
426 call psib%do_pack(batch_packed)
427 ! we need to use sync mode in this case because we use a temporary batch
428 adios2_mode = adios2_mode_sync
429 end select
430 assert(psib%status() == batch_packed)
431
432 ! select part of variable to write, correspond to the memory of the current batch
433 ! first argument gives the start in the global array (-1 needed for C indexing in ADIOS2)
434 ! second argument gives the size of the local batch
435 call adios2_set_selection(var, 3, &
436 [int((states_elec_block_min(st, ib)-1)*st%d%dim, int64), int(mesh%pv%xlocal-1, int64), int(ik-1, int64)], &
437 [int(st%group%psib(ib, ik)%nst_linear, int64), int(mesh%np, int64), 1_int64], ierr)
438 ! set memory layout of one batch, take into account padding and ghost/boundary points
439 if (states_are_real(st)) then
440 call adios2_set_memory_selection(var, 3, [0_int64, 0_int64, 0_int64], &
441 [int(size(psib%dff_pack, 1), int64), &
442 int(size(psib%dff_pack, 2), int64), 1_int64], ierr)
443 call adios2_put(engine, var, psib%dff_pack, adios2_mode, ierr)
444 else
445 call adios2_set_memory_selection(var, 3, [0_int64, 0_int64, 0_int64], &
446 [int(size(psib%zff_pack, 1), int64), &
447 int(size(psib%zff_pack, 2), int64), 1_int64], ierr)
448 call adios2_put(engine, var, psib%zff_pack, adios2_mode, ierr)
449 end if
450 select case (st%group%psib(ib, ik)%status())
452 call psib%end()
453 safe_deallocate_p(psib)
454 case (batch_packed)
455 nullify(psib)
456 end select
457 end do
458 end do
459 call adios2_end_step(engine, ierr)
460
461 ! deallocate only after end_step because only now everything has been written
462 safe_deallocate_a(global_indices)
463
464 ! close restart file
465 call adios2_close(engine, ierr)
466 call check_error(ierr /= adios2_error_none, "Problem closing ADIOS2 engine.")
467 call adios2_finalize(adios, ierr)
468 call check_error(ierr /= adios2_error_none, "Problem finalizing ADIOS2.")
469#else
470 ! avoid empty routine
471 ierr = 0
472#endif
473
475 end subroutine states_elec_dump_adios2
476
477
478 ! ---------------------------------------------------------
483 subroutine states_elec_load(restart, namespace, space, st, mesh, kpoints, ierr, iter, lr, lowest_missing, label, verbose, skip)
484 type(restart_t), intent(in) :: restart
485 type(namespace_t), intent(in) :: namespace
486 class(space_t), intent(in) :: space
487 type(states_elec_t), target, intent(inout) :: st
488 class(mesh_t), intent(in) :: mesh
489 type(kpoints_t), intent(in) :: kpoints
490 integer, intent(out) :: ierr
491 integer, optional, intent(out) :: iter
492 type(lr_t), optional, intent(inout) :: lr
493 integer, optional, intent(out) :: lowest_missing(:, :)
494 character(len=*), optional, intent(in) :: label
495 logical, optional, intent(in) :: verbose
496 logical, optional, intent(in) :: skip(:)
497
498 integer :: states_elec_file, wfns_file, occ_file, err, ik, ist, idir, idim
499 integer :: idone, iread, ntodo
500 character(len=12) :: filename
501 character(len=1) :: char
502 logical, allocatable :: filled(:, :, :)
503 character(len=256) :: lines(3), label_
504 character(len=50) :: str
505
506 real(real64) :: my_occ, imev, my_kweight
507 logical :: read_occ, lr_allocated, verbose_
508 logical :: integral_occs
509 real(real64), allocatable :: dpsi(:)
510 complex(real64), allocatable :: zpsi(:)
511 character(len=256), allocatable :: restart_file(:, :, :)
512 logical, allocatable :: restart_file_present(:, :, :)
513 real(real64) :: kpoint(space%dim), read_kpoint(space%dim)
514
515 integer :: iread_tmp
516 integer, allocatable :: lowest_missing_tmp(:, :)
517 integer :: restart_file_format
518
519 push_sub(states_elec_load)
520
521 ierr = 0
522
523 ! make sure these intent(out)`s are initialized no matter what
524 if (present(lowest_missing)) lowest_missing = 1
525 if (present(iter)) iter = 0
526
527 if (present(skip)) then
528 assert(ubound(skip, dim = 1) == st%nst)
529 end if
530
531 if (restart%skip()) then
532 ierr = -1
533 pop_sub(states_elec_load)
534 return
535 end if
536
537 call profiling_in("RESTART_READ")
538
539 verbose_ = optional_default(verbose, .true.)
540
541 if (present(label)) then
542 label_ = trim(label)
543 else
544 if (present(lr)) then
545 label_ = " for linear response"
546 else
547 label_ = ""
548 end if
549 end if
550
551 message(1) = 'Info: Reading states'
552 if (len(trim(label_)) > 0) then
553 message(1) = trim(message(1)) // trim(label_)
554 end if
555 message(1) = trim(message(1)) // "."
556 if (verbose_) call print_date(trim(message(1))//' ')
557
558 if (.not. present(lr)) then
559 st%fromScratch = .false. ! obviously, we are using restart info
560 end if
561
562 ! If one restarts a GS calculation changing the %Occupations block, one
563 ! cannot read the occupations, otherwise these overwrite the ones from
564 ! the input file. restart_fixed_occ makes that we do use the ones in the file.
565 integral_occs = .true. ! only used if restart_fixed_occ
566 if (st%restart_fixed_occ) then
567 read_occ = .true.
568 st%fixed_occ = .true.
569 else
570 read_occ = .not. st%fixed_occ
571 end if
572
573 if (.not. present(lr)) then
574 st%eigenval(:, :) = m_zero
575 ! to be filled in from reading afterward
576 end if
577
578 if (.not. present(lr) .and. read_occ) then
579 st%occ(:, :) = m_zero
580 ! to be filled in from reading afterward
581 end if
582
583 restart_file_format = restart%file_format_states
584 ! sanity check
585 if (present(lr)) then
586 lr_allocated = (allocated(lr%ddl_psi) .and. states_are_real(st)) .or. &
587 (allocated(lr%zdl_psi) .and. states_are_complex(st))
588 assert(lr_allocated)
589 ! always use obf format for linear response
590 restart_file_format = option__restartfileformatstates__obf
591 end if
592
593 states_elec_file = restart%open('states')
594 ! sanity check on spin/k-points. Example file 'states':
595 ! nst= 2
596 ! dim= 1
597 ! nik= 2
598 call restart%read(states_elec_file, lines, 3, err)
599 if (err /= 0) then
600 ierr = ierr - 2
601 else
602 read(lines(2), *) str, idim
603 read(lines(3), *) str, ik
604 if (idim == 2 .and. st%d%dim == 1) then
605 write(message(1),'(a)') 'Incompatible restart information: saved calculation is spinors, this one is not.'
606 call messages_warning(1, namespace=namespace)
607 ierr = ierr - 2**2
608 end if
609 if (idim == 1 .and. st%d%dim == 2) then
610 write(message(1),'(a)') 'Incompatible restart information: this calculation is spinors, saved one is not.'
611 call messages_warning(1, namespace=namespace)
612 ierr = ierr - 2**3
613 end if
614 if (ik < st%nik) then
615 write(message(1),'(a)') 'Incompatible restart information: not enough k-points.'
616 write(message(2),'(2(a,i6))') 'Expected ', st%nik, ' > Read ', ik
617 call messages_warning(2, namespace=namespace)
618 end if
619 ! We will check that they are the right k-points later, so we do not need to put a specific error here.
620 end if
621 call restart%close(states_elec_file)
622
623
624 ! open files to read
625 wfns_file = restart%open('wfns')
626 occ_file = restart%open('occs')
627 call restart%read(wfns_file, lines, 2, err)
628 if (err /= 0) then
629 ierr = ierr - 2**5
630 else if (states_are_real(st)) then
631 read(lines(2), '(a)') str
632 if (str(2:8) == 'Complex') then
633 message(1) = "Cannot read real states from complex wavefunctions."
634 call messages_warning(1, namespace=namespace)
635 ierr = ierr - 2**6
636 else if (str(2:5) /= 'Real') then
637 message(1) = "Restart file 'wfns' does not specify real/complex; cannot check compatibility."
638 call messages_warning(1, namespace=namespace)
639 end if
640 end if
641 ! complex can be restarted from real, so there is no problem.
642
643 ! Skip two lines.
644 call restart%read(occ_file, lines, 2, err)
645 if (err /= 0) ierr = ierr - 2**7
646
647 ! If any error occured up to this point then it is not worth continuing,
648 ! as there something fundamentally wrong with the restart files
649 if (ierr /= 0) then
650 call restart%close(wfns_file)
651 call restart%close(occ_file)
652 call profiling_out("RESTART_READ")
653 pop_sub(states_elec_load)
654 return
655 end if
656
657 if (states_are_real(st)) then
658 safe_allocate(dpsi(1:mesh%np))
659 else
660 safe_allocate(zpsi(1:mesh%np))
661 end if
662
663 safe_allocate(restart_file(1:st%d%dim, st%st_start:st%st_end, 1:st%nik))
664 safe_allocate(restart_file_present(1:st%d%dim, st%st_start:st%st_end, 1:st%nik))
665 restart_file_present = .false.
666
667 ! Next we read the list of states from the files.
668 ! Errors in reading the information of a specific state from the files are ignored
669 ! at this point, because later we will skip reading the wavefunction of that state.
670 do
671 call restart%read(wfns_file, lines, 1, err)
672 if (err == 0) then
673 read(lines(1), '(a)') char
674 if (char == '%') then
675 !We reached the end of the file
676 exit
677 else
678 read(lines(1), *) ik, char, ist, char, idim, char, filename
679 end if
680 end if
681
682 if (err /= 0 .or. index_is_wrong()) then
683 call restart%read(occ_file, lines, 1, err)
684 cycle
685 end if
686
687 if (ist >= st%st_start .and. ist <= st%st_end .and. &
688 ik >= st%d%kpt%start .and. ik <= st%d%kpt%end) then
689
690 restart_file(idim, ist, ik) = trim(filename)
691 restart_file_present(idim, ist, ik) = .true.
692 end if
693
694 call restart%read(occ_file, lines, 1, err)
695 if (.not. present(lr)) then ! do not read eigenvalues or occupations when reading linear response
696 ! # occupations | eigenvalue[a.u.] | Im(eigenvalue) [a.u.] | k-points | k-weights | filename | ik | ist | idim
697
698 if (err == 0) then
699 read(lines(1), *) my_occ, char, st%eigenval(ist, ik), char, imev, char, &
700 (read_kpoint(idir), char, idir = 1, space%dim), my_kweight
701 ! we do not want to read the k-weights, we have already set them appropriately
702 else
703 ! There is a problem with this states information, so we skip it.
704 if (ist >= st%st_start .and. ist <= st%st_end .and. &
705 ik >= st%d%kpt%start .and. ik <= st%d%kpt%end) then
706 restart_file_present(idim, ist, ik) = .false.
707 end if
708 cycle
709 end if
710
711 kpoint(1:space%dim) = &
712 kpoints%get_point(st%d%get_kpoint_index(ik), absolute_coordinates = .true.)
713 ! FIXME: maybe should ignore ik and just try to match actual vector k-points?
714 if (any(abs(kpoint(1:space%dim) - read_kpoint(1:space%dim)) > 1e-12_real64)) then
715 ! write only once for each k-point so as not to be too verbose
716 if (ist == 1) then
717 write(message(1),'(a,i6)') 'Incompatible restart information: k-point mismatch for ik ', ik
718 write(message(2),'(a,99f18.12)') ' Expected : ', kpoint(1:space%dim)
719 write(message(3),'(a,99f18.12)') ' Read : ', read_kpoint(1:space%dim)
720 call messages_warning(3, namespace=namespace)
721 end if
722 if (ist >= st%st_start .and. ist <= st%st_end .and. &
723 ik >= st%d%kpt%start .and. ik <= st%d%kpt%end) then
724 restart_file_present(idim, ist, ik) = .false.
725 end if
726 end if
727
728 if (read_occ) then
729 st%occ(ist, ik) = my_occ
730 integral_occs = integral_occs .and. &
731 abs((st%occ(ist, ik) - st%smear%el_per_state) * st%occ(ist, ik)) <= m_epsilon
732 end if
733 end if
734 end do
735
736 if (present(iter)) then
737 call restart%read(wfns_file, lines, 1, err)
738 if (err /= 0) then
739 ierr = ierr - 2**8
740 else
741 read(lines(1), *) filename, filename, iter
742 end if
743 end if
744
745 call restart%close(wfns_file)
746 call restart%close(occ_file)
747
748 ! At this point, the restart file should be available
749 ! if not, we fall back to the obf format
750 if (restart_file_format == option__restartfileformatstates__adios2) then
751 if (.not.loct_dir_exists(trim(restart%dir())//"/"//"wavefunctions.bp")) then
752 message(1) = "ADIOS2 restart file not found, falling back to obf format."
753 call messages_warning(1, namespace=namespace)
754 restart_file_format = option__restartfileformatstates__obf
755 end if
756 end if
757
758 ! Now we read the wavefunctions. At this point we need to have all the information from the
759 ! states, occs, and wfns files in order to avoid serialisation of reads, as restart_read
760 ! works as a barrier.
761 safe_allocate(filled(1:st%d%dim, st%st_start:st%st_end, st%d%kpt%start:st%d%kpt%end))
762 filled = .false.
763
764 if (present(lowest_missing)) lowest_missing = st%nst + 1
765
766 iread = 0
767 if (st%system_grp%is_root() .and. verbose_) then
768 idone = 0
769 ntodo = st%lnst*st%d%kpt%nlocal*st%d%dim
770 call loct_progress_bar(-1, ntodo)
771 end if
772 if (restart_file_format == option__restartfileformatstates__obf) then
773 do ik = st%d%kpt%start, st%d%kpt%end
774 do ist = st%st_start, st%st_end
775 if (present(skip)) then
776 if (skip(ist)) cycle
777 end if
778
779 do idim = 1, st%d%dim
780
781 if (.not. restart_file_present(idim, ist, ik)) then
782 if (present(lowest_missing)) then
783 lowest_missing(idim, ik) = min(lowest_missing(idim, ik), ist)
784 end if
785 cycle
786 end if
787
788 if (states_are_real(st)) then
789 call restart%read_mesh_function(restart_file(idim, ist, ik), mesh, dpsi, err)
790 if (.not. present(lr)) then
791 call states_elec_set_state(st, mesh, idim, ist, ik, dpsi)
792 else
793 call lalg_copy(mesh%np, dpsi, lr%ddl_psi(:, idim, ist, ik))
794 end if
795 else
796 call restart%read_mesh_function(restart_file(idim, ist, ik), mesh, zpsi, err)
797 if (.not. present(lr)) then
798 call states_elec_set_state(st, mesh, idim, ist, ik, zpsi)
799 else
800 call lalg_copy(mesh%np, zpsi, lr%zdl_psi(:, idim, ist, ik))
801 end if
802 end if
803
804 if (err == 0) then
805 filled(idim, ist, ik) = .true.
806 iread = iread + 1
807 else if (present(lowest_missing)) then
808 lowest_missing(idim, ik) = min(lowest_missing(idim, ik), ist)
809 end if
810
811 if (st%system_grp%is_root() .and. verbose_) then
812 idone = idone + 1
813 call loct_progress_bar(idone, ntodo)
814 end if
815
816 end do
817 end do
818 end do
819 else if (restart_file_format == option__restartfileformatstates__adios2) then
820 if (present(lr)) then
821 ! this should never occur because we force obf format for linear response
822 call messages_not_implemented("ADIOS2 restart file format with linear response.")
823 end if
824 if (restart%has_map()) then
825 message(1) = "ADIOS2 restart file format does not support restarting from a different grid."
826 message(2) = "Please set RestartFileFormatStates = obf."
827 call messages_fatal(2, namespace=namespace)
828 end if
829 call states_elec_load_adios2(restart, st, mesh, iread, filled, restart_file_present, ierr, skip, lowest_missing)
830 end if
831
832 safe_deallocate_a(dpsi)
833 safe_deallocate_a(zpsi)
834 safe_deallocate_a(restart_file)
835 safe_deallocate_a(restart_file_present)
836
837 if (st%system_grp%is_root() .and. verbose_) then
838 call messages_new_line()
839 end if
840
841 if (st%parallel_in_states .or. st%d%kpt%parallel) then
842 iread_tmp = iread
843 call st%st_kpt_mpi_grp%allreduce(iread_tmp, iread, 1, mpi_integer, mpi_sum)
844 end if
845
846 if (st%d%kpt%parallel) then
847 ! make sure all tasks know lowest_missing over all k-points
848 if (present(lowest_missing)) then
849 safe_allocate(lowest_missing_tmp(1:st%d%dim, 1:st%nik))
850 lowest_missing_tmp = lowest_missing
851 call st%d%kpt%mpi_grp%allreduce(lowest_missing_tmp(1,1), lowest_missing(1,1), st%d%dim*st%nik, &
852 mpi_integer, mpi_min)
853 safe_deallocate_a(lowest_missing_tmp)
854 end if
855 end if
856
857 if (st%restart_fixed_occ .and. iread == st%nst * st%nik * st%d%dim) then
858 ! reset to overwrite whatever smearing may have been set earlier
859 ! only do this if all states could be loaded from restart files
860 call smear_init(st%smear, namespace, st%d%ispin, fixed_occ = .true., integral_occs = integral_occs, kpoints = kpoints)
861 end if
862
863 if (.not. present(lr) .and. .not. present(skip)) call fill_random()
864 ! it is better to initialize lr wfns to zero
865
866 safe_deallocate_a(filled)
867
868 if (ierr == 0 .and. iread /= st%nst * st%nik * st%d%dim) then
869 if (iread > 0) then
870 ierr = iread
871 else
872 ierr = -1
873 end if
874 ! otherwise ierr = 0 would mean either all was read correctly, or nothing at all was read!
875
876 if (.not. present(lr)) then
877 write(str, '(a,i5)') 'Reading states.'
878 else
879 write(str, '(a,i5)') 'Reading states information for linear response.'
880 end if
881 call messages_print_with_emphasis(msg=trim(str), namespace=namespace)
882 if (.not. present(skip)) then
883 write(message(1),'(a,i6,a,i6,a)') 'Only ', iread,' files out of ', &
884 st%nst * st%nik * st%d%dim, ' could be read.'
885 else
886 write(message(1),'(a,i6,a,i6,a)') 'Only ', iread,' files out of ', &
887 st%nst * st%nik * st%d%dim, ' were loaded.'
888 ierr = 0
889 end if
890 call messages_info(1, namespace=namespace)
891 call messages_print_with_emphasis(namespace=namespace)
892 end if
893
894 message(1) = 'Info: States reading done.'
895 if (verbose_) call print_date(trim(message(1))//' ')
896
897 call profiling_out("RESTART_READ")
898 pop_sub(states_elec_load)
899
900 contains
901
902 ! ---------------------------------------------------------
903 subroutine fill_random() !< put random function in orbitals that could not be read.
905
906 do ik = st%d%kpt%start, st%d%kpt%end
907
908 do ist = st%st_start, st%st_end
909 do idim = 1, st%d%dim
910 if (filled(idim, ist, ik)) cycle
911
912 call states_elec_generate_random(st, mesh, kpoints, ist, ist, ik, ik)
913 end do
914 end do
915 end do
916
918 end subroutine fill_random
919
920 ! ---------------------------------------------------------
921
922 logical function index_is_wrong() !< .true. if the index (idim, ist, ik) is not present in st structure...
924
925 if (idim > st%d%dim .or. idim < 1 .or. &
926 ist > st%nst .or. ist < 1 .or. &
927 ik > st%nik .or. ik < 1) then
929 else
930 index_is_wrong = .false.
931 end if
932
934 end function index_is_wrong
935
936 end subroutine states_elec_load
937
938 ! ---------------------------------------------------------
939 subroutine states_elec_load_adios2(restart, st, mesh, iread, filled, restart_file_present, ierr, skip, lowest_missing)
940 type(restart_t), intent(in) :: restart
941 type(states_elec_t), target, intent(inout) :: st
942 class(mesh_t), intent(in) :: mesh
943 integer, intent(out) :: iread
944 logical, intent(out) :: filled(1:, st%st_start:, st%d%kpt%start:)
945 logical, intent(in) :: restart_file_present(:, :, :)
946 integer, intent(out) :: ierr
947 logical, optional, intent(in) :: skip(:)
948 integer, optional, intent(inout) :: lowest_missing(:, :)
949
950#ifdef HAVE_ADIOS2
951 type(adios2_adios) :: adios
952 type(adios2_io) :: io
953 type(adios2_variable) :: var, var_indices
954 type(adios2_attribute) :: attribute
955 type(adios2_engine) :: engine
956 integer :: type_file, type_requested, ib, ik, ndims, pardomains
957 integer :: nst_max
958 integer(int64), allocatable :: var_shape(:)
959 integer(int64), allocatable :: global_indices(:)
960#endif
961
963#ifdef HAVE_ADIOS2
964#ifdef HAVE_MPI
965 call adios2_init(adios, restart%mpi_grp%comm%MPI_VAL, ierr)
966#else
967 call adios2_init(adios, ierr)
968#endif
969 call check_error(.not. adios%valid .or. ierr /= adios2_error_none, "Problem initializing ADIOS2.")
970 call adios2_declare_io(io, adios, "reader", ierr)
971 call check_error(.not. io%valid .or. ierr /= adios2_error_none, "Problem initializing ADIOS2.")
972 ! open restart file
973 call adios2_open(engine, io, trim(restart%dir())//"/"//"wavefunctions.bp", adios2_mode_read, ierr)
974 call check_error(.not. engine%valid .or. ierr /= adios2_error_none, "Problem opening ADIOS2 restart file.")
975
976 call adios2_begin_step(engine, ierr)
977 ! get ParDomains from attribute
978 call adios2_inquire_attribute(attribute, io, "ParDomains", ierr)
979 call check_error(.not. attribute%valid .or. ierr /= adios2_error_none, "Problem inquiring ADIOS2 attribute.")
980 call adios2_attribute_data(pardomains, attribute, ierr)
981 if (states_are_real(st)) then
982 type_requested = adios2_type_dp
983 else
984 type_requested = adios2_type_complex_dp
985 end if
986 call adios2_inquire_variable(var, io, 'wavefunctions', ierr)
987 call check_error(.not. var%valid .or. ierr /= adios2_error_none, "Problem loading ADIOS2 variable (wavefunctions).")
988 ! get variable type and shape
989 call adios2_variable_type(type_file, var, ierr)
990 call adios2_variable_ndims(ndims, var, ierr)
991 call adios2_variable_shape(var_shape, ndims, var, ierr)
992 assert(ndims == 3)
993 nst_max = st%nst
994 if (var_shape(1) < int(st%nst * st%d%dim, int64)) then
995 ! more states requested than available in the restart data, only read up to nst_max
996 nst_max = int(var_shape(1), int32) / st%d%dim
997 end if
998 if (var_shape(2) /= int(mesh%np_global, int64)) then
999 ! this should never happen because we check above if there is a map which is only allocated if the grid is different
1000 message(1) = "Error: trying to restart with a different number of grid points. Not supported with ADIOS2 format."
1001 call messages_fatal(1)
1002 end if
1003 if (present(skip)) then
1004 ! read state by state if skip parameter present, otherwise batch by batch which is much better
1005 ! for the performance
1006 call states_elec_adios2_read_state_by_state(st, mesh, engine, var, filled, restart_file_present, iread, skip, lowest_missing)
1007 else
1008 call states_elec_adios2_read_batch_by_batch(st, mesh, engine, var, var_shape, type_requested, type_file, &
1009 nst_max, filled, iread)
1010 end if
1011 ! communicate points for mesh parallelization
1012 if (mesh%mpi_grp%size > 1 .or. pardomains > 1) then
1013 call adios2_inquire_variable(var_indices, io, 'global_indices', ierr)
1014 call check_error(.not. var_indices%valid .or. ierr /= adios2_error_none, &
1015 "Problem loading ADIOS2 variable (global_indices).")
1016 safe_allocate(global_indices(mesh%np))
1017 call adios2_set_selection(var_indices, 1, &
1018 [int(mesh%pv%xlocal-1, int64)], &
1019 [int(mesh%np, int64)], ierr)
1020 call check_error(ierr /= adios2_error_none, "Problem setting ADIOS2 selection (global_indices).")
1021 call adios2_get(engine, var_indices, global_indices, ierr)
1022 call check_error(ierr /= adios2_error_none, "Problem in ADIOS2 get (global_indices).")
1023 end if
1024 call adios2_end_step(engine, ierr)
1025 call check_error(ierr /= adios2_error_none, "Problem in ADIOS2 end_step.")
1026 if (mesh%mpi_grp%size > 1 .or. pardomains > 1) then
1027 do ik = st%d%kpt%start, st%d%kpt%end
1028 do ib = st%group%block_start, st%group%block_end
1029 if (states_are_real(st)) then
1030 call dmesh_batch_exchange_points(mesh, st%group%psib(ib, ik), forward_map=global_indices)
1031 else
1032 call zmesh_batch_exchange_points(mesh, st%group%psib(ib, ik), forward_map=global_indices)
1033 end if
1034 end do
1035 end do
1036 safe_deallocate_a(global_indices)
1037 end if
1038
1039 ! close restart file
1040 call adios2_close(engine, ierr)
1041 call check_error(ierr /= adios2_error_none, "Problem closing ADIOS2 engine.")
1042 call adios2_finalize(adios, ierr)
1043 call check_error(ierr /= adios2_error_none, "Problem finalizing ADIOS2.")
1044#else
1045 ! avoid an empty routine
1046 ierr = 0
1047#endif
1049 end subroutine states_elec_load_adios2
1050
1051
1052#ifdef HAVE_ADIOS2
1053 ! ---------------------------------------------------------
1055 subroutine states_elec_adios2_read_state_by_state(st, mesh, engine, var, filled, restart_file_present, &
1056 iread, skip, lowest_missing)
1057 type(states_elec_t), target, intent(inout) :: st
1058 class(mesh_t), intent(in) :: mesh
1059 type(adios2_engine), intent(inout) :: engine
1060 type(adios2_variable), intent(inout) :: var
1061 logical, intent(inout) :: filled(1:, st%st_start:, st%d%kpt%start:)
1062 logical, intent(in) :: restart_file_present(:, :, :)
1063 integer, intent(inout) :: iread
1064 logical, optional, intent(in) :: skip(:)
1065 integer, optional, intent(inout) :: lowest_missing(:, :)
1066
1067 integer :: ik, ist, idim, ierr
1068 real(real64), allocatable :: dpsi(:)
1069 complex(real64), allocatable :: zpsi(:)
1070
1071 push_sub(states_elec_adios2_read_state_by_state)
1072
1073 do ik = st%d%kpt%start, st%d%kpt%end
1074 if (states_are_real(st)) then
1075 safe_allocate(dpsi(1:mesh%np))
1076 else
1077 safe_allocate(zpsi(1:mesh%np))
1078 end if
1079 do ist = st%st_start, st%st_end
1080 if (present(skip)) then
1081 if (skip(ist)) cycle
1082 end if
1083
1084 do idim = 1, st%d%dim
1085 if (.not. restart_file_present(idim, ist, ik)) then
1086 if (present(lowest_missing)) then
1087 lowest_missing(idim, ik) = min(lowest_missing(idim, ik), ist)
1088 end if
1089 cycle
1090 end if
1091
1092 ! read only one state
1093 call adios2_set_selection(var, 3, &
1094 [int((ist-1)*st%d%dim+idim-1, int64), int(mesh%pv%xlocal-1, int64), int(ik-1, int64)], &
1095 [1_int64, int(mesh%np, int64), 1_int64], ierr)
1096 ! use sync mode here to immediately read into dpsi/zpsi
1097 if (states_are_real(st)) then
1098 call adios2_get(engine, var, dpsi, adios2_mode_sync, ierr)
1099 call check_error(ierr /= adios2_error_none, "Problem in ADIOS2 get dpsi.")
1100 call states_elec_set_state(st, mesh, idim, ist, ik, dpsi)
1101 else
1102 call adios2_get(engine, var, zpsi, adios2_mode_sync, ierr)
1103 call check_error(ierr /= adios2_error_none, "Problem in ADIOS2 get zpsi.")
1104 call states_elec_set_state(st, mesh, idim, ist, ik, zpsi)
1105 end if
1106
1107 filled(idim, ist, ik) = .true.
1108 iread = iread + 1
1109 end do
1110 end do
1111 safe_deallocate_a(dpsi)
1112 safe_deallocate_a(zpsi)
1113 end do
1114
1115 pop_sub(states_elec_adios2_read_state_by_state)
1116 end subroutine states_elec_adios2_read_state_by_state
1118 ! ---------------------------------------------------------
1120 subroutine states_elec_adios2_read_batch_by_batch(st, mesh, engine, var, var_shape, type_requested, type_file, &
1121 nst_max, filled, iread)
1122 type(states_elec_t), target, intent(inout) :: st
1123 class(mesh_t), intent(in) :: mesh
1124 type(adios2_engine), intent(inout) :: engine
1125 type(adios2_variable), intent(inout) :: var
1126 integer(int64), intent(in) :: var_shape(:)
1127 integer, intent(in) :: type_requested
1128 integer, intent(in) :: type_file
1129 integer, intent(in) :: nst_max
1130 logical, intent(inout) :: filled(1:, st%st_start:, st%d%kpt%start:)
1131 integer, intent(inout) :: iread
1132
1133 integer :: ib, ik, ist, ip, adios2_mode, nst_linear, ierr
1134 class(wfs_elec_t), pointer :: psib
1135 real(real64), allocatable :: dff_pack(:, :)
1136
1137 push_sub(states_elec_adios2_read_batch_by_batch)
1138
1139 do ik = st%d%kpt%start, st%d%kpt%end
1140 ! if there are more k points requested than available, skip the ones that are not available
1141 ! this can, e.g., happen for unocc calculations with a k points path
1142 if (ik > var_shape(3)) cycle
1143 do ib = st%group%block_start, st%group%block_end
1144 select case (st%group%psib(ib, ik)%status())
1145 case (batch_not_packed)
1146 safe_allocate(psib)
1147 call st%group%psib(ib, ik)%copy_to(psib, copy_data=.false.)
1148 call psib%do_pack(batch_packed, copy=.false.)
1149 adios2_mode = adios2_mode_sync
1150 case (batch_packed)
1151 psib => st%group%psib(ib, ik)
1152 !adios2_mode = adios2_mode_deferred
1153 ! switch to sync mode for the time being, seems to solve some errors
1154 ! at the moment, it is unclear why
1155 adios2_mode = adios2_mode_sync
1156 case (batch_device_packed)
1157 safe_allocate(psib)
1158 call st%group%psib(ib, ik)%copy_to(psib)
1159 call psib%do_unpack(force=.true., copy=.false.)
1160 ! make sure we have a packed batch
1161 call psib%do_pack(batch_packed)
1162 adios2_mode = adios2_mode_sync
1163 end select
1164 assert(psib%status() == batch_packed)
1165
1166 ! read only up to the highest available state in the restart data
1167 nst_linear = st%group%psib(ib, ik)%nst_linear
1168 if (states_elec_block_max(st, ib) > nst_max) then
1169 nst_linear = (nst_max - states_elec_block_min(st, ib) + 1) * st%d%dim
1170 end if
1171 if (nst_linear <= 0) then
1172 select case (st%group%psib(ib, ik)%status())
1173 case (batch_not_packed)
1174 call psib%end()
1175 safe_deallocate_p(psib)
1176 case (batch_packed)
1177 nullify(psib)
1178 case (batch_device_packed)
1179 call psib%end()
1180 safe_deallocate_p(psib)
1181 end select
1182 cycle
1183 end if
1184
1185 ! select part of variable to write, correspond to the memory of the current batch
1186 ! first argument gives the start in the global array
1187 ! second argument gives the size of the local batch
1188 call adios2_set_selection(var, 3, &
1189 [int((states_elec_block_min(st, ib)-1)*st%d%dim, int64), int(mesh%pv%xlocal-1, int64), int(ik-1, int64)], &
1190 [int(nst_linear, int64), int(mesh%np, int64), 1_int64], ierr)
1191 call check_error(ierr /= adios2_error_none, "Problem setting ADIOS2 selection.")
1192
1193 if (type_requested == adios2_type_dp .and. type_file == adios2_type_dp) then
1194 ! set memory layout of one batch, take into account padding and ghost/boundary points
1195 call adios2_set_memory_selection(var, 3, [0_int64, 0_int64, 0_int64], &
1196 [int(size(psib%dff_pack, 1), int64), &
1197 int(size(psib%dff_pack, 2), int64), 1_int64], ierr)
1198 call check_error(ierr /= adios2_error_none, "Problem setting ADIOS2 memory selection (reading real).")
1199
1200 call adios2_get(engine, var, psib%dff_pack, adios2_mode, ierr)
1201 call check_error(ierr /= adios2_error_none, "Problem in ADIOS2 get (reading real).")
1202 else if (type_requested == adios2_type_complex_dp .and. type_file == adios2_type_complex_dp) then
1203 ! set memory layout of one batch, take into account padding and ghost/boundary points
1204 call adios2_set_memory_selection(var, 3, [0_int64, 0_int64, 0_int64], &
1205 [int(size(psib%zff_pack, 1), int64), &
1206 int(size(psib%zff_pack, 2), int64), 1_int64], ierr)
1207 call check_error(ierr /= adios2_error_none, "Problem setting ADIOS2 memory selection (reading complex).")
1208
1209 call adios2_get(engine, var, psib%zff_pack, adios2_mode, ierr)
1210 call check_error(ierr /= adios2_error_none, "Problem in ADIOS2 get (reading complex).")
1211 else if (type_requested == adios2_type_complex_dp .and. type_file == adios2_type_dp) then
1212 ! read into a local real variable and copy to the complex batch buffer
1213 safe_allocate(dff_pack(size(psib%zff_pack, 1), size(psib%zff_pack, 2)))
1214 ! set memory layout of one batch, take into account padding and ghost/boundary points
1215 call adios2_set_memory_selection(var, 3, [0_int64, 0_int64, 0_int64], &
1216 [int(size(psib%zff_pack, 1), int64), &
1217 int(size(psib%zff_pack, 2), int64), 1_int64], ierr)
1218 call check_error(ierr /= adios2_error_none, "Problem setting ADIOS2 memory selection (reading complex from real).")
1219
1220 ! use sync mode here to immediately read into dff_pack
1221 call adios2_get(engine, var, dff_pack, adios2_mode_sync, ierr)
1222 call check_error(ierr /= adios2_error_none, "Problem in ADIOS2 get (reading complex from real).")
1223 ! copy to batch memory
1224 !$omp parallel do private(ist)
1225 do ip = 1, mesh%np
1226 do ist = 1, nst_linear
1227 psib%zff_pack(ist, ip) = cmplx(dff_pack(ist, ip), m_zero, real64)
1228 end do
1229 end do
1230 safe_deallocate_a(dff_pack)
1231 else
1232 message(1) = "Error: requested to read complex states for restarting, but calculation has real states."
1233 call messages_fatal(1)
1234 end if
1235 ! make sure iread and filled are set correctly
1236 iread = iread + nst_linear
1237 do ist = 1, nst_linear
1238 filled(st%group%psib(ib, ik)%linear_to_idim(ist), st%group%psib(ib, ik)%linear_to_ist(ist), ik) = .true.
1239 end do
1240
1241 select case (st%group%psib(ib, ik)%status())
1242 case (batch_not_packed)
1243 call psib%do_unpack()
1244 call psib%copy_data_to(mesh%np, st%group%psib(ib, ik))
1245 call psib%end()
1246 safe_deallocate_p(psib)
1247 case (batch_packed)
1248 nullify(psib)
1249 case (batch_device_packed)
1250 call psib%do_pack()
1251 call psib%copy_data_to(mesh%np, st%group%psib(ib, ik))
1252 call psib%end()
1253 safe_deallocate_p(psib)
1254 end select
1255 end do
1256 end do
1257
1258 pop_sub(states_elec_adios2_read_batch_by_batch)
1259 end subroutine states_elec_adios2_read_batch_by_batch
1260
1261 ! ---------------------------------------------------------
1262 ! only used for adios2 error checking
1263 subroutine check_error(condition, error_message)
1264 logical, intent(in) :: condition
1265 character(len=*), intent(in) :: error_message
1266 if (condition) then
1267 message(1) = error_message
1268 call messages_fatal(1)
1269 end if
1270 end subroutine check_error
1271#endif
1272
1273 subroutine states_elec_dump_rho(restart, st, mesh, ierr, iter)
1274 type(restart_t), intent(in) :: restart
1275 type(states_elec_t), intent(in) :: st
1276 class(mesh_t), intent(in) :: mesh
1277 integer, intent(out) :: ierr
1278 integer, optional, intent(in) :: iter
1279
1280 integer :: iunit, isp, err, err2(2)
1281 character(len=MAX_PATH_LEN) :: filename
1282 character(len=300) :: lines(2)
1283
1284 push_sub(states_elec_dump_rho)
1285
1286 ierr = 0
1287
1288 if (restart%skip()) then
1289 pop_sub(states_elec_dump_rho)
1290 return
1291 end if
1292
1293 message(1) = "Debug: Writing density restart."
1294 call messages_info(1, debug_only=.true.)
1295
1297
1298 !write the densities
1299 iunit = restart%open('density')
1300 lines(1) = '# #spin #nspin filename'
1301 lines(2) = '%densities'
1302 call restart%write(iunit, lines, 2, err)
1303 if (err /= 0) ierr = ierr + 1
1304
1305 err2 = 0
1306 do isp = 1, st%d%nspin
1307 filename = get_filename_with_spin('density', st%d%nspin, isp)
1308 write(lines(1), '(i8,a,i8,a)') isp, ' | ', st%d%nspin, ' | "'//trim(adjustl(filename))//'"'
1309 call restart%write(iunit, lines, 1, err)
1310 if (err /= 0) err2(1) = err2(1) + 1
1311
1312 call restart%write_mesh_function(filename, mesh, st%rho(:,isp), err)
1313 if (err /= 0) err2(2) = err2(2) + 1
1314
1315 end do
1316 if (err2(1) /= 0) ierr = ierr + 2
1317 if (err2(2) /= 0) ierr = ierr + 4
1318
1319 lines(1) = '%'
1320 call restart%write(iunit, lines, 1, err)
1321 if (err /= 0) ierr = ierr + 8
1322 if (present(iter)) then
1323 write(lines(1),'(a,i7)') 'Iter = ', iter
1324 call restart%write(iunit, lines, 1, err)
1325 if (err /= 0) ierr = ierr + 16
1326 end if
1327 call restart%close(iunit)
1328
1330
1331 message(1) = "Debug: Writing density restart done."
1332 call messages_info(1, debug_only=.true.)
1333
1334 pop_sub(states_elec_dump_rho)
1335 end subroutine states_elec_dump_rho
1336
1337
1338 ! ---------------------------------------------------------
1339 subroutine states_elec_load_rho(restart, st, mesh, ierr)
1340 type(restart_t), intent(in) :: restart
1341 type(states_elec_t), intent(inout) :: st
1342 class(mesh_t), intent(in) :: mesh
1343 integer, intent(out) :: ierr
1344
1345 integer :: err, err2, isp
1346 character(len=MAX_PATH_LEN) :: filename
1347
1348 push_sub(states_elec_load_rho)
1349
1350 ierr = 0
1351
1352 if (restart%skip()) then
1353 ierr = -1
1354 pop_sub(states_elec_load_rho)
1355 return
1356 end if
1357
1358 message(1) = "Debug: Reading density restart."
1359 call messages_info(1, debug_only=.true.)
1360
1361 ! skip for now, since we know what the files are going to be called
1362 !read the densities
1363! iunit_rho = io_open(trim(dir)//'/density', restart%namespace, action='write')
1364! call iopar_read(st%dom_st_kpt_mpi_grp, iunit_rho, line, err)
1365! call iopar_read(st%dom_st_kpt_mpi_grp, iunit_rho, line, err)
1366! we could read the iteration 'iter' too, not sure if that is useful.
1367
1368 err2 = 0
1369 do isp = 1, st%d%nspin
1370 filename = get_filename_with_spin('density', st%d%nspin, isp)
1371! if (st%dom_st_kpt_mpi_grp%is_root()) then
1372! read(iunit_rho, '(i8,a,i8,a)') isp, ' | ', st%d%nspin, ' | "'//trim(adjustl(filename))//'"'
1373! end if
1374 call restart%read_mesh_function(filename, mesh, st%rho(:,isp), err)
1375 if (err /= 0) err2 = err2 + 1
1376
1377 end do
1378 if (err2 /= 0) ierr = ierr + 1
1379
1380 message(1) = "Debug: Reading density restart done."
1381 call messages_info(1, debug_only=.true.)
1382
1383 pop_sub(states_elec_load_rho)
1384 end subroutine states_elec_load_rho
1385
1386 subroutine states_elec_dump_frozen(restart, space, st, mesh, ierr)
1387 type(restart_t), intent(in) :: restart
1388 class(space_t), intent(in) :: space
1389 type(states_elec_t), intent(in) :: st
1390 class(mesh_t), intent(in) :: mesh
1391 integer, intent(out) :: ierr
1392
1393 integer :: isp, err, err2(2), idir
1394 character(len=MAX_PATH_LEN) :: filename
1395
1396 push_sub(states_elec_dump_frozen)
1397
1398 ierr = 0
1399
1400 assert(allocated(st%frozen_rho))
1401
1402 if (restart%skip()) then
1404 return
1405 end if
1406
1407 message(1) = "Debug: Writing frozen densities restart."
1408 call messages_info(1, debug_only=.true.)
1409
1411
1412 err2 = 0
1413 do isp = 1, st%d%nspin
1414 filename = get_filename_with_spin('frozen_rho', st%d%nspin, isp)
1415
1416 call restart%write_mesh_function(filename, mesh, st%frozen_rho(:,isp), err)
1417 if (err /= 0) err2(2) = err2(2) + 1
1418
1419 if (allocated(st%frozen_tau)) then
1420 filename = get_filename_with_spin('frozen_tau', st%d%nspin, isp)
1421 call restart%write_mesh_function(filename, mesh, st%frozen_tau(:,isp), err)
1422 if (err /= 0) err2 = err2 + 1
1423 end if
1424
1425 if (allocated(st%frozen_gdens)) then
1426 do idir = 1, space%dim
1427 if (st%d%nspin == 1) then
1428 write(filename, fmt='(a,i1)') 'frozen_gdens-dir', idir
1429 else
1430 write(filename, fmt='(a,i1,a,i1)') 'frozen_gdens-dir', idir, '-', isp
1431 end if
1432 call restart%write_mesh_function(filename, mesh, st%frozen_gdens(:,idir,isp), err)
1433 if (err /= 0) err2 = err2 + 1
1434 end do
1435 end if
1436
1437 if (allocated(st%frozen_ldens)) then
1438 filename = get_filename_with_spin('frozen_ldens', st%d%nspin, isp)
1439 call restart%write_mesh_function(filename, mesh, st%frozen_ldens(:,isp), err)
1440 if (err /= 0) err2 = err2 + 1
1441 end if
1442
1443 end do
1444 if (err2(1) /= 0) ierr = ierr + 2
1445 if (err2(2) /= 0) ierr = ierr + 4
1446
1448
1449 message(1) = "Debug: Writing frozen densities restart done."
1450 call messages_info(1, debug_only=.true.)
1451
1453 end subroutine states_elec_dump_frozen
1454
1455
1456 ! ---------------------------------------------------------
1457 subroutine states_elec_load_frozen(restart, space, st, mesh, ierr)
1458 type(restart_t), intent(in) :: restart
1459 class(space_t), intent(in) :: space
1460 type(states_elec_t), intent(inout) :: st
1461 class(mesh_t), intent(in) :: mesh
1462 integer, intent(out) :: ierr
1463
1464 integer :: err, err2, isp, idir
1465 character(len=MAX_PATH_LEN) :: filename
1466
1467 push_sub(states_elec_load_frozen)
1468
1469 assert(allocated(st%frozen_rho))
1470
1471 ierr = 0
1472
1473 if (restart%skip()) then
1474 ierr = -1
1476 return
1477 end if
1479 message(1) = "Debug: Reading densities restart."
1480 call messages_info(1, debug_only=.true.)
1481
1482 err2 = 0
1483 do isp = 1, st%d%nspin
1484 filename = get_filename_with_spin('frozen_rho', st%d%nspin, isp)
1485 call restart%read_mesh_function(filename, mesh, st%frozen_rho(:,isp), err)
1486 if (err /= 0) err2 = err2 + 1
1487
1488 if (allocated(st%frozen_tau)) then
1489 filename = get_filename_with_spin('frozen_tau', st%d%nspin, isp)
1490 call restart%read_mesh_function(filename, mesh, st%frozen_tau(:,isp), err)
1491 if (err /= 0) err2 = err2 + 1
1492 end if
1493
1494 if (allocated(st%frozen_gdens)) then
1495 do idir = 1, space%dim
1496 if (st%d%nspin == 1) then
1497 write(filename, fmt='(a,i1)') 'frozen_gdens-dir', idir
1498 else
1499 write(filename, fmt='(a,i1,a,i1)') 'frozen_gdens-dir', idir, '-', isp
1500 end if
1501 call restart%read_mesh_function(filename, mesh, st%frozen_gdens(:,idir,isp), err)
1502 if (err /= 0) err2 = err2 + 1
1503 end do
1504 end if
1505
1506 if (allocated(st%frozen_ldens)) then
1507 filename = get_filename_with_spin('frozen_ldens', st%d%nspin, isp)
1508 call restart%read_mesh_function(filename, mesh, st%frozen_ldens(:,isp), err)
1509 if (err /= 0) err2 = err2 + 1
1510 end if
1511
1512 end do
1513 if (err2 /= 0) ierr = ierr + 1
1514
1515 message(1) = "Debug: Reading frozen densities restart done."
1516 call messages_info(1, debug_only=.true.)
1517
1519 end subroutine states_elec_load_frozen
1520
1521
1522 ! ---------------------------------------------------------
1525 subroutine states_elec_read_user_def_orbitals(mesh, namespace, space, st)
1526 class(mesh_t), intent(in) :: mesh
1527 type(namespace_t), intent(in) :: namespace
1528 class(space_t), intent(in) :: space
1529 type(states_elec_t), intent(inout) :: st
1530
1531 type(block_t) :: blk
1532 integer :: ip, id, is, ik, nstates, state_from, ierr, ncols
1533 integer :: ib, idim, inst, inik, normalize
1534 real(real64) :: xx(space%dim), rr, psi_re, psi_im
1535 character(len=150) :: filename
1536 complex(real64), allocatable :: zpsi(:, :)
1537
1538 integer, parameter :: &
1539 state_from_formula = 1, &
1540 state_from_file = -10010, &
1541 normalize_yes = 1, &
1542 normalize_no = 0
1543
1545
1546 !%Variable UserDefinedStates
1547 !%Type block
1548 !%Section States
1549 !%Description
1550 !% Instead of using the ground state as initial state for
1551 !% time-propagations it might be interesting in some cases
1552 !% to specify alternate states. Like with user-defined
1553 !% potentials, this block allows you to specify formulas for
1554 !% the orbitals at <i>t</i>=0.
1555 !%
1556 !% Example:
1557 !%
1558 !% <tt>%UserDefinedStates
1559 !% <br>&nbsp;&nbsp; 1 | 1 | 1 | formula | "exp(-r^2)*exp(-i*0.2*x)" | normalize_yes
1560 !% <br>%</tt>
1561 !%
1562 !% The first column specifies the component of the spinor,
1563 !% the second column the number of the state and the third
1564 !% contains <i>k</i>-point and spin quantum numbers. Column four
1565 !% indicates that column five should be interpreted as a formula
1566 !% for the corresponding orbital.
1567 !%
1568 !% Alternatively, if column four states <tt>file</tt> the state will
1569 !% be read from the file given in column five.
1570 !%
1571 !% <tt>%UserDefinedStates
1572 !% <br>&nbsp;&nbsp; 1 | 1 | 1 | file | "/path/to/file" | normalize_no
1573 !% <br>%</tt>
1574 !%
1575 !% Octopus reads first the ground-state orbitals from
1576 !% the <tt>restart/gs</tt> directory. Only the states that are
1577 !% specified in the above block will be overwritten with
1578 !% the given analytic expression for the orbital.
1579 !%
1580 !% The sixth (optional) column indicates whether <tt>Octopus</tt> should renormalize
1581 !% the orbital. The default (no sixth column given) is to renormalize.
1582 !%
1583 !%Option file -10010
1584 !% Read initial orbital from file.
1585 !% Accepted file formats, detected by extension: obf, ncdf and csv (real only).
1586 !% For csv files, the following formatting rules apply:
1587 !%
1588 !% The functions in this file read an array from an ascii matrix (csv) file.
1589 !% Format with values "valueXYZ" as follows
1590 !%
1591 !% File values.csv:
1592 !% --------
1593 !% value111 value211 value311 value411
1594 !% value121 value221 value321 value421
1595 !% value131 value231 value331 value431
1596 !%
1597 !% value112 value212 value312 value412
1598 !% value122 value222 value322 value422
1599 !% value132 value232 value332 value432
1600 !%
1601 !% value113 value213 value313 value413
1602 !% value123 value223 value323 value423
1603 !% value133 value233 value333 value433
1604 !% --------
1605 !%
1606 !% That is, every line scans the x-coordinate, every XY-plane as a table of values
1607 !% and all XY-planes separated by an empty row.
1608 !%
1609 !% The given matrix is interpolated/stretched to fit the calculation
1610 !% box defined in input file.
1611 !%
1612 !% Note that there must not be any empty line at the end of the file.
1613 !%
1614 !% Calculation box shape must be "parallelepiped".
1615 !%
1616 !% The delimiter can be a tab, a comma or a space.
1617 !%Option formula 1
1618 !% Calculate initial orbital by given analytic expression.
1619 !%Option normalize_yes 1
1620 !% Normalize orbitals (default).
1621 !%Option normalize_no 0
1622 !% Do not normalize orbitals.
1623 !%End
1624 if (parse_block(namespace, 'UserDefinedStates', blk) == 0) then
1625
1626 call messages_print_with_emphasis(msg=trim('Substitution of orbitals'), namespace=namespace)
1627
1628 ! find out how many lines (i.e. states) the block has
1629 nstates = parse_block_n(blk)
1630
1631 safe_allocate(zpsi(1:mesh%np, 1:st%d%dim))
1632
1633 ! read all lines
1634 do ib = 1, nstates
1635 ! Check that number of columns is five or six.
1636 ncols = parse_block_cols(blk, ib - 1)
1637 if (ncols < 5 .or. ncols > 6) then
1638 message(1) = 'Each line in the UserDefinedStates block must have'
1639 message(2) = 'five or six columns.'
1640 call messages_fatal(2, namespace=namespace)
1641 end if
1642
1643 call parse_block_integer(blk, ib - 1, 0, idim)
1644 call parse_block_integer(blk, ib - 1, 1, inst)
1645 call parse_block_integer(blk, ib - 1, 2, inik)
1646
1647 ! Calculate from expression or read from file?
1648 call parse_block_integer(blk, ib - 1, 3, state_from)
1649
1650 ! loop over all states
1651 do id = 1, st%d%dim
1652 do is = 1, st%nst
1653 do ik = 1, st%nik
1654
1655 if (.not.(id == idim .and. is == inst .and. ik == inik )) cycle
1656
1657 ! We first parse the value, such that the parsing and stdout looks correct
1658 ! However, if rank 0 is not responsible for the parsing, the variables in the formula
1659 ! will still appear as not parsed (pure k-point/state parallelization case).
1660 ! This could be solved by a dummy call to parse_expression
1661 select case (state_from)
1662 case (state_from_formula)
1663 ! parse formula string
1664 call parse_block_string( &
1665 blk, ib - 1, 4, st%user_def_states(id, is, ik))
1666
1667 write(message(1), '(a,3i5)') 'Substituting state of orbital with k, ist, dim = ', ik, is, id
1668 write(message(2), '(2a)') ' with the expression:'
1669 write(message(3), '(2a)') ' ',trim(st%user_def_states(id, is, ik))
1670 call messages_info(3, namespace=namespace)
1671
1672 ! convert to C string
1673 call conv_to_c_string(st%user_def_states(id, is, ik))
1674
1675 case (state_from_file)
1676 ! The input format can be coded in column four now. As it is
1677 ! not used now, we just say "file".
1678 ! Read the filename.
1679 call parse_block_string(blk, ib - 1, 4, filename)
1680
1681 write(message(1), '(a,3i5)') 'Substituting state of orbital with k, ist, dim = ', ik, is, id
1682 write(message(2), '(2a)') ' with data from file:'
1683 write(message(3), '(2a)') ' ',trim(filename)
1684 call messages_info(3, namespace=namespace)
1685 end select
1686
1687
1688 ! does the block entry match and is this node responsible?
1689 if (.not.(st%st_start <= is .and. st%st_end >= is &
1690 .and. st%d%kpt%start <= ik .and. st%d%kpt%end >= ik)) cycle
1691
1692 select case (state_from)
1693
1694 case (state_from_formula)
1695 ! fill states with user-defined formulas
1696 do ip = 1, mesh%np
1697 xx = mesh%x(:, ip)
1698 rr = norm2(xx)
1699
1700 ! parse user-defined expressions
1701 call parse_expression(psi_re, psi_im, space%dim, xx, rr, m_zero, st%user_def_states(id, is, ik))
1702 ! fill state
1703 zpsi(ip, 1) = cmplx(psi_re, psi_im, real64)
1704 end do
1705
1706 case (state_from_file)
1707 ! finally read the state
1708 call zio_function_input(filename, namespace, space, mesh, zpsi(:, 1), ierr)
1709 if (ierr > 0) then
1710 message(1) = 'Could not read the file!'
1711 write(message(2),'(a,i1)') 'Error code: ', ierr
1712 call messages_fatal(2, namespace=namespace)
1713 end if
1714
1715 case default
1716 message(1) = 'Wrong entry in UserDefinedStates, column 4.'
1717 message(2) = 'You may state "formula" or "file" here.'
1718 call messages_fatal(2, namespace=namespace)
1719 end select
1720
1721 ! normalize orbital
1722 if (parse_block_cols(blk, ib - 1) == 6) then
1723 call parse_block_integer(blk, ib - 1, 5, normalize)
1724 else
1725 normalize = 1
1726 end if
1727 select case (normalize)
1728 case (normalize_no)
1729 call states_elec_set_state(st, mesh, id, is, ik, zpsi(:, 1))
1730 case (normalize_yes)
1731 assert(st%d%dim == 1)
1732 call zmf_normalize(mesh, st%d%dim, zpsi)
1733 call states_elec_set_state(st, mesh, is, ik, zpsi)
1734 case default
1735 message(1) = 'The sixth column in UserDefinedStates may either be'
1736 message(2) = '"normalize_yes" or "normalize_no"'
1737 call messages_fatal(2, namespace=namespace)
1738 end select
1739
1740 end do
1741 end do
1742 end do
1743
1744 end do
1745
1746 safe_deallocate_a(zpsi)
1747
1748 call parse_block_end(blk)
1749 call messages_print_with_emphasis(namespace=namespace)
1750
1751 else
1752 call messages_variable_is_block(namespace, 'UserDefinedStates')
1753 end if
1754
1757
1758 ! ---------------------------------------------------------
1759 ! This is needed as for the generalized Bloch theorem we need to label
1760 ! the states from the expectation value of Sz computed from the GS.
1761 subroutine states_elec_dump_spin(restart, st, ierr)
1762 type(restart_t), intent(in) :: restart
1763 type(states_elec_t), intent(in) :: st
1764 integer, intent(out) :: ierr
1765
1766 integer :: iunit_spin
1767 integer :: err, err2(2), ik, ist
1768 character(len=300) :: lines(3)
1769
1770 push_sub(states_elec_dump_spin)
1771
1772 ierr = 0
1773
1774 if (restart%skip()) then
1775 pop_sub(states_elec_dump_spin)
1776 return
1777 end if
1778
1779 call profiling_in("RESTART_WRITE_SPIN")
1780
1782
1783 iunit_spin = restart%open('spin')
1784 lines(1) = '# #k-point #st #spin(x) spin(y) spin(z)'
1785 call restart%write(iunit_spin, lines, 1, err)
1786 if (err /= 0) ierr = ierr + 1
1787
1788 err2 = 0
1789 do ik = 1, st%nik
1790 do ist = 1, st%nst
1791 write(lines(1), '(i8,a,i8,3(a,f18.12))') ik, ' | ', ist, ' | ', &
1792 st%spin(1,ist,ik), ' | ', st%spin(2,ist,ik),' | ', st%spin(3,ist,ik)
1793 call restart%write(iunit_spin, lines, 1, err)
1794 if (err /= 0) err2(1) = err2(1) + 1
1795 end do ! st%nst
1796 end do ! st%nik
1797 lines(1) = '%'
1798 call restart%write(iunit_spin, lines, 1, err)
1799 if (err2(1) /= 0) ierr = ierr + 8
1800 if (err2(2) /= 0) ierr = ierr + 16
1801
1802 call restart%close(iunit_spin)
1803
1805
1806 call profiling_out("RESTART_WRITE_SPIN")
1807 pop_sub(states_elec_dump_spin)
1808 end subroutine states_elec_dump_spin
1809
1810
1811
1812
1813 ! ---------------------------------------------------------
1818 subroutine states_elec_load_spin(restart, st, ierr)
1819 type(restart_t), intent(in) :: restart
1820 type(states_elec_t), intent(inout) :: st
1821 integer, intent(out) :: ierr
1822
1823 integer :: spin_file, err, ik, ist
1824 character(len=256) :: lines(3)
1825 real(real64) :: spin(3)
1826 character(len=1) :: char
1827
1828
1829 push_sub(states_elec_load_spin)
1830
1831 ierr = 0
1832
1833 if (restart%skip()) then
1834 ierr = -1
1835 pop_sub(states_elec_load_spin)
1836 return
1837 end if
1838
1839 call profiling_in("RESTART_READ_SPIN")
1840
1841 ! open files to read
1842 spin_file = restart%open('spin')
1843 ! Skip two lines.
1844 call restart%read(spin_file, lines, 1, err)
1845 if (err /= 0) ierr = ierr - 2**7
1846
1847 ! If any error occured up to this point then it is not worth continuing,
1848 ! as there something fundamentally wrong with the restart files
1849 if (ierr /= 0) then
1850 call restart%close(spin_file)
1851 call profiling_out("RESTART_READ_SPIN")
1852 pop_sub(states_elec_load_spin)
1853 return
1854 end if
1855
1856 ! Next we read the list of states from the files.
1857 ! Errors in reading the information of a specific state from the files are ignored
1858 ! at this point, because later we will skip reading the wavefunction of that state.
1859 do
1860 call restart%read(spin_file, lines, 1, err)
1861 if (err /= 0) cycle
1862
1863 read(lines(1), '(a)') char
1864 if (char == '%') then
1865 !We reached the end of the file
1866 exit
1867 else
1868 read(lines(1), *) ik, char, ist, char, spin(1), char, spin(2), char, spin(3)
1869 end if
1870
1871 st%spin(1:3, ist, ik) = spin(1:3)
1872 end do
1873
1874 call restart%close(spin_file)
1875
1876 call profiling_out("RESTART_READ_SPIN")
1877 pop_sub(states_elec_load_spin)
1878 end subroutine states_elec_load_spin
1879
1880 ! ---------------------------------------------------------
1881 subroutine states_elec_transform(st, namespace, space, restart, mesh, kpoints, prefix)
1882 type(states_elec_t), intent(inout) :: st
1883 type(namespace_t), intent(in) :: namespace
1884 class(space_t), intent(in) :: space
1885 type(restart_t), intent(inout) :: restart
1886 class(mesh_t), intent(in) :: mesh
1887 type(kpoints_t), intent(in) :: kpoints
1888 character(len=*), optional, intent(in) :: prefix
1889
1890 type(states_elec_t) :: stin
1891 type(block_t) :: blk
1892 complex(real64), allocatable :: rotation_matrix(:,:), psi(:, :)
1893 integer :: ist, jst, ncols, iqn
1894 character(len=256) :: block_name
1895
1896 push_sub(states_elec_transform)
1897
1898 block_name = trim(optional_default(prefix, "")) // "TransformStates"
1899
1900 !%Variable TransformStates
1901 !%Type block
1902 !%Default no
1903 !%Section States
1904 !%Description
1905 !% Before starting the <tt>td</tt> calculation, the initial states (that are
1906 !% read from the <tt>restart/gs</tt> directory, which should have been
1907 !% generated in a previous ground-state calculation) can be "transformed"
1908 !% among themselves. The block <tt>TransformStates</tt> gives the transformation matrix
1909 !% to be used. The number of rows and columns of the matrix should equal the number
1910 !% of the states present in the time-dependent calculation (the independent
1911 !% spin and <i>k</i>-point subspaces are all transformed equally); the number of
1912 !% columns should be equal to the number of states present in the
1913 !% <tt>restart/gs</tt> directory. This number may be different: for example,
1914 !% one could have run previously in <tt>unocc</tt> mode in order to obtain unoccupied
1915 !% Kohn-Sham states, and therefore <tt>restart/gs</tt> will contain more states.
1916 !% These states can be used in the transformation.
1917 !%
1918 !% Note that the code will not check the orthonormality of the new states!
1919 !%
1920 !% Each line provides the coefficients of the new states, in terms of
1921 !% the old ones. The coefficients are complex, but the imaginary part will be
1922 !% ignored for real wavefunctions.
1923 !% Note: This variable cannot be used when parallel in states.
1924 !%End
1925 if (parse_is_defined(namespace, trim(block_name))) then
1926 if (parse_block(namespace, trim(block_name), blk) == 0) then
1927 if (st%parallel_in_states) then
1928 call messages_not_implemented(trim(block_name) // " parallel in states", namespace=namespace)
1929 end if
1930 if (parse_block_n(blk) /= st%nst) then
1931 message(1) = "Number of rows in block " // trim(block_name) // " must equal number of states in this calculation."
1932 call messages_fatal(1, namespace=namespace)
1933 end if
1934 call states_elec_copy(stin, st, exclude_wfns = .true.)
1935 call states_elec_look_and_load(restart, namespace, space, stin, mesh, kpoints)
1936
1937 ! FIXME: rotation matrix should be R_TYPE
1938 safe_allocate(rotation_matrix(1:stin%nst, 1:stin%nst))
1939 safe_allocate(psi(1:mesh%np, 1:st%d%dim))
1940
1941 rotation_matrix = diagonal_matrix(stin%nst, m_z1)
1942
1943 do ist = 1, st%nst
1944 ncols = parse_block_cols(blk, ist-1)
1945 if (ncols /= stin%nst) then
1946 write(message(1),'(a,i6,a,i6,3a,i6,a)') "Number of columns (", ncols, ") in row ", ist, " of block ", &
1947 trim(block_name), " must equal number of states (", stin%nst, ") read from gs restart."
1948 call messages_fatal(1, namespace=namespace)
1949 end if
1950 do jst = 1, stin%nst
1951 call parse_block_cmplx(blk, ist - 1, jst - 1, rotation_matrix(jst, ist))
1952 end do
1953 end do
1954
1955 call parse_block_end(blk)
1956
1957 do iqn = st%d%kpt%start, st%d%kpt%end
1958 if (states_are_real(st)) then
1959 call states_elec_rotate(stin, mesh, real(rotation_matrix, real64) , iqn)
1960 else
1961 call states_elec_rotate(stin, mesh, rotation_matrix, iqn)
1962 end if
1963
1964 do ist = st%st_start, st%st_end
1965 call states_elec_get_state(stin, mesh, ist, iqn, psi)
1966 call states_elec_set_state(st, mesh, ist, iqn, psi)
1967 end do
1968
1969 end do
1970
1971 safe_deallocate_a(rotation_matrix)
1972 safe_deallocate_a(psi)
1973
1974 call states_elec_end(stin)
1975
1976 else
1977 call messages_variable_is_block(namespace, trim(block_name))
1978 end if
1979
1980 end if
1981
1982 pop_sub(states_elec_transform)
1983 end subroutine states_elec_transform
1984
1986
1987
1988!! Local Variables:
1989!! mode: f90
1990!! coding: utf-8
1991!! End:
ssize_t read(int __fd, void *__buf, size_t __nbytes) __attribute__((__access__(__write_only__
long int random(void)
Definition: getopt_f.c:1407
Copies a vector x, to a vector y.
Definition: lalg_basic.F90:188
block signals while writing the restart files
Definition: restart.F90:320
unblock signals when writing restart is finished
Definition: restart.F90:327
This module implements batches of mesh functions.
Definition: batch.F90:135
integer, parameter, public batch_not_packed
functions are stored in CPU memory, unpacked order
Definition: batch.F90:286
integer, parameter, public batch_device_packed
functions are stored in device memory in packed order
Definition: batch.F90:286
integer, parameter, public batch_packed
functions are stored in CPU memory, in transposed (packed) order
Definition: batch.F90:286
This module handles the calculation mode.
integer, parameter, public p_strategy_domains
parallelization in domains
integer, parameter, public spinors
real(real64), parameter, public m_zero
Definition: global.F90:200
real(real64), parameter, public m_epsilon
Definition: global.F90:216
complex(real64), parameter, public m_z1
Definition: global.F90:211
subroutine, public zio_function_input(filename, namespace, space, mesh, ff, ierr, map)
Reads a mesh function from file filename, and puts it into ff. If the map argument is passed,...
System information (time, memory, sysname)
Definition: loct.F90:117
subroutine, public loct_progress_bar(a, maxcount)
A wrapper around the progress bar, such that it can be silenced without needing to dress the call wit...
Definition: loct.F90:276
logical function, public loct_dir_exists(dirname)
Definition: loct.F90:349
This module is intended to contain "only mathematical" functions and procedures.
Definition: math.F90:117
This module defines functions over batches of mesh functions.
Definition: mesh_batch.F90:118
subroutine, public zmesh_batch_exchange_points(mesh, aa, forward_map, backward_map)
This functions exchanges points of a mesh according to a certain map. Two possible maps can be given....
subroutine, public dmesh_batch_exchange_points(mesh, aa, forward_map, backward_map)
This functions exchanges points of a mesh according to a certain map. Two possible maps can be given....
This module defines various routines, operating on mesh functions.
subroutine, public zmf_normalize(mesh, dim, psi, norm)
Normalize a mesh function psi.
This module defines the meshes, which are used in Octopus.
Definition: mesh.F90:120
subroutine, public messages_print_with_emphasis(msg, iunit, namespace)
Definition: messages.F90:898
subroutine, public messages_not_implemented(feature, namespace)
Definition: messages.F90:1068
character(len=512), private msg
Definition: messages.F90:167
subroutine, public messages_variable_is_block(namespace, name)
Definition: messages.F90:1024
subroutine, public messages_warning(no_lines, all_nodes, namespace)
Definition: messages.F90:525
subroutine, public print_date(str)
Definition: messages.F90:983
subroutine, public messages_new_line()
Definition: messages.F90:1089
character(len=256), dimension(max_lines), public message
to be output by fatal, warning
Definition: messages.F90:162
subroutine, public messages_fatal(no_lines, only_root_writes, namespace)
Definition: messages.F90:410
subroutine, public messages_info(no_lines, iunit, debug_only, stress, all_nodes, namespace)
Definition: messages.F90:594
This module handles the communicators for the various parallelization strategies.
Definition: multicomm.F90:147
this module contains the low-level part of the output system
Definition: output_low.F90:117
character(len=max_path_len) function, public get_filename_with_spin(output, nspin, spin_index)
Returns the filame as output, or output-spX is spin polarized.
Definition: output_low.F90:233
Some general things and nomenclature:
Definition: par_vec.F90:173
integer(int64) function, public par_vec_local2global(pv, ip)
Returns global index of local point ip.
Definition: par_vec.F90:805
logical function, public parse_is_defined(namespace, name)
Definition: parser.F90:455
subroutine, public parse_block_string(blk, l, c, res, convert_to_c)
Definition: parser.F90:810
integer function, public parse_block(namespace, name, blk, check_varinfo_)
Definition: parser.F90:615
subroutine, public profiling_out(label)
Increment out counter and sum up difference between entry and exit time.
Definition: profiling.F90:631
subroutine, public profiling_in(label, exclude)
Increment in counter and save entry time.
Definition: profiling.F90:554
subroutine, public smear_init(this, namespace, ispin, fixed_occ, integral_occs, kpoints)
Definition: smear.F90:194
pure logical function, public states_are_complex(st)
pure logical function, public states_are_real(st)
This module handles spin dimensions of the states and the k-point distribution.
integer pure function, public states_elec_block_max(st, ib)
return index of last state in block ib
subroutine, public states_elec_end(st)
finalize the states_elec_t object
subroutine, public states_elec_allocate_wfns(st, mesh, wfs_type, skip, packed)
Allocates the KS wavefunctions defined within a states_elec_t structure.
subroutine, public states_elec_copy(stout, stin, exclude_wfns, exclude_eigenval, special)
make a (selective) copy of a states_elec_t object
subroutine, public states_elec_generate_random(st, mesh, kpoints, ist_start_, ist_end_, ikpt_start_, ikpt_end_, normalized)
randomize states
integer pure function, public states_elec_block_min(st, ib)
return index of first state in block ib
subroutine, public states_elec_look(restart, nik, dim, nst, ierr)
Reads the 'states' file in the restart directory, and finds out the nik, dim, and nst contained in it...
This module handles reading and writing restart information for the states_elec_t.
subroutine, public states_elec_read_user_def_orbitals(mesh, namespace, space, st)
the routine reads formulas for user-defined wavefunctions from the input file and fills the respectiv...
subroutine, public states_elec_load_frozen(restart, space, st, mesh, ierr)
subroutine, public states_elec_look_and_load(restart, namespace, space, st, mesh, kpoints, is_complex, packed)
subroutine states_elec_dump_adios2(restart, st, mesh, ierr)
subroutine, public states_elec_transform(st, namespace, space, restart, mesh, kpoints, prefix)
subroutine, public states_elec_dump(restart, space, st, mesh, kpoints, ierr, iter, lr, verbose)
subroutine, public states_elec_load(restart, namespace, space, st, mesh, kpoints, ierr, iter, lr, lowest_missing, label, verbose, skip)
returns in ierr: <0 => Fatal error, or nothing read =0 => read all wavefunctions >0 => could only rea...
subroutine, public states_elec_load_spin(restart, st, ierr)
returns in ierr: <0 => Fatal error, or nothing read =0 => read all wavefunctions >0 => could only rea...
subroutine, public states_elec_dump_frozen(restart, space, st, mesh, ierr)
subroutine states_elec_load_adios2(restart, st, mesh, iread, filled, restart_file_present, ierr, skip, lowest_missing)
subroutine, public states_elec_load_rho(restart, st, mesh, ierr)
subroutine, public states_elec_dump_rho(restart, st, mesh, ierr, iter)
subroutine, public states_elec_dump_spin(restart, st, ierr)
subroutine, public conv_to_c_string(str)
converts to c string
Definition: string.F90:234
type(type_t), public type_float
Definition: types.F90:135
type(type_t), public type_cmplx
Definition: types.F90:136
subroutine fill_random()
logical function index_is_wrong()
Describes mesh distribution to nodes.
Definition: mesh.F90:187
The states_elec_t class contains all electronic wave functions.
batches of electronic states
Definition: wfs_elec.F90:141
int true(void)