From 4767fbd9385171e8fd0d08512300dd86ca78ea53 Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Fri, 10 May 2024 18:41:56 +0200 Subject: [PATCH 01/43] Support submodules Signed-off-by: Cristian Le --- src/fdep/fortran_dependencies.pl | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/fdep/fortran_dependencies.pl b/src/fdep/fortran_dependencies.pl index d9644ea6b7..51bf106b39 100755 --- a/src/fdep/fortran_dependencies.pl +++ b/src/fdep/fortran_dependencies.pl @@ -17,8 +17,9 @@ my %files = (); # mode is the first argument: either mod or inc my $mode = shift; -my $use_re = qr/^\s*use\s+(\S+)\s*$/; -my $def_re = qr/^\s*(?:submodule|module)\s+(\S+)\s*$/; +# Trick fdep to take `use *` and `submodule (*)` as dependency +my $use_re = qr/^\s*(?:use|submodule)\s+\(?(\w+)\)?.*$/; +my $def_re = qr/^\s*module\s+(\S+)\s*$/; my $inc_re = qr/^\s*(\S+)\s*$/; sub add_use { -- GitLab From de7e8a002fe3c8add5ce6006fca0bfed3c245b17 Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Mon, 15 Jan 2024 10:33:13 +0100 Subject: [PATCH 02/43] [submodule] `td_oct_m` Signed-off-by: Cristian Le --- src/td/td.F90 | 292 +++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 230 insertions(+), 62 deletions(-) diff --git a/src/td/td.F90 b/src/td/td.F90 index 7f267f0a56..71a40cbaf8 100644 --- a/src/td/td.F90 +++ b/src/td/td.F90 @@ -19,68 +19,24 @@ #include "global.h" module td_oct_m - use absorbing_boundaries_oct_m - use boundaries_oct_m - use calc_mode_par_oct_m - use current_oct_m - use classical_particle_oct_m - use debug_oct_m - use density_oct_m - use energy_calc_oct_m - use electrons_ground_state_oct_m use electron_space_oct_m - use epot_oct_m - use ext_partner_list_oct_m - use forces_oct_m - use gauge_field_oct_m use global_oct_m use grid_oct_m use hamiltonian_elec_oct_m use interaction_partner_oct_m - use io_oct_m use ion_dynamics_oct_m use ions_oct_m - use kick_oct_m - use, intrinsic :: iso_fortran_env - use lasers_oct_m - use lda_u_oct_m - use lda_u_io_oct_m - use linked_list_oct_m - use loct_oct_m - use maxwell_boundary_op_oct_m - use mesh_oct_m - use messages_oct_m - use mpi_oct_m use multicomm_oct_m use namespace_oct_m - use output_oct_m use output_low_oct_m - use parser_oct_m use pes_oct_m - use photon_mode_mf_oct_m - use photon_mode_oct_m - use poisson_oct_m - use potential_interpolation_oct_m - use profiling_oct_m - use propagator_oct_m - use propagator_elec_oct_m use propagator_base_oct_m use restart_oct_m use scf_oct_m - use scissor_oct_m use space_oct_m - use states_abst_oct_m use states_elec_oct_m - use states_elec_restart_oct_m - use stress_oct_m use td_write_oct_m - use types_oct_m - use unit_oct_m - use unit_system_oct_m use v_ks_oct_m - use varinfo_oct_m - use walltimer_oct_m - use xc_oct_m implicit none @@ -93,7 +49,6 @@ module td_oct_m td_init_run, & td_end, & td_end_run, & - td_write_iter, & td_check_point, & td_dump, & td_allocate_wavefunctions, & @@ -136,10 +91,222 @@ module td_oct_m type(restart_t) :: restart_dump end type td_t + ! Subroutine/Functions + interface + module subroutine td_run(td, namespace, mc, gr, ions, st, ks, hm, ext_partners, outp, space, from_scratch) + type(td_t), intent(inout) :: td + type(namespace_t), intent(in) :: namespace + type(multicomm_t), intent(inout) :: mc + type(grid_t), intent(inout) :: gr + type(ions_t), intent(inout) :: ions + type(states_elec_t), intent(inout) :: st + type(v_ks_t), intent(inout) :: ks + type(hamiltonian_elec_t), intent(inout) :: hm + type(partner_list_t), intent(in) :: ext_partners + type(output_t), intent(inout) :: outp + type(electron_space_t), intent(in) :: space + logical, intent(inout) :: from_scratch + end subroutine td_run + + module subroutine td_run_init() + end subroutine td_run_init + + module subroutine td_init(td, namespace, space, gr, ions, st, ks, hm, ext_partners, outp) + type(td_t), intent(inout) :: td + type(namespace_t), intent(in) :: namespace + class(space_t), intent(in) :: space + type(grid_t), intent(in) :: gr + type(ions_t), intent(inout) :: ions + type(states_elec_t), intent(in) :: st + type(v_ks_t), intent(in) :: ks + type(hamiltonian_elec_t), intent(in) :: hm + type(partner_list_t), intent(in) :: ext_partners + type(output_t), intent(in) :: outp + end subroutine td_init + + module subroutine td_init_run(td, namespace, mc, gr, ions, st, ks, hm, ext_partners, outp, space, from_scratch) + type(td_t), intent(inout) :: td + type(namespace_t), intent(in) :: namespace + type(multicomm_t), intent(inout) :: mc + type(grid_t), intent(inout) :: gr + type(ions_t), intent(inout) :: ions + type(states_elec_t), intent(inout) :: st + type(v_ks_t), intent(inout) :: ks + type(hamiltonian_elec_t), intent(inout) :: hm + type(partner_list_t), intent(in) :: ext_partners + type(output_t), intent(inout) :: outp + type(electron_space_t), intent(in) :: space + logical, intent(inout) :: from_scratch + end subroutine td_init_run + + module subroutine td_allocate_wavefunctions(td, namespace, mc, gr, ions, st, hm, space) + type(td_t), intent(inout) :: td + type(namespace_t), intent(in) :: namespace + type(multicomm_t), intent(inout) :: mc + type(grid_t), intent(inout) :: gr + type(ions_t), intent(inout) :: ions + type(states_elec_t), intent(inout) :: st + type(hamiltonian_elec_t), intent(inout) :: hm + class(space_t), intent(in) :: space + end subroutine td_allocate_wavefunctions + + module subroutine td_init_gaugefield(td, namespace, gr, st, ks, hm, ext_partners, space) + type(td_t), intent(inout) :: td + type(namespace_t), intent(in) :: namespace + type(grid_t), intent(inout) :: gr + type(states_elec_t), intent(inout) :: st + type(v_ks_t), intent(inout) :: ks + type(hamiltonian_elec_t), intent(inout) :: hm + type(partner_list_t), intent(in) :: ext_partners + class(space_t), intent(in) :: space + end subroutine td_init_gaugefield + + module subroutine td_end(td) + type(td_t), intent(inout) :: td + end subroutine td_end + + module subroutine td_end_run(td, st, hm) + type(td_t), intent(inout) :: td + type(states_elec_t), intent(inout) :: st + type(hamiltonian_elec_t), intent(inout) :: hm + end subroutine td_end_run + + module subroutine td_check_point(td, namespace, mc, gr, ions, st, ks, hm, ext_partners, outp, space, & + iter, scsteps, etime, stopping, from_scratch) + type(td_t), intent(inout) :: td + type(namespace_t), intent(in) :: namespace + type(multicomm_t), intent(in) :: mc + type(grid_t), intent(inout) :: gr + type(ions_t), intent(inout) :: ions + type(states_elec_t), intent(inout) :: st + type(v_ks_t), intent(inout) :: ks + type(hamiltonian_elec_t), intent(inout) :: hm + type(partner_list_t), intent(in) :: ext_partners + type(output_t), intent(in) :: outp + type(electron_space_t), intent(in) :: space + integer, intent(in) :: iter + integer, intent(in) :: scsteps + real(real64), intent(inout) :: etime + logical, intent(in) :: stopping + logical, intent(inout) :: from_scratch + end subroutine td_check_point + + module subroutine td_init_with_wavefunctions(td, namespace, space, mc, gr, ions, ext_partners, st, ks, hm, outp, from_scratch) + type(td_t), intent(inout) :: td + type(namespace_t), intent(in) :: namespace + type(electron_space_t), intent(in) :: space + type(multicomm_t), intent(in) :: mc + type(grid_t), intent(inout) :: gr + type(ions_t), intent(inout) :: ions + type(partner_list_t), intent(in) :: ext_partners + type(states_elec_t), target, intent(inout) :: st + type(v_ks_t), intent(inout) :: ks + type(hamiltonian_elec_t), intent(inout) :: hm + type(output_t), intent(inout) :: outp + logical, intent(in) :: from_scratch + end subroutine td_init_with_wavefunctions + + module subroutine td_load_restart_from_gs(td, namespace, space, mc, gr, ext_partners, st, ks, hm) + type(td_t), intent(inout) :: td + type(namespace_t), intent(in) :: namespace + class(space_t), intent(in) :: space + type(multicomm_t), intent(in) :: mc + type(grid_t), intent(inout) :: gr + type(partner_list_t), intent(in) :: ext_partners + type(states_elec_t), target, intent(inout) :: st + type(v_ks_t), intent(inout) :: ks + type(hamiltonian_elec_t), intent(inout) :: hm + end subroutine td_load_restart_from_gs + + module subroutine td_dump(td, namespace, space, gr, st, hm, ks, ext_partners, iter, ierr) + type(td_t), intent(in) :: td + type(namespace_t), intent(in) :: namespace + class(space_t), intent(in) :: space + type(grid_t), intent(in) :: gr + type(states_elec_t), intent(in) :: st + type(hamiltonian_elec_t), intent(in) :: hm + type(v_ks_t), intent(in) :: ks + type(partner_list_t), intent(in) :: ext_partners + integer, intent(in) :: iter + integer, intent(out) :: ierr + end subroutine td_dump + + module function td_get_from_scratch(td) result(res) + type(td_t), intent(in) :: td + logical :: res + end function td_get_from_scratch + + module subroutine td_set_from_scratch(td, from_scratch) + type(td_t), intent(inout) :: td + logical, intent(in) :: from_scratch + end subroutine td_set_from_scratch + + module subroutine td_load_restart_from_td(td, namespace, space, mc, gr, ext_partners, st, ks, hm, from_scratch) + type(td_t), intent(inout) :: td + type(namespace_t), intent(in) :: namespace + class(space_t), intent(in) :: space + type(multicomm_t), intent(in) :: mc + type(grid_t), intent(inout) :: gr + type(partner_list_t), intent(in) :: ext_partners + type(states_elec_t), target, intent(inout) :: st + type(v_ks_t), intent(inout) :: ks + type(hamiltonian_elec_t), intent(inout) :: hm + logical, intent(inout) :: from_scratch + end subroutine td_load_restart_from_td + end interface +end module td_oct_m + +submodule (td_oct_m) impl + use absorbing_boundaries_oct_m + use boundaries_oct_m + use calc_mode_par_oct_m + use classical_particle_oct_m + use current_oct_m + use debug_oct_m + use density_oct_m + use electrons_ground_state_oct_m + use energy_calc_oct_m + use epot_oct_m + use ext_partner_list_oct_m + use forces_oct_m + use gauge_field_oct_m + use global_oct_m + use io_oct_m + use kick_oct_m + use lasers_oct_m + use lda_u_io_oct_m + use lda_u_oct_m + use linked_list_oct_m + use loct_oct_m + use maxwell_boundary_op_oct_m + use mesh_oct_m + use messages_oct_m + use mpi_oct_m + use output_oct_m + use parser_oct_m + use photon_mode_mf_oct_m + use photon_mode_oct_m + use poisson_oct_m + use potential_interpolation_oct_m + use profiling_oct_m + use propagator_elec_oct_m + use propagator_oct_m + use scissor_oct_m + use states_abst_oct_m + use states_elec_restart_oct_m + use stress_oct_m + use types_oct_m + use unit_oct_m + use unit_system_oct_m + use varinfo_oct_m + use walltimer_oct_m + use xc_oct_m + + implicit none contains - subroutine td_run_init() + module subroutine td_run_init() PUSH_SUB(td_run_init) @@ -150,7 +317,7 @@ contains ! --------------------------------------------------------- - subroutine td_init(td, namespace, space, gr, ions, st, ks, hm, ext_partners, outp) + module subroutine td_init(td, namespace, space, gr, ions, st, ks, hm, ext_partners, outp) type(td_t), intent(inout) :: td type(namespace_t), intent(in) :: namespace class(space_t), intent(in) :: space @@ -396,7 +563,7 @@ contains end subroutine td_init ! --------------------------------------------------------- - subroutine td_init_run(td, namespace, mc, gr, ions, st, ks, hm, ext_partners, outp, space, from_scratch) + module subroutine td_init_run(td, namespace, mc, gr, ions, st, ks, hm, ext_partners, outp, space, from_scratch) type(td_t), intent(inout) :: td type(namespace_t), intent(in) :: namespace type(multicomm_t), intent(inout) :: mc @@ -448,7 +615,7 @@ contains end subroutine td_init_run ! --------------------------------------------------------- - subroutine td_allocate_wavefunctions(td, namespace, mc, gr, ions, st, hm, space) + module subroutine td_allocate_wavefunctions(td, namespace, mc, gr, ions, st, hm, space) type(td_t), intent(inout) :: td type(namespace_t), intent(in) :: namespace type(multicomm_t), intent(inout) :: mc @@ -482,7 +649,7 @@ contains end subroutine td_allocate_wavefunctions ! --------------------------------------------------------- - subroutine td_init_gaugefield(td, namespace, gr, st, ks, hm, ext_partners, space) + module subroutine td_init_gaugefield(td, namespace, gr, st, ks, hm, ext_partners, space) type(td_t), intent(inout) :: td type(namespace_t), intent(in) :: namespace type(grid_t), intent(inout) :: gr @@ -513,7 +680,7 @@ contains end subroutine td_init_gaugefield ! --------------------------------------------------------- - subroutine td_end(td) + module subroutine td_end(td) type(td_t), intent(inout) :: td PUSH_SUB(td_end) @@ -528,7 +695,7 @@ contains end subroutine td_end ! --------------------------------------------------------- - subroutine td_end_run(td, st, hm) + module subroutine td_end_run(td, st, hm) type(td_t), intent(inout) :: td type(states_elec_t), intent(inout) :: st type(hamiltonian_elec_t), intent(inout) :: hm @@ -548,7 +715,7 @@ contains end subroutine td_end_run ! --------------------------------------------------------- - subroutine td_run(td, namespace, mc, gr, ions, st, ks, hm, ext_partners, outp, space, from_scratch) + module subroutine td_run(td, namespace, mc, gr, ions, st, ks, hm, ext_partners, outp, space, from_scratch) type(td_t), intent(inout) :: td type(namespace_t), intent(in) :: namespace type(multicomm_t), intent(inout) :: mc @@ -649,7 +816,7 @@ contains end subroutine td_print_header ! --------------------------------------------------------- - subroutine td_check_point(td, namespace, mc, gr, ions, st, ks, hm, ext_partners, outp, space, & + module subroutine td_check_point(td, namespace, mc, gr, ions, st, ks, hm, ext_partners, outp, space, & iter, scsteps, etime, stopping, from_scratch) type(td_t), intent(inout) :: td type(namespace_t), intent(in) :: namespace @@ -745,7 +912,7 @@ contains end subroutine td_update_elapsed_time ! --------------------------------------------------------- - subroutine td_init_with_wavefunctions(td, namespace, space, mc, gr, ions, ext_partners, st, ks, hm, outp, from_scratch) + module subroutine td_init_with_wavefunctions(td, namespace, space, mc, gr, ions, ext_partners, st, ks, hm, outp, from_scratch) type(td_t), intent(inout) :: td type(namespace_t), intent(in) :: namespace type(electron_space_t), intent(in) :: space @@ -1021,7 +1188,7 @@ contains end subroutine td_init_ions_and_forces ! --------------------------------------------------------- - subroutine td_load_restart_from_td(td, namespace, space, mc, gr, ext_partners, st, ks, hm, from_scratch) + module subroutine td_load_restart_from_td(td, namespace, space, mc, gr, ext_partners, st, ks, hm, from_scratch) type(td_t), intent(inout) :: td type(namespace_t), intent(in) :: namespace class(space_t), intent(in) :: space @@ -1057,7 +1224,7 @@ contains end subroutine td_load_restart_from_td ! --------------------------------------------------------- - subroutine td_load_restart_from_gs(td, namespace, space, mc, gr, ext_partners, st, ks, hm) + module subroutine td_load_restart_from_gs(td, namespace, space, mc, gr, ext_partners, st, ks, hm) type(td_t), intent(inout) :: td type(namespace_t), intent(in) :: namespace class(space_t), intent(in) :: space @@ -1189,7 +1356,7 @@ contains end subroutine td_read_coordinates ! --------------------------------------------------------- - subroutine td_dump(td, namespace, space, gr, st, hm, ks, ext_partners, iter, ierr) + module subroutine td_dump(td, namespace, space, gr, st, hm, ks, ext_partners, iter, ierr) type(td_t), intent(in) :: td type(namespace_t), intent(in) :: namespace class(space_t), intent(in) :: space @@ -1413,18 +1580,19 @@ contains end subroutine td_load_frozen ! --------------------------------------------------------- - logical function td_get_from_scratch(td) + module function td_get_from_scratch(td) result(res) type(td_t), intent(in) :: td + logical :: res PUSH_SUB(td_get_from_scratch) - td_get_from_scratch = td%from_scratch + res = td%from_scratch POP_SUB(td_get_from_scratch) end function td_get_from_scratch ! --------------------------------------------------------- - subroutine td_set_from_scratch(td, from_scratch) + module subroutine td_set_from_scratch(td, from_scratch) type(td_t), intent(inout) :: td logical, intent(in) :: from_scratch @@ -1434,7 +1602,7 @@ contains POP_SUB(td_set_from_scratch) end subroutine td_set_from_scratch -end module td_oct_m +end submodule impl !! Local Variables: !! mode: f90 -- GitLab From 53d2bd1aa7dff38f69901151360baf1fad47e04d Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Mon, 15 Jan 2024 10:29:11 +0100 Subject: [PATCH 03/43] [submodule] `td_oct_m` (split) Signed-off-by: Cristian Le --- src/Makefile.am | 1 + src/td/CMakeLists.txt | 1 + src/td/td.F90 | 238 ------------------------------------------ src/td/td_h.F90 | 237 +++++++++++++++++++++++++++++++++++++++++ 4 files changed, 239 insertions(+), 238 deletions(-) create mode 100644 src/td/td_h.F90 diff --git a/src/Makefile.am b/src/Makefile.am index 444d68d7da..4891d95552 100644 --- a/src/Makefile.am +++ b/src/Makefile.am @@ -758,6 +758,7 @@ td_f_srcs = \ td/spectrum.F90 \ td/td_calc.F90 \ td/td.F90 \ + td/td_h.F90 \ td/td_write.F90 \ td/td_write_low.F90 \ td/propagation_ops_elec.F90 diff --git a/src/td/CMakeLists.txt b/src/td/CMakeLists.txt index 7d266368fd..ac6890018c 100644 --- a/src/td/CMakeLists.txt +++ b/src/td/CMakeLists.txt @@ -17,6 +17,7 @@ target_sources(Octopus_lib PRIVATE spectrum.F90 td.F90 td_calc.F90 + td_h.F90 td_write.F90 td_write_low.F90 ) diff --git a/src/td/td.F90 b/src/td/td.F90 index 71a40cbaf8..f852b2f0fc 100644 --- a/src/td/td.F90 +++ b/src/td/td.F90 @@ -18,244 +18,6 @@ #include "global.h" -module td_oct_m - use electron_space_oct_m - use global_oct_m - use grid_oct_m - use hamiltonian_elec_oct_m - use interaction_partner_oct_m - use ion_dynamics_oct_m - use ions_oct_m - use multicomm_oct_m - use namespace_oct_m - use output_low_oct_m - use pes_oct_m - use propagator_base_oct_m - use restart_oct_m - use scf_oct_m - use space_oct_m - use states_elec_oct_m - use td_write_oct_m - use v_ks_oct_m - - implicit none - - private - public :: & - td_t, & - td_run, & - td_run_init, & - td_init, & - td_init_run, & - td_end, & - td_end_run, & - td_check_point, & - td_dump, & - td_allocate_wavefunctions, & - td_init_gaugefield, & - td_load_restart_from_gs, & - td_load_restart_from_td, & - td_init_with_wavefunctions,& - td_get_from_scratch, & - td_set_from_scratch - - !> Parameters. - integer, parameter, public :: & - EHRENFEST = 1, & - BO = 2 - - type td_t - private - type(propagator_base_t), public :: tr !< contains the details of the time-evolution - type(scf_t), public :: scf - type(ion_dynamics_t), public :: ions_dyn - real(real64), public :: dt !< time step - integer, public :: max_iter !< maximum number of iterations to perform - integer, public :: iter !< the actual iteration - logical, public :: recalculate_gs !< Recalculate ground-state along the evolution. - - type(pes_t), public :: pesv - - integer, public :: dynamics - integer, public :: energy_update_iter - real(real64) :: scissor - - logical :: freeze_occ - logical :: freeze_u - integer :: freeze_orbitals - - logical :: from_scratch = .false. - - type(td_write_t), public :: write_handler - type(restart_t) :: restart_load - type(restart_t) :: restart_dump - end type td_t - - ! Subroutine/Functions - interface - module subroutine td_run(td, namespace, mc, gr, ions, st, ks, hm, ext_partners, outp, space, from_scratch) - type(td_t), intent(inout) :: td - type(namespace_t), intent(in) :: namespace - type(multicomm_t), intent(inout) :: mc - type(grid_t), intent(inout) :: gr - type(ions_t), intent(inout) :: ions - type(states_elec_t), intent(inout) :: st - type(v_ks_t), intent(inout) :: ks - type(hamiltonian_elec_t), intent(inout) :: hm - type(partner_list_t), intent(in) :: ext_partners - type(output_t), intent(inout) :: outp - type(electron_space_t), intent(in) :: space - logical, intent(inout) :: from_scratch - end subroutine td_run - - module subroutine td_run_init() - end subroutine td_run_init - - module subroutine td_init(td, namespace, space, gr, ions, st, ks, hm, ext_partners, outp) - type(td_t), intent(inout) :: td - type(namespace_t), intent(in) :: namespace - class(space_t), intent(in) :: space - type(grid_t), intent(in) :: gr - type(ions_t), intent(inout) :: ions - type(states_elec_t), intent(in) :: st - type(v_ks_t), intent(in) :: ks - type(hamiltonian_elec_t), intent(in) :: hm - type(partner_list_t), intent(in) :: ext_partners - type(output_t), intent(in) :: outp - end subroutine td_init - - module subroutine td_init_run(td, namespace, mc, gr, ions, st, ks, hm, ext_partners, outp, space, from_scratch) - type(td_t), intent(inout) :: td - type(namespace_t), intent(in) :: namespace - type(multicomm_t), intent(inout) :: mc - type(grid_t), intent(inout) :: gr - type(ions_t), intent(inout) :: ions - type(states_elec_t), intent(inout) :: st - type(v_ks_t), intent(inout) :: ks - type(hamiltonian_elec_t), intent(inout) :: hm - type(partner_list_t), intent(in) :: ext_partners - type(output_t), intent(inout) :: outp - type(electron_space_t), intent(in) :: space - logical, intent(inout) :: from_scratch - end subroutine td_init_run - - module subroutine td_allocate_wavefunctions(td, namespace, mc, gr, ions, st, hm, space) - type(td_t), intent(inout) :: td - type(namespace_t), intent(in) :: namespace - type(multicomm_t), intent(inout) :: mc - type(grid_t), intent(inout) :: gr - type(ions_t), intent(inout) :: ions - type(states_elec_t), intent(inout) :: st - type(hamiltonian_elec_t), intent(inout) :: hm - class(space_t), intent(in) :: space - end subroutine td_allocate_wavefunctions - - module subroutine td_init_gaugefield(td, namespace, gr, st, ks, hm, ext_partners, space) - type(td_t), intent(inout) :: td - type(namespace_t), intent(in) :: namespace - type(grid_t), intent(inout) :: gr - type(states_elec_t), intent(inout) :: st - type(v_ks_t), intent(inout) :: ks - type(hamiltonian_elec_t), intent(inout) :: hm - type(partner_list_t), intent(in) :: ext_partners - class(space_t), intent(in) :: space - end subroutine td_init_gaugefield - - module subroutine td_end(td) - type(td_t), intent(inout) :: td - end subroutine td_end - - module subroutine td_end_run(td, st, hm) - type(td_t), intent(inout) :: td - type(states_elec_t), intent(inout) :: st - type(hamiltonian_elec_t), intent(inout) :: hm - end subroutine td_end_run - - module subroutine td_check_point(td, namespace, mc, gr, ions, st, ks, hm, ext_partners, outp, space, & - iter, scsteps, etime, stopping, from_scratch) - type(td_t), intent(inout) :: td - type(namespace_t), intent(in) :: namespace - type(multicomm_t), intent(in) :: mc - type(grid_t), intent(inout) :: gr - type(ions_t), intent(inout) :: ions - type(states_elec_t), intent(inout) :: st - type(v_ks_t), intent(inout) :: ks - type(hamiltonian_elec_t), intent(inout) :: hm - type(partner_list_t), intent(in) :: ext_partners - type(output_t), intent(in) :: outp - type(electron_space_t), intent(in) :: space - integer, intent(in) :: iter - integer, intent(in) :: scsteps - real(real64), intent(inout) :: etime - logical, intent(in) :: stopping - logical, intent(inout) :: from_scratch - end subroutine td_check_point - - module subroutine td_init_with_wavefunctions(td, namespace, space, mc, gr, ions, ext_partners, st, ks, hm, outp, from_scratch) - type(td_t), intent(inout) :: td - type(namespace_t), intent(in) :: namespace - type(electron_space_t), intent(in) :: space - type(multicomm_t), intent(in) :: mc - type(grid_t), intent(inout) :: gr - type(ions_t), intent(inout) :: ions - type(partner_list_t), intent(in) :: ext_partners - type(states_elec_t), target, intent(inout) :: st - type(v_ks_t), intent(inout) :: ks - type(hamiltonian_elec_t), intent(inout) :: hm - type(output_t), intent(inout) :: outp - logical, intent(in) :: from_scratch - end subroutine td_init_with_wavefunctions - - module subroutine td_load_restart_from_gs(td, namespace, space, mc, gr, ext_partners, st, ks, hm) - type(td_t), intent(inout) :: td - type(namespace_t), intent(in) :: namespace - class(space_t), intent(in) :: space - type(multicomm_t), intent(in) :: mc - type(grid_t), intent(inout) :: gr - type(partner_list_t), intent(in) :: ext_partners - type(states_elec_t), target, intent(inout) :: st - type(v_ks_t), intent(inout) :: ks - type(hamiltonian_elec_t), intent(inout) :: hm - end subroutine td_load_restart_from_gs - - module subroutine td_dump(td, namespace, space, gr, st, hm, ks, ext_partners, iter, ierr) - type(td_t), intent(in) :: td - type(namespace_t), intent(in) :: namespace - class(space_t), intent(in) :: space - type(grid_t), intent(in) :: gr - type(states_elec_t), intent(in) :: st - type(hamiltonian_elec_t), intent(in) :: hm - type(v_ks_t), intent(in) :: ks - type(partner_list_t), intent(in) :: ext_partners - integer, intent(in) :: iter - integer, intent(out) :: ierr - end subroutine td_dump - - module function td_get_from_scratch(td) result(res) - type(td_t), intent(in) :: td - logical :: res - end function td_get_from_scratch - - module subroutine td_set_from_scratch(td, from_scratch) - type(td_t), intent(inout) :: td - logical, intent(in) :: from_scratch - end subroutine td_set_from_scratch - - module subroutine td_load_restart_from_td(td, namespace, space, mc, gr, ext_partners, st, ks, hm, from_scratch) - type(td_t), intent(inout) :: td - type(namespace_t), intent(in) :: namespace - class(space_t), intent(in) :: space - type(multicomm_t), intent(in) :: mc - type(grid_t), intent(inout) :: gr - type(partner_list_t), intent(in) :: ext_partners - type(states_elec_t), target, intent(inout) :: st - type(v_ks_t), intent(inout) :: ks - type(hamiltonian_elec_t), intent(inout) :: hm - logical, intent(inout) :: from_scratch - end subroutine td_load_restart_from_td - end interface -end module td_oct_m - submodule (td_oct_m) impl use absorbing_boundaries_oct_m use boundaries_oct_m diff --git a/src/td/td_h.F90 b/src/td/td_h.F90 new file mode 100644 index 0000000000..302202313f --- /dev/null +++ b/src/td/td_h.F90 @@ -0,0 +1,237 @@ +module td_oct_m + use electron_space_oct_m + use global_oct_m + use grid_oct_m + use hamiltonian_elec_oct_m + use interaction_partner_oct_m + use ion_dynamics_oct_m + use ions_oct_m + use multicomm_oct_m + use namespace_oct_m + use output_low_oct_m + use pes_oct_m + use propagator_base_oct_m + use restart_oct_m + use scf_oct_m + use space_oct_m + use states_elec_oct_m + use td_write_oct_m + use v_ks_oct_m + + implicit none + + private + public :: & + td_t, & + td_run, & + td_run_init, & + td_init, & + td_init_run, & + td_end, & + td_end_run, & + td_check_point, & + td_dump, & + td_allocate_wavefunctions, & + td_init_gaugefield, & + td_load_restart_from_gs, & + td_load_restart_from_td, & + td_init_with_wavefunctions,& + td_get_from_scratch, & + td_set_from_scratch + + !> Parameters. + integer, parameter, public :: & + EHRENFEST = 1, & + BO = 2 + + type td_t + private + type(propagator_base_t), public :: tr !< contains the details of the time-evolution + type(scf_t), public :: scf + type(ion_dynamics_t), public :: ions_dyn + real(real64), public :: dt !< time step + integer, public :: max_iter !< maximum number of iterations to perform + integer, public :: iter !< the actual iteration + logical, public :: recalculate_gs !< Recalculate ground-state along the evolution. + + type(pes_t), public :: pesv + + integer, public :: dynamics + integer, public :: energy_update_iter + real(real64) :: scissor + + logical :: freeze_occ + logical :: freeze_u + integer :: freeze_orbitals + + logical :: from_scratch = .false. + + type(td_write_t), public :: write_handler + type(restart_t) :: restart_load + type(restart_t) :: restart_dump + end type td_t + + ! Subroutine/Functions + interface + module subroutine td_run(td, namespace, mc, gr, ions, st, ks, hm, ext_partners, outp, space, from_scratch) + type(td_t), intent(inout) :: td + type(namespace_t), intent(in) :: namespace + type(multicomm_t), intent(inout) :: mc + type(grid_t), intent(inout) :: gr + type(ions_t), intent(inout) :: ions + type(states_elec_t), intent(inout) :: st + type(v_ks_t), intent(inout) :: ks + type(hamiltonian_elec_t), intent(inout) :: hm + type(partner_list_t), intent(in) :: ext_partners + type(output_t), intent(inout) :: outp + type(electron_space_t), intent(in) :: space + logical, intent(inout) :: from_scratch + end subroutine td_run + + module subroutine td_run_init() + end subroutine td_run_init + + module subroutine td_init(td, namespace, space, gr, ions, st, ks, hm, ext_partners, outp) + type(td_t), intent(inout) :: td + type(namespace_t), intent(in) :: namespace + class(space_t), intent(in) :: space + type(grid_t), intent(in) :: gr + type(ions_t), intent(inout) :: ions + type(states_elec_t), intent(in) :: st + type(v_ks_t), intent(in) :: ks + type(hamiltonian_elec_t), intent(in) :: hm + type(partner_list_t), intent(in) :: ext_partners + type(output_t), intent(in) :: outp + end subroutine td_init + + module subroutine td_init_run(td, namespace, mc, gr, ions, st, ks, hm, ext_partners, outp, space, from_scratch) + type(td_t), intent(inout) :: td + type(namespace_t), intent(in) :: namespace + type(multicomm_t), intent(inout) :: mc + type(grid_t), intent(inout) :: gr + type(ions_t), intent(inout) :: ions + type(states_elec_t), intent(inout) :: st + type(v_ks_t), intent(inout) :: ks + type(hamiltonian_elec_t), intent(inout) :: hm + type(partner_list_t), intent(in) :: ext_partners + type(output_t), intent(inout) :: outp + type(electron_space_t), intent(in) :: space + logical, intent(inout) :: from_scratch + end subroutine td_init_run + + module subroutine td_allocate_wavefunctions(td, namespace, mc, gr, ions, st, hm, space) + type(td_t), intent(inout) :: td + type(namespace_t), intent(in) :: namespace + type(multicomm_t), intent(inout) :: mc + type(grid_t), intent(inout) :: gr + type(ions_t), intent(inout) :: ions + type(states_elec_t), intent(inout) :: st + type(hamiltonian_elec_t), intent(inout) :: hm + class(space_t), intent(in) :: space + end subroutine td_allocate_wavefunctions + + module subroutine td_init_gaugefield(td, namespace, gr, st, ks, hm, ext_partners, space) + type(td_t), intent(inout) :: td + type(namespace_t), intent(in) :: namespace + type(grid_t), intent(inout) :: gr + type(states_elec_t), intent(inout) :: st + type(v_ks_t), intent(inout) :: ks + type(hamiltonian_elec_t), intent(inout) :: hm + type(partner_list_t), intent(in) :: ext_partners + class(space_t), intent(in) :: space + end subroutine td_init_gaugefield + + module subroutine td_end(td) + type(td_t), intent(inout) :: td + end subroutine td_end + + module subroutine td_end_run(td, st, hm) + type(td_t), intent(inout) :: td + type(states_elec_t), intent(inout) :: st + type(hamiltonian_elec_t), intent(inout) :: hm + end subroutine td_end_run + + module subroutine td_check_point(td, namespace, mc, gr, ions, st, ks, hm, ext_partners, outp, space, & + iter, scsteps, etime, stopping, from_scratch) + type(td_t), intent(inout) :: td + type(namespace_t), intent(in) :: namespace + type(multicomm_t), intent(in) :: mc + type(grid_t), intent(inout) :: gr + type(ions_t), intent(inout) :: ions + type(states_elec_t), intent(inout) :: st + type(v_ks_t), intent(inout) :: ks + type(hamiltonian_elec_t), intent(inout) :: hm + type(partner_list_t), intent(in) :: ext_partners + type(output_t), intent(in) :: outp + type(electron_space_t), intent(in) :: space + integer, intent(in) :: iter + integer, intent(in) :: scsteps + real(real64), intent(inout) :: etime + logical, intent(in) :: stopping + logical, intent(inout) :: from_scratch + end subroutine td_check_point + + module subroutine td_init_with_wavefunctions(td, namespace, space, mc, gr, ions, ext_partners, st, ks, hm, outp, from_scratch) + type(td_t), intent(inout) :: td + type(namespace_t), intent(in) :: namespace + type(electron_space_t), intent(in) :: space + type(multicomm_t), intent(in) :: mc + type(grid_t), intent(inout) :: gr + type(ions_t), intent(inout) :: ions + type(partner_list_t), intent(in) :: ext_partners + type(states_elec_t), target, intent(inout) :: st + type(v_ks_t), intent(inout) :: ks + type(hamiltonian_elec_t), intent(inout) :: hm + type(output_t), intent(inout) :: outp + logical, intent(in) :: from_scratch + end subroutine td_init_with_wavefunctions + + module subroutine td_load_restart_from_gs(td, namespace, space, mc, gr, ext_partners, st, ks, hm) + type(td_t), intent(inout) :: td + type(namespace_t), intent(in) :: namespace + class(space_t), intent(in) :: space + type(multicomm_t), intent(in) :: mc + type(grid_t), intent(inout) :: gr + type(partner_list_t), intent(in) :: ext_partners + type(states_elec_t), target, intent(inout) :: st + type(v_ks_t), intent(inout) :: ks + type(hamiltonian_elec_t), intent(inout) :: hm + end subroutine td_load_restart_from_gs + + module subroutine td_dump(td, namespace, space, gr, st, hm, ks, ext_partners, iter, ierr) + type(td_t), intent(in) :: td + type(namespace_t), intent(in) :: namespace + class(space_t), intent(in) :: space + type(grid_t), intent(in) :: gr + type(states_elec_t), intent(in) :: st + type(hamiltonian_elec_t), intent(in) :: hm + type(v_ks_t), intent(in) :: ks + type(partner_list_t), intent(in) :: ext_partners + integer, intent(in) :: iter + integer, intent(out) :: ierr + end subroutine td_dump + + module function td_get_from_scratch(td) result(res) + type(td_t), intent(in) :: td + logical :: res + end function td_get_from_scratch + + module subroutine td_set_from_scratch(td, from_scratch) + type(td_t), intent(inout) :: td + logical, intent(in) :: from_scratch + end subroutine td_set_from_scratch + + module subroutine td_load_restart_from_td(td, namespace, space, mc, gr, ext_partners, st, ks, hm, from_scratch) + type(td_t), intent(inout) :: td + type(namespace_t), intent(in) :: namespace + class(space_t), intent(in) :: space + type(multicomm_t), intent(in) :: mc + type(grid_t), intent(inout) :: gr + type(partner_list_t), intent(in) :: ext_partners + type(states_elec_t), target, intent(inout) :: st + type(v_ks_t), intent(inout) :: ks + type(hamiltonian_elec_t), intent(inout) :: hm + logical, intent(inout) :: from_scratch + end subroutine td_load_restart_from_td + end interface +end module td_oct_m -- GitLab From 2b67da7b7cc42a226f4ad0eda246155b118cd5ee Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Tue, 30 May 2023 11:52:31 +0200 Subject: [PATCH 04/43] [submodule] `system_oct_m` Signed-off-by: Cristian Le --- src/multisystem/system.F90 | 273 +++++++++++++++++++++++++++++-------- 1 file changed, 215 insertions(+), 58 deletions(-) diff --git a/src/multisystem/system.F90 b/src/multisystem/system.F90 index 7cd8c44b7d..850ef9484b 100644 --- a/src/multisystem/system.F90 +++ b/src/multisystem/system.F90 @@ -23,26 +23,15 @@ !> This module implements the abstract system type. !! module system_oct_m - use algorithm_oct_m use algorithm_factory_oct_m - use debug_oct_m - use ghost_interaction_oct_m + use algorithm_oct_m use global_oct_m - use interactions_factory_abst_oct_m - use interaction_partner_oct_m use interaction_oct_m + use interaction_partner_oct_m + use interactions_factory_abst_oct_m use iteration_counter_oct_m - use messages_oct_m - use mpi_oct_m - use namespace_oct_m - use multisystem_debug_oct_m use linked_list_oct_m - use parser_oct_m - use profiling_oct_m - use quantity_oct_m - use unit_oct_m - use unit_system_oct_m - use varinfo_oct_m + use mpi_oct_m implicit none private @@ -219,6 +208,168 @@ module system_oct_m procedure :: get_next => system_iterator_get_next !< @copydoc system_oct_m::system_iterator_get_next end type system_iterator_t + ! Subroutine/Functions + interface + module subroutine system_execute_algorithm(this) + class(system_t), intent(inout) :: this + end subroutine system_execute_algorithm + + module subroutine system_reset_iteration_counters(this, accumulated_iterations) + class(system_t), intent(inout) :: this + integer, intent(in) :: accumulated_iterations + end subroutine system_reset_iteration_counters + + recursive module subroutine system_create_interactions(this, interaction_factory, available_partners) + class(system_t), intent(inout) :: this + class(interactions_factory_abst_t), intent(in) :: interaction_factory + class(partner_list_t), target, intent(in) :: available_partners + end subroutine system_create_interactions + + module function system_update_couplings(this) result(all_updated) + class(system_t), intent(inout) :: this + logical :: all_updated + end function system_update_couplings + + module subroutine system_update_interactions(this) + class(system_t), intent(inout) :: this + end subroutine system_update_interactions + + module subroutine system_update_interactions_start(this) + class(system_t), intent(inout) :: this + end subroutine system_update_interactions_start + + module subroutine system_update_interactions_finish(this) + class(system_t), intent(inout) :: this + end subroutine system_update_interactions_finish + + module subroutine system_restart_write(this) + class(system_t), intent(inout) :: this + end subroutine system_restart_write + + module function system_restart_read(this) result(res) + class(system_t), intent(inout) :: this + logical :: res + end function system_restart_read + + module subroutine system_output_start(this) + class(system_t), intent(inout) :: this + end subroutine system_output_start + + module subroutine system_output_write(this) + class(system_t), intent(inout) :: this + end subroutine system_output_write + + module subroutine system_output_finish(this) + class(system_t), intent(inout) :: this + end subroutine system_output_finish + + module subroutine system_init_algorithm(this, factory) + class(system_t), intent(inout) :: this + class(algorithm_factory_t), intent(in) :: factory + end subroutine system_init_algorithm + + recursive module function system_algorithm_finished(this) result(finished) + class(system_t), intent(in) :: this + logical :: finished + end function system_algorithm_finished + + module subroutine system_init_iteration_counters(this) + class(system_t), intent(inout) :: this + end subroutine system_init_iteration_counters + + module subroutine system_propagation_start(this) + class(system_t), intent(inout) :: this + end subroutine system_propagation_start + + module subroutine system_propagation_finish(this) + class(system_t), intent(inout) :: this + end subroutine system_propagation_finish + + module subroutine system_iteration_info(this) + class(system_t), intent(in) :: this + end subroutine system_iteration_info + + module function system_process_is_slave(this) result(res) + class(system_t), intent(in) :: this + logical :: res + end function system_process_is_slave + + module subroutine system_end(this) + class(system_t), intent(inout) :: this + end subroutine system_end + + module subroutine system_list_add_node(this, partner) + class(system_list_t) :: this + class(interaction_partner_t), target :: partner + end subroutine system_list_add_node + + recursive module function system_list_contains(this, partner) result(contains) + class(system_list_t) :: this + class(interaction_partner_t), target :: partner + logical contains + end function system_list_contains + + module function system_iterator_get_next(this) result(system) + class(system_iterator_t), intent(inout) :: this + class(system_t), pointer :: system + end function system_iterator_get_next + + module subroutine system_init_parallelization(this, grp) + class(system_t), intent(inout) :: this + type(mpi_grp_t), intent(in) :: grp + end subroutine system_init_parallelization + + module subroutine system_start_barrier(this, target_time, barrier_index) + class(system_t), intent(inout) :: this + real(real64), intent(in) :: target_time + integer, intent(in) :: barrier_index + end subroutine system_start_barrier + + module subroutine system_end_barrier(this, barrier_index) + class(system_t), intent(inout) :: this + integer, intent(in) :: barrier_index + end subroutine system_end_barrier + + module function system_arrived_at_barrier(this, barrier_index) result(res) + class(system_t), intent(inout) :: this + integer, intent(in) :: barrier_index + logical :: res + end function system_arrived_at_barrier + + module function system_arrived_at_any_barrier(this) result(res) + class(system_t), intent(inout) :: this + logical :: res + end function system_arrived_at_any_barrier + + module subroutine system_update_potential_energy(this) + class(system_t), intent(inout) :: this + end subroutine system_update_potential_energy + + module subroutine system_update_internal_energy(this) + class(system_t), intent(inout) :: this + end subroutine system_update_internal_energy + + module subroutine system_update_total_energy(this) + class(system_t), intent(inout) :: this + end subroutine system_update_total_energy + end interface +end module system_oct_m + +submodule (system_oct_m) impl + use debug_oct_m + use ghost_interaction_oct_m + use global_oct_m + use interactions_factory_abst_oct_m + use messages_oct_m + use namespace_oct_m + use multisystem_debug_oct_m + use parser_oct_m + use profiling_oct_m + use quantity_oct_m + use unit_oct_m + use unit_system_oct_m + use varinfo_oct_m + implicit none contains ! --------------------------------------------------------- @@ -234,7 +385,7 @@ contains !! The couplings update is always considered a barrier, even if the update was !! successful. This is to allow other system to also update their couplings !! with this system before it moves on to the next operations. - subroutine system_execute_algorithm(this) + module subroutine system_execute_algorithm(this) class(system_t), intent(inout) :: this type(algorithmic_operation_t) :: operation @@ -352,7 +503,7 @@ contains end subroutine system_execute_algorithm ! --------------------------------------------------------- - subroutine system_reset_iteration_counters(this, accumulated_iterations) + module subroutine system_reset_iteration_counters(this, accumulated_iterations) class(system_t), intent(inout) :: this integer, intent(in) :: accumulated_iterations @@ -405,7 +556,7 @@ contains !! and all available partners. Any class overriding this method must make sure !! ghost interactions are properly created or the framework might not work !! correctly. - recursive subroutine system_create_interactions(this, interaction_factory, available_partners) + recursive module subroutine system_create_interactions(this, interaction_factory, available_partners) class(system_t), intent(inout) :: this !< system for which interactions are created. class(interactions_factory_abst_t), intent(in) :: interaction_factory !< factory that creates the actual interactions class(partner_list_t), target, intent(in) :: available_partners !< a list of available partners for the given system. @@ -556,8 +707,9 @@ contains !! This function loops over all interactions and the corresponding interaction partners !! and attempts to update their couplings to the requested iteration. It returns true if all !! couplings have been successfully updated. - logical function system_update_couplings(this) result(all_updated) + module function system_update_couplings(this) result(all_updated) class(system_t), intent(inout) :: this + logical :: all_updated class(interaction_t), pointer :: interaction type(interaction_iterator_t) :: iter @@ -593,7 +745,7 @@ contains !! !! First we try to update the systems own quantities required for the interaction, !! and then try to update the interaction itself. - subroutine system_update_interactions(this) + module subroutine system_update_interactions(this) class(system_t), intent(inout) :: this integer :: iq, q_id, n_quantities @@ -666,7 +818,7 @@ contains end subroutine system_update_interactions ! --------------------------------------------------------- - subroutine system_update_interactions_start(this) + module subroutine system_update_interactions_start(this) class(system_t), intent(inout) :: this PUSH_SUB(system_update_interactions_start) @@ -678,7 +830,7 @@ contains end subroutine system_update_interactions_start ! --------------------------------------------------------- - subroutine system_update_interactions_finish(this) + module subroutine system_update_interactions_finish(this) class(system_t), intent(inout) :: this PUSH_SUB(system_update_interactions_finish) @@ -690,7 +842,7 @@ contains end subroutine system_update_interactions_finish ! --------------------------------------------------------- - subroutine system_restart_write(this) + module subroutine system_restart_write(this) class(system_t), intent(inout) :: this logical :: restart_write @@ -729,8 +881,9 @@ contains ! --------------------------------------------------------- ! this function returns true if restart data could be read - logical function system_restart_read(this) + module function system_restart_read(this) result(res) class(system_t), intent(inout) :: this + logical :: res type(interaction_iterator_t) :: iter class(interaction_t), pointer :: interaction @@ -740,19 +893,19 @@ contains ! do some generic restart steps here ! read iteration data - system_restart_read = this%iteration%restart_read('restart_iteration_system', this%namespace) - system_restart_read = system_restart_read .and. & + res = this%iteration%restart_read('restart_iteration_system', this%namespace) + res = res .and. & this%algo%iteration%restart_read('restart_iteration_propagator', this%namespace) call iter%start(this%interactions) do while (iter%has_next()) interaction => iter%get_next() - system_restart_read = system_restart_read .and. interaction%restart_read(this%namespace) + res = res .and. interaction%restart_read(this%namespace) ! reduce by one because of the first UPDATE_INTERACTIONS interaction%iteration = interaction%iteration - 1 end do do ii = 1, MAX_QUANTITIES if (this%quantities(ii)%required) then - system_restart_read = system_restart_read .and. & + res = res .and. & this%quantities(ii)%iteration%restart_read('restart_iteration_quantity_'//trim(QUANTITY_LABEL(ii)), & this%namespace) end if @@ -762,9 +915,9 @@ contains end if end do ! the following call is delegated to the corresponding system - system_restart_read = system_restart_read .and. this%restart_read_data() + res = res .and. this%restart_read_data() - if (system_restart_read) then + if (res) then message(1) = "Successfully read restart data for system "//trim(this%namespace%get()) call messages_info(1, namespace=this%namespace) end if @@ -773,7 +926,7 @@ contains end function system_restart_read ! --------------------------------------------------------- - subroutine system_output_start(this) + module subroutine system_output_start(this) class(system_t), intent(inout) :: this PUSH_SUB(system_output_start) @@ -785,7 +938,7 @@ contains end subroutine system_output_start ! --------------------------------------------------------- - subroutine system_output_write(this) + module subroutine system_output_write(this) class(system_t), intent(inout) :: this PUSH_SUB(system_output_write) @@ -797,7 +950,7 @@ contains end subroutine system_output_write ! --------------------------------------------------------- - subroutine system_output_finish(this) + module subroutine system_output_finish(this) class(system_t), intent(inout) :: this PUSH_SUB(system_output_finish) @@ -809,7 +962,7 @@ contains end subroutine system_output_finish ! --------------------------------------------------------- - subroutine system_init_algorithm(this, factory) + module subroutine system_init_algorithm(this, factory) class(system_t), intent(inout) :: this class(algorithm_factory_t), intent(in) :: factory @@ -832,7 +985,7 @@ contains end subroutine system_init_algorithm ! --------------------------------------------------------------------------------------- - recursive function system_algorithm_finished(this) result(finished) + recursive module function system_algorithm_finished(this) result(finished) class(system_t), intent(in) :: this logical :: finished @@ -847,7 +1000,7 @@ contains !! before the algorithm iteration counter. This is necessary, as the interactions and on-demand quantities !! first need to be updated. ! - subroutine system_init_iteration_counters(this) + module subroutine system_init_iteration_counters(this) class(system_t), intent(inout) :: this type(interaction_iterator_t) :: iter @@ -880,7 +1033,7 @@ contains end subroutine system_init_iteration_counters ! --------------------------------------------------------- - subroutine system_propagation_start(this) + module subroutine system_propagation_start(this) class(system_t), intent(inout) :: this logical :: all_updated @@ -934,7 +1087,7 @@ contains end subroutine system_propagation_start ! --------------------------------------------------------- - subroutine system_propagation_finish(this) + module subroutine system_propagation_finish(this) class(system_t), intent(inout) :: this type(event_handle_t) :: debug_handle @@ -967,7 +1120,7 @@ contains end subroutine system_propagation_finish ! --------------------------------------------------------- - subroutine system_iteration_info(this) + module subroutine system_iteration_info(this) class(system_t), intent(in) :: this real(real64) :: energy @@ -996,19 +1149,20 @@ contains end subroutine system_iteration_info ! --------------------------------------------------------- - logical function system_process_is_slave(this) + module function system_process_is_slave(this) result(res) class(system_t), intent(in) :: this + logical :: res PUSH_SUB(system_process_is_slave) ! By default an MPI process is not a slave - system_process_is_slave = .false. + res = .false. POP_SUB(system_process_is_slave) end function system_process_is_slave ! --------------------------------------------------------- - subroutine system_end(this) + module subroutine system_end(this) class(system_t), intent(inout) :: this type(interaction_iterator_t) :: iter @@ -1033,7 +1187,7 @@ contains end subroutine system_end ! --------------------------------------------------------- - subroutine system_list_add_node(this, partner) + module subroutine system_list_add_node(this, partner) class(system_list_t) :: this class(interaction_partner_t), target :: partner @@ -1050,9 +1204,10 @@ contains end subroutine system_list_add_node ! --------------------------------------------------------- - recursive logical function system_list_contains(this, partner) result(contains) + recursive module function system_list_contains(this, partner) result(contains) class(system_list_t) :: this class(interaction_partner_t), target :: partner + logical :: contains type(partner_iterator_t) :: iterator class(interaction_partner_t), pointer :: system @@ -1078,7 +1233,7 @@ contains end function system_list_contains ! --------------------------------------------------------- - function system_iterator_get_next(this) result(system) + module function system_iterator_get_next(this) result(system) class(system_iterator_t), intent(inout) :: this class(system_t), pointer :: system @@ -1098,7 +1253,7 @@ contains !> Basic functionality: copy the MPI group. !! This function needs to be implemented by extended types !! that need more initialization for their parallelization. - subroutine system_init_parallelization(this, grp) + module subroutine system_init_parallelization(this, grp) class(system_t), intent(inout) :: this type(mpi_grp_t), intent(in) :: grp @@ -1113,7 +1268,7 @@ contains ! --------------------------------------------------------- - subroutine system_start_barrier(this, target_time, barrier_index) + module subroutine system_start_barrier(this, target_time, barrier_index) class(system_t), intent(inout) :: this real(real64), intent(in) :: target_time integer, intent(in) :: barrier_index @@ -1127,7 +1282,7 @@ contains end subroutine system_start_barrier ! --------------------------------------------------------- - subroutine system_end_barrier(this, barrier_index) + module subroutine system_end_barrier(this, barrier_index) class(system_t), intent(inout) :: this integer, intent(in) :: barrier_index @@ -1140,19 +1295,20 @@ contains end subroutine system_end_barrier ! --------------------------------------------------------- - logical function system_arrived_at_barrier(this, barrier_index) + module function system_arrived_at_barrier(this, barrier_index) result(res) class(system_t), intent(inout) :: this integer, intent(in) :: barrier_index + logical :: res type(iteration_counter_t) :: iteration PUSH_SUB(system_arrived_at_barrier) - system_arrived_at_barrier = .false. + res = .false. if (this%barrier(barrier_index)%active) then iteration = this%iteration + 1 if (iteration%value() > this%barrier(barrier_index)%target_time) then - system_arrived_at_barrier = .true. + res = .true. end if end if @@ -1160,16 +1316,17 @@ contains end function system_arrived_at_barrier ! --------------------------------------------------------- - logical function system_arrived_at_any_barrier(this) + module function system_arrived_at_any_barrier(this) result(res) class(system_t), intent(inout) :: this + logical :: res integer :: ii PUSH_SUB(system_arrived_at_any_barrier) - system_arrived_at_any_barrier = .false. + res = .false. do ii = 1, NUMBER_BARRIERS - system_arrived_at_any_barrier = system_arrived_at_any_barrier & + res = res & .or. this%arrived_at_barrier(ii) end do @@ -1182,7 +1339,7 @@ contains !! The potential energy is defined as the sum of all energies !! arising from interactions with external systems. !! (Note that multisystems override this function) - subroutine system_update_potential_energy(this) + module subroutine system_update_potential_energy(this) class(system_t), intent(inout) :: this type(interaction_iterator_t) :: iter @@ -1209,7 +1366,7 @@ contains !! The internal energy is defined as the sum of all energies !! arising from intra-interactions and the entropy terms (if available). !! (Note that multisystems override this function) - subroutine system_update_internal_energy(this) + module subroutine system_update_internal_energy(this) class(system_t), intent(inout) :: this type(interaction_iterator_t) :: iter @@ -1234,7 +1391,7 @@ contains !> Calculate the total energy of the system. !! The total energy is defined as the sum of !! the kinetic, the internal and the potential energies. - subroutine system_update_total_energy(this) + module subroutine system_update_total_energy(this) class(system_t), intent(inout) :: this PUSH_SUB(system_update_total_energy) @@ -1253,7 +1410,7 @@ contains POP_SUB(system_update_total_energy) end subroutine system_update_total_energy -end module system_oct_m +end submodule impl !! Local Variables: !! mode: f90 -- GitLab From d52b101225a0ac8cec179eb38a887a2fb8cf1f5e Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Mon, 15 Jan 2024 10:30:40 +0100 Subject: [PATCH 05/43] [submodule] `system_oct_m` (split) Signed-off-by: Cristian Le --- src/Makefile.am | 1 + src/multisystem/CMakeLists.txt | 1 + src/multisystem/system.F90 | 336 --------------------------------- src/multisystem/system_h.F90 | 334 ++++++++++++++++++++++++++++++++ 4 files changed, 336 insertions(+), 336 deletions(-) create mode 100644 src/multisystem/system_h.F90 diff --git a/src/Makefile.am b/src/Makefile.am index 4891d95552..bf1b092c86 100644 --- a/src/Makefile.am +++ b/src/Makefile.am @@ -551,6 +551,7 @@ multisystem_f_srcs = \ multisystem/propagator_verlet.F90 \ multisystem/quantity.F90 \ multisystem/system.F90 \ + multisystem/system_h.F90 \ multisystem/system_factory_abst.F90 multisystem_srcs = $(multisystem_f_srcs) diff --git a/src/multisystem/CMakeLists.txt b/src/multisystem/CMakeLists.txt index 51bc99876c..1c30e995de 100644 --- a/src/multisystem/CMakeLists.txt +++ b/src/multisystem/CMakeLists.txt @@ -28,4 +28,5 @@ target_sources(Octopus_lib PRIVATE quantity.F90 system.F90 system_factory_abst.F90 + system_h.F90 ) diff --git a/src/multisystem/system.F90 b/src/multisystem/system.F90 index 850ef9484b..cb16c27b6e 100644 --- a/src/multisystem/system.F90 +++ b/src/multisystem/system.F90 @@ -20,346 +20,10 @@ #include "global.h" -!> This module implements the abstract system type. -!! -module system_oct_m - use algorithm_factory_oct_m - use algorithm_oct_m - use global_oct_m - use interaction_oct_m - use interaction_partner_oct_m - use interactions_factory_abst_oct_m - use iteration_counter_oct_m - use linked_list_oct_m - use mpi_oct_m - implicit none - - private - public :: & - system_t, & - system_execute_algorithm, & - system_init_parallelization, & - system_init_algorithm, & - system_init_iteration_counters, & - system_reset_iteration_counters, & - system_create_interactions, & - system_propagation_start, & - system_propagation_finish, & - system_restart_read, & - system_restart_write, & - system_update_potential_energy, & - system_update_total_energy, & - system_end, & - system_list_t, & - system_iterator_t - - type :: barrier_t - logical :: active - real(real64) :: target_time - end type barrier_t - - integer, parameter, public :: & - NUMBER_BARRIERS = 1, & - BARRIER_RESTART = 1 - - !> @brief Abstract class for systems - !! - !! All explicit systems are derived from this class. - type, extends(interaction_partner_t), abstract :: system_t - private - type(iteration_counter_t), public :: iteration - class(algorithm_t), pointer, public :: algo => null() - - integer, allocatable, public :: supported_interactions(:) - type(interaction_list_t), public :: interactions !< List with all the interactions of this system - - type(mpi_grp_t), public :: grp !< mpi group for this system - - type(barrier_t) :: barrier(NUMBER_BARRIERS) - real(real64), public :: kinetic_energy !< Energy not from interactions, like the kinetic energy - real(real64), public :: potential_energy !< Energy from the interactions with external systems - real(real64), public :: internal_energy !< Energy from the interactions with itself and for containers the kinetic energy of its constituents - real(real64), public :: total_energy !< Sum of internal, external, and self energy - - contains - procedure :: execute_algorithm => system_execute_algorithm !< @copydoc system_oct_m::system_execute_algorithm - procedure :: reset_iteration_counters => system_reset_iteration_counters !< @copydoc system_oct_m::system_reset_iteration_counters - procedure :: init_algorithm => system_init_algorithm !< @copydoc system_oct_m::system_init_algorithm - procedure :: algorithm_finished => system_algorithm_finished !< @copydoc system_oct_m::system_algorithm_finished - procedure :: init_iteration_counters => system_init_iteration_counters !< @copydoc system_oct_m::system_init_iteration_counters - procedure :: create_interactions => system_create_interactions !< @copydoc system_oct_m::system_create_interactions - procedure :: init_parallelization => system_init_parallelization !< @copydoc system_oct_m::system_init_parallelization - procedure :: update_couplings => system_update_couplings !< @copydoc system_oct_m::system_update_couplings - procedure :: update_interactions => system_update_interactions !< @copydoc system_oct_m::system_update_interactions - procedure :: update_interactions_start => system_update_interactions_start !< @copydoc system_oct_m::system_update_interactions_start - procedure :: update_interactions_finish => system_update_interactions_finish !< @copydoc system_oct_m::system_update_interactions_finish - procedure :: propagation_start => system_propagation_start !< @copydoc system_oct_m::system_propagation_start - procedure :: propagation_finish => system_propagation_finish !< @copydoc system_oct_m::system_propagation_finish - procedure :: iteration_info => system_iteration_info !< @copydoc system_oct_m::system_iteration_info - procedure :: restart_write => system_restart_write !< @copydoc system_oct_m::system_restart_write - procedure :: restart_read => system_restart_read !< @copydoc system_oct_m::system_restart_read - procedure :: output_start => system_output_start !< @copydoc system_oct_m::system_output_start - procedure :: output_write => system_output_write !< @copydoc system_oct_m::system_output_write - procedure :: output_finish => system_output_finish !< @copydoc system_oct_m::system_output_finish - procedure :: process_is_slave => system_process_is_slave !< @copydoc system_oct_m::system_process_is_slave - procedure :: start_barrier => system_start_barrier !< @copydoc system_oct_m::system_start_barrier - procedure :: end_barrier => system_end_barrier !< @copydoc system_oct_m::system_end_barrier - procedure :: arrived_at_barrier => system_arrived_at_barrier !< @copydoc system_oct_m::system_arrived_at_barrier - procedure :: arrived_at_any_barrier => system_arrived_at_any_barrier !< @copydoc system_oct_m::system_arrived_at_any_barrier - procedure :: update_potential_energy => system_update_potential_energy !< @copydoc system_oct_m::system_update_potential_energy - procedure :: update_internal_energy => system_update_internal_energy !< @copydoc system_oct_m::system_update_internal_energy - procedure :: update_total_energy => system_update_total_energy !< @copydoc system_oct_m::system_update_total_energy - procedure(system_init_interaction), deferred :: init_interaction !< @copydoc system_oct_m::system_init_interaction - procedure(system_initial_conditions), deferred :: initial_conditions !< @copydoc system_oct_m::system_initial_conditions - procedure(system_do_algorithmic_operation), deferred :: do_algorithmic_operation !< @copydoc system_oct_m::system_do_algorithmic_operation - procedure(system_is_tolerance_reached), deferred :: is_tolerance_reached !< @copydoc system_oct_m::system_is_tolerance_reached - procedure(system_restart_write_data), deferred :: restart_write_data !< @copydoc system_oct_m::system_restart_write_data - procedure(system_restart_read_data), deferred :: restart_read_data !< @copydoc system_oct_m::system_restart_read_data - procedure(system_update_kinetic_energy), deferred :: update_kinetic_energy !< @copydoc system_oct_m::system_update_kinetic_energy - end type system_t - - abstract interface - - ! --------------------------------------------------------- - !> @brief initialize a given interaction of the system - subroutine system_init_interaction(this, interaction) - import system_t - import interaction_t - class(system_t), target, intent(inout) :: this - class(interaction_t), intent(inout) :: interaction - end subroutine system_init_interaction - - ! --------------------------------------------------------- - !> set initial conditions for a system - subroutine system_initial_conditions(this) - import system_t - class(system_t), intent(inout) :: this - end subroutine system_initial_conditions - - ! --------------------------------------------------------- - !> @brief Execute one operation that is part of a larger algorithm. Returns true - !! if the operation was successfully executed, false otherwise. - !! - !! Unsuccessful operations can occur, e.g. of quantities from an interaction - !! are required, but the interaction is still behind in terms of the iteration counters. - !! - !! On output, the routine should also provide a list quantities that were - !! updated. If no quantitiy was updated, then the corresponding array should - !! be left unallocated. - logical function system_do_algorithmic_operation(this, operation, updated_quantities) result(done) - import system_t - import algorithmic_operation_t - class(system_t), intent(inout) :: this - class(algorithmic_operation_t), intent(in) :: operation - integer, allocatable, intent(out) :: updated_quantities(:) - end function system_do_algorithmic_operation - - ! --------------------------------------------------------- - !> @brief check whether a system has reached a given tolerance - logical function system_is_tolerance_reached(this, tol) - use, intrinsic :: iso_fortran_env - import system_t - class(system_t), intent(in) :: this - real(real64), intent(in) :: tol - end function system_is_tolerance_reached - - ! --------------------------------------------------------- - !> @brief For some algorithms it might be necessary to store the status of a system at a given algorithmic step - !! - !! This should be implemented by each system in this routine. - subroutine system_store_current_status(this) - import system_t - class(system_t), intent(inout) :: this - end subroutine system_store_current_status - - ! --------------------------------------------------------- - subroutine system_restart_write_data(this) - import system_t - class(system_t), intent(inout) :: this - end subroutine system_restart_write_data - - ! --------------------------------------------------------- - ! this function returns true if restart data could be read - logical function system_restart_read_data(this) - import system_t - class(system_t), intent(inout) :: this - end function system_restart_read_data - subroutine system_update_kinetic_energy(this) - import system_t - class(system_t), intent(inout) :: this - end subroutine system_update_kinetic_energy - - end interface - - !> @brief These classes extends the list and list iterator to create a system list. - !! - !! Since a list of systems is also a list of interaction partners, the system - !! list is an extension of the partner list. - type, extends(partner_list_t) :: system_list_t - private - contains - procedure :: add => system_list_add_node !< @copydoc system_oct_m::system_list_add_node - procedure :: contains => system_list_contains !< @copydoc system_oct_m::system_list_contains - end type system_list_t - - type, extends(linked_list_iterator_t) :: system_iterator_t - private - contains - procedure :: get_next => system_iterator_get_next !< @copydoc system_oct_m::system_iterator_get_next - end type system_iterator_t - - ! Subroutine/Functions - interface - module subroutine system_execute_algorithm(this) - class(system_t), intent(inout) :: this - end subroutine system_execute_algorithm - - module subroutine system_reset_iteration_counters(this, accumulated_iterations) - class(system_t), intent(inout) :: this - integer, intent(in) :: accumulated_iterations - end subroutine system_reset_iteration_counters - - recursive module subroutine system_create_interactions(this, interaction_factory, available_partners) - class(system_t), intent(inout) :: this - class(interactions_factory_abst_t), intent(in) :: interaction_factory - class(partner_list_t), target, intent(in) :: available_partners - end subroutine system_create_interactions - - module function system_update_couplings(this) result(all_updated) - class(system_t), intent(inout) :: this - logical :: all_updated - end function system_update_couplings - - module subroutine system_update_interactions(this) - class(system_t), intent(inout) :: this - end subroutine system_update_interactions - - module subroutine system_update_interactions_start(this) - class(system_t), intent(inout) :: this - end subroutine system_update_interactions_start - - module subroutine system_update_interactions_finish(this) - class(system_t), intent(inout) :: this - end subroutine system_update_interactions_finish - - module subroutine system_restart_write(this) - class(system_t), intent(inout) :: this - end subroutine system_restart_write - - module function system_restart_read(this) result(res) - class(system_t), intent(inout) :: this - logical :: res - end function system_restart_read - - module subroutine system_output_start(this) - class(system_t), intent(inout) :: this - end subroutine system_output_start - - module subroutine system_output_write(this) - class(system_t), intent(inout) :: this - end subroutine system_output_write - - module subroutine system_output_finish(this) - class(system_t), intent(inout) :: this - end subroutine system_output_finish - - module subroutine system_init_algorithm(this, factory) - class(system_t), intent(inout) :: this - class(algorithm_factory_t), intent(in) :: factory - end subroutine system_init_algorithm - - recursive module function system_algorithm_finished(this) result(finished) - class(system_t), intent(in) :: this - logical :: finished - end function system_algorithm_finished - - module subroutine system_init_iteration_counters(this) - class(system_t), intent(inout) :: this - end subroutine system_init_iteration_counters - - module subroutine system_propagation_start(this) - class(system_t), intent(inout) :: this - end subroutine system_propagation_start - - module subroutine system_propagation_finish(this) - class(system_t), intent(inout) :: this - end subroutine system_propagation_finish - - module subroutine system_iteration_info(this) - class(system_t), intent(in) :: this - end subroutine system_iteration_info - - module function system_process_is_slave(this) result(res) - class(system_t), intent(in) :: this - logical :: res - end function system_process_is_slave - - module subroutine system_end(this) - class(system_t), intent(inout) :: this - end subroutine system_end - - module subroutine system_list_add_node(this, partner) - class(system_list_t) :: this - class(interaction_partner_t), target :: partner - end subroutine system_list_add_node - - recursive module function system_list_contains(this, partner) result(contains) - class(system_list_t) :: this - class(interaction_partner_t), target :: partner - logical contains - end function system_list_contains - - module function system_iterator_get_next(this) result(system) - class(system_iterator_t), intent(inout) :: this - class(system_t), pointer :: system - end function system_iterator_get_next - - module subroutine system_init_parallelization(this, grp) - class(system_t), intent(inout) :: this - type(mpi_grp_t), intent(in) :: grp - end subroutine system_init_parallelization - - module subroutine system_start_barrier(this, target_time, barrier_index) - class(system_t), intent(inout) :: this - real(real64), intent(in) :: target_time - integer, intent(in) :: barrier_index - end subroutine system_start_barrier - - module subroutine system_end_barrier(this, barrier_index) - class(system_t), intent(inout) :: this - integer, intent(in) :: barrier_index - end subroutine system_end_barrier - - module function system_arrived_at_barrier(this, barrier_index) result(res) - class(system_t), intent(inout) :: this - integer, intent(in) :: barrier_index - logical :: res - end function system_arrived_at_barrier - - module function system_arrived_at_any_barrier(this) result(res) - class(system_t), intent(inout) :: this - logical :: res - end function system_arrived_at_any_barrier - - module subroutine system_update_potential_energy(this) - class(system_t), intent(inout) :: this - end subroutine system_update_potential_energy - - module subroutine system_update_internal_energy(this) - class(system_t), intent(inout) :: this - end subroutine system_update_internal_energy - - module subroutine system_update_total_energy(this) - class(system_t), intent(inout) :: this - end subroutine system_update_total_energy - end interface -end module system_oct_m - submodule (system_oct_m) impl use debug_oct_m use ghost_interaction_oct_m use global_oct_m - use interactions_factory_abst_oct_m use messages_oct_m use namespace_oct_m use multisystem_debug_oct_m diff --git a/src/multisystem/system_h.F90 b/src/multisystem/system_h.F90 new file mode 100644 index 0000000000..709db1a6bc --- /dev/null +++ b/src/multisystem/system_h.F90 @@ -0,0 +1,334 @@ +!> This module implements the abstract system type. +!! +module system_oct_m + use algorithm_factory_oct_m + use algorithm_oct_m + use global_oct_m + use interaction_oct_m + use interaction_partner_oct_m + use interactions_factory_abst_oct_m + use iteration_counter_oct_m + use linked_list_oct_m + use mpi_oct_m + implicit none + + private + public :: & + system_t, & + system_execute_algorithm, & + system_init_parallelization, & + system_init_algorithm, & + system_init_iteration_counters, & + system_reset_iteration_counters, & + system_create_interactions, & + system_propagation_start, & + system_propagation_finish, & + system_restart_read, & + system_restart_write, & + system_update_potential_energy, & + system_update_total_energy, & + system_end, & + system_list_t, & + system_iterator_t + + type :: barrier_t + logical :: active + real(real64) :: target_time + end type barrier_t + + integer, parameter, public :: & + NUMBER_BARRIERS = 1, & + BARRIER_RESTART = 1 + + !> @brief Abstract class for systems + !! + !! All explicit systems are derived from this class. + type, extends(interaction_partner_t), abstract :: system_t + private + type(iteration_counter_t), public :: iteration + class(algorithm_t), pointer, public :: algo => null() + + integer, allocatable, public :: supported_interactions(:) + type(interaction_list_t), public :: interactions !< List with all the interactions of this system + + type(mpi_grp_t), public :: grp !< mpi group for this system + + type(barrier_t) :: barrier(NUMBER_BARRIERS) + real(real64), public :: kinetic_energy !< Energy not from interactions, like the kinetic energy + real(real64), public :: potential_energy !< Energy from the interactions with external systems + real(real64), public :: internal_energy !< Energy from the interactions with itself and for containers the kinetic energy of its constituents + real(real64), public :: total_energy !< Sum of internal, external, and self energy + + contains + procedure :: execute_algorithm => system_execute_algorithm !< @copydoc system_oct_m::system_execute_algorithm + procedure :: reset_iteration_counters => system_reset_iteration_counters !< @copydoc system_oct_m::system_reset_iteration_counters + procedure :: init_algorithm => system_init_algorithm !< @copydoc system_oct_m::system_init_algorithm + procedure :: algorithm_finished => system_algorithm_finished !< @copydoc system_oct_m::system_algorithm_finished + procedure :: init_iteration_counters => system_init_iteration_counters !< @copydoc system_oct_m::system_init_iteration_counters + procedure :: create_interactions => system_create_interactions !< @copydoc system_oct_m::system_create_interactions + procedure :: init_parallelization => system_init_parallelization !< @copydoc system_oct_m::system_init_parallelization + procedure :: update_couplings => system_update_couplings !< @copydoc system_oct_m::system_update_couplings + procedure :: update_interactions => system_update_interactions !< @copydoc system_oct_m::system_update_interactions + procedure :: update_interactions_start => system_update_interactions_start !< @copydoc system_oct_m::system_update_interactions_start + procedure :: update_interactions_finish => system_update_interactions_finish !< @copydoc system_oct_m::system_update_interactions_finish + procedure :: propagation_start => system_propagation_start !< @copydoc system_oct_m::system_propagation_start + procedure :: propagation_finish => system_propagation_finish !< @copydoc system_oct_m::system_propagation_finish + procedure :: iteration_info => system_iteration_info !< @copydoc system_oct_m::system_iteration_info + procedure :: restart_write => system_restart_write !< @copydoc system_oct_m::system_restart_write + procedure :: restart_read => system_restart_read !< @copydoc system_oct_m::system_restart_read + procedure :: output_start => system_output_start !< @copydoc system_oct_m::system_output_start + procedure :: output_write => system_output_write !< @copydoc system_oct_m::system_output_write + procedure :: output_finish => system_output_finish !< @copydoc system_oct_m::system_output_finish + procedure :: process_is_slave => system_process_is_slave !< @copydoc system_oct_m::system_process_is_slave + procedure :: start_barrier => system_start_barrier !< @copydoc system_oct_m::system_start_barrier + procedure :: end_barrier => system_end_barrier !< @copydoc system_oct_m::system_end_barrier + procedure :: arrived_at_barrier => system_arrived_at_barrier !< @copydoc system_oct_m::system_arrived_at_barrier + procedure :: arrived_at_any_barrier => system_arrived_at_any_barrier !< @copydoc system_oct_m::system_arrived_at_any_barrier + procedure :: update_potential_energy => system_update_potential_energy !< @copydoc system_oct_m::system_update_potential_energy + procedure :: update_internal_energy => system_update_internal_energy !< @copydoc system_oct_m::system_update_internal_energy + procedure :: update_total_energy => system_update_total_energy !< @copydoc system_oct_m::system_update_total_energy + procedure(system_init_interaction), deferred :: init_interaction !< @copydoc system_oct_m::system_init_interaction + procedure(system_initial_conditions), deferred :: initial_conditions !< @copydoc system_oct_m::system_initial_conditions + procedure(system_do_algorithmic_operation), deferred :: do_algorithmic_operation !< @copydoc system_oct_m::system_do_algorithmic_operation + procedure(system_is_tolerance_reached), deferred :: is_tolerance_reached !< @copydoc system_oct_m::system_is_tolerance_reached + procedure(system_restart_write_data), deferred :: restart_write_data !< @copydoc system_oct_m::system_restart_write_data + procedure(system_restart_read_data), deferred :: restart_read_data !< @copydoc system_oct_m::system_restart_read_data + procedure(system_update_kinetic_energy), deferred :: update_kinetic_energy !< @copydoc system_oct_m::system_update_kinetic_energy + end type system_t + + abstract interface + + ! --------------------------------------------------------- + !> @brief initialize a given interaction of the system + subroutine system_init_interaction(this, interaction) + import system_t + import interaction_t + class(system_t), target, intent(inout) :: this + class(interaction_t), intent(inout) :: interaction + end subroutine system_init_interaction + + ! --------------------------------------------------------- + !> set initial conditions for a system + subroutine system_initial_conditions(this) + import system_t + class(system_t), intent(inout) :: this + end subroutine system_initial_conditions + + ! --------------------------------------------------------- + !> @brief Execute one operation that is part of a larger algorithm. Returns true + !! if the operation was successfully executed, false otherwise. + !! + !! Unsuccessful operations can occur, e.g. of quantities from an interaction + !! are required, but the interaction is still behind in terms of the iteration counters. + !! + !! On output, the routine should also provide a list quantities that were + !! updated. If no quantitiy was updated, then the corresponding array should + !! be left unallocated. + logical function system_do_algorithmic_operation(this, operation, updated_quantities) result(done) + import system_t + import algorithmic_operation_t + class(system_t), intent(inout) :: this + class(algorithmic_operation_t), intent(in) :: operation + integer, allocatable, intent(out) :: updated_quantities(:) + end function system_do_algorithmic_operation + + ! --------------------------------------------------------- + !> @brief check whether a system has reached a given tolerance + logical function system_is_tolerance_reached(this, tol) + use, intrinsic :: iso_fortran_env + import system_t + class(system_t), intent(in) :: this + real(real64), intent(in) :: tol + end function system_is_tolerance_reached + + ! --------------------------------------------------------- + !> @brief For some algorithms it might be necessary to store the status of a system at a given algorithmic step + !! + !! This should be implemented by each system in this routine. + subroutine system_store_current_status(this) + import system_t + class(system_t), intent(inout) :: this + end subroutine system_store_current_status + + ! --------------------------------------------------------- + subroutine system_restart_write_data(this) + import system_t + class(system_t), intent(inout) :: this + end subroutine system_restart_write_data + + ! --------------------------------------------------------- + ! this function returns true if restart data could be read + logical function system_restart_read_data(this) + import system_t + class(system_t), intent(inout) :: this + end function system_restart_read_data + subroutine system_update_kinetic_energy(this) + import system_t + class(system_t), intent(inout) :: this + end subroutine system_update_kinetic_energy + + end interface + + !> @brief These classes extends the list and list iterator to create a system list. + !! + !! Since a list of systems is also a list of interaction partners, the system + !! list is an extension of the partner list. + type, extends(partner_list_t) :: system_list_t + private + contains + procedure :: add => system_list_add_node !< @copydoc system_oct_m::system_list_add_node + procedure :: contains => system_list_contains !< @copydoc system_oct_m::system_list_contains + end type system_list_t + + type, extends(linked_list_iterator_t) :: system_iterator_t + private + contains + procedure :: get_next => system_iterator_get_next !< @copydoc system_oct_m::system_iterator_get_next + end type system_iterator_t + + ! Subroutine/Functions + interface + module subroutine system_execute_algorithm(this) + class(system_t), intent(inout) :: this + end subroutine system_execute_algorithm + + module subroutine system_reset_iteration_counters(this, accumulated_iterations) + class(system_t), intent(inout) :: this + integer, intent(in) :: accumulated_iterations + end subroutine system_reset_iteration_counters + + recursive module subroutine system_create_interactions(this, interaction_factory, available_partners) + class(system_t), intent(inout) :: this + class(interactions_factory_abst_t), intent(in) :: interaction_factory + class(partner_list_t), target, intent(in) :: available_partners + end subroutine system_create_interactions + + module function system_update_couplings(this) result(all_updated) + class(system_t), intent(inout) :: this + logical :: all_updated + end function system_update_couplings + + module subroutine system_update_interactions(this) + class(system_t), intent(inout) :: this + end subroutine system_update_interactions + + module subroutine system_update_interactions_start(this) + class(system_t), intent(inout) :: this + end subroutine system_update_interactions_start + + module subroutine system_update_interactions_finish(this) + class(system_t), intent(inout) :: this + end subroutine system_update_interactions_finish + + module subroutine system_restart_write(this) + class(system_t), intent(inout) :: this + end subroutine system_restart_write + + module function system_restart_read(this) result(res) + class(system_t), intent(inout) :: this + logical :: res + end function system_restart_read + + module subroutine system_output_start(this) + class(system_t), intent(inout) :: this + end subroutine system_output_start + + module subroutine system_output_write(this) + class(system_t), intent(inout) :: this + end subroutine system_output_write + + module subroutine system_output_finish(this) + class(system_t), intent(inout) :: this + end subroutine system_output_finish + + module subroutine system_init_algorithm(this, factory) + class(system_t), intent(inout) :: this + class(algorithm_factory_t), intent(in) :: factory + end subroutine system_init_algorithm + + recursive module function system_algorithm_finished(this) result(finished) + class(system_t), intent(in) :: this + logical :: finished + end function system_algorithm_finished + + module subroutine system_init_iteration_counters(this) + class(system_t), intent(inout) :: this + end subroutine system_init_iteration_counters + + module subroutine system_propagation_start(this) + class(system_t), intent(inout) :: this + end subroutine system_propagation_start + + module subroutine system_propagation_finish(this) + class(system_t), intent(inout) :: this + end subroutine system_propagation_finish + + module subroutine system_iteration_info(this) + class(system_t), intent(in) :: this + end subroutine system_iteration_info + + module function system_process_is_slave(this) result(res) + class(system_t), intent(in) :: this + logical :: res + end function system_process_is_slave + + module subroutine system_end(this) + class(system_t), intent(inout) :: this + end subroutine system_end + + module subroutine system_list_add_node(this, partner) + class(system_list_t) :: this + class(interaction_partner_t), target :: partner + end subroutine system_list_add_node + + recursive module function system_list_contains(this, partner) result(contains) + class(system_list_t) :: this + class(interaction_partner_t), target :: partner + logical contains + end function system_list_contains + + module function system_iterator_get_next(this) result(system) + class(system_iterator_t), intent(inout) :: this + class(system_t), pointer :: system + end function system_iterator_get_next + + module subroutine system_init_parallelization(this, grp) + class(system_t), intent(inout) :: this + type(mpi_grp_t), intent(in) :: grp + end subroutine system_init_parallelization + + module subroutine system_start_barrier(this, target_time, barrier_index) + class(system_t), intent(inout) :: this + real(real64), intent(in) :: target_time + integer, intent(in) :: barrier_index + end subroutine system_start_barrier + + module subroutine system_end_barrier(this, barrier_index) + class(system_t), intent(inout) :: this + integer, intent(in) :: barrier_index + end subroutine system_end_barrier + + module function system_arrived_at_barrier(this, barrier_index) result(res) + class(system_t), intent(inout) :: this + integer, intent(in) :: barrier_index + logical :: res + end function system_arrived_at_barrier + + module function system_arrived_at_any_barrier(this) result(res) + class(system_t), intent(inout) :: this + logical :: res + end function system_arrived_at_any_barrier + + module subroutine system_update_potential_energy(this) + class(system_t), intent(inout) :: this + end subroutine system_update_potential_energy + + module subroutine system_update_internal_energy(this) + class(system_t), intent(inout) :: this + end subroutine system_update_internal_energy + + module subroutine system_update_total_energy(this) + class(system_t), intent(inout) :: this + end subroutine system_update_total_energy + end interface +end module system_oct_m -- GitLab From f8af5b3cdccc23e161d6e3aa641e48335e16a7d6 Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Tue, 30 May 2023 14:06:54 +0200 Subject: [PATCH 06/43] [submodule] `electron_oct_m` Signed-off-by: Cristian Le --- src/electrons/electrons.F90 | 270 +++++++++++++++++++++++++----------- 1 file changed, 189 insertions(+), 81 deletions(-) diff --git a/src/electrons/electrons.F90 b/src/electrons/electrons.F90 index 9d42228f18..8c37b106c9 100644 --- a/src/electrons/electrons.F90 +++ b/src/electrons/electrons.F90 @@ -20,91 +20,33 @@ #include "global.h" - module electrons_oct_m - use accel_oct_m - use absorbing_boundaries_oct_m - use algorithm_oct_m use algorithm_factory_oct_m - use calc_mode_par_oct_m - use classical_particles_oct_m + use algorithm_oct_m use current_oct_m - use current_to_mxll_field_oct_m - use debug_oct_m - use density_oct_m use dipole_oct_m use electron_space_oct_m - use elf_oct_m - use energy_calc_oct_m - use ext_partner_list_oct_m - use field_transfer_oct_m - use forces_oct_m use gauge_field_oct_m use global_oct_m use grid_oct_m use hamiltonian_elec_oct_m - use hamiltonian_elec_base_oct_m - use interaction_enum_oct_m use interaction_oct_m use interaction_partner_oct_m use interaction_surrogate_oct_m - use ion_dynamics_oct_m use ions_oct_m - use kick_oct_m use kpoints_oct_m - use lalg_basic_oct_m - use lattice_vectors_oct_m use lasers_oct_m - use lda_u_oct_m - use loct_oct_m - use mesh_oct_m - use messages_oct_m - use modelmb_particles_oct_m use mpi_oct_m use multicomm_oct_m - use mxll_e_field_to_matter_oct_m - use mxll_b_field_to_matter_oct_m - use mxll_vec_pot_to_matter_oct_m - use mxll_elec_coupling_oct_m use namespace_oct_m - use output_oct_m use output_low_oct_m - use parser_oct_m - use pes_oct_m use photons_oct_m - use photon_mode_oct_m - use photon_mode_mf_oct_m - use poisson_oct_m - use potential_interpolation_oct_m - use propagator_oct_m - use propagator_base_oct_m - use propagator_bomd_oct_m - use propagator_aetrs_oct_m - use propagator_elec_oct_m - use propagator_exp_mid_oct_m - use propagator_verlet_oct_m - use propagation_ops_elec_oct_m - use profiling_oct_m - use quantity_oct_m - use regridding_oct_m use scf_oct_m - use space_oct_m - use states_abst_oct_m use states_elec_oct_m - use states_elec_dim_oct_m - use stress_oct_m - use sort_oct_m use system_oct_m use td_oct_m - use td_write_oct_m - use unit_system_oct_m use v_ks_oct_m - use xc_oct_m - use xc_f03_lib_m - use xc_oep_oct_m use xc_interaction_oct_m - use xc_oep_photon_oct_m - use xc_functional_oct_m implicit none @@ -177,10 +119,172 @@ module electrons_oct_m procedure electrons_constructor end interface electrons_t + interface + module function electrons_constructor(namespace, generate_epot) result(sys) + type(namespace_t), intent(in) :: namespace + logical, optional, intent(in) :: generate_epot + class(electrons_t), pointer :: sys + end function electrons_constructor + + module subroutine electrons_init_interaction(this, interaction) + class(electrons_t), target, intent(inout) :: this + class(interaction_t), intent(inout) :: interaction + end subroutine electrons_init_interaction + + module subroutine electrons_init_parallelization(this, grp) + class(electrons_t), intent(inout) :: this + type(mpi_grp_t), intent(in) :: grp + end subroutine electrons_init_parallelization + + module subroutine electrons_init_algorithm(this, factory) + class(electrons_t), intent(inout) :: this + class(algorithm_factory_t), intent(in) :: factory + end subroutine electrons_init_algorithm + + module subroutine electrons_initial_conditions(this) + class(electrons_t), intent(inout) :: this + end subroutine electrons_initial_conditions + + module subroutine electrons_propagation_start(this) + class(electrons_t), intent(inout) :: this + end subroutine electrons_propagation_start + + module function electrons_do_algorithmic_operation(this, operation, updated_quantities) result(done) + class(electrons_t), intent(inout) :: this + class(algorithmic_operation_t), intent(in) :: operation + integer, allocatable, intent(out) :: updated_quantities(:) + logical :: done + end function electrons_do_algorithmic_operation + + module function electrons_is_tolerance_reached(this, tol) result(converged) + class(electrons_t), intent(in) :: this + real(real64), intent(in) :: tol + logical :: converged + end function electrons_is_tolerance_reached + + module subroutine electrons_update_quantity(this, iq) + class(electrons_t), intent(inout) :: this + integer, intent(in) :: iq + end subroutine electrons_update_quantity + + module subroutine electrons_update_exposed_quantity(partner, iq) + class(electrons_t), intent(inout) :: partner + integer, intent(in) :: iq + end subroutine electrons_update_exposed_quantity + + module subroutine electrons_init_interaction_as_partner(partner, interaction) + class(electrons_t), intent(in) :: partner + class(interaction_surrogate_t), intent(inout) :: interaction + end subroutine electrons_init_interaction_as_partner + + module subroutine electrons_copy_quantities_to_interaction(partner, interaction) + class(electrons_t), intent(inout) :: partner + class(interaction_surrogate_t), intent(inout) :: interaction + end subroutine electrons_copy_quantities_to_interaction + + module subroutine electrons_output_start(this) + class(electrons_t), intent(inout) :: this + end subroutine electrons_output_start + + module subroutine electrons_output_write(this) + class(electrons_t), intent(inout) :: this + end subroutine electrons_output_write + + module subroutine electrons_output_finish(this) + class(electrons_t), intent(inout) :: this + end subroutine electrons_output_finish + + module function electrons_process_is_slave(this) result(is_slave) + class(electrons_t), intent(in) :: this + logical :: is_slave + end function electrons_process_is_slave + + module subroutine electrons_restart_write_data(this) + class(electrons_t), intent(inout) :: this + end subroutine electrons_restart_write_data + + module function electrons_restart_read_data(this) result(res) + class(electrons_t), intent(inout) :: this + logical :: res + end function electrons_restart_read_data + + module subroutine electrons_update_kinetic_energy(this) + class(electrons_t), intent(inout) :: this + end subroutine electrons_update_kinetic_energy + + module subroutine electrons_finalize(sys) + type(electrons_t), intent(inout) :: sys + end subroutine electrons_finalize + end interface + +end module electrons_oct_m + +submodule (electrons_oct_m) impl + use accel_oct_m + use absorbing_boundaries_oct_m + use calc_mode_par_oct_m + use classical_particles_oct_m + use current_to_mxll_field_oct_m + use debug_oct_m + use density_oct_m + use elf_oct_m + use energy_calc_oct_m + use ext_partner_list_oct_m + use field_transfer_oct_m + use forces_oct_m + use global_oct_m + use hamiltonian_elec_base_oct_m + use interaction_enum_oct_m + use ion_dynamics_oct_m + use kick_oct_m + use lalg_basic_oct_m + use lattice_vectors_oct_m + use lda_u_oct_m + use loct_oct_m + use mesh_oct_m + use messages_oct_m + use modelmb_particles_oct_m + use mxll_e_field_to_matter_oct_m + use mxll_b_field_to_matter_oct_m + use mxll_vec_pot_to_matter_oct_m + use mxll_elec_coupling_oct_m + use output_oct_m + use parser_oct_m + use pes_oct_m + use photon_mode_oct_m + use photon_mode_mf_oct_m + use poisson_oct_m + use potential_interpolation_oct_m + use propagator_oct_m + use propagator_base_oct_m + use propagator_bomd_oct_m + use propagator_aetrs_oct_m + use propagator_elec_oct_m + use propagator_exp_mid_oct_m + use propagator_verlet_oct_m + use propagation_ops_elec_oct_m + use profiling_oct_m + use quantity_oct_m + use regridding_oct_m + use space_oct_m + use states_abst_oct_m + use states_elec_dim_oct_m + use stress_oct_m + use sort_oct_m + use td_write_oct_m + use unit_system_oct_m + use xc_oct_m + use xc_f03_lib_m + use xc_oep_oct_m + use xc_oep_photon_oct_m + use xc_functional_oct_m + + implicit none + contains !---------------------------------------------------------- - function electrons_constructor(namespace, generate_epot) result(sys) + module function electrons_constructor(namespace, generate_epot) result(sys) class(electrons_t), pointer :: sys type(namespace_t), intent(in) :: namespace logical, optional, intent(in) :: generate_epot @@ -268,7 +372,7 @@ contains end function electrons_constructor ! --------------------------------------------------------- - subroutine electrons_init_interaction(this, interaction) + module subroutine electrons_init_interaction(this, interaction) class(electrons_t), target, intent(inout) :: this class(interaction_t), intent(inout) :: interaction @@ -331,7 +435,7 @@ contains end subroutine electrons_init_interaction ! --------------------------------------------------------- - subroutine electrons_init_parallelization(this, grp) + module subroutine electrons_init_parallelization(this, grp) class(electrons_t), intent(inout) :: this type(mpi_grp_t), intent(in) :: grp @@ -524,7 +628,7 @@ contains end subroutine electrons_init_parallelization ! --------------------------------------------------------- - subroutine electrons_init_algorithm(this, factory) + module subroutine electrons_init_algorithm(this, factory) class(electrons_t), intent(inout) :: this class(algorithm_factory_t), intent(in) :: factory @@ -550,7 +654,7 @@ contains end subroutine electrons_init_algorithm ! --------------------------------------------------------- - subroutine electrons_initial_conditions(this) + module subroutine electrons_initial_conditions(this) class(electrons_t), intent(inout) :: this PUSH_SUB(electrons_initial_conditions) @@ -566,7 +670,7 @@ contains end subroutine electrons_initial_conditions ! --------------------------------------------------------- - subroutine electrons_propagation_start(this) + module subroutine electrons_propagation_start(this) class(electrons_t), intent(inout) :: this PUSH_SUB(electrons_propagation_start) @@ -581,10 +685,11 @@ contains end subroutine electrons_propagation_start ! --------------------------------------------------------- - logical function electrons_do_algorithmic_operation(this, operation, updated_quantities) result(done) + module function electrons_do_algorithmic_operation(this, operation, updated_quantities) result(done) class(electrons_t), intent(inout) :: this class(algorithmic_operation_t), intent(in) :: operation integer, allocatable, intent(out) :: updated_quantities(:) + logical :: done logical :: update_energy_ type(gauge_field_t), pointer :: gfield @@ -744,9 +849,10 @@ contains end function electrons_do_algorithmic_operation ! --------------------------------------------------------- - logical function electrons_is_tolerance_reached(this, tol) result(converged) + module function electrons_is_tolerance_reached(this, tol) result(converged) class(electrons_t), intent(in) :: this real(real64), intent(in) :: tol + logical :: converged PUSH_SUB(electrons_is_tolerance_reached) @@ -756,7 +862,7 @@ contains end function electrons_is_tolerance_reached ! --------------------------------------------------------- - subroutine electrons_update_quantity(this, iq) + module subroutine electrons_update_quantity(this, iq) class(electrons_t), intent(inout) :: this integer, intent(in) :: iq @@ -783,7 +889,7 @@ contains end subroutine electrons_update_quantity ! --------------------------------------------------------- - subroutine electrons_init_interaction_as_partner(partner, interaction) + module subroutine electrons_init_interaction_as_partner(partner, interaction) class(electrons_t), intent(in) :: partner class(interaction_surrogate_t), intent(inout) :: interaction @@ -801,7 +907,7 @@ contains end subroutine electrons_init_interaction_as_partner ! --------------------------------------------------------- - subroutine electrons_copy_quantities_to_interaction(partner, interaction) + module subroutine electrons_copy_quantities_to_interaction(partner, interaction) class(electrons_t), intent(inout) :: partner class(interaction_surrogate_t), intent(inout) :: interaction @@ -823,7 +929,7 @@ contains end subroutine electrons_copy_quantities_to_interaction ! --------------------------------------------------------- - subroutine electrons_output_start(this) + module subroutine electrons_output_start(this) class(electrons_t), intent(inout) :: this PUSH_SUB(electrons_output_start) @@ -832,7 +938,7 @@ contains end subroutine electrons_output_start ! --------------------------------------------------------- - subroutine electrons_output_write(this) + module subroutine electrons_output_write(this) class(electrons_t), intent(inout) :: this integer :: iter @@ -858,7 +964,7 @@ contains end subroutine electrons_output_write ! --------------------------------------------------------- - subroutine electrons_output_finish(this) + module subroutine electrons_output_finish(this) class(electrons_t), intent(inout) :: this PUSH_SUB(electrons_output_finish) @@ -867,8 +973,9 @@ contains end subroutine electrons_output_finish ! --------------------------------------------------------- - logical function electrons_process_is_slave(this) result(is_slave) + module function electrons_process_is_slave(this) result(is_slave) class(electrons_t), intent(in) :: this + logical :: is_slave PUSH_SUB(electrons_process_is_slave) @@ -985,7 +1092,7 @@ contains end subroutine electrons_exec_end_of_timestep_tasks ! --------------------------------------------------------- - subroutine electrons_restart_write_data(this) + module subroutine electrons_restart_write_data(this) class(electrons_t), intent(inout) :: this integer :: ierr @@ -1014,8 +1121,9 @@ contains ! --------------------------------------------------------- ! this function returns true if restart data could be read - logical function electrons_restart_read_data(this) + module function electrons_restart_read_data(this) result(res) class(electrons_t), intent(inout) :: this + logical :: res logical :: from_scratch @@ -1030,10 +1138,10 @@ contains call td_set_from_scratch(this%td, from_scratch) if (from_scratch) then ! restart data could not be loaded - electrons_restart_read_data = .false. + res = .false. else ! restart data could be loaded - electrons_restart_read_data = .true. + res = .true. end if end select @@ -1042,7 +1150,7 @@ contains end function electrons_restart_read_data !---------------------------------------------------------- - subroutine electrons_update_kinetic_energy(this) + module subroutine electrons_update_kinetic_energy(this) class(electrons_t), intent(inout) :: this PUSH_SUB(electrons_update_kinetic_energy) @@ -1099,7 +1207,7 @@ contains end subroutine get_fields_from_interaction !---------------------------------------------------------- - subroutine electrons_finalize(sys) + module subroutine electrons_finalize(sys) type(electrons_t), intent(inout) :: sys type(partner_iterator_t) :: iter @@ -1158,7 +1266,7 @@ contains POP_SUB(electrons_finalize) end subroutine electrons_finalize -end module electrons_oct_m +end submodule impl !! Local Variables: !! mode: f90 -- GitLab From eaae49c76d704c0666ded3b652c58e5291ba2497 Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Tue, 23 Apr 2024 19:03:01 +0200 Subject: [PATCH 07/43] [Temp] Avoid a build failure Some combination of `module subroutine` + `final` + some other magical thing causes the compilation to break on `ifx` with: error #6437: A subroutine or function is calling itself recursively. [HAS_NEXT] This offers an innocent fix to avoid this issue Signed-off-by: Cristian Le --- src/electrons/electrons.F90 | 23 ++++++++++++++--------- 1 file changed, 14 insertions(+), 9 deletions(-) diff --git a/src/electrons/electrons.F90 b/src/electrons/electrons.F90 index 8c37b106c9..2020ced0ee 100644 --- a/src/electrons/electrons.F90 +++ b/src/electrons/electrons.F90 @@ -1210,9 +1210,6 @@ contains module subroutine electrons_finalize(sys) type(electrons_t), intent(inout) :: sys - type(partner_iterator_t) :: iter - class(interaction_partner_t), pointer :: partner - PUSH_SUB(electrons_finalize) if (associated(sys%algo)) then @@ -1227,12 +1224,7 @@ contains call poisson_async_end(sys%hm%psolver, sys%mc) end if - call iter%start(sys%ext_partners) - do while (iter%has_next()) - partner => iter%get_next() - SAFE_DEALLOCATE_P(partner) - end do - call sys%ext_partners%empty() + call deallocate_ext_partners() SAFE_DEALLOCATE_P(sys%xc_interaction) @@ -1264,6 +1256,19 @@ contains call system_end(sys) POP_SUB(electrons_finalize) + contains + subroutine deallocate_ext_partners() + + type(partner_iterator_t) :: iter + class(interaction_partner_t), pointer :: partner + + call iter%start(sys%ext_partners) + do while (iter%has_next()) + partner => iter%get_next() + SAFE_DEALLOCATE_P(partner) + end do + call sys%ext_partners%empty() + end subroutine deallocate_ext_partners end subroutine electrons_finalize end submodule impl -- GitLab From 0a13509e567b1b1b2af6027e49da4b2243036155 Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Mon, 15 Jan 2024 10:31:59 +0100 Subject: [PATCH 08/43] [submodule] `electron_oct_m` (split) Signed-off-by: Cristian Le --- src/Makefile.am | 1 + src/electrons/CMakeLists.txt | 1 + src/electrons/electrons.F90 | 199 ---------------------------------- src/electrons/electrons_h.F90 | 198 +++++++++++++++++++++++++++++++++ 4 files changed, 200 insertions(+), 199 deletions(-) create mode 100644 src/electrons/electrons_h.F90 diff --git a/src/Makefile.am b/src/Makefile.am index bf1b092c86..5c414f8980 100644 --- a/src/Makefile.am +++ b/src/Makefile.am @@ -659,6 +659,7 @@ electrons_f_srcs = \ electrons/stress.F90 \ electrons/subspace.F90 \ electrons/electrons.F90 \ + electrons/electrons_h.F90 \ electrons/v_ks.F90 \ electrons/x_fbe.F90 \ electrons/x_slater.F90 \ diff --git a/src/electrons/CMakeLists.txt b/src/electrons/CMakeLists.txt index f87ba1d062..d602c56ffb 100644 --- a/src/electrons/CMakeLists.txt +++ b/src/electrons/CMakeLists.txt @@ -9,6 +9,7 @@ target_sources(Octopus_lib PRIVATE eigen_rmmdiis.F90 eigensolver.F90 electrons.F90 + electrons_h.F90 electron_space.F90 elf.F90 energy_calc.F90 diff --git a/src/electrons/electrons.F90 b/src/electrons/electrons.F90 index 2020ced0ee..9c75963644 100644 --- a/src/electrons/electrons.F90 +++ b/src/electrons/electrons.F90 @@ -20,205 +20,6 @@ #include "global.h" -module electrons_oct_m - use algorithm_factory_oct_m - use algorithm_oct_m - use current_oct_m - use dipole_oct_m - use electron_space_oct_m - use gauge_field_oct_m - use global_oct_m - use grid_oct_m - use hamiltonian_elec_oct_m - use interaction_oct_m - use interaction_partner_oct_m - use interaction_surrogate_oct_m - use ions_oct_m - use kpoints_oct_m - use lasers_oct_m - use mpi_oct_m - use multicomm_oct_m - use namespace_oct_m - use output_low_oct_m - use photons_oct_m - use scf_oct_m - use states_elec_oct_m - use system_oct_m - use td_oct_m - use v_ks_oct_m - use xc_interaction_oct_m - - implicit none - - private - public :: & - electrons_t - - - !> @brief Class describing the electron system - !! - !! This class describes a system of electrons and ions. - !! - !! \todo move the ions into their own ions_t class. - type, extends(system_t) :: electrons_t - ! Components are public by default - type(electron_space_t) :: space - class(ions_t), pointer :: ions => NULL() !< the ion component of the system - type(photons_t), pointer :: photons => null() - type(grid_t) :: gr !< the mesh - type(states_elec_t) :: st !< the states - type(v_ks_t) :: ks !< the Kohn-Sham potentials - type(output_t) :: outp !< the output - type(multicomm_t) :: mc !< index and domain communicators - type(hamiltonian_elec_t) :: hm !< the Hamiltonian - type(td_t) :: td !< everything related to time propagation - type(current_t) :: current_calculator - type(dipole_t) :: dipole !< total dipole of electrons and ions - type(scf_t) :: scf !< SCF for BOMD - - type(kpoints_t) :: kpoints !< the k-points - - logical :: generate_epot - - type(states_elec_t) :: st_copy !< copy of the states - - ! At the moment this is not treated as an external potential - class(lasers_t), pointer :: lasers => null() !< lasers - class(gauge_field_t), pointer :: gfield => null() !< gauge field - - ! List with all the external partners - ! This will become a list of interactions in the future - type(partner_list_t) :: ext_partners - - !TODO: have a list of self interactions - type(xc_interaction_t), pointer :: xc_interaction => null() - - logical :: ions_propagated = .false. - contains - procedure :: init_interaction => electrons_init_interaction - procedure :: init_parallelization => electrons_init_parallelization - procedure :: init_algorithm => electrons_init_algorithm - procedure :: initial_conditions => electrons_initial_conditions - procedure :: do_algorithmic_operation => electrons_do_algorithmic_operation - procedure :: is_tolerance_reached => electrons_is_tolerance_reached - procedure :: update_quantity => electrons_update_quantity - procedure :: init_interaction_as_partner => electrons_init_interaction_as_partner - procedure :: copy_quantities_to_interaction => electrons_copy_quantities_to_interaction - procedure :: output_start => electrons_output_start - procedure :: output_write => electrons_output_write - procedure :: output_finish => electrons_output_finish - procedure :: process_is_slave => electrons_process_is_slave - procedure :: restart_write_data => electrons_restart_write_data - procedure :: restart_read_data => electrons_restart_read_data - procedure :: update_kinetic_energy => electrons_update_kinetic_energy - procedure :: propagation_start => electrons_propagation_start - final :: electrons_finalize - end type electrons_t - - interface electrons_t - procedure electrons_constructor - end interface electrons_t - - interface - module function electrons_constructor(namespace, generate_epot) result(sys) - type(namespace_t), intent(in) :: namespace - logical, optional, intent(in) :: generate_epot - class(electrons_t), pointer :: sys - end function electrons_constructor - - module subroutine electrons_init_interaction(this, interaction) - class(electrons_t), target, intent(inout) :: this - class(interaction_t), intent(inout) :: interaction - end subroutine electrons_init_interaction - - module subroutine electrons_init_parallelization(this, grp) - class(electrons_t), intent(inout) :: this - type(mpi_grp_t), intent(in) :: grp - end subroutine electrons_init_parallelization - - module subroutine electrons_init_algorithm(this, factory) - class(electrons_t), intent(inout) :: this - class(algorithm_factory_t), intent(in) :: factory - end subroutine electrons_init_algorithm - - module subroutine electrons_initial_conditions(this) - class(electrons_t), intent(inout) :: this - end subroutine electrons_initial_conditions - - module subroutine electrons_propagation_start(this) - class(electrons_t), intent(inout) :: this - end subroutine electrons_propagation_start - - module function electrons_do_algorithmic_operation(this, operation, updated_quantities) result(done) - class(electrons_t), intent(inout) :: this - class(algorithmic_operation_t), intent(in) :: operation - integer, allocatable, intent(out) :: updated_quantities(:) - logical :: done - end function electrons_do_algorithmic_operation - - module function electrons_is_tolerance_reached(this, tol) result(converged) - class(electrons_t), intent(in) :: this - real(real64), intent(in) :: tol - logical :: converged - end function electrons_is_tolerance_reached - - module subroutine electrons_update_quantity(this, iq) - class(electrons_t), intent(inout) :: this - integer, intent(in) :: iq - end subroutine electrons_update_quantity - - module subroutine electrons_update_exposed_quantity(partner, iq) - class(electrons_t), intent(inout) :: partner - integer, intent(in) :: iq - end subroutine electrons_update_exposed_quantity - - module subroutine electrons_init_interaction_as_partner(partner, interaction) - class(electrons_t), intent(in) :: partner - class(interaction_surrogate_t), intent(inout) :: interaction - end subroutine electrons_init_interaction_as_partner - - module subroutine electrons_copy_quantities_to_interaction(partner, interaction) - class(electrons_t), intent(inout) :: partner - class(interaction_surrogate_t), intent(inout) :: interaction - end subroutine electrons_copy_quantities_to_interaction - - module subroutine electrons_output_start(this) - class(electrons_t), intent(inout) :: this - end subroutine electrons_output_start - - module subroutine electrons_output_write(this) - class(electrons_t), intent(inout) :: this - end subroutine electrons_output_write - - module subroutine electrons_output_finish(this) - class(electrons_t), intent(inout) :: this - end subroutine electrons_output_finish - - module function electrons_process_is_slave(this) result(is_slave) - class(electrons_t), intent(in) :: this - logical :: is_slave - end function electrons_process_is_slave - - module subroutine electrons_restart_write_data(this) - class(electrons_t), intent(inout) :: this - end subroutine electrons_restart_write_data - - module function electrons_restart_read_data(this) result(res) - class(electrons_t), intent(inout) :: this - logical :: res - end function electrons_restart_read_data - - module subroutine electrons_update_kinetic_energy(this) - class(electrons_t), intent(inout) :: this - end subroutine electrons_update_kinetic_energy - - module subroutine electrons_finalize(sys) - type(electrons_t), intent(inout) :: sys - end subroutine electrons_finalize - end interface - -end module electrons_oct_m - submodule (electrons_oct_m) impl use accel_oct_m use absorbing_boundaries_oct_m diff --git a/src/electrons/electrons_h.F90 b/src/electrons/electrons_h.F90 new file mode 100644 index 0000000000..56d8d402d6 --- /dev/null +++ b/src/electrons/electrons_h.F90 @@ -0,0 +1,198 @@ +module electrons_oct_m + use algorithm_factory_oct_m + use algorithm_oct_m + use current_oct_m + use dipole_oct_m + use electron_space_oct_m + use gauge_field_oct_m + use global_oct_m + use grid_oct_m + use hamiltonian_elec_oct_m + use interaction_oct_m + use interaction_partner_oct_m + use interaction_surrogate_oct_m + use ions_oct_m + use kpoints_oct_m + use lasers_oct_m + use mpi_oct_m + use multicomm_oct_m + use namespace_oct_m + use output_low_oct_m + use photons_oct_m + use scf_oct_m + use states_elec_oct_m + use system_oct_m + use td_oct_m + use v_ks_oct_m + use xc_interaction_oct_m + + implicit none + + private + public :: & + electrons_t + + + !> @brief Class describing the electron system + !! + !! This class describes a system of electrons and ions. + !! + !! \todo move the ions into their own ions_t class. + type, extends(system_t) :: electrons_t + ! Components are public by default + type(electron_space_t) :: space + class(ions_t), pointer :: ions => NULL() !< the ion component of the system + type(photons_t), pointer :: photons => null() + type(grid_t) :: gr !< the mesh + type(states_elec_t) :: st !< the states + type(v_ks_t) :: ks !< the Kohn-Sham potentials + type(output_t) :: outp !< the output + type(multicomm_t) :: mc !< index and domain communicators + type(hamiltonian_elec_t) :: hm !< the Hamiltonian + type(td_t) :: td !< everything related to time propagation + type(current_t) :: current_calculator + type(dipole_t) :: dipole !< total dipole of electrons and ions + type(scf_t) :: scf !< SCF for BOMD + + type(kpoints_t) :: kpoints !< the k-points + + logical :: generate_epot + + type(states_elec_t) :: st_copy !< copy of the states + + ! At the moment this is not treated as an external potential + class(lasers_t), pointer :: lasers => null() !< lasers + class(gauge_field_t), pointer :: gfield => null() !< gauge field + + ! List with all the external partners + ! This will become a list of interactions in the future + type(partner_list_t) :: ext_partners + + !TODO: have a list of self interactions + type(xc_interaction_t), pointer :: xc_interaction => null() + + logical :: ions_propagated = .false. + contains + procedure :: init_interaction => electrons_init_interaction + procedure :: init_parallelization => electrons_init_parallelization + procedure :: init_algorithm => electrons_init_algorithm + procedure :: initial_conditions => electrons_initial_conditions + procedure :: do_algorithmic_operation => electrons_do_algorithmic_operation + procedure :: is_tolerance_reached => electrons_is_tolerance_reached + procedure :: update_quantity => electrons_update_quantity + procedure :: init_interaction_as_partner => electrons_init_interaction_as_partner + procedure :: copy_quantities_to_interaction => electrons_copy_quantities_to_interaction + procedure :: output_start => electrons_output_start + procedure :: output_write => electrons_output_write + procedure :: output_finish => electrons_output_finish + procedure :: process_is_slave => electrons_process_is_slave + procedure :: restart_write_data => electrons_restart_write_data + procedure :: restart_read_data => electrons_restart_read_data + procedure :: update_kinetic_energy => electrons_update_kinetic_energy + procedure :: propagation_start => electrons_propagation_start + final :: electrons_finalize + end type electrons_t + + interface electrons_t + procedure electrons_constructor + end interface electrons_t + + interface + module function electrons_constructor(namespace, generate_epot) result(sys) + type(namespace_t), intent(in) :: namespace + logical, optional, intent(in) :: generate_epot + class(electrons_t), pointer :: sys + end function electrons_constructor + + module subroutine electrons_init_interaction(this, interaction) + class(electrons_t), target, intent(inout) :: this + class(interaction_t), intent(inout) :: interaction + end subroutine electrons_init_interaction + + module subroutine electrons_init_parallelization(this, grp) + class(electrons_t), intent(inout) :: this + type(mpi_grp_t), intent(in) :: grp + end subroutine electrons_init_parallelization + + module subroutine electrons_init_algorithm(this, factory) + class(electrons_t), intent(inout) :: this + class(algorithm_factory_t), intent(in) :: factory + end subroutine electrons_init_algorithm + + module subroutine electrons_initial_conditions(this) + class(electrons_t), intent(inout) :: this + end subroutine electrons_initial_conditions + + module subroutine electrons_propagation_start(this) + class(electrons_t), intent(inout) :: this + end subroutine electrons_propagation_start + + module function electrons_do_algorithmic_operation(this, operation, updated_quantities) result(done) + class(electrons_t), intent(inout) :: this + class(algorithmic_operation_t), intent(in) :: operation + integer, allocatable, intent(out) :: updated_quantities(:) + logical :: done + end function electrons_do_algorithmic_operation + + module function electrons_is_tolerance_reached(this, tol) result(converged) + class(electrons_t), intent(in) :: this + real(real64), intent(in) :: tol + logical :: converged + end function electrons_is_tolerance_reached + + module subroutine electrons_update_quantity(this, iq) + class(electrons_t), intent(inout) :: this + integer, intent(in) :: iq + end subroutine electrons_update_quantity + + module subroutine electrons_update_exposed_quantity(partner, iq) + class(electrons_t), intent(inout) :: partner + integer, intent(in) :: iq + end subroutine electrons_update_exposed_quantity + + module subroutine electrons_init_interaction_as_partner(partner, interaction) + class(electrons_t), intent(in) :: partner + class(interaction_surrogate_t), intent(inout) :: interaction + end subroutine electrons_init_interaction_as_partner + + module subroutine electrons_copy_quantities_to_interaction(partner, interaction) + class(electrons_t), intent(inout) :: partner + class(interaction_surrogate_t), intent(inout) :: interaction + end subroutine electrons_copy_quantities_to_interaction + + module subroutine electrons_output_start(this) + class(electrons_t), intent(inout) :: this + end subroutine electrons_output_start + + module subroutine electrons_output_write(this) + class(electrons_t), intent(inout) :: this + end subroutine electrons_output_write + + module subroutine electrons_output_finish(this) + class(electrons_t), intent(inout) :: this + end subroutine electrons_output_finish + + module function electrons_process_is_slave(this) result(is_slave) + class(electrons_t), intent(in) :: this + logical :: is_slave + end function electrons_process_is_slave + + module subroutine electrons_restart_write_data(this) + class(electrons_t), intent(inout) :: this + end subroutine electrons_restart_write_data + + module function electrons_restart_read_data(this) result(res) + class(electrons_t), intent(inout) :: this + logical :: res + end function electrons_restart_read_data + + module subroutine electrons_update_kinetic_energy(this) + class(electrons_t), intent(inout) :: this + end subroutine electrons_update_kinetic_energy + + module subroutine electrons_finalize(sys) + type(electrons_t), intent(inout) :: sys + end subroutine electrons_finalize + end interface + +end module electrons_oct_m -- GitLab From bd9110983a5fccb951f0b03655a6979c7a634e5d Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Tue, 30 May 2023 15:16:09 +0200 Subject: [PATCH 09/43] [submodule] `propagator_elec_oct_m` Signed-off-by: Cristian Le --- src/td/propagator_elec.F90 | 158 ++++++++++++++++++++++++++++--------- 1 file changed, 122 insertions(+), 36 deletions(-) diff --git a/src/td/propagator_elec.F90 b/src/td/propagator_elec.F90 index 68f9f50b48..f18fcc9545 100644 --- a/src/td/propagator_elec.F90 +++ b/src/td/propagator_elec.F90 @@ -19,48 +19,23 @@ #include "global.h" module propagator_elec_oct_m - use debug_oct_m use electron_space_oct_m - use energy_calc_oct_m - use exponential_oct_m - use ext_partner_list_oct_m - use forces_oct_m - use gauge_field_oct_m - use grid_oct_m use global_oct_m + use grid_oct_m use hamiltonian_elec_oct_m use interaction_partner_oct_m use ion_dynamics_oct_m use ions_oct_m - use, intrinsic :: iso_fortran_env - use lasers_oct_m - use lda_u_oct_m - use parser_oct_m - use mesh_function_oct_m - use messages_oct_m use multicomm_oct_m use namespace_oct_m use opt_control_state_oct_m use output_low_oct_m - use potential_interpolation_oct_m - use profiling_oct_m use propagator_base_oct_m - use propagator_cn_oct_m - use propagator_etrs_oct_m - use propagator_expmid_oct_m - use propagator_magnus_oct_m - use propagator_qoct_oct_m - use propagator_rk_oct_m - use propagator_verlet_oct_m use scf_oct_m - use sparskit_oct_m use space_oct_m use states_elec_oct_m - use stress_oct_m use td_write_oct_m use v_ks_oct_m - use varinfo_oct_m - use xc_oct_m implicit none @@ -76,10 +51,119 @@ module propagator_elec_oct_m propagator_elec_ions_are_propagated, & propagator_elec_dt_bo + interface + module subroutine propagator_elec_copy(tro, tri) + type(propagator_base_t), intent(inout) :: tro + type(propagator_base_t), intent(in) :: tri + end subroutine propagator_elec_copy + + module subroutine propagator_elec_init(gr, namespace, st, tr, have_fields, family_is_mgga_with_exc) + type(grid_t), intent(in) :: gr + type(namespace_t), intent(in) :: namespace + type(states_elec_t), intent(in) :: st + type(propagator_base_t), intent(inout) :: tr + logical, intent(in) :: have_fields + logical, intent(in) :: family_is_mgga_with_exc + end subroutine propagator_elec_init + + module subroutine propagator_elec_set_scf_prop(tr, threshold) + type(propagator_base_t), intent(inout) :: tr + real(real64), optional, intent(in) :: threshold + end subroutine propagator_elec_set_scf_prop + + module subroutine propagator_elec_remove_scf_prop(tr) + type(propagator_base_t), intent(inout) :: tr + end subroutine propagator_elec_remove_scf_prop + + module subroutine propagator_elec_end(tr) + type(propagator_base_t), intent(inout) :: tr + end subroutine propagator_elec_end + + module subroutine propagator_elec_run_zero_iter(hm, gr, tr) + type(hamiltonian_elec_t), intent(in) :: hm + type(grid_t), intent(in) :: gr + type(propagator_base_t), intent(inout) :: tr + end subroutine propagator_elec_run_zero_iter + + module subroutine propagator_elec_dt(ks, namespace, space, hm, gr, st, tr, time, dt, nt, & + ions_dyn, ions, ext_partners, outp, write_handler, scsteps, update_energy, qcchi) + type(v_ks_t), target, intent(inout) :: ks + type(namespace_t), intent(in) :: namespace + type(electron_space_t), intent(in) :: space + type(hamiltonian_elec_t), target, intent(inout) :: hm + type(grid_t), target, intent(inout) :: gr + type(states_elec_t), target, intent(inout) :: st + type(propagator_base_t), target, intent(inout) :: tr + real(real64), intent(in) :: time + real(real64), intent(in) :: dt + integer, intent(in) :: nt + type(ion_dynamics_t), intent(inout) :: ions_dyn + type(ions_t), intent(inout) :: ions + type(partner_list_t), intent(in) :: ext_partners + type(output_t), intent(in) :: outp + type(td_write_t), intent(in) :: write_handler + integer, optional, intent(out) :: scsteps + logical, optional, intent(in) :: update_energy + type(opt_control_state_t), optional, target, intent(inout) :: qcchi + end subroutine propagator_elec_dt + + pure module function propagator_elec_ions_are_propagated(tr) result(propagated) + type(propagator_base_t), intent(in) :: tr + logical :: propagated + end function propagator_elec_ions_are_propagated + + module subroutine propagator_elec_dt_bo(scf, namespace, space, gr, ks, st, hm, ions, ext_partners, & + mc, outp, iter, dt, ions_dyn, scsteps) + type(scf_t), intent(inout) :: scf + type(namespace_t), intent(in) :: namespace + type(electron_space_t), intent(in) :: space + type(grid_t), intent(inout) :: gr + type(v_ks_t), intent(inout) :: ks + type(states_elec_t), intent(inout) :: st + type(hamiltonian_elec_t), intent(inout) :: hm + type(ions_t), intent(inout) :: ions + type(partner_list_t), intent(in) :: ext_partners + type(multicomm_t), intent(inout) :: mc !< index and domain communicators + type(output_t), intent(inout) :: outp + integer, intent(in) :: iter + real(real64), intent(in) :: dt + type(ion_dynamics_t), intent(inout) :: ions_dyn + integer, intent(inout) :: scsteps + end subroutine propagator_elec_dt_bo + end interface +end module propagator_elec_oct_m + +submodule (propagator_elec_oct_m) impl + use debug_oct_m + use energy_calc_oct_m + use exponential_oct_m + use ext_partner_list_oct_m + use forces_oct_m + use gauge_field_oct_m + use lasers_oct_m + use lda_u_oct_m + use parser_oct_m + use mesh_function_oct_m + use messages_oct_m + use potential_interpolation_oct_m + use profiling_oct_m + use propagator_cn_oct_m + use propagator_etrs_oct_m + use propagator_expmid_oct_m + use propagator_magnus_oct_m + use propagator_qoct_oct_m + use propagator_rk_oct_m + use propagator_verlet_oct_m + use sparskit_oct_m + use stress_oct_m + use varinfo_oct_m + use xc_oct_m + implicit none + contains ! --------------------------------------------------------- - subroutine propagator_elec_copy(tro, tri) + module subroutine propagator_elec_copy(tro, tri) type(propagator_base_t), intent(inout) :: tro type(propagator_base_t), intent(in) :: tri @@ -117,7 +201,7 @@ contains ! --------------------------------------------------------- - subroutine propagator_elec_init(gr, namespace, st, tr, have_fields, family_is_mgga_with_exc) + module subroutine propagator_elec_init(gr, namespace, st, tr, have_fields, family_is_mgga_with_exc) type(grid_t), intent(in) :: gr type(namespace_t), intent(in) :: namespace type(states_elec_t), intent(in) :: st @@ -389,7 +473,7 @@ contains ! --------------------------------------------------------- - subroutine propagator_elec_set_scf_prop(tr, threshold) + module subroutine propagator_elec_set_scf_prop(tr, threshold) type(propagator_base_t), intent(inout) :: tr real(real64), optional, intent(in) :: threshold @@ -406,7 +490,7 @@ contains ! --------------------------------------------------------- - subroutine propagator_elec_remove_scf_prop(tr) + module subroutine propagator_elec_remove_scf_prop(tr) type(propagator_base_t), intent(inout) :: tr PUSH_SUB(propagator_elec_remove_scf_prop) @@ -419,7 +503,7 @@ contains ! --------------------------------------------------------- - subroutine propagator_elec_end(tr) + module subroutine propagator_elec_end(tr) type(propagator_base_t), intent(inout) :: tr PUSH_SUB(propagator_elec_end) @@ -442,7 +526,7 @@ contains ! --------------------------------------------------------- - subroutine propagator_elec_run_zero_iter(hm, gr, tr) + module subroutine propagator_elec_run_zero_iter(hm, gr, tr) type(hamiltonian_elec_t), intent(in) :: hm type(grid_t), intent(in) :: gr type(propagator_base_t), intent(inout) :: tr @@ -459,7 +543,7 @@ contains !> Propagates st from time - dt to t. !! If dt<0, it propagates *backwards* from t+|dt| to t ! --------------------------------------------------------- - subroutine propagator_elec_dt(ks, namespace, space, hm, gr, st, tr, time, dt, nt, & + module subroutine propagator_elec_dt(ks, namespace, space, hm, gr, st, tr, time, dt, nt, & ions_dyn, ions, ext_partners, outp, write_handler, scsteps, update_energy, qcchi) type(v_ks_t), target, intent(inout) :: ks type(namespace_t), intent(in) :: namespace @@ -614,8 +698,9 @@ contains ! --------------------------------------------------------- - logical pure function propagator_elec_ions_are_propagated(tr) result(propagated) + pure module function propagator_elec_ions_are_propagated(tr) result(propagated) type(propagator_base_t), intent(in) :: tr + logical :: propagated select case (tr%method) case (PROP_ETRS, PROP_AETRS, PROP_CAETRS, PROP_EXPLICIT_RUNGE_KUTTA4) @@ -630,7 +715,8 @@ contains ! --------------------------------------------------------- - subroutine propagator_elec_dt_bo(scf, namespace, space, gr, ks, st, hm, ions, ext_partners, mc, outp, iter, dt, ions_dyn, scsteps) + module subroutine propagator_elec_dt_bo(scf, namespace, space, gr, ks, st, hm, ions, ext_partners, & + mc, outp, iter, dt, ions_dyn, scsteps) type(scf_t), intent(inout) :: scf type(namespace_t), intent(in) :: namespace type(electron_space_t), intent(in) :: space @@ -692,7 +778,7 @@ contains POP_SUB(propagator_elec_dt_bo) end subroutine propagator_elec_dt_bo -end module propagator_elec_oct_m +end submodule impl !! Local Variables: -- GitLab From c40c5269948c2a9a292d11e1409574b1c99b6981 Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Mon, 15 Jan 2024 10:33:13 +0100 Subject: [PATCH 10/43] [submodule] `propagator_elec_oct_m` (split) Signed-off-by: Cristian Le --- src/Makefile.am | 1 + src/td/CMakeLists.txt | 1 + src/td/propagator_elec.F90 | 115 ----------------------------------- src/td/propagator_elec_h.F90 | 114 ++++++++++++++++++++++++++++++++++ 4 files changed, 116 insertions(+), 115 deletions(-) create mode 100644 src/td/propagator_elec_h.F90 diff --git a/src/Makefile.am b/src/Makefile.am index 5c414f8980..b2228811bd 100644 --- a/src/Makefile.am +++ b/src/Makefile.am @@ -752,6 +752,7 @@ td_f_srcs = \ td/propagator_base.F90 \ td/propagator_cn.F90 \ td/propagator_elec.F90 \ + td/propagator_elec_h.F90 \ td/propagator_etrs.F90 \ td/propagator_expmid.F90 \ td/propagator_magnus.F90 \ diff --git a/src/td/CMakeLists.txt b/src/td/CMakeLists.txt index ac6890018c..e68cc3ae4b 100644 --- a/src/td/CMakeLists.txt +++ b/src/td/CMakeLists.txt @@ -9,6 +9,7 @@ target_sources(Octopus_lib PRIVATE propagator_base.F90 propagator_cn.F90 propagator_elec.F90 + propagator_elec_h.F90 propagator_etrs.F90 propagator_expmid.F90 propagator_magnus.F90 diff --git a/src/td/propagator_elec.F90 b/src/td/propagator_elec.F90 index f18fcc9545..9febe7acd3 100644 --- a/src/td/propagator_elec.F90 +++ b/src/td/propagator_elec.F90 @@ -18,121 +18,6 @@ #include "global.h" -module propagator_elec_oct_m - use electron_space_oct_m - use global_oct_m - use grid_oct_m - use hamiltonian_elec_oct_m - use interaction_partner_oct_m - use ion_dynamics_oct_m - use ions_oct_m - use multicomm_oct_m - use namespace_oct_m - use opt_control_state_oct_m - use output_low_oct_m - use propagator_base_oct_m - use scf_oct_m - use space_oct_m - use states_elec_oct_m - use td_write_oct_m - use v_ks_oct_m - - implicit none - - private - public :: & - propagator_elec_init, & - propagator_elec_end, & - propagator_elec_copy, & - propagator_elec_run_zero_iter, & - propagator_elec_dt, & - propagator_elec_set_scf_prop, & - propagator_elec_remove_scf_prop, & - propagator_elec_ions_are_propagated, & - propagator_elec_dt_bo - - interface - module subroutine propagator_elec_copy(tro, tri) - type(propagator_base_t), intent(inout) :: tro - type(propagator_base_t), intent(in) :: tri - end subroutine propagator_elec_copy - - module subroutine propagator_elec_init(gr, namespace, st, tr, have_fields, family_is_mgga_with_exc) - type(grid_t), intent(in) :: gr - type(namespace_t), intent(in) :: namespace - type(states_elec_t), intent(in) :: st - type(propagator_base_t), intent(inout) :: tr - logical, intent(in) :: have_fields - logical, intent(in) :: family_is_mgga_with_exc - end subroutine propagator_elec_init - - module subroutine propagator_elec_set_scf_prop(tr, threshold) - type(propagator_base_t), intent(inout) :: tr - real(real64), optional, intent(in) :: threshold - end subroutine propagator_elec_set_scf_prop - - module subroutine propagator_elec_remove_scf_prop(tr) - type(propagator_base_t), intent(inout) :: tr - end subroutine propagator_elec_remove_scf_prop - - module subroutine propagator_elec_end(tr) - type(propagator_base_t), intent(inout) :: tr - end subroutine propagator_elec_end - - module subroutine propagator_elec_run_zero_iter(hm, gr, tr) - type(hamiltonian_elec_t), intent(in) :: hm - type(grid_t), intent(in) :: gr - type(propagator_base_t), intent(inout) :: tr - end subroutine propagator_elec_run_zero_iter - - module subroutine propagator_elec_dt(ks, namespace, space, hm, gr, st, tr, time, dt, nt, & - ions_dyn, ions, ext_partners, outp, write_handler, scsteps, update_energy, qcchi) - type(v_ks_t), target, intent(inout) :: ks - type(namespace_t), intent(in) :: namespace - type(electron_space_t), intent(in) :: space - type(hamiltonian_elec_t), target, intent(inout) :: hm - type(grid_t), target, intent(inout) :: gr - type(states_elec_t), target, intent(inout) :: st - type(propagator_base_t), target, intent(inout) :: tr - real(real64), intent(in) :: time - real(real64), intent(in) :: dt - integer, intent(in) :: nt - type(ion_dynamics_t), intent(inout) :: ions_dyn - type(ions_t), intent(inout) :: ions - type(partner_list_t), intent(in) :: ext_partners - type(output_t), intent(in) :: outp - type(td_write_t), intent(in) :: write_handler - integer, optional, intent(out) :: scsteps - logical, optional, intent(in) :: update_energy - type(opt_control_state_t), optional, target, intent(inout) :: qcchi - end subroutine propagator_elec_dt - - pure module function propagator_elec_ions_are_propagated(tr) result(propagated) - type(propagator_base_t), intent(in) :: tr - logical :: propagated - end function propagator_elec_ions_are_propagated - - module subroutine propagator_elec_dt_bo(scf, namespace, space, gr, ks, st, hm, ions, ext_partners, & - mc, outp, iter, dt, ions_dyn, scsteps) - type(scf_t), intent(inout) :: scf - type(namespace_t), intent(in) :: namespace - type(electron_space_t), intent(in) :: space - type(grid_t), intent(inout) :: gr - type(v_ks_t), intent(inout) :: ks - type(states_elec_t), intent(inout) :: st - type(hamiltonian_elec_t), intent(inout) :: hm - type(ions_t), intent(inout) :: ions - type(partner_list_t), intent(in) :: ext_partners - type(multicomm_t), intent(inout) :: mc !< index and domain communicators - type(output_t), intent(inout) :: outp - integer, intent(in) :: iter - real(real64), intent(in) :: dt - type(ion_dynamics_t), intent(inout) :: ions_dyn - integer, intent(inout) :: scsteps - end subroutine propagator_elec_dt_bo - end interface -end module propagator_elec_oct_m - submodule (propagator_elec_oct_m) impl use debug_oct_m use energy_calc_oct_m diff --git a/src/td/propagator_elec_h.F90 b/src/td/propagator_elec_h.F90 new file mode 100644 index 0000000000..bc6db9574c --- /dev/null +++ b/src/td/propagator_elec_h.F90 @@ -0,0 +1,114 @@ +module propagator_elec_oct_m + use electron_space_oct_m + use global_oct_m + use grid_oct_m + use hamiltonian_elec_oct_m + use interaction_partner_oct_m + use ion_dynamics_oct_m + use ions_oct_m + use multicomm_oct_m + use namespace_oct_m + use opt_control_state_oct_m + use output_low_oct_m + use propagator_base_oct_m + use scf_oct_m + use space_oct_m + use states_elec_oct_m + use td_write_oct_m + use v_ks_oct_m + + implicit none + + private + public :: & + propagator_elec_init, & + propagator_elec_end, & + propagator_elec_copy, & + propagator_elec_run_zero_iter, & + propagator_elec_dt, & + propagator_elec_set_scf_prop, & + propagator_elec_remove_scf_prop, & + propagator_elec_ions_are_propagated, & + propagator_elec_dt_bo + + interface + module subroutine propagator_elec_copy(tro, tri) + type(propagator_base_t), intent(inout) :: tro + type(propagator_base_t), intent(in) :: tri + end subroutine propagator_elec_copy + + module subroutine propagator_elec_init(gr, namespace, st, tr, have_fields, family_is_mgga_with_exc) + type(grid_t), intent(in) :: gr + type(namespace_t), intent(in) :: namespace + type(states_elec_t), intent(in) :: st + type(propagator_base_t), intent(inout) :: tr + logical, intent(in) :: have_fields + logical, intent(in) :: family_is_mgga_with_exc + end subroutine propagator_elec_init + + module subroutine propagator_elec_set_scf_prop(tr, threshold) + type(propagator_base_t), intent(inout) :: tr + real(real64), optional, intent(in) :: threshold + end subroutine propagator_elec_set_scf_prop + + module subroutine propagator_elec_remove_scf_prop(tr) + type(propagator_base_t), intent(inout) :: tr + end subroutine propagator_elec_remove_scf_prop + + module subroutine propagator_elec_end(tr) + type(propagator_base_t), intent(inout) :: tr + end subroutine propagator_elec_end + + module subroutine propagator_elec_run_zero_iter(hm, gr, tr) + type(hamiltonian_elec_t), intent(in) :: hm + type(grid_t), intent(in) :: gr + type(propagator_base_t), intent(inout) :: tr + end subroutine propagator_elec_run_zero_iter + + module subroutine propagator_elec_dt(ks, namespace, space, hm, gr, st, tr, time, dt, nt, & + ions_dyn, ions, ext_partners, outp, write_handler, scsteps, update_energy, qcchi) + type(v_ks_t), target, intent(inout) :: ks + type(namespace_t), intent(in) :: namespace + type(electron_space_t), intent(in) :: space + type(hamiltonian_elec_t), target, intent(inout) :: hm + type(grid_t), target, intent(inout) :: gr + type(states_elec_t), target, intent(inout) :: st + type(propagator_base_t), target, intent(inout) :: tr + real(real64), intent(in) :: time + real(real64), intent(in) :: dt + integer, intent(in) :: nt + type(ion_dynamics_t), intent(inout) :: ions_dyn + type(ions_t), intent(inout) :: ions + type(partner_list_t), intent(in) :: ext_partners + type(output_t), intent(in) :: outp + type(td_write_t), intent(in) :: write_handler + integer, optional, intent(out) :: scsteps + logical, optional, intent(in) :: update_energy + type(opt_control_state_t), optional, target, intent(inout) :: qcchi + end subroutine propagator_elec_dt + + pure module function propagator_elec_ions_are_propagated(tr) result(propagated) + type(propagator_base_t), intent(in) :: tr + logical :: propagated + end function propagator_elec_ions_are_propagated + + module subroutine propagator_elec_dt_bo(scf, namespace, space, gr, ks, st, hm, ions, ext_partners, & + mc, outp, iter, dt, ions_dyn, scsteps) + type(scf_t), intent(inout) :: scf + type(namespace_t), intent(in) :: namespace + type(electron_space_t), intent(in) :: space + type(grid_t), intent(inout) :: gr + type(v_ks_t), intent(inout) :: ks + type(states_elec_t), intent(inout) :: st + type(hamiltonian_elec_t), intent(inout) :: hm + type(ions_t), intent(inout) :: ions + type(partner_list_t), intent(in) :: ext_partners + type(multicomm_t), intent(inout) :: mc !< index and domain communicators + type(output_t), intent(inout) :: outp + integer, intent(in) :: iter + real(real64), intent(in) :: dt + type(ion_dynamics_t), intent(inout) :: ions_dyn + integer, intent(inout) :: scsteps + end subroutine propagator_elec_dt_bo + end interface +end module propagator_elec_oct_m -- GitLab From d8cf055bc2f53c1f14efdcde6bf3f2e3adefb9c9 Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Fri, 2 Jun 2023 20:45:36 +0200 Subject: [PATCH 11/43] [submodule] `global_oct_m` Signed-off-by: Cristian Le --- src/basic/global.F90 | 212 +++++++++++++++++++++++++++++++++---------- 1 file changed, 166 insertions(+), 46 deletions(-) diff --git a/src/basic/global.F90 b/src/basic/global.F90 index 1d610352fe..eb0f3ceea7 100644 --- a/src/basic/global.F90 +++ b/src/basic/global.F90 @@ -19,14 +19,8 @@ #include "global.h" module global_oct_m - use, intrinsic :: iso_fortran_env - use hardware_oct_m - use loct_oct_m use mpi_oct_m - use varinfo_oct_m -#ifdef HAVE_OPENMP - use omp_lib -#endif + use, intrinsic :: iso_fortran_env implicit none @@ -205,10 +199,127 @@ module global_oct_m module procedure i8_to_i4_0, i8_to_i4_1 end interface i8_to_i4 + interface + module subroutine conf_init(this) + class(conf_t), intent(inout) :: this + end subroutine conf_init + + module subroutine global_init(communicator) + integer, intent(in), optional :: communicator + end subroutine global_init + + module subroutine init_octopus_globals(comm) + integer, intent(in) :: comm + end subroutine init_octopus_globals + + module subroutine global_end() + end subroutine global_end + + pure module function doptional_default(opt, def) result(val) + real(real64), optional, intent(in) :: opt + real(real64), intent(in) :: def + real(real64) :: val + end function doptional_default + + pure module function zoptional_default(opt, def) result(val) + complex(real64), optional, intent(in) :: opt + complex(real64), intent(in) :: def + complex(real64) :: val + end function zoptional_default + + pure module function ioptional_default(opt, def) result(val) + integer, optional, intent(in) :: opt + integer, intent(in) :: def + integer :: val + end function ioptional_default + + pure module function loptional_default(opt, def) result(val) + integer(int64), optional, intent(in) :: opt + integer(int64), intent(in) :: def + integer(int64) :: val + end function loptional_default + + pure module function looptional_default(opt, def) result(val) + logical, optional, intent(in) :: opt + logical, intent(in) :: def + logical :: val + end function looptional_default + + pure module function soptional_default(opt, def) result(val) + character(len=*), optional, intent(in) :: opt + character(len=*), intent(in) :: def + character(:), allocatable :: val + end function soptional_default + + module function not_in_openmp() result(res) + logical :: res + end function not_in_openmp + + module function cat(str1, str2) result(res) + character(len=*), intent(in) :: str1 + character(len=*), intent(in) :: str2 + character(len=len(str1) + len(str2)) :: res + end function cat + + pure module function bitand48(val1, val2) result(res) + integer(int32), intent(in) :: val1 + integer(int64), intent(in) :: val2 + integer(int64) :: res + end function bitand48 + + pure module function bitand84(val1, val2) result(res) + integer(int64), intent(in) :: val1 + integer(int32), intent(in) :: val2 + integer(int64) :: res + end function bitand84 + + pure module function bitand88(val1, val2) result(res) + integer(int64), intent(in) :: val1 + integer(int64), intent(in) :: val2 + integer(int64) :: res + end function bitand88 + + pure module function bitand44(val1, val2) result(res) + integer(int32), intent(in) :: val1 + integer(int32), intent(in) :: val2 + integer(int32) :: res + end function bitand44 + + pure module function i4_to_i8_0(ii) result(res) + integer(int32), intent(in) :: ii + integer(int64) :: res + end function i4_to_i8_0 + + pure module function i8_to_i4_0(ii) result(res) + integer(int64), intent(in) :: ii + integer(int32) :: res + end function i8_to_i4_0 + + pure module function i4_to_i8_1(ii) result(res) + integer(int32), intent(in) :: ii(:) + integer(int64) :: res(lbound(ii, 1, kind=int64):ubound(ii, 1, kind=int64)) + end function i4_to_i8_1 + + pure module function i8_to_i4_1(ii) result(res) + integer(int64), intent(in) :: ii(:) + integer(int32) :: res(lbound(ii, 1, kind=int64):ubound(ii, 1, kind=int64)) + end function i8_to_i4_1 + end interface +end module global_oct_m + +submodule (global_oct_m) impl + use hardware_oct_m + use loct_oct_m + use varinfo_oct_m +#ifdef HAVE_OPENMP + use omp_lib +#endif + + implicit none contains !> @brief Initialiser for conf_t - subroutine conf_init(this) + module subroutine conf_init(this) class(conf_t), intent(inout) :: this character(len=256) :: share @@ -225,7 +336,7 @@ contains !! Main entry point for callers initialising Octopus. !! If a communicator is passed, no call is made to initialise MPI_COMM_WORLD. !! Else, Octopus initialises MPI_COMM_WORLD - subroutine global_init(communicator) + module subroutine global_init(communicator) integer, intent(in), optional :: communicator !< Optional MPI communicator from caller integer :: comm @@ -254,7 +365,7 @@ contains !! * Default CPU cache sizes !! * varinfo file, required for the parser !! * Configuration instance. - subroutine init_octopus_globals(comm) + module subroutine init_octopus_globals(comm) integer, intent(in) :: comm !< MPI communicator. Can be a dummy value for serial apps. call mpi_grp_init(mpi_world, comm) @@ -282,7 +393,7 @@ contains !> @brief Finalise parser varinfo file, and MPI - subroutine global_end() + module subroutine global_end() call varinfo_end() call mpi_mod_end() @@ -290,9 +401,10 @@ contains end subroutine global_end - real(real64) pure function doptional_default(opt, def) result(val) + pure module function doptional_default(opt, def) result(val) real(real64), optional, intent(in) :: opt real(real64), intent(in) :: def + real(real64) :: val val = def if (present(opt)) val = opt @@ -300,9 +412,10 @@ contains !---------------------------------------------------------- - complex(real64) pure function zoptional_default(opt, def) result(val) + pure module function zoptional_default(opt, def) result(val) complex(real64), optional, intent(in) :: opt complex(real64), intent(in) :: def + complex(real64) :: val val = def if (present(opt)) val = opt @@ -310,9 +423,10 @@ contains !---------------------------------------------------------- - integer pure function ioptional_default(opt, def) result(val) + pure module function ioptional_default(opt, def) result(val) integer, optional, intent(in) :: opt integer, intent(in) :: def + integer :: val val = def if (present(opt)) val = opt @@ -320,9 +434,10 @@ contains !---------------------------------------------------------- - integer(int64) pure function loptional_default(opt, def) result(val) + pure module function loptional_default(opt, def) result(val) integer(int64), optional, intent(in) :: opt integer(int64), intent(in) :: def + integer(int64) :: val val = def if (present(opt)) val = opt @@ -330,9 +445,10 @@ contains !---------------------------------------------------------- - logical pure function looptional_default(opt, def) result(val) + pure module function looptional_default(opt, def) result(val) logical, optional, intent(in) :: opt logical, intent(in) :: def + logical :: val val = def if (present(opt)) val = opt @@ -340,9 +456,10 @@ contains !---------------------------------------------------------- - character(len=80) pure function soptional_default(opt, def) result(val) + pure module function soptional_default(opt, def) result(val) character(len=*), optional, intent(in) :: opt character(len=*), intent(in) :: def + character(:), allocatable :: val val = def if (present(opt)) val = opt @@ -350,105 +467,108 @@ contains !----------------------------------------------------------- - logical & -#ifndef HAVE_OPENMP - pure & -#endif - function not_in_openmp() + module function not_in_openmp() result(res) + logical :: res #ifdef HAVE_OPENMP - not_in_openmp = .not. omp_in_parallel() + res = .not. omp_in_parallel() #else - not_in_openmp = .true. + res = .true. #endif end function not_in_openmp !----------------------------------------------------------- - function cat(str1, str2) + module function cat(str1, str2) result(res) character(len=*), intent(in) :: str1 character(len=*), intent(in) :: str2 + character(len=len(str1) + len(str2)) :: res - character(len=len(str1) + len(str2)) :: cat - cat = str1//str2 + res = str1//str2 end function cat ! ----------------------------------------------------------- - integer(int64) pure function bitand48(val1, val2) + pure module function bitand48(val1, val2) result(res) integer(int32), intent(in) :: val1 integer(int64), intent(in) :: val2 + integer(int64) :: res - bitand48 = iand(int(val1, int64), val2) + res = iand(int(val1, int64), val2) end function bitand48 ! ----------------------------------------------------------- - integer(int64) pure function bitand84(val1, val2) + pure module function bitand84(val1, val2) result(res) integer(int64), intent(in) :: val1 integer(int32), intent(in) :: val2 + integer(int64) :: res - bitand84 = iand(val1, int(val2, int64)) + res = iand(val1, int(val2, int64)) end function bitand84 ! ----------------------------------------------------------- - integer(int64) pure function bitand88(val1, val2) + pure module function bitand88(val1, val2) result(res) integer(int64), intent(in) :: val1 integer(int64), intent(in) :: val2 + integer(int64) :: res - bitand88 = iand(val1, val2) + res = iand(val1, val2) end function bitand88 ! ----------------------------------------------------------- - integer(int32) pure function bitand44(val1, val2) + pure module function bitand44(val1, val2) result(res) integer(int32), intent(in) :: val1 integer(int32), intent(in) :: val2 + integer(int32) :: res - bitand44 = iand(val1, val2) + res = iand(val1, val2) end function bitand44 ! ----------------------------------------------------------- - integer(int64) pure function i4_to_i8_0(ii) + pure module function i4_to_i8_0(ii) result(res) integer(int32), intent(in) :: ii + integer(int64) :: res - i4_to_i8_0 = int(ii, int64) + res = int(ii, int64) end function i4_to_i8_0 ! ----------------------------------------------------------- - integer(int32) pure function i8_to_i4_0(ii) + pure module function i8_to_i4_0(ii) result(res) integer(int64), intent(in) :: ii + integer(int32) :: res - i8_to_i4_0 = int(ii, int32) + res = int(ii, int32) end function i8_to_i4_0 ! ----------------------------------------------------------- - pure function i4_to_i8_1(ii) + pure module function i4_to_i8_1(ii) result(res) integer(int32), intent(in) :: ii(:) - integer(int64) :: i4_to_i8_1(lbound(ii, 1, kind=int64):ubound(ii, 1, kind=int64)) + integer(int64) :: res(lbound(ii, 1, kind=int64):ubound(ii, 1, kind=int64)) - i4_to_i8_1 = int(ii, int64) + res = int(ii, int64) end function i4_to_i8_1 ! ----------------------------------------------------------- - pure function i8_to_i4_1(ii) + pure module function i8_to_i4_1(ii) result(res) integer(int64), intent(in) :: ii(:) - integer(int32) :: i8_to_i4_1(lbound(ii, 1, kind=int64):ubound(ii, 1, kind=int64)) + integer(int32) :: res(lbound(ii, 1, kind=int64):ubound(ii, 1, kind=int64)) - i8_to_i4_1 = int(ii, int32) + res = int(ii, int32) end function i8_to_i4_1 -end module global_oct_m +end submodule impl !! Local Variables: !! mode: f90 -- GitLab From e60a455e9ec834525029a4a6a6138e9668013d38 Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Mon, 15 Jan 2024 10:49:13 +0100 Subject: [PATCH 12/43] [submodule] `global_oct_m` (split) Signed-off-by: Cristian Le --- src/Makefile.am | 1 + src/basic/CMakeLists.txt | 1 + src/basic/global.F90 | 289 -------------------------------------- src/basic/global_h.F90 | 290 +++++++++++++++++++++++++++++++++++++++ 4 files changed, 292 insertions(+), 289 deletions(-) create mode 100644 src/basic/global_h.F90 diff --git a/src/Makefile.am b/src/Makefile.am index b2228811bd..d507c9336b 100644 --- a/src/Makefile.am +++ b/src/Makefile.am @@ -55,6 +55,7 @@ basic_f_srcs = \ basic/debug.F90 \ basic/gdlib.F90 \ basic/global.F90 \ + basic/global_h.F90 \ basic/hardware.F90 \ basic/heap.F90 \ basic/iihash.F90 \ diff --git a/src/basic/CMakeLists.txt b/src/basic/CMakeLists.txt index 96efa81094..fdf90ef09c 100644 --- a/src/basic/CMakeLists.txt +++ b/src/basic/CMakeLists.txt @@ -17,6 +17,7 @@ target_sources(Octopus_lib PRIVATE gdlib_f.c getopt_f.c global.F90 + global_h.F90 hardware.F90 heap.F90 iihash.F90 diff --git a/src/basic/global.F90 b/src/basic/global.F90 index eb0f3ceea7..dc588b7f3f 100644 --- a/src/basic/global.F90 +++ b/src/basic/global.F90 @@ -18,295 +18,6 @@ #include "global.h" -module global_oct_m - use mpi_oct_m - use, intrinsic :: iso_fortran_env - - implicit none - - private - - !> Public types, variables and procedures. - public :: & - conf_t, & - global_init, & - global_end, & - init_octopus_globals, & - optional_default, & - assert_die, & - not_in_openmp, & - operator(+), & - bitand, & - int32, int64, & - real32, real64, & - i4_to_i8, & - i8_to_i4 - ! Make these kind variables from kind_oct_m public here so that they are - ! available basically everywhere in the code. They still need to be in a - ! separate module because they are also needed in some low-level modules. - - integer, public, parameter :: MAX_PATH_LEN=512 - integer, public, parameter :: MAX_OUTPUT_TYPES=44 - - !> @brief Build configuration type - type conf_t - logical :: devel_version !< If true then allow unstable parts of the code - logical :: report_memory - character(len=256) :: share = SHARE_DIR !< Name of the share dir - character(len=256) :: git_commit = GIT_COMMIT !< hash of latest git commit - character(len=50) :: config_time = BUILD_TIME !< time octopus was configured - character(len=20) :: version = PACKAGE_VERSION !< version number - character(len=256) :: cc = CC !< C compiler - character(len=256) :: cxx = CXX !< C++ compiler - character(len=256) :: fc = FC !< Fortran compiler - ! Split flag definitions in case they don`t fit in one line, following preprocessing - character(len=256) :: cflags = & - CFLAGS //& - CFLAGS_EXTRA - character(len=256) :: cxxflags = & - CXXFLAGS //& - CXXFLAGS_EXTRA - character(len=256) :: fcflags = & - FCFLAGS //& - FCFLAGS_EXTRA - integer :: target_states_block_size = -1 - contains - procedure :: init => conf_init - end type conf_t - - !> Global instance of Octopus configuration - type(conf_t), public :: conf - - real(real64), public, parameter :: R_SMALL = 1e-8_real64 - - !> Minimal distance between two distinguishable atoms - real(real64), public, parameter :: R_MIN_ATOM_DIST = 1e-3_real64 - - !> some mathematical constants - real(real64), public, parameter :: M_Pi = 3.1415926535897932384626433832795029_real64 - real(real64), public, parameter :: M_E = 2.7182818284590452353602874713526625_real64 - real(real64), public, parameter :: M_ZERO = 0.0_real64 - real(real64), public, parameter :: M_ONE = 1.0_real64 - real(real64), public, parameter :: M_TWO = 2.0_real64 - real(real64), public, parameter :: M_THREE = 3.0_real64 - real(real64), public, parameter :: M_FOUR = 4.0_real64 - real(real64), public, parameter :: M_FIVE = 5.0_real64 - real(real64), public, parameter :: M_HALF = 0.5_real64 - real(real64), public, parameter :: M_THIRD = M_ONE/M_THREE - real(real64), public, parameter :: M_TWOTHIRD = M_TWO/M_THREE - real(real64), public, parameter :: M_FOURTH = M_ONE/M_FOUR - complex(real64), public, parameter :: M_z0 = (0.0_real64, 0.0_real64) - complex(real64), public, parameter :: M_z1 = (1.0_real64, 0.0_real64) - complex(real64), public, parameter :: M_z2 = (2.0_real64, 0.0_real64) - complex(real64), public, parameter :: M_z2I = (0.0_real64, 2.0_real64) - complex(real64), public, parameter :: M_zI = (0.0_real64, 1.0_real64) - - real(real64), public, parameter :: M_EPSILON = epsilon(M_ONE) - real(real64), public, parameter :: M_TINY = tiny(M_ONE) - real(real64), public, parameter :: M_HUGE = huge(M_ONE) - real(real64), public, parameter :: M_MIN_EXP_ARG = -650_real64 - real(real64), public, parameter :: M_MAX_EXP_ARG = 700_real64 - - !> Minimal occupation that is considered to be non-zero - real(real64), public, parameter :: M_MIN_OCC = 1.0e-10_real64 - !> Minimal density that is considered to be non-zero - real(real64), public, parameter :: M_MIN_DENSITY = 1.0e-20_real64 - - - !> some physical constants - real(real64), public, parameter :: P_a_B = 0.52917720859_real64 - real(real64), public, parameter :: P_Ang = M_ONE / P_a_B - real(real64), public, parameter :: P_Ry = 13.60569193_real64 - real(real64), public, parameter :: P_eV = M_ONE / P_Ry - real(real64), public, parameter :: P_Kb = 8.617343e-5_real64/(M_TWO*P_Ry) !< Boltzmann constant in Ha/K - real(real64), public, parameter :: P_c = 137.035999679_real64 - !< Electron gyromagnetic ratio, see Phys. Rev. Lett. 130, 071801 (2023) - real(real64), public, parameter :: P_g = 2.00231930436118_real64 - real(real64), public, parameter :: P_PROTON_CHARGE = -1.0_real64 - real(real64), public, parameter :: P_ep = M_ONE/(M_FOUR*M_Pi) - real(real64), public, parameter :: P_mu = M_FOUR*M_PI/(P_c**2) - - !> the standard input and output - integer, public :: stderr, stdin, stdout - - !> global epoch time (time at startup) - integer, public :: s_epoch_sec, s_epoch_usec - - !> The stack. - character(len=80), public :: sub_stack(50) - real(real64), public :: time_stack(50) - integer, public :: no_sub_stack = 0 - - !> Same for profiling mode. - logical, public :: in_profiling_mode = .false. - - integer, public :: global_alloc_err - integer(int64), public :: global_sizeof - character(len=100), public :: global_alloc_errmsg - - ! The code directories should be defined here, and not hard coded in the Fortran files. - character(len=*), public, parameter :: GS_DIR = "gs/" - character(len=*), public, parameter :: TD_DIR = "td/" - character(len=*), public, parameter :: STATIC_DIR = "static/" - character(len=*), public, parameter :: EM_RESP_DIR = "em_resp/" - character(len=*), public, parameter :: EM_RESP_FD_DIR = "em_resp_fd/" - character(len=*), public, parameter :: KDOTP_DIR = "kdotp/" - character(len=*), public, parameter :: VIB_MODES_DIR = "vib_modes/" - character(len=*), public, parameter :: VDW_DIR = "vdw/" - character(len=*), public, parameter :: CASIDA_DIR = "casida/" - character(len=*), public, parameter :: OCT_DIR = "opt-control/" - character(len=*), public, parameter :: PCM_DIR = "pcm/" - character(len=*), public, parameter :: PARTITION_DIR = "partition/" - - !> Alias MPI_COMM_UNDEFINED for the specific use case of initialising - !! Octopus utilities with no MPI support - integer, public, parameter :: SERIAL_DUMMY_COMM = MPI_COMM_UNDEFINED - - ! End of declaration of public objects. - ! --------------------------------------------------------- - - interface optional_default - module procedure doptional_default, zoptional_default, ioptional_default, loptional_default - module procedure looptional_default, soptional_default - end interface optional_default - - - !> This function is defined in messages.F90 - interface - subroutine assert_die(s, f, l) - implicit none - character(len=*), intent(in) :: s, f - integer, intent(in) :: l - end subroutine assert_die - end interface - - interface operator (+) - module procedure cat - end interface operator (+) - - interface bitand - module procedure bitand48 - module procedure bitand84 - module procedure bitand88 - module procedure bitand44 - end interface bitand - - interface i4_to_i8 - module procedure i4_to_i8_0, i4_to_i8_1 - end interface i4_to_i8 - - interface i8_to_i4 - module procedure i8_to_i4_0, i8_to_i4_1 - end interface i8_to_i4 - - interface - module subroutine conf_init(this) - class(conf_t), intent(inout) :: this - end subroutine conf_init - - module subroutine global_init(communicator) - integer, intent(in), optional :: communicator - end subroutine global_init - - module subroutine init_octopus_globals(comm) - integer, intent(in) :: comm - end subroutine init_octopus_globals - - module subroutine global_end() - end subroutine global_end - - pure module function doptional_default(opt, def) result(val) - real(real64), optional, intent(in) :: opt - real(real64), intent(in) :: def - real(real64) :: val - end function doptional_default - - pure module function zoptional_default(opt, def) result(val) - complex(real64), optional, intent(in) :: opt - complex(real64), intent(in) :: def - complex(real64) :: val - end function zoptional_default - - pure module function ioptional_default(opt, def) result(val) - integer, optional, intent(in) :: opt - integer, intent(in) :: def - integer :: val - end function ioptional_default - - pure module function loptional_default(opt, def) result(val) - integer(int64), optional, intent(in) :: opt - integer(int64), intent(in) :: def - integer(int64) :: val - end function loptional_default - - pure module function looptional_default(opt, def) result(val) - logical, optional, intent(in) :: opt - logical, intent(in) :: def - logical :: val - end function looptional_default - - pure module function soptional_default(opt, def) result(val) - character(len=*), optional, intent(in) :: opt - character(len=*), intent(in) :: def - character(:), allocatable :: val - end function soptional_default - - module function not_in_openmp() result(res) - logical :: res - end function not_in_openmp - - module function cat(str1, str2) result(res) - character(len=*), intent(in) :: str1 - character(len=*), intent(in) :: str2 - character(len=len(str1) + len(str2)) :: res - end function cat - - pure module function bitand48(val1, val2) result(res) - integer(int32), intent(in) :: val1 - integer(int64), intent(in) :: val2 - integer(int64) :: res - end function bitand48 - - pure module function bitand84(val1, val2) result(res) - integer(int64), intent(in) :: val1 - integer(int32), intent(in) :: val2 - integer(int64) :: res - end function bitand84 - - pure module function bitand88(val1, val2) result(res) - integer(int64), intent(in) :: val1 - integer(int64), intent(in) :: val2 - integer(int64) :: res - end function bitand88 - - pure module function bitand44(val1, val2) result(res) - integer(int32), intent(in) :: val1 - integer(int32), intent(in) :: val2 - integer(int32) :: res - end function bitand44 - - pure module function i4_to_i8_0(ii) result(res) - integer(int32), intent(in) :: ii - integer(int64) :: res - end function i4_to_i8_0 - - pure module function i8_to_i4_0(ii) result(res) - integer(int64), intent(in) :: ii - integer(int32) :: res - end function i8_to_i4_0 - - pure module function i4_to_i8_1(ii) result(res) - integer(int32), intent(in) :: ii(:) - integer(int64) :: res(lbound(ii, 1, kind=int64):ubound(ii, 1, kind=int64)) - end function i4_to_i8_1 - - pure module function i8_to_i4_1(ii) result(res) - integer(int64), intent(in) :: ii(:) - integer(int32) :: res(lbound(ii, 1, kind=int64):ubound(ii, 1, kind=int64)) - end function i8_to_i4_1 - end interface -end module global_oct_m - submodule (global_oct_m) impl use hardware_oct_m use loct_oct_m diff --git a/src/basic/global_h.F90 b/src/basic/global_h.F90 new file mode 100644 index 0000000000..fd28c70b26 --- /dev/null +++ b/src/basic/global_h.F90 @@ -0,0 +1,290 @@ +#include "global.h" + +module global_oct_m + use mpi_oct_m + use, intrinsic :: iso_fortran_env + + implicit none + + private + + !> Public types, variables and procedures. + public :: & + conf_t, & + global_init, & + global_end, & + init_octopus_globals, & + optional_default, & + assert_die, & + not_in_openmp, & + operator(+), & + bitand, & + int32, int64, & + real32, real64, & + i4_to_i8, & + i8_to_i4 + ! Make these kind variables from kind_oct_m public here so that they are + ! available basically everywhere in the code. They still need to be in a + ! separate module because they are also needed in some low-level modules. + + integer, public, parameter :: MAX_PATH_LEN=512 + integer, public, parameter :: MAX_OUTPUT_TYPES=44 + + !> @brief Build configuration type + type conf_t + logical :: devel_version !< If true then allow unstable parts of the code + logical :: report_memory + character(len=256) :: share = SHARE_DIR !< Name of the share dir + character(len=256) :: git_commit = GIT_COMMIT !< hash of latest git commit + character(len=50) :: config_time = BUILD_TIME !< time octopus was configured + character(len=20) :: version = PACKAGE_VERSION !< version number + character(len=256) :: cc = CC !< C compiler + character(len=256) :: cxx = CXX !< C++ compiler + character(len=256) :: fc = FC !< Fortran compiler + ! Split flag definitions in case they don`t fit in one line, following preprocessing + character(len=256) :: cflags = & + CFLAGS //& + CFLAGS_EXTRA + character(len=256) :: cxxflags = & + CXXFLAGS //& + CXXFLAGS_EXTRA + character(len=256) :: fcflags = & + FCFLAGS //& + FCFLAGS_EXTRA + integer :: target_states_block_size = -1 + contains + procedure :: init => conf_init + end type conf_t + + !> Global instance of Octopus configuration + type(conf_t), public :: conf + + real(real64), public, parameter :: R_SMALL = 1e-8_real64 + + !> Minimal distance between two distinguishable atoms + real(real64), public, parameter :: R_MIN_ATOM_DIST = 1e-3_real64 + + !> some mathematical constants + real(real64), public, parameter :: M_Pi = 3.1415926535897932384626433832795029_real64 + real(real64), public, parameter :: M_E = 2.7182818284590452353602874713526625_real64 + real(real64), public, parameter :: M_ZERO = 0.0_real64 + real(real64), public, parameter :: M_ONE = 1.0_real64 + real(real64), public, parameter :: M_TWO = 2.0_real64 + real(real64), public, parameter :: M_THREE = 3.0_real64 + real(real64), public, parameter :: M_FOUR = 4.0_real64 + real(real64), public, parameter :: M_FIVE = 5.0_real64 + real(real64), public, parameter :: M_HALF = 0.5_real64 + real(real64), public, parameter :: M_THIRD = M_ONE/M_THREE + real(real64), public, parameter :: M_TWOTHIRD = M_TWO/M_THREE + real(real64), public, parameter :: M_FOURTH = M_ONE/M_FOUR + complex(real64), public, parameter :: M_z0 = (0.0_real64, 0.0_real64) + complex(real64), public, parameter :: M_z1 = (1.0_real64, 0.0_real64) + complex(real64), public, parameter :: M_z2 = (2.0_real64, 0.0_real64) + complex(real64), public, parameter :: M_z2I = (0.0_real64, 2.0_real64) + complex(real64), public, parameter :: M_zI = (0.0_real64, 1.0_real64) + + real(real64), public, parameter :: M_EPSILON = epsilon(M_ONE) + real(real64), public, parameter :: M_TINY = tiny(M_ONE) + real(real64), public, parameter :: M_HUGE = huge(M_ONE) + real(real64), public, parameter :: M_MIN_EXP_ARG = -650_real64 + real(real64), public, parameter :: M_MAX_EXP_ARG = 700_real64 + + !> Minimal occupation that is considered to be non-zero + real(real64), public, parameter :: M_MIN_OCC = 1.0e-10_real64 + !> Minimal density that is considered to be non-zero + real(real64), public, parameter :: M_MIN_DENSITY = 1.0e-20_real64 + + + !> some physical constants + real(real64), public, parameter :: P_a_B = 0.52917720859_real64 + real(real64), public, parameter :: P_Ang = M_ONE / P_a_B + real(real64), public, parameter :: P_Ry = 13.60569193_real64 + real(real64), public, parameter :: P_eV = M_ONE / P_Ry + real(real64), public, parameter :: P_Kb = 8.617343e-5_real64/(M_TWO*P_Ry) !< Boltzmann constant in Ha/K + real(real64), public, parameter :: P_c = 137.035999679_real64 + !< Electron gyromagnetic ratio, see Phys. Rev. Lett. 130, 071801 (2023) + real(real64), public, parameter :: P_g = 2.00231930436118_real64 + real(real64), public, parameter :: P_PROTON_CHARGE = -1.0_real64 + real(real64), public, parameter :: P_ep = M_ONE/(M_FOUR*M_Pi) + real(real64), public, parameter :: P_mu = M_FOUR*M_PI/(P_c**2) + + !> the standard input and output + integer, public :: stderr, stdin, stdout + + !> global epoch time (time at startup) + integer, public :: s_epoch_sec, s_epoch_usec + + !> The stack. + character(len=80), public :: sub_stack(50) + real(real64), public :: time_stack(50) + integer, public :: no_sub_stack = 0 + + !> Same for profiling mode. + logical, public :: in_profiling_mode = .false. + + integer, public :: global_alloc_err + integer(int64), public :: global_sizeof + character(len=100), public :: global_alloc_errmsg + + ! The code directories should be defined here, and not hard coded in the Fortran files. + character(len=*), public, parameter :: GS_DIR = "gs/" + character(len=*), public, parameter :: TD_DIR = "td/" + character(len=*), public, parameter :: STATIC_DIR = "static/" + character(len=*), public, parameter :: EM_RESP_DIR = "em_resp/" + character(len=*), public, parameter :: EM_RESP_FD_DIR = "em_resp_fd/" + character(len=*), public, parameter :: KDOTP_DIR = "kdotp/" + character(len=*), public, parameter :: VIB_MODES_DIR = "vib_modes/" + character(len=*), public, parameter :: VDW_DIR = "vdw/" + character(len=*), public, parameter :: CASIDA_DIR = "casida/" + character(len=*), public, parameter :: OCT_DIR = "opt-control/" + character(len=*), public, parameter :: PCM_DIR = "pcm/" + character(len=*), public, parameter :: PARTITION_DIR = "partition/" + + !> Alias MPI_COMM_UNDEFINED for the specific use case of initialising + !! Octopus utilities with no MPI support + integer, public, parameter :: SERIAL_DUMMY_COMM = MPI_COMM_UNDEFINED + + ! End of declaration of public objects. + ! --------------------------------------------------------- + + interface optional_default + module procedure doptional_default, zoptional_default, ioptional_default, loptional_default + module procedure looptional_default, soptional_default + end interface optional_default + + + !> This function is defined in messages.F90 + interface + subroutine assert_die(s, f, l) + implicit none + character(len=*), intent(in) :: s, f + integer, intent(in) :: l + end subroutine assert_die + end interface + + interface operator (+) + module procedure cat + end interface operator (+) + + interface bitand + module procedure bitand48 + module procedure bitand84 + module procedure bitand88 + module procedure bitand44 + end interface bitand + + interface i4_to_i8 + module procedure i4_to_i8_0, i4_to_i8_1 + end interface i4_to_i8 + + interface i8_to_i4 + module procedure i8_to_i4_0, i8_to_i4_1 + end interface i8_to_i4 + + interface + module subroutine conf_init(this) + class(conf_t), intent(inout) :: this + end subroutine conf_init + + module subroutine global_init(communicator) + integer, intent(in), optional :: communicator + end subroutine global_init + + module subroutine init_octopus_globals(comm) + integer, intent(in) :: comm + end subroutine init_octopus_globals + + module subroutine global_end() + end subroutine global_end + + pure module function doptional_default(opt, def) result(val) + real(real64), optional, intent(in) :: opt + real(real64), intent(in) :: def + real(real64) :: val + end function doptional_default + + pure module function zoptional_default(opt, def) result(val) + complex(real64), optional, intent(in) :: opt + complex(real64), intent(in) :: def + complex(real64) :: val + end function zoptional_default + + pure module function ioptional_default(opt, def) result(val) + integer, optional, intent(in) :: opt + integer, intent(in) :: def + integer :: val + end function ioptional_default + + pure module function loptional_default(opt, def) result(val) + integer(int64), optional, intent(in) :: opt + integer(int64), intent(in) :: def + integer(int64) :: val + end function loptional_default + + pure module function looptional_default(opt, def) result(val) + logical, optional, intent(in) :: opt + logical, intent(in) :: def + logical :: val + end function looptional_default + + pure module function soptional_default(opt, def) result(val) + character(len=*), optional, intent(in) :: opt + character(len=*), intent(in) :: def + character(:), allocatable :: val + end function soptional_default + + module function not_in_openmp() result(res) + logical :: res + end function not_in_openmp + + module function cat(str1, str2) result(res) + character(len=*), intent(in) :: str1 + character(len=*), intent(in) :: str2 + character(len=len(str1) + len(str2)) :: res + end function cat + + pure module function bitand48(val1, val2) result(res) + integer(int32), intent(in) :: val1 + integer(int64), intent(in) :: val2 + integer(int64) :: res + end function bitand48 + + pure module function bitand84(val1, val2) result(res) + integer(int64), intent(in) :: val1 + integer(int32), intent(in) :: val2 + integer(int64) :: res + end function bitand84 + + pure module function bitand88(val1, val2) result(res) + integer(int64), intent(in) :: val1 + integer(int64), intent(in) :: val2 + integer(int64) :: res + end function bitand88 + + pure module function bitand44(val1, val2) result(res) + integer(int32), intent(in) :: val1 + integer(int32), intent(in) :: val2 + integer(int32) :: res + end function bitand44 + + pure module function i4_to_i8_0(ii) result(res) + integer(int32), intent(in) :: ii + integer(int64) :: res + end function i4_to_i8_0 + + pure module function i8_to_i4_0(ii) result(res) + integer(int64), intent(in) :: ii + integer(int32) :: res + end function i8_to_i4_0 + + pure module function i4_to_i8_1(ii) result(res) + integer(int32), intent(in) :: ii(:) + integer(int64) :: res(lbound(ii, 1, kind=int64):ubound(ii, 1, kind=int64)) + end function i4_to_i8_1 + + pure module function i8_to_i4_1(ii) result(res) + integer(int64), intent(in) :: ii(:) + integer(int32) :: res(lbound(ii, 1, kind=int64):ubound(ii, 1, kind=int64)) + end function i8_to_i4_1 + end interface +end module global_oct_m -- GitLab From 17888350494c7e2ec2e7aec373cf5e402c5a3f92 Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Tue, 20 Jun 2023 16:39:43 +0200 Subject: [PATCH 13/43] [submodule] `hamiltonian_elec_oct_m` Signed-off-by: Cristian Le --- src/hamiltonian/hamiltonian_elec.F90 | 492 +++++++++++++++++++---- src/hamiltonian/hamiltonian_elec_inc.F90 | 18 +- 2 files changed, 433 insertions(+), 77 deletions(-) diff --git a/src/hamiltonian/hamiltonian_elec.F90 b/src/hamiltonian/hamiltonian_elec.F90 index 1a9a97b196..e385434e59 100644 --- a/src/hamiltonian/hamiltonian_elec.F90 +++ b/src/hamiltonian/hamiltonian_elec.F90 @@ -21,75 +21,43 @@ module hamiltonian_elec_oct_m use absorbing_boundaries_oct_m - use accel_oct_m - use affine_coordinates_oct_m use batch_oct_m - use batch_ops_oct_m - use boundaries_oct_m - use comm_oct_m - use debug_oct_m use derivatives_oct_m use distributed_oct_m - use energy_oct_m use electron_space_oct_m - use exchange_operator_oct_m - use external_potential_oct_m - use hamiltonian_elec_base_oct_m + use energy_oct_m use epot_oct_m - use ext_partner_list_oct_m - use gauge_field_oct_m + use exchange_operator_oct_m use global_oct_m use grid_oct_m use hamiltonian_abst_oct_m + use hamiltonian_elec_base_oct_m use interaction_partner_oct_m use ion_electron_local_potential_oct_m - use io_oct_m use ions_oct_m use kick_oct_m - use, intrinsic :: iso_fortran_env use kpoints_oct_m - use lalg_basic_oct_m - use lasers_oct_m use lattice_vectors_oct_m use lda_u_oct_m - use linked_list_oct_m use magnetic_constrain_oct_m - use math_oct_m use mesh_oct_m - use mesh_function_oct_m - use messages_oct_m - use mpi_oct_m use multicomm_oct_m use mxll_elec_coupling_oct_m use namespace_oct_m use nlcc_oct_m use nonlocal_pseudopotential_oct_m use oct_exchange_oct_m - use parser_oct_m - use par_vec_oct_m - use poisson_oct_m - use profiling_oct_m - use projector_oct_m use pcm_oct_m use phase_oct_m + use poisson_oct_m use restart_oct_m use scissor_oct_m use space_oct_m use species_oct_m - use states_abst_oct_m - use states_elec_oct_m use states_elec_dim_oct_m - use states_elec_parallel_oct_m - use symmetries_oct_m - use symm_op_oct_m - use types_oct_m - use unit_oct_m - use unit_system_oct_m + use states_elec_oct_m use wfs_elec_oct_m use xc_oct_m - use xc_f03_lib_m - use xc_functional_oct_m - use xc_interaction_oct_m use xc_photons_oct_m use zora_oct_m @@ -236,11 +204,393 @@ module hamiltonian_elec_oct_m GENERALIZED_KOHN_SHAM_DFT = 5, & RDMFT = 7 + interface + module subroutine hamiltonian_elec_init(hm, namespace, space, gr, ions, ext_partners, st, theory_level, xc, & + mc, kpoints, need_exchange, xc_photons) + type(hamiltonian_elec_t), target, intent(inout) :: hm + type(namespace_t), intent(in) :: namespace + class(space_t), intent(in) :: space + type(grid_t), target, intent(inout) :: gr + type(ions_t), target, intent(inout) :: ions + type(partner_list_t), intent(inout) :: ext_partners + type(states_elec_t), target, intent(inout) :: st + integer, intent(in) :: theory_level + type(xc_t), target, intent(in) :: xc + type(multicomm_t), intent(in) :: mc + type(kpoints_t), target, intent(in) :: kpoints + logical, optional, intent(in) :: need_exchange + type(xc_photons_t), optional, target, intent(in) :: xc_photons + end subroutine hamiltonian_elec_init + + module subroutine hamiltonian_elec_end(hm) + type(hamiltonian_elec_t), target, intent(inout) :: hm + end subroutine hamiltonian_elec_end + + module function hamiltonian_elec_hermitian(hm) result(res) + class(hamiltonian_elec_t), intent(in) :: hm + logical :: res + end function hamiltonian_elec_hermitian + + module subroutine hamiltonian_elec_span(hm, delta, emin, namespace) + class(hamiltonian_elec_t), intent(inout) :: hm + real(real64), intent(in) :: delta(:) + real(real64), intent(in) :: emin + type(namespace_t), intent(in) :: namespace + end subroutine hamiltonian_elec_span + + pure module function hamiltonian_elec_inh_term(hm) result(inh) + type(hamiltonian_elec_t), intent(in) :: hm + logical :: inh + end function hamiltonian_elec_inh_term + + module subroutine hamiltonian_elec_set_inh(hm, st) + type(hamiltonian_elec_t), intent(inout) :: hm + type(states_elec_t), intent(in) :: st + end subroutine hamiltonian_elec_set_inh + + module subroutine hamiltonian_elec_remove_inh(hm) + type(hamiltonian_elec_t), intent(inout) :: hm + end subroutine hamiltonian_elec_remove_inh + + module subroutine hamiltonian_elec_adjoint(hm) + type(hamiltonian_elec_t), intent(inout) :: hm + end subroutine hamiltonian_elec_adjoint + + module subroutine hamiltonian_elec_not_adjoint(hm) + type(hamiltonian_elec_t), intent(inout) :: hm + end subroutine hamiltonian_elec_not_adjoint + + module subroutine hamiltonian_elec_update(this, mesh, namespace, space, ext_partners, time) + class(hamiltonian_elec_t), intent(inout) :: this + class(mesh_t), intent(in) :: mesh + type(namespace_t), intent(in) :: namespace + class(space_t), intent(in) :: space + type(partner_list_t), intent(in) :: ext_partners + real(real64), optional, intent(in) :: time + end subroutine hamiltonian_elec_update + + module subroutine hamiltonian_elec_update_pot(this, mesh, accumulate) + type(hamiltonian_elec_t), intent(inout) :: this + class(mesh_t), intent(in) :: mesh + logical, optional, intent(in) :: accumulate + end subroutine hamiltonian_elec_update_pot + + module subroutine hamiltonian_elec_epot_generate(this, namespace, space, gr, ions, ext_partners, st, time) + type(hamiltonian_elec_t), intent(inout) :: this + type(namespace_t), intent(in) :: namespace + class(electron_space_t), intent(in) :: space + type(grid_t), intent(in) :: gr + type(ions_t), target, intent(inout) :: ions + type(partner_list_t), intent(in) :: ext_partners + type(states_elec_t), intent(inout) :: st + real(real64), optional, intent(in) :: time + end subroutine hamiltonian_elec_epot_generate + + module function hamiltonian_elec_get_time(this) result(time) + type(hamiltonian_elec_t), intent(inout) :: this + real(real64) :: time + end function hamiltonian_elec_get_time + + pure module function hamiltonian_elec_apply_packed(this) result(apply) + class(hamiltonian_elec_t), intent(in) :: this + logical :: apply + end function hamiltonian_elec_apply_packed + + module subroutine zhamiltonian_elec_apply_atom (hm, namespace, space, latt, species, pos, ia, mesh, psi, vpsi) + type(hamiltonian_elec_t), intent(in) :: hm + type(namespace_t), intent(in) :: namespace + class(space_t), intent(in) :: space + type(lattice_vectors_t), intent(in) :: latt + class(species_t), intent(in) :: species + real(real64), intent(in) :: pos(1:space%dim) + integer, intent(in) :: ia + class(mesh_t), intent(in) :: mesh + complex(real64), intent(in) :: psi(:,:) !< (gr%np_part, hm%d%dim) + complex(real64), intent(out) :: vpsi(:,:) !< (gr%np, hm%d%dim) + end subroutine zhamiltonian_elec_apply_atom + + module subroutine hamiltonian_elec_dump_vhxc(restart, hm, space, mesh, ierr) + type(restart_t), intent(in) :: restart + type(hamiltonian_elec_t), intent(in) :: hm + class(space_t), intent(in) :: space + class(mesh_t), intent(in) :: mesh + integer, intent(out) :: ierr + end subroutine hamiltonian_elec_dump_vhxc + + module subroutine hamiltonian_elec_load_vhxc(restart, hm, space, mesh, ierr) + type(restart_t), intent(in) :: restart + type(hamiltonian_elec_t), intent(inout) :: hm + class(space_t), intent(in) :: space + class(mesh_t), intent(in) :: mesh + integer, intent(out) :: ierr + end subroutine hamiltonian_elec_load_vhxc + + module subroutine hamiltonian_elec_update_with_ext_pot(this, mesh, space, ext_partners, time, mu) + type(hamiltonian_elec_t), intent(inout) :: this + class(space_t), intent(in) :: space + class(mesh_t), intent(in) :: mesh + type(partner_list_t), intent(in) :: ext_partners + real(real64), intent(in) :: time(1:2) + real(real64), intent(in) :: mu(1:2) + end subroutine hamiltonian_elec_update_with_ext_pot + + module subroutine hamiltonian_elec_set_vhxc(hm, mesh, vold, vold_tau) + type(hamiltonian_elec_t), intent(inout) :: hm + class(mesh_t), intent(in) :: mesh + real(real64), intent(in) :: vold(:, :) + real(real64), optional, intent(in) :: vold_tau(:, :) + end subroutine hamiltonian_elec_set_vhxc + + module function hamiltonian_elec_needs_current(hm, states_are_real) result(res) + type(hamiltonian_elec_t), intent(in) :: hm + logical, intent(in) :: states_are_real + logical :: res + end function hamiltonian_elec_needs_current + + module subroutine zhamiltonian_elec_apply_all(hm, namespace, mesh, st, hst) + type(hamiltonian_elec_t), intent(inout) :: hm + type(namespace_t), intent(in) :: namespace + class(mesh_t), intent(in) :: mesh + type(states_elec_t), intent(inout) :: st + type(states_elec_t), intent(inout) :: hst + end subroutine zhamiltonian_elec_apply_all + + module subroutine magnus(hm, namespace, mesh, psi, hpsi, ik, vmagnus, set_phase) + type(hamiltonian_elec_t), intent(in) :: hm + type(namespace_t), intent(in) :: namespace + class(mesh_t), intent(in) :: mesh + complex(real64), intent(inout) :: psi(:,:) + complex(real64), intent(out) :: hpsi(:,:) + integer, intent(in) :: ik + real(real64), intent(in) :: vmagnus(:, :, :) + logical, optional, intent(in) :: set_phase + end subroutine magnus + + module subroutine vborders (mesh, hm, psi, hpsi) + class(mesh_t), intent(in) :: mesh + type(hamiltonian_elec_t), intent(in) :: hm + complex(real64), intent(in) :: psi(:) + complex(real64), intent(inout) :: hpsi(:) + end subroutine vborders + + module function hamiltonian_elec_has_kick(hm) result(res) + type(hamiltonian_elec_t), intent(in) :: hm + logical :: res + end function hamiltonian_elec_has_kick + + module subroutine dhamiltonian_elec_apply(hm, namespace, mesh, psib, hpsib, terms, set_bc) + class(hamiltonian_elec_t), intent(in) :: hm + type(namespace_t), intent(in) :: namespace + class(mesh_t), intent(in) :: mesh + class(batch_t), target, intent(inout) :: psib + class(batch_t), target, intent(inout) :: hpsib + integer, optional, intent(in) :: terms + logical, optional, intent(in) :: set_bc + end subroutine dhamiltonian_elec_apply + + module subroutine dhamiltonian_elec_magnus_apply(hm, namespace, mesh, psib, hpsib, vmagnus) + class(hamiltonian_elec_t), intent(in) :: hm + type(namespace_t), intent(in) :: namespace + class(mesh_t), intent(in) :: mesh + class(batch_t), intent(inout) :: psib + class(batch_t), intent(inout) :: hpsib + real(real64), intent(in) :: vmagnus(:, :, :) + end subroutine dhamiltonian_elec_magnus_apply + + module subroutine dhamiltonian_elec_apply_batch(hm, namespace, mesh, psib, hpsib, terms, set_bc) + type(hamiltonian_elec_t), intent(in) :: hm + type(namespace_t), intent(in) :: namespace + class(mesh_t), intent(in) :: mesh + type(wfs_elec_t), target, intent(inout) :: psib + type(wfs_elec_t), target, intent(inout) :: hpsib + integer, optional, intent(in) :: terms + logical, optional, intent(in) :: set_bc + end subroutine dhamiltonian_elec_apply_batch + + module subroutine dhamiltonian_elec_external(this, mesh, psib, vpsib) + type(hamiltonian_elec_t), intent(in) :: this + class(mesh_t), intent(in) :: mesh + type(wfs_elec_t), intent(in) :: psib + type(wfs_elec_t), intent(inout) :: vpsib + end subroutine dhamiltonian_elec_external + + module subroutine dhamiltonian_elec_apply_single(hm, namespace, mesh, psi, hpsi, ist, ik, terms, set_bc, set_phase) + type(hamiltonian_elec_t), intent(in) :: hm + type(namespace_t), intent(in) :: namespace + class(mesh_t), intent(in) :: mesh + integer, intent(in) :: ist + integer, intent(in) :: ik + real(real64), contiguous, target, intent(inout) :: psi(:,:) + real(real64), contiguous, target, intent(inout) :: hpsi(:,:) + integer, optional, intent(in) :: terms + logical, optional, intent(in) :: set_bc + logical, optional, intent(in) :: set_phase + end subroutine dhamiltonian_elec_apply_single + + module subroutine dhamiltonian_elec_magnus_apply_batch(hm, namespace, mesh, psib, hpsib, vmagnus) + type(hamiltonian_elec_t), intent(in) :: hm + type(namespace_t), intent(in) :: namespace + class(mesh_t), intent(in) :: mesh + type(wfs_elec_t), intent(inout) :: psib + type(wfs_elec_t), intent(inout) :: hpsib + real(real64), intent(in) :: vmagnus(:, :, :) + end subroutine dhamiltonian_elec_magnus_apply_batch + + module subroutine dh_mgga_terms(hm, mesh, psib, hpsib, ghost_update) + type(hamiltonian_elec_t), intent(in) :: hm + class(mesh_t), intent(in) :: mesh + type(wfs_elec_t), intent(inout) :: psib + type(wfs_elec_t), intent(inout) :: hpsib + logical, intent(in) :: ghost_update + end subroutine dh_mgga_terms + + module subroutine dvmask(mesh, hm, st) + class(mesh_t), intent(in) :: mesh + type(hamiltonian_elec_t), intent(in) :: hm + type(states_elec_t), intent(inout) :: st + end subroutine dvmask + + module subroutine dhamiltonian_elec_diagonal(hm, mesh, diag, ik) + type(hamiltonian_elec_t), intent(in) :: hm + class(mesh_t), intent(in) :: mesh + real(real64), intent(out) :: diag(:,:) + integer, intent(in) :: ik + end subroutine dhamiltonian_elec_diagonal + + module subroutine zhamiltonian_elec_apply(hm, namespace, mesh, psib, hpsib, terms, set_bc) + class(hamiltonian_elec_t), intent(in) :: hm + type(namespace_t), intent(in) :: namespace + class(mesh_t), intent(in) :: mesh + class(batch_t), target, intent(inout) :: psib + class(batch_t), target, intent(inout) :: hpsib + integer, optional, intent(in) :: terms + logical, optional, intent(in) :: set_bc + end subroutine zhamiltonian_elec_apply + + module subroutine zhamiltonian_elec_magnus_apply(hm, namespace, mesh, psib, hpsib, vmagnus) + class(hamiltonian_elec_t), intent(in) :: hm + type(namespace_t), intent(in) :: namespace + class(mesh_t), intent(in) :: mesh + class(batch_t), intent(inout) :: psib + class(batch_t), intent(inout) :: hpsib + real(real64), intent(in) :: vmagnus(:, :, :) + end subroutine zhamiltonian_elec_magnus_apply + + module subroutine zhamiltonian_elec_apply_batch(hm, namespace, mesh, psib, hpsib, terms, set_bc) + type(hamiltonian_elec_t), intent(in) :: hm + type(namespace_t), intent(in) :: namespace + class(mesh_t), intent(in) :: mesh + type(wfs_elec_t), target, intent(inout) :: psib + type(wfs_elec_t), target, intent(inout) :: hpsib + integer, optional, intent(in) :: terms + logical, optional, intent(in) :: set_bc + end subroutine zhamiltonian_elec_apply_batch + + module subroutine zhamiltonian_elec_external(this, mesh, psib, vpsib) + type(hamiltonian_elec_t), intent(in) :: this + class(mesh_t), intent(in) :: mesh + type(wfs_elec_t), intent(in) :: psib + type(wfs_elec_t), intent(inout) :: vpsib + end subroutine zhamiltonian_elec_external + + module subroutine zhamiltonian_elec_apply_single(hm, namespace, mesh, psi, hpsi, ist, ik, terms, set_bc, set_phase) + type(hamiltonian_elec_t), intent(in) :: hm + type(namespace_t), intent(in) :: namespace + class(mesh_t), intent(in) :: mesh + integer, intent(in) :: ist + integer, intent(in) :: ik + complex(real64), contiguous, target, intent(inout) :: psi(:,:) + complex(real64), contiguous, target, intent(inout) :: hpsi(:,:) + integer, optional, intent(in) :: terms + logical, optional, intent(in) :: set_bc + logical, optional, intent(in) :: set_phase + end subroutine zhamiltonian_elec_apply_single + + module subroutine zhamiltonian_elec_magnus_apply_batch(hm, namespace, mesh, psib, hpsib, vmagnus) + type(hamiltonian_elec_t), intent(in) :: hm + type(namespace_t), intent(in) :: namespace + class(mesh_t), intent(in) :: mesh + type(wfs_elec_t), intent(inout) :: psib + type(wfs_elec_t), intent(inout) :: hpsib + real(real64), intent(in) :: vmagnus(:, :, :) + end subroutine zhamiltonian_elec_magnus_apply_batch + + module subroutine zh_mgga_terms(hm, mesh, psib, hpsib, ghost_update) + type(hamiltonian_elec_t), intent(in) :: hm + class(mesh_t), intent(in) :: mesh + type(wfs_elec_t), intent(inout) :: psib + type(wfs_elec_t), intent(inout) :: hpsib + logical, intent(in) :: ghost_update + end subroutine zh_mgga_terms + + module subroutine zvmask(mesh, hm, st) + class(mesh_t), intent(in) :: mesh + type(hamiltonian_elec_t), intent(in) :: hm + type(states_elec_t), intent(inout) :: st + end subroutine zvmask + + module subroutine zhamiltonian_elec_diagonal(hm, mesh, diag, ik) + type(hamiltonian_elec_t), intent(in) :: hm + class(mesh_t), intent(in) :: mesh + complex(real64), intent(out) :: diag(:,:) + integer, intent(in) :: ik + end subroutine zhamiltonian_elec_diagonal + + module subroutine hamiltonian_elec_set_mass(this, namespace, mass) + class(hamiltonian_elec_t) , intent(inout) :: this + type(namespace_t), intent(in) :: namespace + real(real64), intent(in) :: mass + end subroutine hamiltonian_elec_set_mass + + module subroutine hamiltonian_elec_copy_and_set_phase(hm, gr, kpt, psib, psib_with_phase) + type(hamiltonian_elec_t), intent(in) :: hm + type(grid_t), intent(in) :: gr + type(distributed_t), intent(in) :: kpt !< k-point distribution + type(wfs_elec_t), intent(in) :: psib !< Batched wave functions + type(wfs_elec_t), intent(out) :: psib_with_phase !< Batched wave functions with phase applied + end subroutine hamiltonian_elec_copy_and_set_phase + end interface +end module hamiltonian_elec_oct_m + +submodule (hamiltonian_elec_oct_m) impl + use accel_oct_m + use affine_coordinates_oct_m + use batch_ops_oct_m + use boundaries_oct_m + use comm_oct_m + use debug_oct_m + use ext_partner_list_oct_m + use external_potential_oct_m + use gauge_field_oct_m + use global_oct_m + use io_oct_m + use lalg_basic_oct_m + use lasers_oct_m + use linked_list_oct_m + use math_oct_m + use mesh_function_oct_m + use messages_oct_m + use mpi_oct_m + use par_vec_oct_m + use parser_oct_m + use profiling_oct_m + use projector_oct_m + use states_abst_oct_m + use states_elec_parallel_oct_m + use symm_op_oct_m + use symmetries_oct_m + use types_oct_m + use unit_oct_m + use unit_system_oct_m + use xc_f03_lib_m + use xc_functional_oct_m + use xc_interaction_oct_m + implicit none contains ! --------------------------------------------------------- - subroutine hamiltonian_elec_init(hm, namespace, space, gr, ions, ext_partners, st, theory_level, xc, & + module subroutine hamiltonian_elec_init(hm, namespace, space, gr, ions, ext_partners, st, theory_level, xc, & mc, kpoints, need_exchange, xc_photons) type(hamiltonian_elec_t), target, intent(inout) :: hm type(namespace_t), intent(in) :: namespace @@ -687,7 +1037,7 @@ contains ! --------------------------------------------------------- - subroutine hamiltonian_elec_end(hm) + module subroutine hamiltonian_elec_end(hm) type(hamiltonian_elec_t), target, intent(inout) :: hm type(partner_iterator_t) :: iter @@ -756,11 +1106,12 @@ contains ! --------------------------------------------------------- ! True if the Hamiltonian is Hermitian, false otherwise - logical function hamiltonian_elec_hermitian(hm) + module function hamiltonian_elec_hermitian(hm) result(res) class(hamiltonian_elec_t), intent(in) :: hm + logical :: res PUSH_SUB(hamiltonian_elec_hermitian) - hamiltonian_elec_hermitian = .not.((hm%abs_boundaries%abtype == IMAGINARY_ABSORBING) .or. & + res = .not.((hm%abs_boundaries%abtype == IMAGINARY_ABSORBING) .or. & oct_exchange_enabled(hm%oct_exchange)) POP_SUB(hamiltonian_elec_hermitian) @@ -768,7 +1119,7 @@ contains ! --------------------------------------------------------- - subroutine hamiltonian_elec_span(hm, delta, emin, namespace) + module subroutine hamiltonian_elec_span(hm, delta, emin, namespace) class(hamiltonian_elec_t), intent(inout) :: hm real(real64), intent(in) :: delta(:) real(real64), intent(in) :: emin @@ -805,15 +1156,16 @@ contains ! --------------------------------------------------------- - pure logical function hamiltonian_elec_inh_term(hm) result(inh) + pure module function hamiltonian_elec_inh_term(hm) result(inh) type(hamiltonian_elec_t), intent(in) :: hm + logical :: inh inh = hm%inh_term end function hamiltonian_elec_inh_term ! --------------------------------------------------------- - subroutine hamiltonian_elec_set_inh(hm, st) + module subroutine hamiltonian_elec_set_inh(hm, st) type(hamiltonian_elec_t), intent(inout) :: hm type(states_elec_t), intent(in) :: st @@ -828,7 +1180,7 @@ contains ! --------------------------------------------------------- - subroutine hamiltonian_elec_remove_inh(hm) + module subroutine hamiltonian_elec_remove_inh(hm) type(hamiltonian_elec_t), intent(inout) :: hm PUSH_SUB(hamiltonian_elec_remove_inh) @@ -842,7 +1194,7 @@ contains end subroutine hamiltonian_elec_remove_inh ! --------------------------------------------------------- - subroutine hamiltonian_elec_adjoint(hm) + module subroutine hamiltonian_elec_adjoint(hm) type(hamiltonian_elec_t), intent(inout) :: hm PUSH_SUB(hamiltonian_elec_adjoint) @@ -859,7 +1211,7 @@ contains ! --------------------------------------------------------- - subroutine hamiltonian_elec_not_adjoint(hm) + module subroutine hamiltonian_elec_not_adjoint(hm) type(hamiltonian_elec_t), intent(inout) :: hm PUSH_SUB(hamiltonian_elec_not_adjoint) @@ -877,7 +1229,7 @@ contains ! --------------------------------------------------------- !> (re-)build the Hamiltonian for the next application: - subroutine hamiltonian_elec_update(this, mesh, namespace, space, ext_partners, time) + module subroutine hamiltonian_elec_update(this, mesh, namespace, space, ext_partners, time) class(hamiltonian_elec_t), intent(inout) :: this class(mesh_t), intent(in) :: mesh type(namespace_t), intent(in) :: namespace @@ -1108,7 +1460,7 @@ contains !>@brief Update the KS potential of the electronic Hamiltonian !! ! TODO: See Issue #1064 - subroutine hamiltonian_elec_update_pot(this, mesh, accumulate) + module subroutine hamiltonian_elec_update_pot(this, mesh, accumulate) type(hamiltonian_elec_t), intent(inout) :: this class(mesh_t), intent(in) :: mesh logical, optional, intent(in) :: accumulate @@ -1228,7 +1580,7 @@ contains end subroutine hamiltonian_elec_update_pot ! --------------------------------------------------------- - subroutine hamiltonian_elec_epot_generate(this, namespace, space, gr, ions, ext_partners, st, time) + module subroutine hamiltonian_elec_epot_generate(this, namespace, space, gr, ions, ext_partners, st, time) type(hamiltonian_elec_t), intent(inout) :: this type(namespace_t), intent(in) :: namespace class(electron_space_t), intent(in) :: space @@ -1311,16 +1663,18 @@ contains ! ----------------------------------------------------------------- - real(real64) function hamiltonian_elec_get_time(this) result(time) + module function hamiltonian_elec_get_time(this) result(time) type(hamiltonian_elec_t), intent(inout) :: this + real(real64) :: time time = this%current_time end function hamiltonian_elec_get_time ! ----------------------------------------------------------------- - pure logical function hamiltonian_elec_apply_packed(this) result(apply) + pure module function hamiltonian_elec_apply_packed(this) result(apply) class(hamiltonian_elec_t), intent(in) :: this + logical :: apply apply = this%is_applied_packed @@ -1328,7 +1682,7 @@ contains ! ----------------------------------------------------------------- - subroutine zhamiltonian_elec_apply_atom (hm, namespace, space, latt, species, pos, ia, mesh, psi, vpsi) + module subroutine zhamiltonian_elec_apply_atom (hm, namespace, space, latt, species, pos, ia, mesh, psi, vpsi) type(hamiltonian_elec_t), intent(in) :: hm type(namespace_t), intent(in) :: namespace class(space_t), intent(in) :: space @@ -1358,7 +1712,7 @@ contains ! ----------------------------------------------------------------- - subroutine hamiltonian_elec_dump_vhxc(restart, hm, space, mesh, ierr) + module subroutine hamiltonian_elec_dump_vhxc(restart, hm, space, mesh, ierr) type(restart_t), intent(in) :: restart type(hamiltonian_elec_t), intent(in) :: hm class(space_t), intent(in) :: space @@ -1454,7 +1808,7 @@ contains ! --------------------------------------------------------- - subroutine hamiltonian_elec_load_vhxc(restart, hm, space, mesh, ierr) + module subroutine hamiltonian_elec_load_vhxc(restart, hm, space, mesh, ierr) type(restart_t), intent(in) :: restart type(hamiltonian_elec_t), intent(inout) :: hm class(space_t), intent(in) :: space @@ -1524,7 +1878,7 @@ contains !! CFM4 propagator. It updates the Hamiltonian by considering a !! weighted sum of the external potentials at times time(1) and time(2), !! weighted by alpha(1) and alpha(2). - subroutine hamiltonian_elec_update_with_ext_pot(this, mesh, space, ext_partners, time, mu) + module subroutine hamiltonian_elec_update_with_ext_pot(this, mesh, space, ext_partners, time, mu) type(hamiltonian_elec_t), intent(inout) :: this class(space_t), intent(in) :: space class(mesh_t), intent(in) :: mesh @@ -1720,7 +2074,7 @@ contains end subroutine hamiltonian_elec_update_with_ext_pot ! --------------------------------------------------------- - subroutine hamiltonian_elec_set_vhxc(hm, mesh, vold, vold_tau) + module subroutine hamiltonian_elec_set_vhxc(hm, mesh, vold, vold_tau) type(hamiltonian_elec_t), intent(inout) :: hm class(mesh_t), intent(in) :: mesh real(real64), intent(in) :: vold(:, :) @@ -1736,15 +2090,16 @@ contains POP_SUB(hamiltonian_elec_set_vhxc) end subroutine hamiltonian_elec_set_vhxc - logical function hamiltonian_elec_needs_current(hm, states_are_real) + module function hamiltonian_elec_needs_current(hm, states_are_real) result(res) type(hamiltonian_elec_t), intent(in) :: hm logical, intent(in) :: states_are_real + logical :: res - hamiltonian_elec_needs_current = .false. + res = .false. if (hm%self_induced_magnetic) then if (.not. states_are_real) then - hamiltonian_elec_needs_current = .true. + res = .true. else message(1) = 'No current density for real states since it is identically zero.' call messages_warning(1) @@ -1754,7 +2109,7 @@ contains end function hamiltonian_elec_needs_current ! --------------------------------------------------------- - subroutine zhamiltonian_elec_apply_all(hm, namespace, mesh, st, hst) + module subroutine zhamiltonian_elec_apply_all(hm, namespace, mesh, st, hst) type(hamiltonian_elec_t), intent(inout) :: hm type(namespace_t), intent(in) :: namespace class(mesh_t), intent(in) :: mesh @@ -1803,7 +2158,7 @@ contains ! --------------------------------------------------------- - subroutine magnus(hm, namespace, mesh, psi, hpsi, ik, vmagnus, set_phase) + module subroutine magnus(hm, namespace, mesh, psi, hpsi, ik, vmagnus, set_phase) type(hamiltonian_elec_t), intent(in) :: hm type(namespace_t), intent(in) :: namespace class(mesh_t), intent(in) :: mesh @@ -1855,7 +2210,7 @@ contains end subroutine magnus ! --------------------------------------------------------- - subroutine vborders (mesh, hm, psi, hpsi) + module subroutine vborders (mesh, hm, psi, hpsi) class(mesh_t), intent(in) :: mesh type(hamiltonian_elec_t), intent(in) :: hm complex(real64), intent(in) :: psi(:) @@ -1875,19 +2230,20 @@ contains end subroutine vborders ! --------------------------------------------------------- - logical function hamiltonian_elec_has_kick(hm) + module function hamiltonian_elec_has_kick(hm) result(res) type(hamiltonian_elec_t), intent(in) :: hm + logical :: res PUSH_SUB(hamiltonian_elec_has_kick) - hamiltonian_elec_has_kick = (abs(hm%kick%delta_strength) > M_EPSILON) + res = (abs(hm%kick%delta_strength) > M_EPSILON) POP_SUB(hamiltonian_elec_has_kick) end function hamiltonian_elec_has_kick !> set the effective electron mass, checking whether it was previously redefined. ! - subroutine hamiltonian_elec_set_mass(this, namespace, mass) + module subroutine hamiltonian_elec_set_mass(this, namespace, mass) class(hamiltonian_elec_t) , intent(inout) :: this type(namespace_t), intent(in) :: namespace real(real64), intent(in) :: mass @@ -1911,7 +2267,7 @@ contains !! If no phase is defined, a packed copy of psib is returned !! !! TODO: This should should probably belong to wfs_elec_t, but cannot due to circular dependencies - subroutine hamiltonian_elec_copy_and_set_phase(hm, gr, kpt, psib, psib_with_phase) + module subroutine hamiltonian_elec_copy_and_set_phase(hm, gr, kpt, psib, psib_with_phase) type(hamiltonian_elec_t), intent(in) :: hm type(grid_t), intent(in) :: gr type(distributed_t), intent(in) :: kpt !< k-point distribution @@ -1949,7 +2305,7 @@ contains #include "complex.F90" #include "hamiltonian_elec_inc.F90" -end module hamiltonian_elec_oct_m +end submodule impl !! Local Variables: !! mode: f90 diff --git a/src/hamiltonian/hamiltonian_elec_inc.F90 b/src/hamiltonian/hamiltonian_elec_inc.F90 index 898297ed27..a71db78c8c 100644 --- a/src/hamiltonian/hamiltonian_elec_inc.F90 +++ b/src/hamiltonian/hamiltonian_elec_inc.F90 @@ -17,7 +17,7 @@ !! ! --------------------------------------------------------- -subroutine X(hamiltonian_elec_apply) (hm, namespace, mesh, psib, hpsib, terms, set_bc) +module subroutine X(hamiltonian_elec_apply) (hm, namespace, mesh, psib, hpsib, terms, set_bc) class(hamiltonian_elec_t), intent(in) :: hm type(namespace_t), intent(in) :: namespace class(mesh_t), intent(in) :: mesh @@ -46,7 +46,7 @@ subroutine X(hamiltonian_elec_apply) (hm, namespace, mesh, psib, hpsib, terms, s end subroutine X(hamiltonian_elec_apply) ! --------------------------------------------------------- -subroutine X(hamiltonian_elec_magnus_apply) (hm, namespace, mesh, psib, hpsib, vmagnus) +module subroutine X(hamiltonian_elec_magnus_apply) (hm, namespace, mesh, psib, hpsib, vmagnus) class(hamiltonian_elec_t), intent(in) :: hm type(namespace_t), intent(in) :: namespace class(mesh_t), intent(in) :: mesh @@ -74,7 +74,7 @@ subroutine X(hamiltonian_elec_magnus_apply) (hm, namespace, mesh, psib, hpsib, v end subroutine X(hamiltonian_elec_magnus_apply) ! --------------------------------------------------------- -subroutine X(hamiltonian_elec_apply_batch) (hm, namespace, mesh, psib, hpsib, terms, set_bc) +module subroutine X(hamiltonian_elec_apply_batch) (hm, namespace, mesh, psib, hpsib, terms, set_bc) type(hamiltonian_elec_t), intent(in) :: hm type(namespace_t), intent(in) :: namespace class(mesh_t), intent(in) :: mesh @@ -283,7 +283,7 @@ end subroutine X(hamiltonian_elec_apply_batch) ! --------------------------------------------------------- -subroutine X(hamiltonian_elec_external)(this, mesh, psib, vpsib) +module subroutine X(hamiltonian_elec_external)(this, mesh, psib, vpsib) type(hamiltonian_elec_t), intent(in) :: this class(mesh_t), intent(in) :: mesh type(wfs_elec_t), intent(in) :: psib @@ -332,7 +332,7 @@ end subroutine X(hamiltonian_elec_external) ! --------------------------------------------------------- -subroutine X(hamiltonian_elec_apply_single) (hm, namespace, mesh, psi, hpsi, ist, ik, terms, set_bc, set_phase) +module subroutine X(hamiltonian_elec_apply_single) (hm, namespace, mesh, psi, hpsi, ist, ik, terms, set_bc, set_phase) type(hamiltonian_elec_t), intent(in) :: hm type(namespace_t), intent(in) :: namespace class(mesh_t), intent(in) :: mesh @@ -366,7 +366,7 @@ subroutine X(hamiltonian_elec_apply_single) (hm, namespace, mesh, psi, hpsi, ist end subroutine X(hamiltonian_elec_apply_single) -subroutine X(hamiltonian_elec_magnus_apply_batch) (hm, namespace, mesh, psib, hpsib, vmagnus) +module subroutine X(hamiltonian_elec_magnus_apply_batch) (hm, namespace, mesh, psib, hpsib, vmagnus) type(hamiltonian_elec_t), intent(in) :: hm type(namespace_t), intent(in) :: namespace class(mesh_t), intent(in) :: mesh @@ -418,7 +418,7 @@ subroutine X(hamiltonian_elec_magnus_apply_batch) (hm, namespace, mesh, psib, hp end subroutine X(hamiltonian_elec_magnus_apply_batch) ! --------------------------------------------------------- -subroutine X(h_mgga_terms) (hm, mesh, psib, hpsib, ghost_update) +module subroutine X(h_mgga_terms) (hm, mesh, psib, hpsib, ghost_update) type(hamiltonian_elec_t), intent(in) :: hm class(mesh_t), intent(in) :: mesh type(wfs_elec_t), intent(inout) :: psib @@ -482,7 +482,7 @@ end subroutine X(h_mgga_terms) ! --------------------------------------------------------- -subroutine X(vmask) (mesh, hm, st) +module subroutine X(vmask) (mesh, hm, st) class(mesh_t), intent(in) :: mesh type(hamiltonian_elec_t), intent(in) :: hm type(states_elec_t), intent(inout) :: st @@ -513,7 +513,7 @@ end subroutine X(vmask) ! --------------------------------------------------------- -subroutine X(hamiltonian_elec_diagonal) (hm, mesh, diag, ik) +module subroutine X(hamiltonian_elec_diagonal) (hm, mesh, diag, ik) type(hamiltonian_elec_t), intent(in) :: hm class(mesh_t), intent(in) :: mesh R_TYPE, intent(out) :: diag(:,:) !< hpsi(gr%mesh%np, hm%d%dim) -- GitLab From 496d4fa31caa2472f4852b03d8b30cfb1e2babec Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Mon, 15 Jan 2024 10:50:30 +0100 Subject: [PATCH 14/43] [submodule] `hamiltonian_elec_oct_m` (split) Signed-off-by: Cristian Le --- src/Makefile.am | 1 + src/hamiltonian/CMakeLists.txt | 1 + src/hamiltonian/hamiltonian_elec.F90 | 533 ------------------------- src/hamiltonian/hamiltonian_elec_h.F90 | 532 ++++++++++++++++++++++++ 4 files changed, 534 insertions(+), 533 deletions(-) create mode 100644 src/hamiltonian/hamiltonian_elec_h.F90 diff --git a/src/Makefile.am b/src/Makefile.am index d507c9336b..731680a17b 100644 --- a/src/Makefile.am +++ b/src/Makefile.am @@ -470,6 +470,7 @@ hamiltonian_f_srcs = \ hamiltonian/hamiltonian_abst.F90 \ hamiltonian/hamiltonian_elec_base.F90 \ hamiltonian/hamiltonian_elec.F90 \ + hamiltonian/hamiltonian_elec_h.F90 \ hamiltonian/hgh_projector.F90 \ hamiltonian/hirshfeld.F90 \ hamiltonian/ion_interaction.F90 \ diff --git a/src/hamiltonian/CMakeLists.txt b/src/hamiltonian/CMakeLists.txt index 803f9218f5..eba12392e2 100644 --- a/src/hamiltonian/CMakeLists.txt +++ b/src/hamiltonian/CMakeLists.txt @@ -9,6 +9,7 @@ target_sources(Octopus_lib PRIVATE hamiltonian_abst.F90 hamiltonian_elec.F90 hamiltonian_elec_base.F90 + hamiltonian_elec_h.F90 hgh_projector.F90 hirshfeld.F90 ion_interaction.F90 diff --git a/src/hamiltonian/hamiltonian_elec.F90 b/src/hamiltonian/hamiltonian_elec.F90 index e385434e59..ff9d6c813f 100644 --- a/src/hamiltonian/hamiltonian_elec.F90 +++ b/src/hamiltonian/hamiltonian_elec.F90 @@ -19,539 +19,6 @@ #include "global.h" -module hamiltonian_elec_oct_m - use absorbing_boundaries_oct_m - use batch_oct_m - use derivatives_oct_m - use distributed_oct_m - use electron_space_oct_m - use energy_oct_m - use epot_oct_m - use exchange_operator_oct_m - use global_oct_m - use grid_oct_m - use hamiltonian_abst_oct_m - use hamiltonian_elec_base_oct_m - use interaction_partner_oct_m - use ion_electron_local_potential_oct_m - use ions_oct_m - use kick_oct_m - use kpoints_oct_m - use lattice_vectors_oct_m - use lda_u_oct_m - use magnetic_constrain_oct_m - use mesh_oct_m - use multicomm_oct_m - use mxll_elec_coupling_oct_m - use namespace_oct_m - use nlcc_oct_m - use nonlocal_pseudopotential_oct_m - use oct_exchange_oct_m - use pcm_oct_m - use phase_oct_m - use poisson_oct_m - use restart_oct_m - use scissor_oct_m - use space_oct_m - use species_oct_m - use states_elec_dim_oct_m - use states_elec_oct_m - use wfs_elec_oct_m - use xc_oct_m - use xc_photons_oct_m - use zora_oct_m - - implicit none - - private - public :: & - hamiltonian_elec_t, & - hamiltonian_elec_init, & - hamiltonian_elec_end, & - dhamiltonian_elec_apply_single, & - zhamiltonian_elec_apply_single, & - zhamiltonian_elec_apply_all, & - dhamiltonian_elec_apply_batch, & - zhamiltonian_elec_apply_batch, & - dhamiltonian_elec_diagonal, & - zhamiltonian_elec_diagonal, & - magnus, & - dvmask, & - zvmask, & - hamiltonian_elec_inh_term, & - hamiltonian_elec_set_inh, & - hamiltonian_elec_remove_inh, & - hamiltonian_elec_adjoint, & - hamiltonian_elec_not_adjoint, & - hamiltonian_elec_epot_generate, & - hamiltonian_elec_needs_current, & - hamiltonian_elec_update_pot, & - hamiltonian_elec_update_with_ext_pot, & - hamiltonian_elec_get_time, & - hamiltonian_elec_apply_packed, & - zhamiltonian_elec_apply_atom, & - hamiltonian_elec_dump_vhxc, & - hamiltonian_elec_load_vhxc, & - hamiltonian_elec_set_vhxc, & - hamiltonian_elec_has_kick, & - hamiltonian_elec_copy_and_set_phase - - - type, extends(hamiltonian_abst_t) :: hamiltonian_elec_t - ! Components are public by default - - !> The Hamiltonian must know what are the "dimensions" of the spaces, - !! in order to be able to operate on the states. - type(space_t), private :: space - type(states_elec_dim_t) :: d - type(hamiltonian_elec_base_t) :: hm_base - type(phase_t) :: phase - type(energy_t), allocatable :: energy - type(absorbing_boundaries_t) :: abs_boundaries !< absorbing boundaries - real(real64), allocatable :: vhartree(:) !< Hartree potential - real(real64), allocatable :: vxc(:,:) !< XC potential - real(real64), allocatable :: vhxc(:,:) !< XC potential + Hartree potential + Berry potential - real(real64), allocatable :: vtau(:,:) !< Derivative of e_XC w.r.t. tau - real(real64), allocatable :: vberry(:,:) !< Berry phase potential from external e_field - - type(derivatives_t), pointer, private :: der !< pointer to derivatives - - type(nonlocal_pseudopotential_t) :: vnl !< Nonlocal part of the pseudopotential - - type(ions_t), pointer :: ions - real(real64) :: exx_coef !< how much of EXX to mix - - type(poisson_t) :: psolver !< Poisson solver - - !> The self-induced vector potential and magnetic field - logical :: self_induced_magnetic - real(real64), allocatable :: a_ind(:, :) - real(real64), allocatable :: b_ind(:, :) - - integer :: theory_level !< copied from sys%ks - type(xc_t), pointer :: xc !< pointer to xc object - type(xc_photons_t), pointer :: xc_photons !< pointer to the xc_photons object - - type(epot_t) :: ep !< handles the external potential - type(pcm_t) :: pcm !< handles pcm variables - - !> absorbing boundaries - logical, private :: adjoint - - !> Mass of the particle (in most cases, mass = 1, electron mass) - real(real64), private :: mass - - !> There may be an "inhomogeneous", "source", or "forcing" term (useful for the OCT formalism) - logical, private :: inh_term - type(states_elec_t) :: inh_st - - !> There may also be a exchange-like term, similar to the one necessary for time-dependent - !! Hartree Fock, also useful only for the OCT equations - type(oct_exchange_t) :: oct_exchange - - type(scissor_t) :: scissor - - real(real64) :: current_time - logical, private :: is_applied_packed !< This is initialized by the StatesPack variable. - - !> For the DFT+U - type(lda_u_t) :: lda_u - integer :: lda_u_level - - logical, public :: time_zero - - type(exchange_operator_t), public :: exxop - - type(kpoints_t), pointer, public :: kpoints => null() - - type(partner_list_t) :: external_potentials !< List with all the external potentials - real(real64), allocatable, public :: v_ext_pot(:) !< the potential comming from external potentials - real(real64), allocatable, public :: v_static(:) !< static scalar potential - - type(ion_electron_local_potential_t) :: v_ie_loc !< Ion-electron local potential interaction - type(nlcc_t) :: nlcc !< Ion-electron NLCC interaction - - type(magnetic_constrain_t) :: magnetic_constrain - - !> The possible kick - type(kick_t) :: kick - - !> Maxwell-electrons coupling information - type(mxll_coupling_t) :: mxll - type(zora_t), pointer :: zora - - contains - procedure :: update => hamiltonian_elec_update - procedure :: apply_packed => hamiltonian_elec_apply_packed - procedure :: update_span => hamiltonian_elec_span - procedure :: dapply => dhamiltonian_elec_apply - procedure :: zapply => zhamiltonian_elec_apply - procedure :: dmagnus_apply => dhamiltonian_elec_magnus_apply - procedure :: zmagnus_apply => zhamiltonian_elec_magnus_apply - procedure :: is_hermitian => hamiltonian_elec_hermitian - procedure :: set_mass => hamiltonian_elec_set_mass - end type hamiltonian_elec_t - - integer, public, parameter :: & - LENGTH = 1, & - VELOCITY = 2 - - integer, public, parameter :: & - INDEPENDENT_PARTICLES = 2, & - HARTREE = 1, & - HARTREE_FOCK = 3, & - KOHN_SHAM_DFT = 4, & - GENERALIZED_KOHN_SHAM_DFT = 5, & - RDMFT = 7 - - interface - module subroutine hamiltonian_elec_init(hm, namespace, space, gr, ions, ext_partners, st, theory_level, xc, & - mc, kpoints, need_exchange, xc_photons) - type(hamiltonian_elec_t), target, intent(inout) :: hm - type(namespace_t), intent(in) :: namespace - class(space_t), intent(in) :: space - type(grid_t), target, intent(inout) :: gr - type(ions_t), target, intent(inout) :: ions - type(partner_list_t), intent(inout) :: ext_partners - type(states_elec_t), target, intent(inout) :: st - integer, intent(in) :: theory_level - type(xc_t), target, intent(in) :: xc - type(multicomm_t), intent(in) :: mc - type(kpoints_t), target, intent(in) :: kpoints - logical, optional, intent(in) :: need_exchange - type(xc_photons_t), optional, target, intent(in) :: xc_photons - end subroutine hamiltonian_elec_init - - module subroutine hamiltonian_elec_end(hm) - type(hamiltonian_elec_t), target, intent(inout) :: hm - end subroutine hamiltonian_elec_end - - module function hamiltonian_elec_hermitian(hm) result(res) - class(hamiltonian_elec_t), intent(in) :: hm - logical :: res - end function hamiltonian_elec_hermitian - - module subroutine hamiltonian_elec_span(hm, delta, emin, namespace) - class(hamiltonian_elec_t), intent(inout) :: hm - real(real64), intent(in) :: delta(:) - real(real64), intent(in) :: emin - type(namespace_t), intent(in) :: namespace - end subroutine hamiltonian_elec_span - - pure module function hamiltonian_elec_inh_term(hm) result(inh) - type(hamiltonian_elec_t), intent(in) :: hm - logical :: inh - end function hamiltonian_elec_inh_term - - module subroutine hamiltonian_elec_set_inh(hm, st) - type(hamiltonian_elec_t), intent(inout) :: hm - type(states_elec_t), intent(in) :: st - end subroutine hamiltonian_elec_set_inh - - module subroutine hamiltonian_elec_remove_inh(hm) - type(hamiltonian_elec_t), intent(inout) :: hm - end subroutine hamiltonian_elec_remove_inh - - module subroutine hamiltonian_elec_adjoint(hm) - type(hamiltonian_elec_t), intent(inout) :: hm - end subroutine hamiltonian_elec_adjoint - - module subroutine hamiltonian_elec_not_adjoint(hm) - type(hamiltonian_elec_t), intent(inout) :: hm - end subroutine hamiltonian_elec_not_adjoint - - module subroutine hamiltonian_elec_update(this, mesh, namespace, space, ext_partners, time) - class(hamiltonian_elec_t), intent(inout) :: this - class(mesh_t), intent(in) :: mesh - type(namespace_t), intent(in) :: namespace - class(space_t), intent(in) :: space - type(partner_list_t), intent(in) :: ext_partners - real(real64), optional, intent(in) :: time - end subroutine hamiltonian_elec_update - - module subroutine hamiltonian_elec_update_pot(this, mesh, accumulate) - type(hamiltonian_elec_t), intent(inout) :: this - class(mesh_t), intent(in) :: mesh - logical, optional, intent(in) :: accumulate - end subroutine hamiltonian_elec_update_pot - - module subroutine hamiltonian_elec_epot_generate(this, namespace, space, gr, ions, ext_partners, st, time) - type(hamiltonian_elec_t), intent(inout) :: this - type(namespace_t), intent(in) :: namespace - class(electron_space_t), intent(in) :: space - type(grid_t), intent(in) :: gr - type(ions_t), target, intent(inout) :: ions - type(partner_list_t), intent(in) :: ext_partners - type(states_elec_t), intent(inout) :: st - real(real64), optional, intent(in) :: time - end subroutine hamiltonian_elec_epot_generate - - module function hamiltonian_elec_get_time(this) result(time) - type(hamiltonian_elec_t), intent(inout) :: this - real(real64) :: time - end function hamiltonian_elec_get_time - - pure module function hamiltonian_elec_apply_packed(this) result(apply) - class(hamiltonian_elec_t), intent(in) :: this - logical :: apply - end function hamiltonian_elec_apply_packed - - module subroutine zhamiltonian_elec_apply_atom (hm, namespace, space, latt, species, pos, ia, mesh, psi, vpsi) - type(hamiltonian_elec_t), intent(in) :: hm - type(namespace_t), intent(in) :: namespace - class(space_t), intent(in) :: space - type(lattice_vectors_t), intent(in) :: latt - class(species_t), intent(in) :: species - real(real64), intent(in) :: pos(1:space%dim) - integer, intent(in) :: ia - class(mesh_t), intent(in) :: mesh - complex(real64), intent(in) :: psi(:,:) !< (gr%np_part, hm%d%dim) - complex(real64), intent(out) :: vpsi(:,:) !< (gr%np, hm%d%dim) - end subroutine zhamiltonian_elec_apply_atom - - module subroutine hamiltonian_elec_dump_vhxc(restart, hm, space, mesh, ierr) - type(restart_t), intent(in) :: restart - type(hamiltonian_elec_t), intent(in) :: hm - class(space_t), intent(in) :: space - class(mesh_t), intent(in) :: mesh - integer, intent(out) :: ierr - end subroutine hamiltonian_elec_dump_vhxc - - module subroutine hamiltonian_elec_load_vhxc(restart, hm, space, mesh, ierr) - type(restart_t), intent(in) :: restart - type(hamiltonian_elec_t), intent(inout) :: hm - class(space_t), intent(in) :: space - class(mesh_t), intent(in) :: mesh - integer, intent(out) :: ierr - end subroutine hamiltonian_elec_load_vhxc - - module subroutine hamiltonian_elec_update_with_ext_pot(this, mesh, space, ext_partners, time, mu) - type(hamiltonian_elec_t), intent(inout) :: this - class(space_t), intent(in) :: space - class(mesh_t), intent(in) :: mesh - type(partner_list_t), intent(in) :: ext_partners - real(real64), intent(in) :: time(1:2) - real(real64), intent(in) :: mu(1:2) - end subroutine hamiltonian_elec_update_with_ext_pot - - module subroutine hamiltonian_elec_set_vhxc(hm, mesh, vold, vold_tau) - type(hamiltonian_elec_t), intent(inout) :: hm - class(mesh_t), intent(in) :: mesh - real(real64), intent(in) :: vold(:, :) - real(real64), optional, intent(in) :: vold_tau(:, :) - end subroutine hamiltonian_elec_set_vhxc - - module function hamiltonian_elec_needs_current(hm, states_are_real) result(res) - type(hamiltonian_elec_t), intent(in) :: hm - logical, intent(in) :: states_are_real - logical :: res - end function hamiltonian_elec_needs_current - - module subroutine zhamiltonian_elec_apply_all(hm, namespace, mesh, st, hst) - type(hamiltonian_elec_t), intent(inout) :: hm - type(namespace_t), intent(in) :: namespace - class(mesh_t), intent(in) :: mesh - type(states_elec_t), intent(inout) :: st - type(states_elec_t), intent(inout) :: hst - end subroutine zhamiltonian_elec_apply_all - - module subroutine magnus(hm, namespace, mesh, psi, hpsi, ik, vmagnus, set_phase) - type(hamiltonian_elec_t), intent(in) :: hm - type(namespace_t), intent(in) :: namespace - class(mesh_t), intent(in) :: mesh - complex(real64), intent(inout) :: psi(:,:) - complex(real64), intent(out) :: hpsi(:,:) - integer, intent(in) :: ik - real(real64), intent(in) :: vmagnus(:, :, :) - logical, optional, intent(in) :: set_phase - end subroutine magnus - - module subroutine vborders (mesh, hm, psi, hpsi) - class(mesh_t), intent(in) :: mesh - type(hamiltonian_elec_t), intent(in) :: hm - complex(real64), intent(in) :: psi(:) - complex(real64), intent(inout) :: hpsi(:) - end subroutine vborders - - module function hamiltonian_elec_has_kick(hm) result(res) - type(hamiltonian_elec_t), intent(in) :: hm - logical :: res - end function hamiltonian_elec_has_kick - - module subroutine dhamiltonian_elec_apply(hm, namespace, mesh, psib, hpsib, terms, set_bc) - class(hamiltonian_elec_t), intent(in) :: hm - type(namespace_t), intent(in) :: namespace - class(mesh_t), intent(in) :: mesh - class(batch_t), target, intent(inout) :: psib - class(batch_t), target, intent(inout) :: hpsib - integer, optional, intent(in) :: terms - logical, optional, intent(in) :: set_bc - end subroutine dhamiltonian_elec_apply - - module subroutine dhamiltonian_elec_magnus_apply(hm, namespace, mesh, psib, hpsib, vmagnus) - class(hamiltonian_elec_t), intent(in) :: hm - type(namespace_t), intent(in) :: namespace - class(mesh_t), intent(in) :: mesh - class(batch_t), intent(inout) :: psib - class(batch_t), intent(inout) :: hpsib - real(real64), intent(in) :: vmagnus(:, :, :) - end subroutine dhamiltonian_elec_magnus_apply - - module subroutine dhamiltonian_elec_apply_batch(hm, namespace, mesh, psib, hpsib, terms, set_bc) - type(hamiltonian_elec_t), intent(in) :: hm - type(namespace_t), intent(in) :: namespace - class(mesh_t), intent(in) :: mesh - type(wfs_elec_t), target, intent(inout) :: psib - type(wfs_elec_t), target, intent(inout) :: hpsib - integer, optional, intent(in) :: terms - logical, optional, intent(in) :: set_bc - end subroutine dhamiltonian_elec_apply_batch - - module subroutine dhamiltonian_elec_external(this, mesh, psib, vpsib) - type(hamiltonian_elec_t), intent(in) :: this - class(mesh_t), intent(in) :: mesh - type(wfs_elec_t), intent(in) :: psib - type(wfs_elec_t), intent(inout) :: vpsib - end subroutine dhamiltonian_elec_external - - module subroutine dhamiltonian_elec_apply_single(hm, namespace, mesh, psi, hpsi, ist, ik, terms, set_bc, set_phase) - type(hamiltonian_elec_t), intent(in) :: hm - type(namespace_t), intent(in) :: namespace - class(mesh_t), intent(in) :: mesh - integer, intent(in) :: ist - integer, intent(in) :: ik - real(real64), contiguous, target, intent(inout) :: psi(:,:) - real(real64), contiguous, target, intent(inout) :: hpsi(:,:) - integer, optional, intent(in) :: terms - logical, optional, intent(in) :: set_bc - logical, optional, intent(in) :: set_phase - end subroutine dhamiltonian_elec_apply_single - - module subroutine dhamiltonian_elec_magnus_apply_batch(hm, namespace, mesh, psib, hpsib, vmagnus) - type(hamiltonian_elec_t), intent(in) :: hm - type(namespace_t), intent(in) :: namespace - class(mesh_t), intent(in) :: mesh - type(wfs_elec_t), intent(inout) :: psib - type(wfs_elec_t), intent(inout) :: hpsib - real(real64), intent(in) :: vmagnus(:, :, :) - end subroutine dhamiltonian_elec_magnus_apply_batch - - module subroutine dh_mgga_terms(hm, mesh, psib, hpsib, ghost_update) - type(hamiltonian_elec_t), intent(in) :: hm - class(mesh_t), intent(in) :: mesh - type(wfs_elec_t), intent(inout) :: psib - type(wfs_elec_t), intent(inout) :: hpsib - logical, intent(in) :: ghost_update - end subroutine dh_mgga_terms - - module subroutine dvmask(mesh, hm, st) - class(mesh_t), intent(in) :: mesh - type(hamiltonian_elec_t), intent(in) :: hm - type(states_elec_t), intent(inout) :: st - end subroutine dvmask - - module subroutine dhamiltonian_elec_diagonal(hm, mesh, diag, ik) - type(hamiltonian_elec_t), intent(in) :: hm - class(mesh_t), intent(in) :: mesh - real(real64), intent(out) :: diag(:,:) - integer, intent(in) :: ik - end subroutine dhamiltonian_elec_diagonal - - module subroutine zhamiltonian_elec_apply(hm, namespace, mesh, psib, hpsib, terms, set_bc) - class(hamiltonian_elec_t), intent(in) :: hm - type(namespace_t), intent(in) :: namespace - class(mesh_t), intent(in) :: mesh - class(batch_t), target, intent(inout) :: psib - class(batch_t), target, intent(inout) :: hpsib - integer, optional, intent(in) :: terms - logical, optional, intent(in) :: set_bc - end subroutine zhamiltonian_elec_apply - - module subroutine zhamiltonian_elec_magnus_apply(hm, namespace, mesh, psib, hpsib, vmagnus) - class(hamiltonian_elec_t), intent(in) :: hm - type(namespace_t), intent(in) :: namespace - class(mesh_t), intent(in) :: mesh - class(batch_t), intent(inout) :: psib - class(batch_t), intent(inout) :: hpsib - real(real64), intent(in) :: vmagnus(:, :, :) - end subroutine zhamiltonian_elec_magnus_apply - - module subroutine zhamiltonian_elec_apply_batch(hm, namespace, mesh, psib, hpsib, terms, set_bc) - type(hamiltonian_elec_t), intent(in) :: hm - type(namespace_t), intent(in) :: namespace - class(mesh_t), intent(in) :: mesh - type(wfs_elec_t), target, intent(inout) :: psib - type(wfs_elec_t), target, intent(inout) :: hpsib - integer, optional, intent(in) :: terms - logical, optional, intent(in) :: set_bc - end subroutine zhamiltonian_elec_apply_batch - - module subroutine zhamiltonian_elec_external(this, mesh, psib, vpsib) - type(hamiltonian_elec_t), intent(in) :: this - class(mesh_t), intent(in) :: mesh - type(wfs_elec_t), intent(in) :: psib - type(wfs_elec_t), intent(inout) :: vpsib - end subroutine zhamiltonian_elec_external - - module subroutine zhamiltonian_elec_apply_single(hm, namespace, mesh, psi, hpsi, ist, ik, terms, set_bc, set_phase) - type(hamiltonian_elec_t), intent(in) :: hm - type(namespace_t), intent(in) :: namespace - class(mesh_t), intent(in) :: mesh - integer, intent(in) :: ist - integer, intent(in) :: ik - complex(real64), contiguous, target, intent(inout) :: psi(:,:) - complex(real64), contiguous, target, intent(inout) :: hpsi(:,:) - integer, optional, intent(in) :: terms - logical, optional, intent(in) :: set_bc - logical, optional, intent(in) :: set_phase - end subroutine zhamiltonian_elec_apply_single - - module subroutine zhamiltonian_elec_magnus_apply_batch(hm, namespace, mesh, psib, hpsib, vmagnus) - type(hamiltonian_elec_t), intent(in) :: hm - type(namespace_t), intent(in) :: namespace - class(mesh_t), intent(in) :: mesh - type(wfs_elec_t), intent(inout) :: psib - type(wfs_elec_t), intent(inout) :: hpsib - real(real64), intent(in) :: vmagnus(:, :, :) - end subroutine zhamiltonian_elec_magnus_apply_batch - - module subroutine zh_mgga_terms(hm, mesh, psib, hpsib, ghost_update) - type(hamiltonian_elec_t), intent(in) :: hm - class(mesh_t), intent(in) :: mesh - type(wfs_elec_t), intent(inout) :: psib - type(wfs_elec_t), intent(inout) :: hpsib - logical, intent(in) :: ghost_update - end subroutine zh_mgga_terms - - module subroutine zvmask(mesh, hm, st) - class(mesh_t), intent(in) :: mesh - type(hamiltonian_elec_t), intent(in) :: hm - type(states_elec_t), intent(inout) :: st - end subroutine zvmask - - module subroutine zhamiltonian_elec_diagonal(hm, mesh, diag, ik) - type(hamiltonian_elec_t), intent(in) :: hm - class(mesh_t), intent(in) :: mesh - complex(real64), intent(out) :: diag(:,:) - integer, intent(in) :: ik - end subroutine zhamiltonian_elec_diagonal - - module subroutine hamiltonian_elec_set_mass(this, namespace, mass) - class(hamiltonian_elec_t) , intent(inout) :: this - type(namespace_t), intent(in) :: namespace - real(real64), intent(in) :: mass - end subroutine hamiltonian_elec_set_mass - - module subroutine hamiltonian_elec_copy_and_set_phase(hm, gr, kpt, psib, psib_with_phase) - type(hamiltonian_elec_t), intent(in) :: hm - type(grid_t), intent(in) :: gr - type(distributed_t), intent(in) :: kpt !< k-point distribution - type(wfs_elec_t), intent(in) :: psib !< Batched wave functions - type(wfs_elec_t), intent(out) :: psib_with_phase !< Batched wave functions with phase applied - end subroutine hamiltonian_elec_copy_and_set_phase - end interface -end module hamiltonian_elec_oct_m - submodule (hamiltonian_elec_oct_m) impl use accel_oct_m use affine_coordinates_oct_m diff --git a/src/hamiltonian/hamiltonian_elec_h.F90 b/src/hamiltonian/hamiltonian_elec_h.F90 new file mode 100644 index 0000000000..bf15740e4f --- /dev/null +++ b/src/hamiltonian/hamiltonian_elec_h.F90 @@ -0,0 +1,532 @@ +module hamiltonian_elec_oct_m + use absorbing_boundaries_oct_m + use batch_oct_m + use derivatives_oct_m + use distributed_oct_m + use electron_space_oct_m + use energy_oct_m + use epot_oct_m + use exchange_operator_oct_m + use global_oct_m + use grid_oct_m + use hamiltonian_abst_oct_m + use hamiltonian_elec_base_oct_m + use interaction_partner_oct_m + use ion_electron_local_potential_oct_m + use ions_oct_m + use kick_oct_m + use kpoints_oct_m + use lattice_vectors_oct_m + use lda_u_oct_m + use magnetic_constrain_oct_m + use mesh_oct_m + use multicomm_oct_m + use mxll_elec_coupling_oct_m + use namespace_oct_m + use nlcc_oct_m + use nonlocal_pseudopotential_oct_m + use oct_exchange_oct_m + use pcm_oct_m + use phase_oct_m + use poisson_oct_m + use restart_oct_m + use scissor_oct_m + use space_oct_m + use species_oct_m + use states_elec_dim_oct_m + use states_elec_oct_m + use wfs_elec_oct_m + use xc_oct_m + use xc_photons_oct_m + use zora_oct_m + + implicit none + + private + public :: & + hamiltonian_elec_t, & + hamiltonian_elec_init, & + hamiltonian_elec_end, & + dhamiltonian_elec_apply_single, & + zhamiltonian_elec_apply_single, & + zhamiltonian_elec_apply_all, & + dhamiltonian_elec_apply_batch, & + zhamiltonian_elec_apply_batch, & + dhamiltonian_elec_diagonal, & + zhamiltonian_elec_diagonal, & + magnus, & + dvmask, & + zvmask, & + hamiltonian_elec_inh_term, & + hamiltonian_elec_set_inh, & + hamiltonian_elec_remove_inh, & + hamiltonian_elec_adjoint, & + hamiltonian_elec_not_adjoint, & + hamiltonian_elec_epot_generate, & + hamiltonian_elec_needs_current, & + hamiltonian_elec_update_pot, & + hamiltonian_elec_update_with_ext_pot, & + hamiltonian_elec_get_time, & + hamiltonian_elec_apply_packed, & + zhamiltonian_elec_apply_atom, & + hamiltonian_elec_dump_vhxc, & + hamiltonian_elec_load_vhxc, & + hamiltonian_elec_set_vhxc, & + hamiltonian_elec_has_kick, & + hamiltonian_elec_copy_and_set_phase + + + type, extends(hamiltonian_abst_t) :: hamiltonian_elec_t + ! Components are public by default + + !> The Hamiltonian must know what are the "dimensions" of the spaces, + !! in order to be able to operate on the states. + type(space_t), private :: space + type(states_elec_dim_t) :: d + type(hamiltonian_elec_base_t) :: hm_base + type(phase_t) :: phase + type(energy_t), allocatable :: energy + type(absorbing_boundaries_t) :: abs_boundaries !< absorbing boundaries + real(real64), allocatable :: vhartree(:) !< Hartree potential + real(real64), allocatable :: vxc(:,:) !< XC potential + real(real64), allocatable :: vhxc(:,:) !< XC potential + Hartree potential + Berry potential + real(real64), allocatable :: vtau(:,:) !< Derivative of e_XC w.r.t. tau + real(real64), allocatable :: vberry(:,:) !< Berry phase potential from external e_field + + type(derivatives_t), pointer, private :: der !< pointer to derivatives + + type(nonlocal_pseudopotential_t) :: vnl !< Nonlocal part of the pseudopotential + + type(ions_t), pointer :: ions + real(real64) :: exx_coef !< how much of EXX to mix + + type(poisson_t) :: psolver !< Poisson solver + + !> The self-induced vector potential and magnetic field + logical :: self_induced_magnetic + real(real64), allocatable :: a_ind(:, :) + real(real64), allocatable :: b_ind(:, :) + + integer :: theory_level !< copied from sys%ks + type(xc_t), pointer :: xc !< pointer to xc object + type(xc_photons_t), pointer :: xc_photons !< pointer to the xc_photons object + + type(epot_t) :: ep !< handles the external potential + type(pcm_t) :: pcm !< handles pcm variables + + !> absorbing boundaries + logical, private :: adjoint + + !> Mass of the particle (in most cases, mass = 1, electron mass) + real(real64), private :: mass + + !> There may be an "inhomogeneous", "source", or "forcing" term (useful for the OCT formalism) + logical, private :: inh_term + type(states_elec_t) :: inh_st + + !> There may also be a exchange-like term, similar to the one necessary for time-dependent + !! Hartree Fock, also useful only for the OCT equations + type(oct_exchange_t) :: oct_exchange + + type(scissor_t) :: scissor + + real(real64) :: current_time + logical, private :: is_applied_packed !< This is initialized by the StatesPack variable. + + !> For the DFT+U + type(lda_u_t) :: lda_u + integer :: lda_u_level + + logical, public :: time_zero + + type(exchange_operator_t), public :: exxop + + type(kpoints_t), pointer, public :: kpoints => null() + + type(partner_list_t) :: external_potentials !< List with all the external potentials + real(real64), allocatable, public :: v_ext_pot(:) !< the potential comming from external potentials + real(real64), allocatable, public :: v_static(:) !< static scalar potential + + type(ion_electron_local_potential_t) :: v_ie_loc !< Ion-electron local potential interaction + type(nlcc_t) :: nlcc !< Ion-electron NLCC interaction + + type(magnetic_constrain_t) :: magnetic_constrain + + !> The possible kick + type(kick_t) :: kick + + !> Maxwell-electrons coupling information + type(mxll_coupling_t) :: mxll + type(zora_t), pointer :: zora + + contains + procedure :: update => hamiltonian_elec_update + procedure :: apply_packed => hamiltonian_elec_apply_packed + procedure :: update_span => hamiltonian_elec_span + procedure :: dapply => dhamiltonian_elec_apply + procedure :: zapply => zhamiltonian_elec_apply + procedure :: dmagnus_apply => dhamiltonian_elec_magnus_apply + procedure :: zmagnus_apply => zhamiltonian_elec_magnus_apply + procedure :: is_hermitian => hamiltonian_elec_hermitian + procedure :: set_mass => hamiltonian_elec_set_mass + end type hamiltonian_elec_t + + integer, public, parameter :: & + LENGTH = 1, & + VELOCITY = 2 + + integer, public, parameter :: & + INDEPENDENT_PARTICLES = 2, & + HARTREE = 1, & + HARTREE_FOCK = 3, & + KOHN_SHAM_DFT = 4, & + GENERALIZED_KOHN_SHAM_DFT = 5, & + RDMFT = 7 + + interface + module subroutine hamiltonian_elec_init(hm, namespace, space, gr, ions, ext_partners, st, theory_level, xc, & + mc, kpoints, need_exchange, xc_photons) + type(hamiltonian_elec_t), target, intent(inout) :: hm + type(namespace_t), intent(in) :: namespace + class(space_t), intent(in) :: space + type(grid_t), target, intent(inout) :: gr + type(ions_t), target, intent(inout) :: ions + type(partner_list_t), intent(inout) :: ext_partners + type(states_elec_t), target, intent(inout) :: st + integer, intent(in) :: theory_level + type(xc_t), target, intent(in) :: xc + type(multicomm_t), intent(in) :: mc + type(kpoints_t), target, intent(in) :: kpoints + logical, optional, intent(in) :: need_exchange + type(xc_photons_t), optional, target, intent(in) :: xc_photons + end subroutine hamiltonian_elec_init + + module subroutine hamiltonian_elec_end(hm) + type(hamiltonian_elec_t), target, intent(inout) :: hm + end subroutine hamiltonian_elec_end + + module function hamiltonian_elec_hermitian(hm) result(res) + class(hamiltonian_elec_t), intent(in) :: hm + logical :: res + end function hamiltonian_elec_hermitian + + module subroutine hamiltonian_elec_span(hm, delta, emin, namespace) + class(hamiltonian_elec_t), intent(inout) :: hm + real(real64), intent(in) :: delta(:) + real(real64), intent(in) :: emin + type(namespace_t), intent(in) :: namespace + end subroutine hamiltonian_elec_span + + pure module function hamiltonian_elec_inh_term(hm) result(inh) + type(hamiltonian_elec_t), intent(in) :: hm + logical :: inh + end function hamiltonian_elec_inh_term + + module subroutine hamiltonian_elec_set_inh(hm, st) + type(hamiltonian_elec_t), intent(inout) :: hm + type(states_elec_t), intent(in) :: st + end subroutine hamiltonian_elec_set_inh + + module subroutine hamiltonian_elec_remove_inh(hm) + type(hamiltonian_elec_t), intent(inout) :: hm + end subroutine hamiltonian_elec_remove_inh + + module subroutine hamiltonian_elec_adjoint(hm) + type(hamiltonian_elec_t), intent(inout) :: hm + end subroutine hamiltonian_elec_adjoint + + module subroutine hamiltonian_elec_not_adjoint(hm) + type(hamiltonian_elec_t), intent(inout) :: hm + end subroutine hamiltonian_elec_not_adjoint + + module subroutine hamiltonian_elec_update(this, mesh, namespace, space, ext_partners, time) + class(hamiltonian_elec_t), intent(inout) :: this + class(mesh_t), intent(in) :: mesh + type(namespace_t), intent(in) :: namespace + class(space_t), intent(in) :: space + type(partner_list_t), intent(in) :: ext_partners + real(real64), optional, intent(in) :: time + end subroutine hamiltonian_elec_update + + module subroutine hamiltonian_elec_update_pot(this, mesh, accumulate) + type(hamiltonian_elec_t), intent(inout) :: this + class(mesh_t), intent(in) :: mesh + logical, optional, intent(in) :: accumulate + end subroutine hamiltonian_elec_update_pot + + module subroutine hamiltonian_elec_epot_generate(this, namespace, space, gr, ions, ext_partners, st, time) + type(hamiltonian_elec_t), intent(inout) :: this + type(namespace_t), intent(in) :: namespace + class(electron_space_t), intent(in) :: space + type(grid_t), intent(in) :: gr + type(ions_t), target, intent(inout) :: ions + type(partner_list_t), intent(in) :: ext_partners + type(states_elec_t), intent(inout) :: st + real(real64), optional, intent(in) :: time + end subroutine hamiltonian_elec_epot_generate + + module function hamiltonian_elec_get_time(this) result(time) + type(hamiltonian_elec_t), intent(inout) :: this + real(real64) :: time + end function hamiltonian_elec_get_time + + pure module function hamiltonian_elec_apply_packed(this) result(apply) + class(hamiltonian_elec_t), intent(in) :: this + logical :: apply + end function hamiltonian_elec_apply_packed + + module subroutine zhamiltonian_elec_apply_atom (hm, namespace, space, latt, species, pos, ia, mesh, psi, vpsi) + type(hamiltonian_elec_t), intent(in) :: hm + type(namespace_t), intent(in) :: namespace + class(space_t), intent(in) :: space + type(lattice_vectors_t), intent(in) :: latt + class(species_t), intent(in) :: species + real(real64), intent(in) :: pos(1:space%dim) + integer, intent(in) :: ia + class(mesh_t), intent(in) :: mesh + complex(real64), intent(in) :: psi(:,:) !< (gr%np_part, hm%d%dim) + complex(real64), intent(out) :: vpsi(:,:) !< (gr%np, hm%d%dim) + end subroutine zhamiltonian_elec_apply_atom + + module subroutine hamiltonian_elec_dump_vhxc(restart, hm, space, mesh, ierr) + type(restart_t), intent(in) :: restart + type(hamiltonian_elec_t), intent(in) :: hm + class(space_t), intent(in) :: space + class(mesh_t), intent(in) :: mesh + integer, intent(out) :: ierr + end subroutine hamiltonian_elec_dump_vhxc + + module subroutine hamiltonian_elec_load_vhxc(restart, hm, space, mesh, ierr) + type(restart_t), intent(in) :: restart + type(hamiltonian_elec_t), intent(inout) :: hm + class(space_t), intent(in) :: space + class(mesh_t), intent(in) :: mesh + integer, intent(out) :: ierr + end subroutine hamiltonian_elec_load_vhxc + + module subroutine hamiltonian_elec_update_with_ext_pot(this, mesh, space, ext_partners, time, mu) + type(hamiltonian_elec_t), intent(inout) :: this + class(space_t), intent(in) :: space + class(mesh_t), intent(in) :: mesh + type(partner_list_t), intent(in) :: ext_partners + real(real64), intent(in) :: time(1:2) + real(real64), intent(in) :: mu(1:2) + end subroutine hamiltonian_elec_update_with_ext_pot + + module subroutine hamiltonian_elec_set_vhxc(hm, mesh, vold, vold_tau) + type(hamiltonian_elec_t), intent(inout) :: hm + class(mesh_t), intent(in) :: mesh + real(real64), intent(in) :: vold(:, :) + real(real64), optional, intent(in) :: vold_tau(:, :) + end subroutine hamiltonian_elec_set_vhxc + + module function hamiltonian_elec_needs_current(hm, states_are_real) result(res) + type(hamiltonian_elec_t), intent(in) :: hm + logical, intent(in) :: states_are_real + logical :: res + end function hamiltonian_elec_needs_current + + module subroutine zhamiltonian_elec_apply_all(hm, namespace, mesh, st, hst) + type(hamiltonian_elec_t), intent(inout) :: hm + type(namespace_t), intent(in) :: namespace + class(mesh_t), intent(in) :: mesh + type(states_elec_t), intent(inout) :: st + type(states_elec_t), intent(inout) :: hst + end subroutine zhamiltonian_elec_apply_all + + module subroutine magnus(hm, namespace, mesh, psi, hpsi, ik, vmagnus, set_phase) + type(hamiltonian_elec_t), intent(in) :: hm + type(namespace_t), intent(in) :: namespace + class(mesh_t), intent(in) :: mesh + complex(real64), intent(inout) :: psi(:,:) + complex(real64), intent(out) :: hpsi(:,:) + integer, intent(in) :: ik + real(real64), intent(in) :: vmagnus(:, :, :) + logical, optional, intent(in) :: set_phase + end subroutine magnus + + module subroutine vborders (mesh, hm, psi, hpsi) + class(mesh_t), intent(in) :: mesh + type(hamiltonian_elec_t), intent(in) :: hm + complex(real64), intent(in) :: psi(:) + complex(real64), intent(inout) :: hpsi(:) + end subroutine vborders + + module function hamiltonian_elec_has_kick(hm) result(res) + type(hamiltonian_elec_t), intent(in) :: hm + logical :: res + end function hamiltonian_elec_has_kick + + module subroutine dhamiltonian_elec_apply(hm, namespace, mesh, psib, hpsib, terms, set_bc) + class(hamiltonian_elec_t), intent(in) :: hm + type(namespace_t), intent(in) :: namespace + class(mesh_t), intent(in) :: mesh + class(batch_t), target, intent(inout) :: psib + class(batch_t), target, intent(inout) :: hpsib + integer, optional, intent(in) :: terms + logical, optional, intent(in) :: set_bc + end subroutine dhamiltonian_elec_apply + + module subroutine dhamiltonian_elec_magnus_apply(hm, namespace, mesh, psib, hpsib, vmagnus) + class(hamiltonian_elec_t), intent(in) :: hm + type(namespace_t), intent(in) :: namespace + class(mesh_t), intent(in) :: mesh + class(batch_t), intent(inout) :: psib + class(batch_t), intent(inout) :: hpsib + real(real64), intent(in) :: vmagnus(:, :, :) + end subroutine dhamiltonian_elec_magnus_apply + + module subroutine dhamiltonian_elec_apply_batch(hm, namespace, mesh, psib, hpsib, terms, set_bc) + type(hamiltonian_elec_t), intent(in) :: hm + type(namespace_t), intent(in) :: namespace + class(mesh_t), intent(in) :: mesh + type(wfs_elec_t), target, intent(inout) :: psib + type(wfs_elec_t), target, intent(inout) :: hpsib + integer, optional, intent(in) :: terms + logical, optional, intent(in) :: set_bc + end subroutine dhamiltonian_elec_apply_batch + + module subroutine dhamiltonian_elec_external(this, mesh, psib, vpsib) + type(hamiltonian_elec_t), intent(in) :: this + class(mesh_t), intent(in) :: mesh + type(wfs_elec_t), intent(in) :: psib + type(wfs_elec_t), intent(inout) :: vpsib + end subroutine dhamiltonian_elec_external + + module subroutine dhamiltonian_elec_apply_single(hm, namespace, mesh, psi, hpsi, ist, ik, terms, set_bc, set_phase) + type(hamiltonian_elec_t), intent(in) :: hm + type(namespace_t), intent(in) :: namespace + class(mesh_t), intent(in) :: mesh + integer, intent(in) :: ist + integer, intent(in) :: ik + real(real64), contiguous, target, intent(inout) :: psi(:,:) + real(real64), contiguous, target, intent(inout) :: hpsi(:,:) + integer, optional, intent(in) :: terms + logical, optional, intent(in) :: set_bc + logical, optional, intent(in) :: set_phase + end subroutine dhamiltonian_elec_apply_single + + module subroutine dhamiltonian_elec_magnus_apply_batch(hm, namespace, mesh, psib, hpsib, vmagnus) + type(hamiltonian_elec_t), intent(in) :: hm + type(namespace_t), intent(in) :: namespace + class(mesh_t), intent(in) :: mesh + type(wfs_elec_t), intent(inout) :: psib + type(wfs_elec_t), intent(inout) :: hpsib + real(real64), intent(in) :: vmagnus(:, :, :) + end subroutine dhamiltonian_elec_magnus_apply_batch + + module subroutine dh_mgga_terms(hm, mesh, psib, hpsib, ghost_update) + type(hamiltonian_elec_t), intent(in) :: hm + class(mesh_t), intent(in) :: mesh + type(wfs_elec_t), intent(inout) :: psib + type(wfs_elec_t), intent(inout) :: hpsib + logical, intent(in) :: ghost_update + end subroutine dh_mgga_terms + + module subroutine dvmask(mesh, hm, st) + class(mesh_t), intent(in) :: mesh + type(hamiltonian_elec_t), intent(in) :: hm + type(states_elec_t), intent(inout) :: st + end subroutine dvmask + + module subroutine dhamiltonian_elec_diagonal(hm, mesh, diag, ik) + type(hamiltonian_elec_t), intent(in) :: hm + class(mesh_t), intent(in) :: mesh + real(real64), intent(out) :: diag(:,:) + integer, intent(in) :: ik + end subroutine dhamiltonian_elec_diagonal + + module subroutine zhamiltonian_elec_apply(hm, namespace, mesh, psib, hpsib, terms, set_bc) + class(hamiltonian_elec_t), intent(in) :: hm + type(namespace_t), intent(in) :: namespace + class(mesh_t), intent(in) :: mesh + class(batch_t), target, intent(inout) :: psib + class(batch_t), target, intent(inout) :: hpsib + integer, optional, intent(in) :: terms + logical, optional, intent(in) :: set_bc + end subroutine zhamiltonian_elec_apply + + module subroutine zhamiltonian_elec_magnus_apply(hm, namespace, mesh, psib, hpsib, vmagnus) + class(hamiltonian_elec_t), intent(in) :: hm + type(namespace_t), intent(in) :: namespace + class(mesh_t), intent(in) :: mesh + class(batch_t), intent(inout) :: psib + class(batch_t), intent(inout) :: hpsib + real(real64), intent(in) :: vmagnus(:, :, :) + end subroutine zhamiltonian_elec_magnus_apply + + module subroutine zhamiltonian_elec_apply_batch(hm, namespace, mesh, psib, hpsib, terms, set_bc) + type(hamiltonian_elec_t), intent(in) :: hm + type(namespace_t), intent(in) :: namespace + class(mesh_t), intent(in) :: mesh + type(wfs_elec_t), target, intent(inout) :: psib + type(wfs_elec_t), target, intent(inout) :: hpsib + integer, optional, intent(in) :: terms + logical, optional, intent(in) :: set_bc + end subroutine zhamiltonian_elec_apply_batch + + module subroutine zhamiltonian_elec_external(this, mesh, psib, vpsib) + type(hamiltonian_elec_t), intent(in) :: this + class(mesh_t), intent(in) :: mesh + type(wfs_elec_t), intent(in) :: psib + type(wfs_elec_t), intent(inout) :: vpsib + end subroutine zhamiltonian_elec_external + + module subroutine zhamiltonian_elec_apply_single(hm, namespace, mesh, psi, hpsi, ist, ik, terms, set_bc, set_phase) + type(hamiltonian_elec_t), intent(in) :: hm + type(namespace_t), intent(in) :: namespace + class(mesh_t), intent(in) :: mesh + integer, intent(in) :: ist + integer, intent(in) :: ik + complex(real64), contiguous, target, intent(inout) :: psi(:,:) + complex(real64), contiguous, target, intent(inout) :: hpsi(:,:) + integer, optional, intent(in) :: terms + logical, optional, intent(in) :: set_bc + logical, optional, intent(in) :: set_phase + end subroutine zhamiltonian_elec_apply_single + + module subroutine zhamiltonian_elec_magnus_apply_batch(hm, namespace, mesh, psib, hpsib, vmagnus) + type(hamiltonian_elec_t), intent(in) :: hm + type(namespace_t), intent(in) :: namespace + class(mesh_t), intent(in) :: mesh + type(wfs_elec_t), intent(inout) :: psib + type(wfs_elec_t), intent(inout) :: hpsib + real(real64), intent(in) :: vmagnus(:, :, :) + end subroutine zhamiltonian_elec_magnus_apply_batch + + module subroutine zh_mgga_terms(hm, mesh, psib, hpsib, ghost_update) + type(hamiltonian_elec_t), intent(in) :: hm + class(mesh_t), intent(in) :: mesh + type(wfs_elec_t), intent(inout) :: psib + type(wfs_elec_t), intent(inout) :: hpsib + logical, intent(in) :: ghost_update + end subroutine zh_mgga_terms + + module subroutine zvmask(mesh, hm, st) + class(mesh_t), intent(in) :: mesh + type(hamiltonian_elec_t), intent(in) :: hm + type(states_elec_t), intent(inout) :: st + end subroutine zvmask + + module subroutine zhamiltonian_elec_diagonal(hm, mesh, diag, ik) + type(hamiltonian_elec_t), intent(in) :: hm + class(mesh_t), intent(in) :: mesh + complex(real64), intent(out) :: diag(:,:) + integer, intent(in) :: ik + end subroutine zhamiltonian_elec_diagonal + + module subroutine hamiltonian_elec_set_mass(this, namespace, mass) + class(hamiltonian_elec_t) , intent(inout) :: this + type(namespace_t), intent(in) :: namespace + real(real64), intent(in) :: mass + end subroutine hamiltonian_elec_set_mass + + module subroutine hamiltonian_elec_copy_and_set_phase(hm, gr, kpt, psib, psib_with_phase) + type(hamiltonian_elec_t), intent(in) :: hm + type(grid_t), intent(in) :: gr + type(distributed_t), intent(in) :: kpt !< k-point distribution + type(wfs_elec_t), intent(in) :: psib !< Batched wave functions + type(wfs_elec_t), intent(out) :: psib_with_phase !< Batched wave functions with phase applied + end subroutine hamiltonian_elec_copy_and_set_phase + end interface +end module hamiltonian_elec_oct_m -- GitLab From b385fe14c381d74b584e87d4272186a209e5959c Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Tue, 20 Jun 2023 16:41:39 +0200 Subject: [PATCH 15/43] [submodule] `hamiltonian_mxll_oct_m` Signed-off-by: Cristian Le --- src/maxwell/hamiltonian_mxll.F90 | 275 ++++++++++++++++++++++++++----- 1 file changed, 233 insertions(+), 42 deletions(-) diff --git a/src/maxwell/hamiltonian_mxll.F90 b/src/maxwell/hamiltonian_mxll.F90 index 599ff2c43b..3e95a1f201 100644 --- a/src/maxwell/hamiltonian_mxll.F90 +++ b/src/maxwell/hamiltonian_mxll.F90 @@ -19,32 +19,19 @@ #include "global.h" module hamiltonian_mxll_oct_m - use accel_oct_m use batch_oct_m - use batch_ops_oct_m - use boundaries_oct_m use cube_oct_m - use debug_oct_m use derivatives_oct_m use energy_mxll_oct_m use global_oct_m use grid_oct_m use hamiltonian_abst_oct_m - use hamiltonian_elec_oct_m - use, intrinsic :: iso_fortran_env use linear_medium_to_em_field_oct_m - use math_oct_m use maxwell_boundary_op_oct_m use mesh_cube_parallel_map_oct_m use mesh_oct_m - use messages_oct_m use namespace_oct_m use nl_operator_oct_m - use parser_oct_m - use poisson_oct_m - use profiling_oct_m - use states_elec_dim_oct_m - use states_elec_oct_m use states_mxll_oct_m implicit none @@ -153,11 +140,212 @@ module hamiltonian_mxll_oct_m FARADAY_AMPERE_MEDIUM = 2, & MXLL_SIMPLE = 3 + interface + module subroutine hamiltonian_mxll_init(hm, namespace, gr, st) + type(hamiltonian_mxll_t), intent(inout) :: hm + type(namespace_t), intent(in) :: namespace + type(grid_t), target, intent(inout) :: gr + type(states_mxll_t), target, intent(inout) :: st + end subroutine hamiltonian_mxll_init + + module subroutine hamiltonian_mxll_end(hm) + type(hamiltonian_mxll_t), intent(inout) :: hm + end subroutine hamiltonian_mxll_end + + module function hamiltonian_mxll_hermitian(hm) result(res) + class(hamiltonian_mxll_t), intent(in) :: hm + logical :: res + end function hamiltonian_mxll_hermitian + + module subroutine hamiltonian_mxll_span(hm, delta, emin, namespace) + class(hamiltonian_mxll_t), intent(inout) :: hm + real(real64), intent(in) :: delta(:) + real(real64), intent(in) :: emin + type(namespace_t), intent(in) :: namespace + end subroutine hamiltonian_mxll_span + + module subroutine hamiltonian_mxll_adjoint(hm) + type(hamiltonian_mxll_t), intent(inout) :: hm + end subroutine hamiltonian_mxll_adjoint + + module subroutine hamiltonian_mxll_not_adjoint(hm) + type(hamiltonian_mxll_t), intent(inout) :: hm + end subroutine hamiltonian_mxll_not_adjoint + + module subroutine hamiltonian_mxll_update(this, time) + type(hamiltonian_mxll_t), intent(inout) :: this + real(real64), optional, intent(in) :: time + end subroutine hamiltonian_mxll_update + + module function hamiltonian_mxll_get_time(this) result(time) + type(hamiltonian_mxll_t), intent(inout) :: this + real(real64) :: time + end function hamiltonian_mxll_get_time + + pure module function hamiltonian_mxll_apply_packed(this, mesh) result(apply) + type(hamiltonian_mxll_t), intent(in) :: this + class(mesh_t), intent(in) :: mesh + logical :: apply + end function hamiltonian_mxll_apply_packed + + module subroutine hamiltonian_mxll_apply_batch(hm, namespace, der, psib, hpsib, time, terms, set_bc) + type(hamiltonian_mxll_t), intent(in) :: hm + type(namespace_t), intent(in) :: namespace + type(derivatives_t), intent(in) :: der + type(batch_t), target, intent(inout) :: psib + type(batch_t), target, intent(inout) :: hpsib + real(real64), optional, intent(in) :: time + integer, optional, intent(in) :: terms + logical, optional, intent(in) :: set_bc + end subroutine hamiltonian_mxll_apply_batch + + module subroutine hamiltonian_mxll_apply_simple(hm, namespace, mesh, psib, hpsib, terms, set_bc) + type(hamiltonian_mxll_t), intent(in) :: hm + type(namespace_t), intent(in) :: namespace + class(mesh_t), intent(in) :: mesh + type(batch_t), target, intent(inout) :: psib + type(batch_t), target, intent(inout) :: hpsib + integer, optional, intent(in) :: terms + logical, optional, intent(in) :: set_bc + end subroutine hamiltonian_mxll_apply_simple + + module subroutine mxll_apply_pml_simple(hm, gradb) + type(hamiltonian_mxll_t), target, intent(in) :: hm + type(batch_t), intent(inout) :: gradb(1:hm%st%dim) + end subroutine mxll_apply_pml_simple + + module subroutine mxll_copy_pml_simple(hm, rs_stateb) + type(hamiltonian_mxll_t),intent(inout) :: hm + type(batch_t), intent(inout) :: rs_stateb + end subroutine mxll_copy_pml_simple + + module subroutine mxll_update_pml_simple(hm, rs_stateb) + type(hamiltonian_mxll_t),intent(inout) :: hm + type(batch_t), intent(inout) :: rs_stateb + end subroutine mxll_update_pml_simple + + module subroutine mxll_linear_medium_terms_simple(hm, rs_stateb) + type(hamiltonian_mxll_t),intent(in) :: hm + type(batch_t), intent(inout) :: rs_stateb + end subroutine mxll_linear_medium_terms_simple + + module subroutine dhamiltonian_mxll_apply(hm, namespace, mesh, psib, hpsib, terms, set_bc) + class(hamiltonian_mxll_t), intent(in) :: hm + type(namespace_t), intent(in) :: namespace + class(mesh_t), intent(in) :: mesh + class(batch_t), target, intent(inout) :: psib + class(batch_t), target, intent(inout) :: hpsib + integer, optional, intent(in) :: terms + logical, optional, intent(in) :: set_bc + end subroutine dhamiltonian_mxll_apply + + module subroutine zhamiltonian_mxll_apply(hm, namespace, mesh, psib, hpsib, terms, set_bc) + class(hamiltonian_mxll_t), intent(in) :: hm + type(namespace_t), intent(in) :: namespace + class(mesh_t), intent(in) :: mesh + class(batch_t), target, intent(inout) :: psib + class(batch_t), target, intent(inout) :: hpsib + integer, optional, intent(in) :: terms + logical, optional, intent(in) :: set_bc + end subroutine zhamiltonian_mxll_apply + + module subroutine maxwell_hamiltonian_apply_fd(hm, der, psi, oppsi) + type(hamiltonian_mxll_t), intent(in) :: hm + type(derivatives_t), intent(in) :: der + complex(real64), intent(inout) :: psi(:,:) + complex(real64), intent(inout) :: oppsi(:,:) + end subroutine maxwell_hamiltonian_apply_fd + + module subroutine maxwell_pml_hamiltonian(hm, der, psi, dir1, dir2, tmp) + type(hamiltonian_mxll_t), intent(in) :: hm + type(derivatives_t), intent(in) :: der + complex(real64), intent(inout) :: psi(:,:) + integer, intent(in) :: dir1 + integer, intent(in) :: dir2 + complex(real64), intent(inout) :: tmp(:) + end subroutine maxwell_pml_hamiltonian + + module subroutine maxwell_pml_hamiltonian_medium(hm, der, psi, dir1, dir2, tmp) + type(hamiltonian_mxll_t), intent(in) :: hm + type(derivatives_t), intent(in) :: der + complex(real64), intent(inout) :: psi(:,:) + integer, intent(in) :: dir1 + integer, intent(in) :: dir2 + complex(real64), intent(inout) :: tmp(:,:) + end subroutine maxwell_pml_hamiltonian_medium + + module subroutine maxwell_pml_calculation_via_riemann_silberstein(hm, der, psi, pml_dir, field_dir, pml) + type(hamiltonian_mxll_t), intent(in) :: hm + type(derivatives_t), intent(in) :: der + integer, intent(in) :: pml_dir + complex(real64), intent(inout) :: psi(:,:) + integer, intent(in) :: field_dir + complex(real64), intent(inout) :: pml(:) + end subroutine maxwell_pml_calculation_via_riemann_silberstein + + module subroutine maxwell_pml_calculation_via_riemann_silberstein_medium(hm, der, psi, pml_dir, field_dir, pml) + type(hamiltonian_mxll_t), intent(in) :: hm + type(derivatives_t), intent(in) :: der + integer, intent(in) :: pml_dir + complex(real64), intent(inout) :: psi(:,:) + integer, intent(in) :: field_dir + complex(real64), intent(inout) :: pml(:,:) + end subroutine maxwell_pml_calculation_via_riemann_silberstein_medium + + module subroutine maxwell_medium_boundaries_calculation(hm, psi, oppsi) + type(hamiltonian_mxll_t), intent(in) :: hm + complex(real64), intent(in) :: psi(:,:) + complex(real64), intent(inout) :: oppsi(:,:) + end subroutine maxwell_medium_boundaries_calculation + + module subroutine maxwell_medium_boxes_calculation(hm, der, psi, oppsi) + type(hamiltonian_mxll_t), intent(in) :: hm + type(derivatives_t), intent(in) :: der + complex(real64), intent(in) :: psi(:,:) + complex(real64), intent(inout) :: oppsi(:,:) + end subroutine maxwell_medium_boxes_calculation + + module subroutine dhamiltonian_mxll_magnus_apply(hm, namespace, mesh, psib, hpsib, vmagnus) + class(hamiltonian_mxll_t), intent(in) :: hm + type(namespace_t), intent(in) :: namespace + class(mesh_t), intent(in) :: mesh + class(batch_t), intent(inout) :: psib + class(batch_t), intent(inout) :: hpsib + real(real64), intent(in) :: vmagnus(:, :, :) + end subroutine dhamiltonian_mxll_magnus_apply + + module subroutine zhamiltonian_mxll_magnus_apply(hm, namespace, mesh, psib, hpsib, vmagnus) + class(hamiltonian_mxll_t), intent(in) :: hm + type(namespace_t), intent(in) :: namespace + class(mesh_t), intent(in) :: mesh + class(batch_t), intent(inout) :: psib + class(batch_t), intent(inout) :: hpsib + real(real64), intent(in) :: vmagnus(:, :, :) + end subroutine zhamiltonian_mxll_magnus_apply + end interface +end module hamiltonian_mxll_oct_m + +submodule (hamiltonian_mxll_oct_m) impl + use accel_oct_m + use batch_ops_oct_m + use boundaries_oct_m + use debug_oct_m + use global_oct_m + use hamiltonian_elec_oct_m + use math_oct_m + use messages_oct_m + use parser_oct_m + use poisson_oct_m + use profiling_oct_m + use states_elec_dim_oct_m + use states_elec_oct_m + + implicit none contains ! --------------------------------------------------------- !> Initializing the Maxwell Hamiltonian - subroutine hamiltonian_mxll_init(hm, namespace, gr, st) + module subroutine hamiltonian_mxll_init(hm, namespace, gr, st) type(hamiltonian_mxll_t), intent(inout) :: hm type(namespace_t), intent(in) :: namespace type(grid_t), target, intent(inout) :: gr @@ -258,7 +446,7 @@ contains ! --------------------------------------------------------- - subroutine hamiltonian_mxll_end(hm) + module subroutine hamiltonian_mxll_end(hm) type(hamiltonian_mxll_t), intent(inout) :: hm integer :: il @@ -284,16 +472,17 @@ contains ! --------------------------------------------------------- - logical function hamiltonian_mxll_hermitian(hm) + module function hamiltonian_mxll_hermitian(hm) result(res) class(hamiltonian_mxll_t), intent(in) :: hm + logical :: res PUSH_SUB(hamiltonian_mxll_hermitian) if (any(hm%bc%bc_ab_type == OPTION__MAXWELLABSORBINGBOUNDARIES__CPML)) then ! With PML, the Hamiltonian is not purely Hermitian - hamiltonian_mxll_hermitian = .false. + res = .false. else - hamiltonian_mxll_hermitian = .true. + res = .true. end if POP_SUB(hamiltonian_mxll_hermitian) @@ -301,7 +490,7 @@ contains ! --------------------------------------------------------- - subroutine hamiltonian_mxll_span(hm, delta, emin, namespace) + module subroutine hamiltonian_mxll_span(hm, delta, emin, namespace) class(hamiltonian_mxll_t), intent(inout) :: hm real(real64), intent(in) :: delta(:) real(real64), intent(in) :: emin @@ -337,7 +526,7 @@ contains ! --------------------------------------------------------- - subroutine hamiltonian_mxll_adjoint(hm) + module subroutine hamiltonian_mxll_adjoint(hm) type(hamiltonian_mxll_t), intent(inout) :: hm PUSH_SUB(hamiltonian_mxll_adjoint) @@ -351,7 +540,7 @@ contains ! --------------------------------------------------------- - subroutine hamiltonian_mxll_not_adjoint(hm) + module subroutine hamiltonian_mxll_not_adjoint(hm) type(hamiltonian_mxll_t), intent(inout) :: hm PUSH_SUB(hamiltonian_mxll_not_adjoint) @@ -366,7 +555,7 @@ contains ! --------------------------------------------------------- !> Maxwell Hamiltonian update (here only the time is updated, can maybe be added to another routine) - subroutine hamiltonian_mxll_update(this, time) + module subroutine hamiltonian_mxll_update(this, time) type(hamiltonian_mxll_t), intent(inout) :: this real(real64), optional, intent(in) :: time @@ -380,8 +569,9 @@ contains ! ----------------------------------------------------------------- - real(real64) function hamiltonian_mxll_get_time(this) result(time) + module function hamiltonian_mxll_get_time(this) result(time) type(hamiltonian_mxll_t), intent(inout) :: this + real(real64) :: time time = this%current_time @@ -389,9 +579,10 @@ contains ! ----------------------------------------------------------------- - logical pure function hamiltonian_mxll_apply_packed(this, mesh) result(apply) + pure module function hamiltonian_mxll_apply_packed(this, mesh) result(apply) type(hamiltonian_mxll_t), intent(in) :: this class(mesh_t), intent(in) :: mesh + logical :: apply apply = this%apply_packed if (mesh%use_curvilinear) apply = .false. @@ -399,7 +590,7 @@ contains end function hamiltonian_mxll_apply_packed ! --------------------------------------------------------- - subroutine hamiltonian_mxll_apply_batch(hm, namespace, der, psib, hpsib, time, terms, set_bc) + module subroutine hamiltonian_mxll_apply_batch(hm, namespace, der, psib, hpsib, time, terms, set_bc) type(hamiltonian_mxll_t), intent(in) :: hm type(namespace_t), intent(in) :: namespace type(derivatives_t), intent(in) :: der @@ -680,7 +871,7 @@ contains end subroutine hamiltonian_mxll_apply_batch ! --------------------------------------------------------- - subroutine hamiltonian_mxll_apply_simple(hm, namespace, mesh, psib, hpsib, terms, set_bc) + module subroutine hamiltonian_mxll_apply_simple(hm, namespace, mesh, psib, hpsib, terms, set_bc) type(hamiltonian_mxll_t), intent(in) :: hm type(namespace_t), intent(in) :: namespace class(mesh_t), intent(in) :: mesh @@ -722,7 +913,7 @@ contains end subroutine hamiltonian_mxll_apply_simple ! --------------------------------------------------------- - subroutine mxll_apply_pml_simple(hm, gradb) + module subroutine mxll_apply_pml_simple(hm, gradb) type(hamiltonian_mxll_t), target, intent(in) :: hm type(batch_t), intent(inout) :: gradb(1:hm%st%dim) @@ -779,7 +970,7 @@ contains end subroutine mxll_apply_pml_simple ! --------------------------------------------------------- - subroutine mxll_update_pml_simple(hm, rs_stateb) + module subroutine mxll_update_pml_simple(hm, rs_stateb) type(hamiltonian_mxll_t),intent(inout) :: hm type(batch_t), intent(inout) :: rs_stateb @@ -838,7 +1029,7 @@ contains end subroutine mxll_update_pml_simple ! --------------------------------------------------------- - subroutine mxll_copy_pml_simple(hm, rs_stateb) + module subroutine mxll_copy_pml_simple(hm, rs_stateb) type(hamiltonian_mxll_t),intent(inout) :: hm type(batch_t), intent(inout) :: rs_stateb @@ -875,7 +1066,7 @@ contains end subroutine mxll_copy_pml_simple ! --------------------------------------------------------- - subroutine mxll_linear_medium_terms_simple(hm, rs_stateb) + module subroutine mxll_linear_medium_terms_simple(hm, rs_stateb) type(hamiltonian_mxll_t),intent(in) :: hm type(batch_t), intent(inout) :: rs_stateb @@ -942,7 +1133,7 @@ contains ! -------------------------------------------------------- !> Apply hamiltonian to real states (not possible) - subroutine dhamiltonian_mxll_apply(hm, namespace, mesh, psib, hpsib, terms, set_bc) + module subroutine dhamiltonian_mxll_apply(hm, namespace, mesh, psib, hpsib, terms, set_bc) class(hamiltonian_mxll_t), intent(in) :: hm type(namespace_t), intent(in) :: namespace class(mesh_t), intent(in) :: mesh @@ -958,7 +1149,7 @@ contains ! --------------------------------------------------------- !> Applying the Maxwell Hamiltonian on Maxwell states - subroutine zhamiltonian_mxll_apply(hm, namespace, mesh, psib, hpsib, terms, set_bc) + module subroutine zhamiltonian_mxll_apply(hm, namespace, mesh, psib, hpsib, terms, set_bc) class(hamiltonian_mxll_t), intent(in) :: hm type(namespace_t), intent(in) :: namespace class(mesh_t), intent(in) :: mesh @@ -1004,7 +1195,7 @@ contains ! --------------------------------------------------------- !> Applying the Maxwell Hamiltonian on Maxwell states with finite difference - subroutine maxwell_hamiltonian_apply_fd(hm, der, psi, oppsi) + module subroutine maxwell_hamiltonian_apply_fd(hm, der, psi, oppsi) type(hamiltonian_mxll_t), intent(in) :: hm type(derivatives_t), intent(in) :: der complex(real64), intent(inout) :: psi(:,:) @@ -1152,7 +1343,7 @@ contains ! --------------------------------------------------------- !> Maxwell Hamiltonian is updated for the PML calculation - subroutine maxwell_pml_hamiltonian(hm, der, psi, dir1, dir2, tmp) + module subroutine maxwell_pml_hamiltonian(hm, der, psi, dir1, dir2, tmp) type(hamiltonian_mxll_t), intent(in) :: hm type(derivatives_t), intent(in) :: der complex(real64), intent(inout) :: psi(:,:) @@ -1176,7 +1367,7 @@ contains ! --------------------------------------------------------- !> Maxwell Hamiltonian is updated for the PML calculation - subroutine maxwell_pml_hamiltonian_medium(hm, der, psi, dir1, dir2, tmp) + module subroutine maxwell_pml_hamiltonian_medium(hm, der, psi, dir1, dir2, tmp) type(hamiltonian_mxll_t), intent(in) :: hm type(derivatives_t), intent(in) :: der complex(real64), intent(inout) :: psi(:,:) @@ -1200,7 +1391,7 @@ contains ! --------------------------------------------------------- !> Maxwell Hamiltonian is updated for the PML calculation via Riemann-Silberstein vector - subroutine maxwell_pml_calculation_via_riemann_silberstein(hm, der, psi, pml_dir, field_dir, pml) + module subroutine maxwell_pml_calculation_via_riemann_silberstein(hm, der, psi, pml_dir, field_dir, pml) type(hamiltonian_mxll_t), intent(in) :: hm type(derivatives_t), intent(in) :: der integer, intent(in) :: pml_dir @@ -1245,7 +1436,7 @@ contains ! --------------------------------------------------------- !> Maxwell Hamiltonian is updated for the PML calculation via Riemann-Silberstein !> vector with medium inside the box - subroutine maxwell_pml_calculation_via_riemann_silberstein_medium(hm, der, psi, pml_dir, field_dir, pml) + module subroutine maxwell_pml_calculation_via_riemann_silberstein_medium(hm, der, psi, pml_dir, field_dir, pml) type(hamiltonian_mxll_t), intent(in) :: hm type(derivatives_t), intent(in) :: der integer, intent(in) :: pml_dir @@ -1296,7 +1487,7 @@ contains ! --------------------------------------------------------- !> Maxwell Hamiltonian for medium boundaries - subroutine maxwell_medium_boundaries_calculation(hm, psi, oppsi) + module subroutine maxwell_medium_boundaries_calculation(hm, psi, oppsi) type(hamiltonian_mxll_t), intent(in) :: hm complex(real64), intent(in) :: psi(:,:) complex(real64), intent(inout) :: oppsi(:,:) @@ -1358,7 +1549,7 @@ contains ! --------------------------------------------------------- ! > Maxwell Hamiltonian including medium boxes - subroutine maxwell_medium_boxes_calculation(hm, der, psi, oppsi) + module subroutine maxwell_medium_boxes_calculation(hm, der, psi, oppsi) type(hamiltonian_mxll_t), intent(in) :: hm type(derivatives_t), intent(in) :: der complex(real64), intent(in) :: psi(:,:) @@ -1421,7 +1612,7 @@ contains ! --------------------------------------------------------- !> Maxwell hamiltonian Magnus (not implemented) - subroutine dhamiltonian_mxll_magnus_apply(hm, namespace, mesh, psib, hpsib, vmagnus) + module subroutine dhamiltonian_mxll_magnus_apply(hm, namespace, mesh, psib, hpsib, vmagnus) class(hamiltonian_mxll_t), intent(in) :: hm type(namespace_t), intent(in) :: namespace class(mesh_t), intent(in) :: mesh @@ -1435,7 +1626,7 @@ contains ! --------------------------------------------------------- !> Maxwell hamiltonian Magnus (not implemented) - subroutine zhamiltonian_mxll_magnus_apply(hm, namespace, mesh, psib, hpsib, vmagnus) + module subroutine zhamiltonian_mxll_magnus_apply(hm, namespace, mesh, psib, hpsib, vmagnus) class(hamiltonian_mxll_t), intent(in) :: hm type(namespace_t), intent(in) :: namespace class(mesh_t), intent(in) :: mesh @@ -1447,7 +1638,7 @@ contains end subroutine zhamiltonian_mxll_magnus_apply -end module hamiltonian_mxll_oct_m +end submodule impl !! Local Variables: !! mode: f90 -- GitLab From 14320f23621a86ca3a9478d81712688f8b9c18ff Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Mon, 15 Jan 2024 11:02:46 +0100 Subject: [PATCH 16/43] [submodule] `hamiltonian_mxll_oct_m` (split) Signed-off-by: Cristian Le --- src/Makefile.am | 1 + src/maxwell/CMakeLists.txt | 1 + src/maxwell/hamiltonian_mxll.F90 | 307 ----------------------------- src/maxwell/hamiltonian_mxll_h.F90 | 306 ++++++++++++++++++++++++++++ 4 files changed, 308 insertions(+), 307 deletions(-) create mode 100644 src/maxwell/hamiltonian_mxll_h.F90 diff --git a/src/Makefile.am b/src/Makefile.am index 731680a17b..530ad5d23c 100644 --- a/src/Makefile.am +++ b/src/Makefile.am @@ -708,6 +708,7 @@ maxwell_f_srcs = \ maxwell/external_densities.F90 \ maxwell/external_waves.F90 \ maxwell/hamiltonian_mxll.F90 \ + maxwell/hamiltonian_mxll_h.F90 \ maxwell/propagator_mxll.F90 \ maxwell/dispersive_medium.F90 \ maxwell/linear_medium.F90 \ diff --git a/src/maxwell/CMakeLists.txt b/src/maxwell/CMakeLists.txt index 74a639c24e..6a6ffcb669 100644 --- a/src/maxwell/CMakeLists.txt +++ b/src/maxwell/CMakeLists.txt @@ -4,6 +4,7 @@ target_sources(Octopus_lib PRIVATE external_densities.F90 external_waves.F90 hamiltonian_mxll.F90 + hamiltonian_mxll_h.F90 linear_medium.F90 maxwell.F90 maxwell_boundary_op.F90 diff --git a/src/maxwell/hamiltonian_mxll.F90 b/src/maxwell/hamiltonian_mxll.F90 index 3e95a1f201..ca15634cdb 100644 --- a/src/maxwell/hamiltonian_mxll.F90 +++ b/src/maxwell/hamiltonian_mxll.F90 @@ -18,313 +18,6 @@ #include "global.h" -module hamiltonian_mxll_oct_m - use batch_oct_m - use cube_oct_m - use derivatives_oct_m - use energy_mxll_oct_m - use global_oct_m - use grid_oct_m - use hamiltonian_abst_oct_m - use linear_medium_to_em_field_oct_m - use maxwell_boundary_op_oct_m - use mesh_cube_parallel_map_oct_m - use mesh_oct_m - use namespace_oct_m - use nl_operator_oct_m - use states_mxll_oct_m - - implicit none - - private - public :: & - hamiltonian_mxll_t, & - hamiltonian_mxll_init, & - hamiltonian_mxll_end, & - dhamiltonian_mxll_apply, & - zhamiltonian_mxll_apply, & - dhamiltonian_mxll_magnus_apply, & - zhamiltonian_mxll_magnus_apply, & - hamiltonian_mxll_apply_batch, & - hamiltonian_mxll_span, & - hamiltonian_mxll_adjoint, & - hamiltonian_mxll_not_adjoint, & - hamiltonian_mxll_hermitian, & - hamiltonian_mxll_update, & - hamiltonian_mxll_get_time, & - hamiltonian_mxll_apply_packed, & - hamiltonian_mxll_apply_simple, & - mxll_update_pml_simple, & - mxll_copy_pml_simple - - type, extends(hamiltonian_abst_t) :: hamiltonian_mxll_t - integer :: dim - !> absorbing boundaries - logical :: adjoint = .false. - - real(real64) :: current_time - logical :: apply_packed !< This is initialized by the StatesPack variable. - - logical :: time_zero - - type(nl_operator_t), pointer :: operators(:) - - type(bc_mxll_t) :: bc - type(derivatives_t), pointer, private :: der !< pointer to derivatives - type(states_mxll_t), pointer :: st - - integer :: rs_sign - - logical :: propagation_apply = .false. - - integer, pointer :: rs_state_fft_map(:,:,:) - integer, pointer :: rs_state_fft_map_inv(:,:) - - logical :: mx_ma_coupling = .false. - logical :: mx_ma_coupling_apply = .false. - integer :: mx_ma_trans_field_calc_method - logical :: mx_ma_trans_field_calc_corr = .false. - integer :: mx_ma_coupling_points_number - real(real64), allocatable :: mx_ma_coupling_points(:,:) - integer, allocatable :: mx_ma_coupling_points_map(:) - integer :: mx_ma_coupling_order - logical :: ma_mx_coupling = .false. - logical :: ma_mx_coupling_apply = .false. - - logical :: bc_add_ab_region = .false. - logical :: bc_zero = .false. - logical :: bc_constant = .false. - logical :: bc_mirror_pec = .false. - logical :: bc_mirror_pmc = .false. - logical :: bc_periodic = .false. - logical :: bc_plane_waves = .false. - logical :: bc_medium = .false. - - logical :: plane_waves = .false. - logical :: plane_waves_apply = .false. - logical :: spatial_constant = .false. - logical :: spatial_constant_apply = .false. - logical :: spatial_constant_propagate = .false. - - logical :: calc_medium_box = .false. - type(single_medium_box_t), allocatable :: medium_boxes(:) - logical :: medium_boxes_initialized = .false. - - !> maxwell hamiltonian_mxll - integer :: operator - logical :: current_density_ext_flag = .false. - logical :: current_density_from_medium = .false. - - type(energy_mxll_t) :: energy - - logical :: cpml_hamiltonian = .false. - - logical :: diamag_current = .false. - real(real64) :: c_factor - real(real64) :: current_factor - - type(cube_t) :: cube - type(mesh_cube_parallel_map_t) :: mesh_cube_map - - contains - procedure :: update_span => hamiltonian_mxll_span - procedure :: dapply => dhamiltonian_mxll_apply - procedure :: zapply => zhamiltonian_mxll_apply - procedure :: dmagnus_apply => dhamiltonian_mxll_magnus_apply - procedure :: zmagnus_apply => zhamiltonian_mxll_magnus_apply - procedure :: is_hermitian => hamiltonian_mxll_hermitian - end type hamiltonian_mxll_t - - integer, public, parameter :: & - FARADAY_AMPERE = 1, & - FARADAY_AMPERE_MEDIUM = 2, & - MXLL_SIMPLE = 3 - - interface - module subroutine hamiltonian_mxll_init(hm, namespace, gr, st) - type(hamiltonian_mxll_t), intent(inout) :: hm - type(namespace_t), intent(in) :: namespace - type(grid_t), target, intent(inout) :: gr - type(states_mxll_t), target, intent(inout) :: st - end subroutine hamiltonian_mxll_init - - module subroutine hamiltonian_mxll_end(hm) - type(hamiltonian_mxll_t), intent(inout) :: hm - end subroutine hamiltonian_mxll_end - - module function hamiltonian_mxll_hermitian(hm) result(res) - class(hamiltonian_mxll_t), intent(in) :: hm - logical :: res - end function hamiltonian_mxll_hermitian - - module subroutine hamiltonian_mxll_span(hm, delta, emin, namespace) - class(hamiltonian_mxll_t), intent(inout) :: hm - real(real64), intent(in) :: delta(:) - real(real64), intent(in) :: emin - type(namespace_t), intent(in) :: namespace - end subroutine hamiltonian_mxll_span - - module subroutine hamiltonian_mxll_adjoint(hm) - type(hamiltonian_mxll_t), intent(inout) :: hm - end subroutine hamiltonian_mxll_adjoint - - module subroutine hamiltonian_mxll_not_adjoint(hm) - type(hamiltonian_mxll_t), intent(inout) :: hm - end subroutine hamiltonian_mxll_not_adjoint - - module subroutine hamiltonian_mxll_update(this, time) - type(hamiltonian_mxll_t), intent(inout) :: this - real(real64), optional, intent(in) :: time - end subroutine hamiltonian_mxll_update - - module function hamiltonian_mxll_get_time(this) result(time) - type(hamiltonian_mxll_t), intent(inout) :: this - real(real64) :: time - end function hamiltonian_mxll_get_time - - pure module function hamiltonian_mxll_apply_packed(this, mesh) result(apply) - type(hamiltonian_mxll_t), intent(in) :: this - class(mesh_t), intent(in) :: mesh - logical :: apply - end function hamiltonian_mxll_apply_packed - - module subroutine hamiltonian_mxll_apply_batch(hm, namespace, der, psib, hpsib, time, terms, set_bc) - type(hamiltonian_mxll_t), intent(in) :: hm - type(namespace_t), intent(in) :: namespace - type(derivatives_t), intent(in) :: der - type(batch_t), target, intent(inout) :: psib - type(batch_t), target, intent(inout) :: hpsib - real(real64), optional, intent(in) :: time - integer, optional, intent(in) :: terms - logical, optional, intent(in) :: set_bc - end subroutine hamiltonian_mxll_apply_batch - - module subroutine hamiltonian_mxll_apply_simple(hm, namespace, mesh, psib, hpsib, terms, set_bc) - type(hamiltonian_mxll_t), intent(in) :: hm - type(namespace_t), intent(in) :: namespace - class(mesh_t), intent(in) :: mesh - type(batch_t), target, intent(inout) :: psib - type(batch_t), target, intent(inout) :: hpsib - integer, optional, intent(in) :: terms - logical, optional, intent(in) :: set_bc - end subroutine hamiltonian_mxll_apply_simple - - module subroutine mxll_apply_pml_simple(hm, gradb) - type(hamiltonian_mxll_t), target, intent(in) :: hm - type(batch_t), intent(inout) :: gradb(1:hm%st%dim) - end subroutine mxll_apply_pml_simple - - module subroutine mxll_copy_pml_simple(hm, rs_stateb) - type(hamiltonian_mxll_t),intent(inout) :: hm - type(batch_t), intent(inout) :: rs_stateb - end subroutine mxll_copy_pml_simple - - module subroutine mxll_update_pml_simple(hm, rs_stateb) - type(hamiltonian_mxll_t),intent(inout) :: hm - type(batch_t), intent(inout) :: rs_stateb - end subroutine mxll_update_pml_simple - - module subroutine mxll_linear_medium_terms_simple(hm, rs_stateb) - type(hamiltonian_mxll_t),intent(in) :: hm - type(batch_t), intent(inout) :: rs_stateb - end subroutine mxll_linear_medium_terms_simple - - module subroutine dhamiltonian_mxll_apply(hm, namespace, mesh, psib, hpsib, terms, set_bc) - class(hamiltonian_mxll_t), intent(in) :: hm - type(namespace_t), intent(in) :: namespace - class(mesh_t), intent(in) :: mesh - class(batch_t), target, intent(inout) :: psib - class(batch_t), target, intent(inout) :: hpsib - integer, optional, intent(in) :: terms - logical, optional, intent(in) :: set_bc - end subroutine dhamiltonian_mxll_apply - - module subroutine zhamiltonian_mxll_apply(hm, namespace, mesh, psib, hpsib, terms, set_bc) - class(hamiltonian_mxll_t), intent(in) :: hm - type(namespace_t), intent(in) :: namespace - class(mesh_t), intent(in) :: mesh - class(batch_t), target, intent(inout) :: psib - class(batch_t), target, intent(inout) :: hpsib - integer, optional, intent(in) :: terms - logical, optional, intent(in) :: set_bc - end subroutine zhamiltonian_mxll_apply - - module subroutine maxwell_hamiltonian_apply_fd(hm, der, psi, oppsi) - type(hamiltonian_mxll_t), intent(in) :: hm - type(derivatives_t), intent(in) :: der - complex(real64), intent(inout) :: psi(:,:) - complex(real64), intent(inout) :: oppsi(:,:) - end subroutine maxwell_hamiltonian_apply_fd - - module subroutine maxwell_pml_hamiltonian(hm, der, psi, dir1, dir2, tmp) - type(hamiltonian_mxll_t), intent(in) :: hm - type(derivatives_t), intent(in) :: der - complex(real64), intent(inout) :: psi(:,:) - integer, intent(in) :: dir1 - integer, intent(in) :: dir2 - complex(real64), intent(inout) :: tmp(:) - end subroutine maxwell_pml_hamiltonian - - module subroutine maxwell_pml_hamiltonian_medium(hm, der, psi, dir1, dir2, tmp) - type(hamiltonian_mxll_t), intent(in) :: hm - type(derivatives_t), intent(in) :: der - complex(real64), intent(inout) :: psi(:,:) - integer, intent(in) :: dir1 - integer, intent(in) :: dir2 - complex(real64), intent(inout) :: tmp(:,:) - end subroutine maxwell_pml_hamiltonian_medium - - module subroutine maxwell_pml_calculation_via_riemann_silberstein(hm, der, psi, pml_dir, field_dir, pml) - type(hamiltonian_mxll_t), intent(in) :: hm - type(derivatives_t), intent(in) :: der - integer, intent(in) :: pml_dir - complex(real64), intent(inout) :: psi(:,:) - integer, intent(in) :: field_dir - complex(real64), intent(inout) :: pml(:) - end subroutine maxwell_pml_calculation_via_riemann_silberstein - - module subroutine maxwell_pml_calculation_via_riemann_silberstein_medium(hm, der, psi, pml_dir, field_dir, pml) - type(hamiltonian_mxll_t), intent(in) :: hm - type(derivatives_t), intent(in) :: der - integer, intent(in) :: pml_dir - complex(real64), intent(inout) :: psi(:,:) - integer, intent(in) :: field_dir - complex(real64), intent(inout) :: pml(:,:) - end subroutine maxwell_pml_calculation_via_riemann_silberstein_medium - - module subroutine maxwell_medium_boundaries_calculation(hm, psi, oppsi) - type(hamiltonian_mxll_t), intent(in) :: hm - complex(real64), intent(in) :: psi(:,:) - complex(real64), intent(inout) :: oppsi(:,:) - end subroutine maxwell_medium_boundaries_calculation - - module subroutine maxwell_medium_boxes_calculation(hm, der, psi, oppsi) - type(hamiltonian_mxll_t), intent(in) :: hm - type(derivatives_t), intent(in) :: der - complex(real64), intent(in) :: psi(:,:) - complex(real64), intent(inout) :: oppsi(:,:) - end subroutine maxwell_medium_boxes_calculation - - module subroutine dhamiltonian_mxll_magnus_apply(hm, namespace, mesh, psib, hpsib, vmagnus) - class(hamiltonian_mxll_t), intent(in) :: hm - type(namespace_t), intent(in) :: namespace - class(mesh_t), intent(in) :: mesh - class(batch_t), intent(inout) :: psib - class(batch_t), intent(inout) :: hpsib - real(real64), intent(in) :: vmagnus(:, :, :) - end subroutine dhamiltonian_mxll_magnus_apply - - module subroutine zhamiltonian_mxll_magnus_apply(hm, namespace, mesh, psib, hpsib, vmagnus) - class(hamiltonian_mxll_t), intent(in) :: hm - type(namespace_t), intent(in) :: namespace - class(mesh_t), intent(in) :: mesh - class(batch_t), intent(inout) :: psib - class(batch_t), intent(inout) :: hpsib - real(real64), intent(in) :: vmagnus(:, :, :) - end subroutine zhamiltonian_mxll_magnus_apply - end interface -end module hamiltonian_mxll_oct_m - submodule (hamiltonian_mxll_oct_m) impl use accel_oct_m use batch_ops_oct_m diff --git a/src/maxwell/hamiltonian_mxll_h.F90 b/src/maxwell/hamiltonian_mxll_h.F90 new file mode 100644 index 0000000000..e4b90ec990 --- /dev/null +++ b/src/maxwell/hamiltonian_mxll_h.F90 @@ -0,0 +1,306 @@ +module hamiltonian_mxll_oct_m + use batch_oct_m + use cube_oct_m + use derivatives_oct_m + use energy_mxll_oct_m + use global_oct_m + use grid_oct_m + use hamiltonian_abst_oct_m + use linear_medium_to_em_field_oct_m + use maxwell_boundary_op_oct_m + use mesh_cube_parallel_map_oct_m + use mesh_oct_m + use namespace_oct_m + use nl_operator_oct_m + use states_mxll_oct_m + + implicit none + + private + public :: & + hamiltonian_mxll_t, & + hamiltonian_mxll_init, & + hamiltonian_mxll_end, & + dhamiltonian_mxll_apply, & + zhamiltonian_mxll_apply, & + dhamiltonian_mxll_magnus_apply, & + zhamiltonian_mxll_magnus_apply, & + hamiltonian_mxll_apply_batch, & + hamiltonian_mxll_span, & + hamiltonian_mxll_adjoint, & + hamiltonian_mxll_not_adjoint, & + hamiltonian_mxll_hermitian, & + hamiltonian_mxll_update, & + hamiltonian_mxll_get_time, & + hamiltonian_mxll_apply_packed, & + hamiltonian_mxll_apply_simple, & + mxll_update_pml_simple, & + mxll_copy_pml_simple + + type, extends(hamiltonian_abst_t) :: hamiltonian_mxll_t + integer :: dim + !> absorbing boundaries + logical :: adjoint = .false. + + real(real64) :: current_time + logical :: apply_packed !< This is initialized by the StatesPack variable. + + logical :: time_zero + + type(nl_operator_t), pointer :: operators(:) + + type(bc_mxll_t) :: bc + type(derivatives_t), pointer, private :: der !< pointer to derivatives + type(states_mxll_t), pointer :: st + + integer :: rs_sign + + logical :: propagation_apply = .false. + + integer, pointer :: rs_state_fft_map(:,:,:) + integer, pointer :: rs_state_fft_map_inv(:,:) + + logical :: mx_ma_coupling = .false. + logical :: mx_ma_coupling_apply = .false. + integer :: mx_ma_trans_field_calc_method + logical :: mx_ma_trans_field_calc_corr = .false. + integer :: mx_ma_coupling_points_number + real(real64), allocatable :: mx_ma_coupling_points(:,:) + integer, allocatable :: mx_ma_coupling_points_map(:) + integer :: mx_ma_coupling_order + logical :: ma_mx_coupling = .false. + logical :: ma_mx_coupling_apply = .false. + + logical :: bc_add_ab_region = .false. + logical :: bc_zero = .false. + logical :: bc_constant = .false. + logical :: bc_mirror_pec = .false. + logical :: bc_mirror_pmc = .false. + logical :: bc_periodic = .false. + logical :: bc_plane_waves = .false. + logical :: bc_medium = .false. + + logical :: plane_waves = .false. + logical :: plane_waves_apply = .false. + logical :: spatial_constant = .false. + logical :: spatial_constant_apply = .false. + logical :: spatial_constant_propagate = .false. + + logical :: calc_medium_box = .false. + type(single_medium_box_t), allocatable :: medium_boxes(:) + logical :: medium_boxes_initialized = .false. + + !> maxwell hamiltonian_mxll + integer :: operator + logical :: current_density_ext_flag = .false. + logical :: current_density_from_medium = .false. + + type(energy_mxll_t) :: energy + + logical :: cpml_hamiltonian = .false. + + logical :: diamag_current = .false. + real(real64) :: c_factor + real(real64) :: current_factor + + type(cube_t) :: cube + type(mesh_cube_parallel_map_t) :: mesh_cube_map + + contains + procedure :: update_span => hamiltonian_mxll_span + procedure :: dapply => dhamiltonian_mxll_apply + procedure :: zapply => zhamiltonian_mxll_apply + procedure :: dmagnus_apply => dhamiltonian_mxll_magnus_apply + procedure :: zmagnus_apply => zhamiltonian_mxll_magnus_apply + procedure :: is_hermitian => hamiltonian_mxll_hermitian + end type hamiltonian_mxll_t + + integer, public, parameter :: & + FARADAY_AMPERE = 1, & + FARADAY_AMPERE_MEDIUM = 2, & + MXLL_SIMPLE = 3 + + interface + module subroutine hamiltonian_mxll_init(hm, namespace, gr, st) + type(hamiltonian_mxll_t), intent(inout) :: hm + type(namespace_t), intent(in) :: namespace + type(grid_t), target, intent(inout) :: gr + type(states_mxll_t), target, intent(inout) :: st + end subroutine hamiltonian_mxll_init + + module subroutine hamiltonian_mxll_end(hm) + type(hamiltonian_mxll_t), intent(inout) :: hm + end subroutine hamiltonian_mxll_end + + module function hamiltonian_mxll_hermitian(hm) result(res) + class(hamiltonian_mxll_t), intent(in) :: hm + logical :: res + end function hamiltonian_mxll_hermitian + + module subroutine hamiltonian_mxll_span(hm, delta, emin, namespace) + class(hamiltonian_mxll_t), intent(inout) :: hm + real(real64), intent(in) :: delta(:) + real(real64), intent(in) :: emin + type(namespace_t), intent(in) :: namespace + end subroutine hamiltonian_mxll_span + + module subroutine hamiltonian_mxll_adjoint(hm) + type(hamiltonian_mxll_t), intent(inout) :: hm + end subroutine hamiltonian_mxll_adjoint + + module subroutine hamiltonian_mxll_not_adjoint(hm) + type(hamiltonian_mxll_t), intent(inout) :: hm + end subroutine hamiltonian_mxll_not_adjoint + + module subroutine hamiltonian_mxll_update(this, time) + type(hamiltonian_mxll_t), intent(inout) :: this + real(real64), optional, intent(in) :: time + end subroutine hamiltonian_mxll_update + + module function hamiltonian_mxll_get_time(this) result(time) + type(hamiltonian_mxll_t), intent(inout) :: this + real(real64) :: time + end function hamiltonian_mxll_get_time + + pure module function hamiltonian_mxll_apply_packed(this, mesh) result(apply) + type(hamiltonian_mxll_t), intent(in) :: this + class(mesh_t), intent(in) :: mesh + logical :: apply + end function hamiltonian_mxll_apply_packed + + module subroutine hamiltonian_mxll_apply_batch(hm, namespace, der, psib, hpsib, time, terms, set_bc) + type(hamiltonian_mxll_t), intent(in) :: hm + type(namespace_t), intent(in) :: namespace + type(derivatives_t), intent(in) :: der + type(batch_t), target, intent(inout) :: psib + type(batch_t), target, intent(inout) :: hpsib + real(real64), optional, intent(in) :: time + integer, optional, intent(in) :: terms + logical, optional, intent(in) :: set_bc + end subroutine hamiltonian_mxll_apply_batch + + module subroutine hamiltonian_mxll_apply_simple(hm, namespace, mesh, psib, hpsib, terms, set_bc) + type(hamiltonian_mxll_t), intent(in) :: hm + type(namespace_t), intent(in) :: namespace + class(mesh_t), intent(in) :: mesh + type(batch_t), target, intent(inout) :: psib + type(batch_t), target, intent(inout) :: hpsib + integer, optional, intent(in) :: terms + logical, optional, intent(in) :: set_bc + end subroutine hamiltonian_mxll_apply_simple + + module subroutine mxll_apply_pml_simple(hm, gradb) + type(hamiltonian_mxll_t), target, intent(in) :: hm + type(batch_t), intent(inout) :: gradb(1:hm%st%dim) + end subroutine mxll_apply_pml_simple + + module subroutine mxll_copy_pml_simple(hm, rs_stateb) + type(hamiltonian_mxll_t),intent(inout) :: hm + type(batch_t), intent(inout) :: rs_stateb + end subroutine mxll_copy_pml_simple + + module subroutine mxll_update_pml_simple(hm, rs_stateb) + type(hamiltonian_mxll_t),intent(inout) :: hm + type(batch_t), intent(inout) :: rs_stateb + end subroutine mxll_update_pml_simple + + module subroutine mxll_linear_medium_terms_simple(hm, rs_stateb) + type(hamiltonian_mxll_t),intent(in) :: hm + type(batch_t), intent(inout) :: rs_stateb + end subroutine mxll_linear_medium_terms_simple + + module subroutine dhamiltonian_mxll_apply(hm, namespace, mesh, psib, hpsib, terms, set_bc) + class(hamiltonian_mxll_t), intent(in) :: hm + type(namespace_t), intent(in) :: namespace + class(mesh_t), intent(in) :: mesh + class(batch_t), target, intent(inout) :: psib + class(batch_t), target, intent(inout) :: hpsib + integer, optional, intent(in) :: terms + logical, optional, intent(in) :: set_bc + end subroutine dhamiltonian_mxll_apply + + module subroutine zhamiltonian_mxll_apply(hm, namespace, mesh, psib, hpsib, terms, set_bc) + class(hamiltonian_mxll_t), intent(in) :: hm + type(namespace_t), intent(in) :: namespace + class(mesh_t), intent(in) :: mesh + class(batch_t), target, intent(inout) :: psib + class(batch_t), target, intent(inout) :: hpsib + integer, optional, intent(in) :: terms + logical, optional, intent(in) :: set_bc + end subroutine zhamiltonian_mxll_apply + + module subroutine maxwell_hamiltonian_apply_fd(hm, der, psi, oppsi) + type(hamiltonian_mxll_t), intent(in) :: hm + type(derivatives_t), intent(in) :: der + complex(real64), intent(inout) :: psi(:,:) + complex(real64), intent(inout) :: oppsi(:,:) + end subroutine maxwell_hamiltonian_apply_fd + + module subroutine maxwell_pml_hamiltonian(hm, der, psi, dir1, dir2, tmp) + type(hamiltonian_mxll_t), intent(in) :: hm + type(derivatives_t), intent(in) :: der + complex(real64), intent(inout) :: psi(:,:) + integer, intent(in) :: dir1 + integer, intent(in) :: dir2 + complex(real64), intent(inout) :: tmp(:) + end subroutine maxwell_pml_hamiltonian + + module subroutine maxwell_pml_hamiltonian_medium(hm, der, psi, dir1, dir2, tmp) + type(hamiltonian_mxll_t), intent(in) :: hm + type(derivatives_t), intent(in) :: der + complex(real64), intent(inout) :: psi(:,:) + integer, intent(in) :: dir1 + integer, intent(in) :: dir2 + complex(real64), intent(inout) :: tmp(:,:) + end subroutine maxwell_pml_hamiltonian_medium + + module subroutine maxwell_pml_calculation_via_riemann_silberstein(hm, der, psi, pml_dir, field_dir, pml) + type(hamiltonian_mxll_t), intent(in) :: hm + type(derivatives_t), intent(in) :: der + integer, intent(in) :: pml_dir + complex(real64), intent(inout) :: psi(:,:) + integer, intent(in) :: field_dir + complex(real64), intent(inout) :: pml(:) + end subroutine maxwell_pml_calculation_via_riemann_silberstein + + module subroutine maxwell_pml_calculation_via_riemann_silberstein_medium(hm, der, psi, pml_dir, field_dir, pml) + type(hamiltonian_mxll_t), intent(in) :: hm + type(derivatives_t), intent(in) :: der + integer, intent(in) :: pml_dir + complex(real64), intent(inout) :: psi(:,:) + integer, intent(in) :: field_dir + complex(real64), intent(inout) :: pml(:,:) + end subroutine maxwell_pml_calculation_via_riemann_silberstein_medium + + module subroutine maxwell_medium_boundaries_calculation(hm, psi, oppsi) + type(hamiltonian_mxll_t), intent(in) :: hm + complex(real64), intent(in) :: psi(:,:) + complex(real64), intent(inout) :: oppsi(:,:) + end subroutine maxwell_medium_boundaries_calculation + + module subroutine maxwell_medium_boxes_calculation(hm, der, psi, oppsi) + type(hamiltonian_mxll_t), intent(in) :: hm + type(derivatives_t), intent(in) :: der + complex(real64), intent(in) :: psi(:,:) + complex(real64), intent(inout) :: oppsi(:,:) + end subroutine maxwell_medium_boxes_calculation + + module subroutine dhamiltonian_mxll_magnus_apply(hm, namespace, mesh, psib, hpsib, vmagnus) + class(hamiltonian_mxll_t), intent(in) :: hm + type(namespace_t), intent(in) :: namespace + class(mesh_t), intent(in) :: mesh + class(batch_t), intent(inout) :: psib + class(batch_t), intent(inout) :: hpsib + real(real64), intent(in) :: vmagnus(:, :, :) + end subroutine dhamiltonian_mxll_magnus_apply + + module subroutine zhamiltonian_mxll_magnus_apply(hm, namespace, mesh, psib, hpsib, vmagnus) + class(hamiltonian_mxll_t), intent(in) :: hm + type(namespace_t), intent(in) :: namespace + class(mesh_t), intent(in) :: mesh + class(batch_t), intent(inout) :: psib + class(batch_t), intent(inout) :: hpsib + real(real64), intent(in) :: vmagnus(:, :, :) + end subroutine zhamiltonian_mxll_magnus_apply + end interface +end module hamiltonian_mxll_oct_m -- GitLab From 7609927fc08124575976546344578103e17f7e6b Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Mon, 15 Jan 2024 15:00:49 +0100 Subject: [PATCH 17/43] [submodule] `hamiltonian_abst_oct_m` Signed-off-by: Cristian Le --- src/Makefile.am | 2 +- src/hamiltonian/CMakeLists.txt | 2 +- .../{hamiltonian_abst.F90 => hamiltonian_abst_h.F90} | 6 +----- 3 files changed, 3 insertions(+), 7 deletions(-) rename src/hamiltonian/{hamiltonian_abst.F90 => hamiltonian_abst_h.F90} (97%) diff --git a/src/Makefile.am b/src/Makefile.am index 530ad5d23c..a01b876c48 100644 --- a/src/Makefile.am +++ b/src/Makefile.am @@ -467,7 +467,7 @@ hamiltonian_f_srcs = \ hamiltonian/exchange_operator.F90 \ hamiltonian/xc_functional.F90 \ hamiltonian/gauge_field.F90 \ - hamiltonian/hamiltonian_abst.F90 \ + hamiltonian/hamiltonian_abst_h.F90 \ hamiltonian/hamiltonian_elec_base.F90 \ hamiltonian/hamiltonian_elec.F90 \ hamiltonian/hamiltonian_elec_h.F90 \ diff --git a/src/hamiltonian/CMakeLists.txt b/src/hamiltonian/CMakeLists.txt index eba12392e2..b72bbeac07 100644 --- a/src/hamiltonian/CMakeLists.txt +++ b/src/hamiltonian/CMakeLists.txt @@ -6,7 +6,7 @@ target_sources(Octopus_lib PRIVATE exchange_operator.F90 ext_partner_list.F90 gauge_field.F90 - hamiltonian_abst.F90 + hamiltonian_abst_h.F90 hamiltonian_elec.F90 hamiltonian_elec_base.F90 hamiltonian_elec_h.F90 diff --git a/src/hamiltonian/hamiltonian_abst.F90 b/src/hamiltonian/hamiltonian_abst_h.F90 similarity index 97% rename from src/hamiltonian/hamiltonian_abst.F90 rename to src/hamiltonian/hamiltonian_abst_h.F90 index 7ae72767d5..8e3976d228 100644 --- a/src/hamiltonian/hamiltonian_abst.F90 +++ b/src/hamiltonian/hamiltonian_abst_h.F90 @@ -15,7 +15,6 @@ !! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA !! 02110-1301, USA. !! -#include "global.h" !> @brief This module defines an abstract class for Hamiltonians !! @@ -31,11 +30,8 @@ module hamiltonian_abst_oct_m private - public :: & - hamiltonian_abst_t - !> @brief The abstract Hamiltonian class defines a skeleton for specific implementations - type, abstract :: hamiltonian_abst_t + type, abstract, public :: hamiltonian_abst_t !> Spectral range real(real64) :: spectral_middle_point real(real64) :: spectral_half_span -- GitLab From 6181b9330ab049d7c44fe255848236e12b211f53 Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Tue, 23 Apr 2024 12:02:14 +0200 Subject: [PATCH 18/43] [submodule] `electrons_ground_state_oct_m` Signed-off-by: Cristian Le --- src/scf/electrons_ground_state.F90 | 50 +++++++++++++++++++++--------- 1 file changed, 36 insertions(+), 14 deletions(-) diff --git a/src/scf/electrons_ground_state.F90 b/src/scf/electrons_ground_state.F90 index 0e608c8e9c..c0a7fba319 100644 --- a/src/scf/electrons_ground_state.F90 +++ b/src/scf/electrons_ground_state.F90 @@ -19,41 +19,63 @@ #include "global.h" module electrons_ground_state_oct_m - use debug_oct_m use electron_space_oct_m - use global_oct_m use grid_oct_m use hamiltonian_elec_oct_m use interaction_partner_oct_m - use io_function_oct_m use ions_oct_m + use multicomm_oct_m + use namespace_oct_m + use output_low_oct_m + use states_elec_oct_m + use v_ks_oct_m + + implicit none + + private + public :: & + electrons_ground_state_run + + interface + module subroutine electrons_ground_state_run(namespace, mc, gr, ions, ext_partners, st, ks, hm, outp, space, fromScratch) + type(namespace_t), intent(in) :: namespace + type(multicomm_t), intent(in) :: mc + type(grid_t), intent(inout) :: gr + type(ions_t), intent(inout) :: ions + type(partner_list_t), intent(in) :: ext_partners + type(states_elec_t), intent(inout) :: st + type(v_ks_t), intent(inout) :: ks + type(hamiltonian_elec_t), intent(inout) :: hm + type(output_t), intent(in) :: outp + type(electron_space_t), intent(in) :: space + logical, intent(inout) :: fromScratch + end subroutine electrons_ground_state_run + end interface +end module electrons_ground_state_oct_m + +submodule (electrons_ground_state_oct_m) impl + use debug_oct_m + use global_oct_m + use hamiltonian_elec_oct_m + use io_function_oct_m use lcao_oct_m use math_oct_m use mesh_oct_m use messages_oct_m - use multicomm_oct_m - use namespace_oct_m - use output_low_oct_m use pcm_oct_m use rdmft_oct_m use restart_oct_m use scf_oct_m use space_oct_m use states_abst_oct_m - use states_elec_oct_m use states_elec_restart_oct_m - use v_ks_oct_m implicit none - private - public :: & - electrons_ground_state_run - contains ! --------------------------------------------------------- - subroutine electrons_ground_state_run(namespace, mc, gr, ions, ext_partners, st, ks, hm, outp, space, fromScratch) + module subroutine electrons_ground_state_run(namespace, mc, gr, ions, ext_partners, st, ks, hm, outp, space, fromScratch) type(namespace_t), intent(in) :: namespace type(multicomm_t), intent(in) :: mc type(grid_t), intent(inout) :: gr @@ -188,7 +210,7 @@ contains POP_SUB(ground_state_run_legacy) end subroutine electrons_ground_state_run -end module electrons_ground_state_oct_m +end submodule impl !! Local Variables: !! mode: f90 -- GitLab From fe30f077925ca5dd422c281dfd8da9ac3fdacb7e Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Tue, 23 Apr 2024 12:04:02 +0200 Subject: [PATCH 19/43] [submodule] `electrons_ground_state_oct_m` (split) Signed-off-by: Cristian Le --- src/Makefile.am | 1 + src/scf/CMakeLists.txt | 1 + src/scf/electrons_ground_state.F90 | 35 ---------------------------- src/scf/electrons_ground_state_h.F90 | 34 +++++++++++++++++++++++++++ 4 files changed, 36 insertions(+), 35 deletions(-) create mode 100644 src/scf/electrons_ground_state_h.F90 diff --git a/src/Makefile.am b/src/Makefile.am index a01b876c48..c982e03674 100644 --- a/src/Makefile.am +++ b/src/Makefile.am @@ -727,6 +727,7 @@ scf_f_srcs = \ scf/criteria_factory.F90 \ scf/density_criterion.F90 \ scf/electrons_ground_state.F90 \ + scf/electrons_ground_state_h.F90 \ scf/eigenval_criterion.F90 \ scf/energy_criterion.F90 \ scf/lcao.F90 \ diff --git a/src/scf/CMakeLists.txt b/src/scf/CMakeLists.txt index 75f20d3a98..b1e44316e6 100644 --- a/src/scf/CMakeLists.txt +++ b/src/scf/CMakeLists.txt @@ -3,6 +3,7 @@ target_sources(Octopus_lib PRIVATE density_criterion.F90 eigenval_criterion.F90 electrons_ground_state.F90 + electrons_ground_state_h.F90 energy_criterion.F90 lcao.F90 lda_u_mixer.F90 diff --git a/src/scf/electrons_ground_state.F90 b/src/scf/electrons_ground_state.F90 index c0a7fba319..a12c891ca7 100644 --- a/src/scf/electrons_ground_state.F90 +++ b/src/scf/electrons_ground_state.F90 @@ -18,41 +18,6 @@ #include "global.h" -module electrons_ground_state_oct_m - use electron_space_oct_m - use grid_oct_m - use hamiltonian_elec_oct_m - use interaction_partner_oct_m - use ions_oct_m - use multicomm_oct_m - use namespace_oct_m - use output_low_oct_m - use states_elec_oct_m - use v_ks_oct_m - - implicit none - - private - public :: & - electrons_ground_state_run - - interface - module subroutine electrons_ground_state_run(namespace, mc, gr, ions, ext_partners, st, ks, hm, outp, space, fromScratch) - type(namespace_t), intent(in) :: namespace - type(multicomm_t), intent(in) :: mc - type(grid_t), intent(inout) :: gr - type(ions_t), intent(inout) :: ions - type(partner_list_t), intent(in) :: ext_partners - type(states_elec_t), intent(inout) :: st - type(v_ks_t), intent(inout) :: ks - type(hamiltonian_elec_t), intent(inout) :: hm - type(output_t), intent(in) :: outp - type(electron_space_t), intent(in) :: space - logical, intent(inout) :: fromScratch - end subroutine electrons_ground_state_run - end interface -end module electrons_ground_state_oct_m - submodule (electrons_ground_state_oct_m) impl use debug_oct_m use global_oct_m diff --git a/src/scf/electrons_ground_state_h.F90 b/src/scf/electrons_ground_state_h.F90 new file mode 100644 index 0000000000..da0b3ac4e1 --- /dev/null +++ b/src/scf/electrons_ground_state_h.F90 @@ -0,0 +1,34 @@ +module electrons_ground_state_oct_m + use electron_space_oct_m + use grid_oct_m + use hamiltonian_elec_oct_m + use interaction_partner_oct_m + use ions_oct_m + use multicomm_oct_m + use namespace_oct_m + use output_low_oct_m + use states_elec_oct_m + use v_ks_oct_m + + implicit none + + private + public :: & + electrons_ground_state_run + + interface + module subroutine electrons_ground_state_run(namespace, mc, gr, ions, ext_partners, st, ks, hm, outp, space, fromScratch) + type(namespace_t), intent(in) :: namespace + type(multicomm_t), intent(in) :: mc + type(grid_t), intent(inout) :: gr + type(ions_t), intent(inout) :: ions + type(partner_list_t), intent(in) :: ext_partners + type(states_elec_t), intent(inout) :: st + type(v_ks_t), intent(inout) :: ks + type(hamiltonian_elec_t), intent(inout) :: hm + type(output_t), intent(in) :: outp + type(electron_space_t), intent(in) :: space + logical, intent(inout) :: fromScratch + end subroutine electrons_ground_state_run + end interface +end module electrons_ground_state_oct_m -- GitLab From 9976fcc2d18e40efe195878c4c963c1b30c96331 Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Mon, 11 Sep 2023 21:14:42 +0200 Subject: [PATCH 20/43] Move td interface subroutines to `td_interface_oct_m` Signed-off-by: Cristian Le --- src/Makefile.am | 3 +- src/electrons/electrons.F90 | 3 +- src/main/run.F90 | 2 +- src/main/time_dependent.F90 | 2 +- src/opt_control/opt_control.F90 | 1 + src/td/CMakeLists.txt | 3 +- src/td/td_h.F90 | 193 +-------------------------- src/td/{td.F90 => td_interface.F90} | 7 +- src/td/td_interface_h.F90 | 197 ++++++++++++++++++++++++++++ 9 files changed, 218 insertions(+), 193 deletions(-) rename src/td/{td.F90 => td_interface.F90} (99%) create mode 100644 src/td/td_interface_h.F90 diff --git a/src/Makefile.am b/src/Makefile.am index c982e03674..ed101a956a 100644 --- a/src/Makefile.am +++ b/src/Makefile.am @@ -764,7 +764,8 @@ td_f_srcs = \ td/propagator_rk.F90 \ td/spectrum.F90 \ td/td_calc.F90 \ - td/td.F90 \ + td/td_interface.F90 \ + td/td_interface_h.F90 \ td/td_h.F90 \ td/td_write.F90 \ td/td_write_low.F90 \ diff --git a/src/electrons/electrons.F90 b/src/electrons/electrons.F90 index 9c75963644..d76a94cfaa 100644 --- a/src/electrons/electrons.F90 +++ b/src/electrons/electrons.F90 @@ -72,6 +72,7 @@ submodule (electrons_oct_m) impl use states_elec_dim_oct_m use stress_oct_m use sort_oct_m + use td_interface_oct_m use td_write_oct_m use unit_system_oct_m use xc_oct_m @@ -480,7 +481,7 @@ contains ! additional initialization needed for electrons call td_init_with_wavefunctions(this%td, this%namespace, this%space, this%mc, this%gr, this%ions, & - this%ext_partners, this%st, this%ks, this%hm, this%outp, td_get_from_scratch(this%td)) + this%ext_partners, this%st, this%ks, this%hm, this%outp, this%td%from_scratch) POP_SUB(electrons_propagation_start) end subroutine electrons_propagation_start diff --git a/src/main/run.F90 b/src/main/run.F90 index 708273bdf9..dc15b4ee4e 100644 --- a/src/main/run.F90 +++ b/src/main/run.F90 @@ -55,7 +55,7 @@ module run_oct_m use static_pol_oct_m use system_factory_oct_m use system_oct_m - use td_oct_m + use td_interface_oct_m use test_oct_m use time_dependent_oct_m use unit_system_oct_m diff --git a/src/main/time_dependent.F90 b/src/main/time_dependent.F90 index 556c733da5..468f14985f 100644 --- a/src/main/time_dependent.F90 +++ b/src/main/time_dependent.F90 @@ -30,7 +30,7 @@ module time_dependent_oct_m use profiling_oct_m use restart_oct_m use system_oct_m - use td_oct_m + use td_interface_oct_m use walltimer_oct_m implicit none diff --git a/src/opt_control/opt_control.F90 b/src/opt_control/opt_control.F90 index 4530b3d3c7..2953a3d09b 100644 --- a/src/opt_control/opt_control.F90 +++ b/src/opt_control/opt_control.F90 @@ -58,6 +58,7 @@ module opt_control_oct_m use electrons_oct_m use target_oct_m use td_oct_m + use td_interface_oct_m implicit none diff --git a/src/td/CMakeLists.txt b/src/td/CMakeLists.txt index e68cc3ae4b..819f0ca648 100644 --- a/src/td/CMakeLists.txt +++ b/src/td/CMakeLists.txt @@ -16,9 +16,10 @@ target_sources(Octopus_lib PRIVATE propagator_qoct.F90 propagator_rk.F90 spectrum.F90 - td.F90 td_calc.F90 td_h.F90 + td_interface.F90 + td_interface_h.F90 td_write.F90 td_write_low.F90 ) diff --git a/src/td/td_h.F90 b/src/td/td_h.F90 index 302202313f..1867f3a53b 100644 --- a/src/td/td_h.F90 +++ b/src/td/td_h.F90 @@ -21,30 +21,13 @@ module td_oct_m implicit none private - public :: & - td_t, & - td_run, & - td_run_init, & - td_init, & - td_init_run, & - td_end, & - td_end_run, & - td_check_point, & - td_dump, & - td_allocate_wavefunctions, & - td_init_gaugefield, & - td_load_restart_from_gs, & - td_load_restart_from_td, & - td_init_with_wavefunctions,& - td_get_from_scratch, & - td_set_from_scratch !> Parameters. integer, parameter, public :: & EHRENFEST = 1, & BO = 2 - type td_t + type, public :: td_t private type(propagator_base_t), public :: tr !< contains the details of the time-evolution type(scf_t), public :: scf @@ -58,180 +41,16 @@ module td_oct_m integer, public :: dynamics integer, public :: energy_update_iter - real(real64) :: scissor + real(real64), public :: scissor logical :: freeze_occ logical :: freeze_u - integer :: freeze_orbitals + integer, public :: freeze_orbitals - logical :: from_scratch = .false. + logical, public :: from_scratch = .false. type(td_write_t), public :: write_handler - type(restart_t) :: restart_load - type(restart_t) :: restart_dump + type(restart_t), public :: restart_load + type(restart_t), public :: restart_dump end type td_t - - ! Subroutine/Functions - interface - module subroutine td_run(td, namespace, mc, gr, ions, st, ks, hm, ext_partners, outp, space, from_scratch) - type(td_t), intent(inout) :: td - type(namespace_t), intent(in) :: namespace - type(multicomm_t), intent(inout) :: mc - type(grid_t), intent(inout) :: gr - type(ions_t), intent(inout) :: ions - type(states_elec_t), intent(inout) :: st - type(v_ks_t), intent(inout) :: ks - type(hamiltonian_elec_t), intent(inout) :: hm - type(partner_list_t), intent(in) :: ext_partners - type(output_t), intent(inout) :: outp - type(electron_space_t), intent(in) :: space - logical, intent(inout) :: from_scratch - end subroutine td_run - - module subroutine td_run_init() - end subroutine td_run_init - - module subroutine td_init(td, namespace, space, gr, ions, st, ks, hm, ext_partners, outp) - type(td_t), intent(inout) :: td - type(namespace_t), intent(in) :: namespace - class(space_t), intent(in) :: space - type(grid_t), intent(in) :: gr - type(ions_t), intent(inout) :: ions - type(states_elec_t), intent(in) :: st - type(v_ks_t), intent(in) :: ks - type(hamiltonian_elec_t), intent(in) :: hm - type(partner_list_t), intent(in) :: ext_partners - type(output_t), intent(in) :: outp - end subroutine td_init - - module subroutine td_init_run(td, namespace, mc, gr, ions, st, ks, hm, ext_partners, outp, space, from_scratch) - type(td_t), intent(inout) :: td - type(namespace_t), intent(in) :: namespace - type(multicomm_t), intent(inout) :: mc - type(grid_t), intent(inout) :: gr - type(ions_t), intent(inout) :: ions - type(states_elec_t), intent(inout) :: st - type(v_ks_t), intent(inout) :: ks - type(hamiltonian_elec_t), intent(inout) :: hm - type(partner_list_t), intent(in) :: ext_partners - type(output_t), intent(inout) :: outp - type(electron_space_t), intent(in) :: space - logical, intent(inout) :: from_scratch - end subroutine td_init_run - - module subroutine td_allocate_wavefunctions(td, namespace, mc, gr, ions, st, hm, space) - type(td_t), intent(inout) :: td - type(namespace_t), intent(in) :: namespace - type(multicomm_t), intent(inout) :: mc - type(grid_t), intent(inout) :: gr - type(ions_t), intent(inout) :: ions - type(states_elec_t), intent(inout) :: st - type(hamiltonian_elec_t), intent(inout) :: hm - class(space_t), intent(in) :: space - end subroutine td_allocate_wavefunctions - - module subroutine td_init_gaugefield(td, namespace, gr, st, ks, hm, ext_partners, space) - type(td_t), intent(inout) :: td - type(namespace_t), intent(in) :: namespace - type(grid_t), intent(inout) :: gr - type(states_elec_t), intent(inout) :: st - type(v_ks_t), intent(inout) :: ks - type(hamiltonian_elec_t), intent(inout) :: hm - type(partner_list_t), intent(in) :: ext_partners - class(space_t), intent(in) :: space - end subroutine td_init_gaugefield - - module subroutine td_end(td) - type(td_t), intent(inout) :: td - end subroutine td_end - - module subroutine td_end_run(td, st, hm) - type(td_t), intent(inout) :: td - type(states_elec_t), intent(inout) :: st - type(hamiltonian_elec_t), intent(inout) :: hm - end subroutine td_end_run - - module subroutine td_check_point(td, namespace, mc, gr, ions, st, ks, hm, ext_partners, outp, space, & - iter, scsteps, etime, stopping, from_scratch) - type(td_t), intent(inout) :: td - type(namespace_t), intent(in) :: namespace - type(multicomm_t), intent(in) :: mc - type(grid_t), intent(inout) :: gr - type(ions_t), intent(inout) :: ions - type(states_elec_t), intent(inout) :: st - type(v_ks_t), intent(inout) :: ks - type(hamiltonian_elec_t), intent(inout) :: hm - type(partner_list_t), intent(in) :: ext_partners - type(output_t), intent(in) :: outp - type(electron_space_t), intent(in) :: space - integer, intent(in) :: iter - integer, intent(in) :: scsteps - real(real64), intent(inout) :: etime - logical, intent(in) :: stopping - logical, intent(inout) :: from_scratch - end subroutine td_check_point - - module subroutine td_init_with_wavefunctions(td, namespace, space, mc, gr, ions, ext_partners, st, ks, hm, outp, from_scratch) - type(td_t), intent(inout) :: td - type(namespace_t), intent(in) :: namespace - type(electron_space_t), intent(in) :: space - type(multicomm_t), intent(in) :: mc - type(grid_t), intent(inout) :: gr - type(ions_t), intent(inout) :: ions - type(partner_list_t), intent(in) :: ext_partners - type(states_elec_t), target, intent(inout) :: st - type(v_ks_t), intent(inout) :: ks - type(hamiltonian_elec_t), intent(inout) :: hm - type(output_t), intent(inout) :: outp - logical, intent(in) :: from_scratch - end subroutine td_init_with_wavefunctions - - module subroutine td_load_restart_from_gs(td, namespace, space, mc, gr, ext_partners, st, ks, hm) - type(td_t), intent(inout) :: td - type(namespace_t), intent(in) :: namespace - class(space_t), intent(in) :: space - type(multicomm_t), intent(in) :: mc - type(grid_t), intent(inout) :: gr - type(partner_list_t), intent(in) :: ext_partners - type(states_elec_t), target, intent(inout) :: st - type(v_ks_t), intent(inout) :: ks - type(hamiltonian_elec_t), intent(inout) :: hm - end subroutine td_load_restart_from_gs - - module subroutine td_dump(td, namespace, space, gr, st, hm, ks, ext_partners, iter, ierr) - type(td_t), intent(in) :: td - type(namespace_t), intent(in) :: namespace - class(space_t), intent(in) :: space - type(grid_t), intent(in) :: gr - type(states_elec_t), intent(in) :: st - type(hamiltonian_elec_t), intent(in) :: hm - type(v_ks_t), intent(in) :: ks - type(partner_list_t), intent(in) :: ext_partners - integer, intent(in) :: iter - integer, intent(out) :: ierr - end subroutine td_dump - - module function td_get_from_scratch(td) result(res) - type(td_t), intent(in) :: td - logical :: res - end function td_get_from_scratch - - module subroutine td_set_from_scratch(td, from_scratch) - type(td_t), intent(inout) :: td - logical, intent(in) :: from_scratch - end subroutine td_set_from_scratch - - module subroutine td_load_restart_from_td(td, namespace, space, mc, gr, ext_partners, st, ks, hm, from_scratch) - type(td_t), intent(inout) :: td - type(namespace_t), intent(in) :: namespace - class(space_t), intent(in) :: space - type(multicomm_t), intent(in) :: mc - type(grid_t), intent(inout) :: gr - type(partner_list_t), intent(in) :: ext_partners - type(states_elec_t), target, intent(inout) :: st - type(v_ks_t), intent(inout) :: ks - type(hamiltonian_elec_t), intent(inout) :: hm - logical, intent(inout) :: from_scratch - end subroutine td_load_restart_from_td - end interface end module td_oct_m diff --git a/src/td/td.F90 b/src/td/td_interface.F90 similarity index 99% rename from src/td/td.F90 rename to src/td/td_interface.F90 index f852b2f0fc..4492e548c6 100644 --- a/src/td/td.F90 +++ b/src/td/td_interface.F90 @@ -18,7 +18,7 @@ #include "global.h" -submodule (td_oct_m) impl +submodule (td_interface_oct_m) impl use absorbing_boundaries_oct_m use boundaries_oct_m use calc_mode_par_oct_m @@ -34,6 +34,7 @@ submodule (td_oct_m) impl use gauge_field_oct_m use global_oct_m use io_oct_m + use ion_dynamics_oct_m use kick_oct_m use lasers_oct_m use lda_u_io_oct_m @@ -46,6 +47,7 @@ submodule (td_oct_m) impl use mpi_oct_m use output_oct_m use parser_oct_m + use pes_oct_m use photon_mode_mf_oct_m use photon_mode_oct_m use poisson_oct_m @@ -53,10 +55,13 @@ submodule (td_oct_m) impl use profiling_oct_m use propagator_elec_oct_m use propagator_oct_m + use restart_oct_m + use scf_oct_m use scissor_oct_m use states_abst_oct_m use states_elec_restart_oct_m use stress_oct_m + use td_write_oct_m use types_oct_m use unit_oct_m use unit_system_oct_m diff --git a/src/td/td_interface_h.F90 b/src/td/td_interface_h.F90 new file mode 100644 index 0000000000..86f99e6333 --- /dev/null +++ b/src/td/td_interface_h.F90 @@ -0,0 +1,197 @@ +module td_interface_oct_m + use electron_space_oct_m + use grid_oct_m + use hamiltonian_elec_oct_m + use interaction_partner_oct_m + use ions_oct_m + use multicomm_oct_m + use namespace_oct_m + use output_low_oct_m + use space_oct_m + use states_elec_oct_m + use td_oct_m + use v_ks_oct_m + use, intrinsic :: iso_fortran_env + + private + public :: & + td_run, & + td_run_init, & + td_init, & + td_init_run, & + td_end, & + td_end_run, & + td_check_point, & + td_dump, & + td_allocate_wavefunctions, & + td_init_gaugefield, & + td_load_restart_from_gs, & + td_load_restart_from_td, & + td_init_with_wavefunctions,& + td_get_from_scratch, & + td_set_from_scratch + + ! Subroutine/Functions + interface + module subroutine td_run(td, namespace, mc, gr, ions, st, ks, hm, ext_partners, outp, space, from_scratch) + type(td_t), intent(inout) :: td + type(namespace_t), intent(in) :: namespace + type(multicomm_t), intent(inout) :: mc + type(grid_t), intent(inout) :: gr + type(ions_t), intent(inout) :: ions + type(states_elec_t), intent(inout) :: st + type(v_ks_t), intent(inout) :: ks + type(hamiltonian_elec_t), intent(inout) :: hm + type(partner_list_t), intent(in) :: ext_partners + type(output_t), intent(inout) :: outp + type(electron_space_t), intent(in) :: space + logical, intent(inout) :: from_scratch + end subroutine td_run + + module subroutine td_run_init() + end subroutine td_run_init + + module subroutine td_init(td, namespace, space, gr, ions, st, ks, hm, ext_partners, outp) + type(td_t), intent(inout) :: td + type(namespace_t), intent(in) :: namespace + class(space_t), intent(in) :: space + type(grid_t), intent(in) :: gr + type(ions_t), intent(inout) :: ions + type(states_elec_t), intent(in) :: st + type(v_ks_t), intent(in) :: ks + type(hamiltonian_elec_t), intent(in) :: hm + type(partner_list_t), intent(in) :: ext_partners + type(output_t), intent(in) :: outp + end subroutine td_init + + module subroutine td_init_run(td, namespace, mc, gr, ions, st, ks, hm, ext_partners, outp, space, from_scratch) + type(td_t), intent(inout) :: td + type(namespace_t), intent(in) :: namespace + type(multicomm_t), intent(inout) :: mc + type(grid_t), intent(inout) :: gr + type(ions_t), intent(inout) :: ions + type(states_elec_t), intent(inout) :: st + type(v_ks_t), intent(inout) :: ks + type(hamiltonian_elec_t), intent(inout) :: hm + type(partner_list_t), intent(in) :: ext_partners + type(output_t), intent(inout) :: outp + type(electron_space_t), intent(in) :: space + logical, intent(inout) :: from_scratch + end subroutine td_init_run + + module subroutine td_allocate_wavefunctions(td, namespace, mc, gr, ions, st, hm, space) + type(td_t), intent(inout) :: td + type(namespace_t), intent(in) :: namespace + type(multicomm_t), intent(inout) :: mc + type(grid_t), intent(inout) :: gr + type(ions_t), intent(inout) :: ions + type(states_elec_t), intent(inout) :: st + type(hamiltonian_elec_t), intent(inout) :: hm + class(space_t), intent(in) :: space + end subroutine td_allocate_wavefunctions + + module subroutine td_init_gaugefield(td, namespace, gr, st, ks, hm, ext_partners, space) + type(td_t), intent(inout) :: td + type(namespace_t), intent(in) :: namespace + type(grid_t), intent(inout) :: gr + type(states_elec_t), intent(inout) :: st + type(v_ks_t), intent(inout) :: ks + type(hamiltonian_elec_t), intent(inout) :: hm + type(partner_list_t), intent(in) :: ext_partners + class(space_t), intent(in) :: space + end subroutine td_init_gaugefield + + module subroutine td_end(td) + type(td_t), intent(inout) :: td + end subroutine td_end + + module subroutine td_end_run(td, st, hm) + type(td_t), intent(inout) :: td + type(states_elec_t), intent(inout) :: st + type(hamiltonian_elec_t), intent(inout) :: hm + end subroutine td_end_run + + module subroutine td_check_point(td, namespace, mc, gr, ions, st, ks, hm, ext_partners, outp, space, & + iter, scsteps, etime, stopping, from_scratch) + type(td_t), intent(inout) :: td + type(namespace_t), intent(in) :: namespace + type(multicomm_t), intent(in) :: mc + type(grid_t), intent(inout) :: gr + type(ions_t), intent(inout) :: ions + type(states_elec_t), intent(inout) :: st + type(v_ks_t), intent(inout) :: ks + type(hamiltonian_elec_t), intent(inout) :: hm + type(partner_list_t), intent(in) :: ext_partners + type(output_t), intent(in) :: outp + type(electron_space_t), intent(in) :: space + integer, intent(in) :: iter + integer, intent(in) :: scsteps + real(real64), intent(inout) :: etime + logical, intent(in) :: stopping + logical, intent(inout) :: from_scratch + end subroutine td_check_point + + module subroutine td_init_with_wavefunctions(td, namespace, space, mc, gr, ions, ext_partners, st, ks, hm, outp, from_scratch) + type(td_t), intent(inout) :: td + type(namespace_t), intent(in) :: namespace + type(electron_space_t), intent(in) :: space + type(multicomm_t), intent(in) :: mc + type(grid_t), intent(inout) :: gr + type(ions_t), intent(inout) :: ions + type(partner_list_t), intent(in) :: ext_partners + type(states_elec_t), target, intent(inout) :: st + type(v_ks_t), intent(inout) :: ks + type(hamiltonian_elec_t), intent(inout) :: hm + type(output_t), intent(inout) :: outp + logical, intent(in) :: from_scratch + end subroutine td_init_with_wavefunctions + + module subroutine td_load_restart_from_gs(td, namespace, space, mc, gr, ext_partners, st, ks, hm) + type(td_t), intent(inout) :: td + type(namespace_t), intent(in) :: namespace + class(space_t), intent(in) :: space + type(multicomm_t), intent(in) :: mc + type(grid_t), intent(inout) :: gr + type(partner_list_t), intent(in) :: ext_partners + type(states_elec_t), target, intent(inout) :: st + type(v_ks_t), intent(inout) :: ks + type(hamiltonian_elec_t), intent(inout) :: hm + end subroutine td_load_restart_from_gs + + module subroutine td_dump(td, namespace, space, gr, st, hm, ks, ext_partners, iter, ierr) + type(td_t), intent(in) :: td + type(namespace_t), intent(in) :: namespace + class(space_t), intent(in) :: space + type(grid_t), intent(in) :: gr + type(states_elec_t), intent(in) :: st + type(hamiltonian_elec_t), intent(in) :: hm + type(v_ks_t), intent(in) :: ks + type(partner_list_t), intent(in) :: ext_partners + integer, intent(in) :: iter + integer, intent(out) :: ierr + end subroutine td_dump + + module function td_get_from_scratch(td) result(res) + type(td_t), intent(in) :: td + logical :: res + end function td_get_from_scratch + + module subroutine td_set_from_scratch(td, from_scratch) + type(td_t), intent(inout) :: td + logical, intent(in) :: from_scratch + end subroutine td_set_from_scratch + + module subroutine td_load_restart_from_td(td, namespace, space, mc, gr, ext_partners, st, ks, hm, from_scratch) + type(td_t), intent(inout) :: td + type(namespace_t), intent(in) :: namespace + class(space_t), intent(in) :: space + type(multicomm_t), intent(in) :: mc + type(grid_t), intent(inout) :: gr + type(partner_list_t), intent(in) :: ext_partners + type(states_elec_t), target, intent(inout) :: st + type(v_ks_t), intent(inout) :: ks + type(hamiltonian_elec_t), intent(inout) :: hm + logical, intent(inout) :: from_scratch + end subroutine td_load_restart_from_td + end interface +end module td_interface_oct_m -- GitLab From 3fd53d1d62e8b804134274541d8bd68e56f954f2 Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Tue, 23 Apr 2024 20:29:27 +0200 Subject: [PATCH 21/43] [submodule] `scf_oct_m` Signed-off-by: Cristian Le --- src/scf/scf.F90 | 162 ++++++++++++++++++++++++++++++++---------------- 1 file changed, 107 insertions(+), 55 deletions(-) diff --git a/src/scf/scf.F90 b/src/scf/scf.F90 index 2b8eb87c97..83e2969022 100644 --- a/src/scf/scf.F90 +++ b/src/scf/scf.F90 @@ -19,73 +19,25 @@ #include "global.h" module scf_oct_m - use batch_ops_oct_m use berry_oct_m use convergence_criterion_oct_m - use criteria_factory_oct_m - use debug_oct_m - use density_oct_m - use density_criterion_oct_m use eigensolver_oct_m - use eigenval_criterion_oct_m use electron_space_oct_m - use energy_calc_oct_m - use energy_criterion_oct_m - use forces_oct_m use global_oct_m use grid_oct_m use hamiltonian_elec_oct_m use interaction_partner_oct_m - use io_oct_m use ions_oct_m - use, intrinsic :: iso_fortran_env - use kpoints_oct_m - use lcao_oct_m - use lda_u_oct_m - use lda_u_io_oct_m use lda_u_mixer_oct_m - use lalg_basic_oct_m - use loct_oct_m - use magnetic_oct_m - use math_oct_m - use mesh_oct_m - use mesh_function_oct_m - use messages_oct_m use mix_oct_m - use modelmb_exchange_syms_oct_m - use mpi_oct_m use multicomm_oct_m use namespace_oct_m - use output_oct_m use output_low_oct_m - use output_modelmb_oct_m - use parser_oct_m - use partial_charges_oct_m - use profiling_oct_m use restart_oct_m - use smear_oct_m use space_oct_m - use species_oct_m use states_abst_oct_m use states_elec_oct_m - use states_elec_io_oct_m - use states_elec_restart_oct_m - use stress_oct_m - use symmetries_oct_m - use types_oct_m - use unit_oct_m - use unit_system_oct_m - use utils_oct_m use v_ks_oct_m - use varinfo_oct_m - use vdw_ts_oct_m - use walltimer_oct_m - use wfs_elec_oct_m - use xc_oct_m - use xc_f03_lib_m - use xc_interaction_oct_m - use xc_oep_oct_m - use xc_oep_photon_oct_m implicit none @@ -134,10 +86,110 @@ module scf_oct_m real(real64) :: energy_in, energy_diff, abs_dens_diff, evsum_in, evsum_out, evsum_diff end type scf_t + interface + module subroutine scf_init(scf, namespace, gr, ions, st, mc, hm, space) + type(scf_t), intent(inout) :: scf + type(grid_t), intent(in) :: gr + type(namespace_t), intent(in) :: namespace + type(ions_t), intent(in) :: ions + type(states_elec_t), intent(in) :: st + type(multicomm_t), intent(in) :: mc + type(hamiltonian_elec_t), intent(inout) :: hm + class(space_t), intent(in) :: space + end subroutine scf_init + + module subroutine scf_mix_clear(scf) + type(scf_t), intent(inout) :: scf + end subroutine scf_mix_clear + + module subroutine scf_run(scf, namespace, space, mc, gr, ions, ext_partners, st, ks, hm, outp, & + verbosity, iters_done, restart_load, restart_dump) + type(scf_t), intent(inout) :: scf !< self consistent cycle + type(namespace_t), intent(in) :: namespace + type(electron_space_t), intent(in) :: space + type(multicomm_t), intent(in) :: mc + type(grid_t), intent(inout) :: gr !< grid + type(ions_t), intent(inout) :: ions !< geometry + type(partner_list_t), intent(in) :: ext_partners + type(states_elec_t), intent(inout) :: st !< States + type(v_ks_t), intent(inout) :: ks !< Kohn-Sham + type(hamiltonian_elec_t), intent(inout) :: hm !< Hamiltonian + type(output_t), optional, intent(in) :: outp + integer, optional, intent(in) :: verbosity + integer, optional, intent(out) :: iters_done + type(restart_t), optional, intent(in) :: restart_load + type(restart_t), optional, intent(in) :: restart_dump + end subroutine scf_run + + module subroutine scf_end(scf) + type(scf_t), intent(inout) :: scf + end subroutine scf_end + + module subroutine scf_state_info(namespace, st) + type(namespace_t), intent(in) :: namespace + class(states_abst_t), intent(in) :: st + end subroutine scf_state_info + + module subroutine scf_print_mem_use(namespace) + type(namespace_t), intent(in) :: namespace + end subroutine scf_print_mem_use + end interface +end module scf_oct_m + +submodule (scf_oct_m) impl + use batch_ops_oct_m + use criteria_factory_oct_m + use debug_oct_m + use density_criterion_oct_m + use density_oct_m + use eigenval_criterion_oct_m + use energy_calc_oct_m + use energy_criterion_oct_m + use forces_oct_m + use io_oct_m + use kpoints_oct_m + use lalg_basic_oct_m + use lcao_oct_m + use lda_u_io_oct_m + use lda_u_oct_m + use loct_oct_m + use magnetic_oct_m + use math_oct_m + use mesh_function_oct_m + use mesh_oct_m + use messages_oct_m + use modelmb_exchange_syms_oct_m + use mpi_oct_m + use output_modelmb_oct_m + use output_oct_m + use parser_oct_m + use partial_charges_oct_m + use profiling_oct_m + use smear_oct_m + use species_oct_m + use states_elec_io_oct_m + use states_elec_restart_oct_m + use stress_oct_m + use symmetries_oct_m + use types_oct_m + use unit_oct_m + use unit_system_oct_m + use utils_oct_m + use varinfo_oct_m + use vdw_ts_oct_m + use walltimer_oct_m + use wfs_elec_oct_m + use xc_f03_lib_m + use xc_interaction_oct_m + use xc_oct_m + use xc_oep_oct_m + use xc_oep_photon_oct_m + + implicit none contains ! --------------------------------------------------------- - subroutine scf_init(scf, namespace, gr, ions, st, mc, hm, space) + module subroutine scf_init(scf, namespace, gr, ions, st, mc, hm, space) type(scf_t), intent(inout) :: scf type(grid_t), intent(in) :: gr type(namespace_t), intent(in) :: namespace @@ -432,7 +484,7 @@ contains ! --------------------------------------------------------- - subroutine scf_end(scf) + module subroutine scf_end(scf) type(scf_t), intent(inout) :: scf class(convergence_criterion_t), pointer :: crit @@ -459,7 +511,7 @@ contains ! --------------------------------------------------------- - subroutine scf_mix_clear(scf) + module subroutine scf_mix_clear(scf) type(scf_t), intent(inout) :: scf PUSH_SUB(scf_mix_clear) @@ -473,7 +525,7 @@ contains ! --------------------------------------------------------- - subroutine scf_run(scf, namespace, space, mc, gr, ions, ext_partners, st, ks, hm, outp, & + module subroutine scf_run(scf, namespace, space, mc, gr, ions, ext_partners, st, ks, hm, outp, & verbosity, iters_done, restart_load, restart_dump) type(scf_t), intent(inout) :: scf !< self consistent cycle type(namespace_t), intent(in) :: namespace @@ -1319,7 +1371,7 @@ contains end subroutine scf_run ! --------------------------------------------------------- - subroutine scf_state_info(namespace, st) + module subroutine scf_state_info(namespace, st) type(namespace_t), intent(in) :: namespace class(states_abst_t), intent(in) :: st @@ -1337,7 +1389,7 @@ contains end subroutine scf_state_info ! --------------------------------------------------------- - subroutine scf_print_mem_use(namespace) + module subroutine scf_print_mem_use(namespace) type(namespace_t), intent(in) :: namespace real(real64) :: mem real(real64) :: mem_tmp @@ -1419,7 +1471,7 @@ contains end subroutine scf_update_diff_quantity -end module scf_oct_m +end submodule impl !! Local Variables: -- GitLab From fbcbe558ac70afa2e00fbd0fc4cdd3eb839decb0 Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Tue, 23 Apr 2024 20:30:55 +0200 Subject: [PATCH 22/43] [submodule] `scf_oct_m` (split) Signed-off-by: Cristian Le --- src/Makefile.am | 1 + src/scf/CMakeLists.txt | 1 + src/scf/scf.F90 | 118 ----------------------------------------- src/scf/scf_h.F90 | 117 ++++++++++++++++++++++++++++++++++++++++ 4 files changed, 119 insertions(+), 118 deletions(-) create mode 100644 src/scf/scf_h.F90 diff --git a/src/Makefile.am b/src/Makefile.am index ed101a956a..9a2b169c26 100644 --- a/src/Makefile.am +++ b/src/Makefile.am @@ -736,6 +736,7 @@ scf_f_srcs = \ scf/mixing_preconditioner.F90 \ scf/rdmft.F90 \ scf/scf.F90 \ + scf/scf_h.F90 \ scf/unocc.F90 scf_srcs = $(scf_f_srcs) diff --git a/src/scf/CMakeLists.txt b/src/scf/CMakeLists.txt index b1e44316e6..50f31a2304 100644 --- a/src/scf/CMakeLists.txt +++ b/src/scf/CMakeLists.txt @@ -11,6 +11,7 @@ target_sources(Octopus_lib PRIVATE mixing_preconditioner.F90 rdmft.F90 scf.F90 + scf_h.F90 unocc.F90 ) ## Unused sources diff --git a/src/scf/scf.F90 b/src/scf/scf.F90 index 83e2969022..cc25a6c198 100644 --- a/src/scf/scf.F90 +++ b/src/scf/scf.F90 @@ -18,124 +18,6 @@ #include "global.h" -module scf_oct_m - use berry_oct_m - use convergence_criterion_oct_m - use eigensolver_oct_m - use electron_space_oct_m - use global_oct_m - use grid_oct_m - use hamiltonian_elec_oct_m - use interaction_partner_oct_m - use ions_oct_m - use lda_u_mixer_oct_m - use mix_oct_m - use multicomm_oct_m - use namespace_oct_m - use output_low_oct_m - use restart_oct_m - use space_oct_m - use states_abst_oct_m - use states_elec_oct_m - use v_ks_oct_m - - implicit none - - private - public :: & - scf_t, & - scf_init, & - scf_mix_clear, & - scf_run, & - scf_end, & - scf_state_info, & - scf_print_mem_use - - integer, public, parameter :: & - VERB_NO = 0, & - VERB_COMPACT = 1, & - VERB_FULL = 3 - - !> some variables used for the SCF cycle - type scf_t - private - integer, public :: max_iter !< maximum number of SCF iterations - - real(real64), public :: lmm_r - - ! several convergence criteria - logical :: conv_eigen_error - logical :: check_conv - - integer :: mix_field - logical :: lcao_restricted - logical :: calc_force - logical, public :: calc_stress - logical :: calc_dipole - logical :: calc_partial_charges - type(mix_t) :: smix - type(mixfield_t), pointer :: mixfield - type(eigensolver_t) :: eigens - integer :: mixdim1 - logical :: forced_finish !< remember if 'touch stop' was triggered earlier. - type(lda_u_mixer_t) :: lda_u_mix - type(berry_t) :: berry - integer :: matvec !< number matrix-vector products - - type(criterion_list_t), public :: criterion_list - real(real64) :: energy_in, energy_diff, abs_dens_diff, evsum_in, evsum_out, evsum_diff - end type scf_t - - interface - module subroutine scf_init(scf, namespace, gr, ions, st, mc, hm, space) - type(scf_t), intent(inout) :: scf - type(grid_t), intent(in) :: gr - type(namespace_t), intent(in) :: namespace - type(ions_t), intent(in) :: ions - type(states_elec_t), intent(in) :: st - type(multicomm_t), intent(in) :: mc - type(hamiltonian_elec_t), intent(inout) :: hm - class(space_t), intent(in) :: space - end subroutine scf_init - - module subroutine scf_mix_clear(scf) - type(scf_t), intent(inout) :: scf - end subroutine scf_mix_clear - - module subroutine scf_run(scf, namespace, space, mc, gr, ions, ext_partners, st, ks, hm, outp, & - verbosity, iters_done, restart_load, restart_dump) - type(scf_t), intent(inout) :: scf !< self consistent cycle - type(namespace_t), intent(in) :: namespace - type(electron_space_t), intent(in) :: space - type(multicomm_t), intent(in) :: mc - type(grid_t), intent(inout) :: gr !< grid - type(ions_t), intent(inout) :: ions !< geometry - type(partner_list_t), intent(in) :: ext_partners - type(states_elec_t), intent(inout) :: st !< States - type(v_ks_t), intent(inout) :: ks !< Kohn-Sham - type(hamiltonian_elec_t), intent(inout) :: hm !< Hamiltonian - type(output_t), optional, intent(in) :: outp - integer, optional, intent(in) :: verbosity - integer, optional, intent(out) :: iters_done - type(restart_t), optional, intent(in) :: restart_load - type(restart_t), optional, intent(in) :: restart_dump - end subroutine scf_run - - module subroutine scf_end(scf) - type(scf_t), intent(inout) :: scf - end subroutine scf_end - - module subroutine scf_state_info(namespace, st) - type(namespace_t), intent(in) :: namespace - class(states_abst_t), intent(in) :: st - end subroutine scf_state_info - - module subroutine scf_print_mem_use(namespace) - type(namespace_t), intent(in) :: namespace - end subroutine scf_print_mem_use - end interface -end module scf_oct_m - submodule (scf_oct_m) impl use batch_ops_oct_m use criteria_factory_oct_m diff --git a/src/scf/scf_h.F90 b/src/scf/scf_h.F90 new file mode 100644 index 0000000000..d42d79951d --- /dev/null +++ b/src/scf/scf_h.F90 @@ -0,0 +1,117 @@ +module scf_oct_m + use berry_oct_m + use convergence_criterion_oct_m + use eigensolver_oct_m + use electron_space_oct_m + use global_oct_m + use grid_oct_m + use hamiltonian_elec_oct_m + use interaction_partner_oct_m + use ions_oct_m + use lda_u_mixer_oct_m + use mix_oct_m + use multicomm_oct_m + use namespace_oct_m + use output_low_oct_m + use restart_oct_m + use space_oct_m + use states_abst_oct_m + use states_elec_oct_m + use v_ks_oct_m + + implicit none + + private + public :: & + scf_t, & + scf_init, & + scf_mix_clear, & + scf_run, & + scf_end, & + scf_state_info, & + scf_print_mem_use + + integer, public, parameter :: & + VERB_NO = 0, & + VERB_COMPACT = 1, & + VERB_FULL = 3 + + !> some variables used for the SCF cycle + type scf_t + private + integer, public :: max_iter !< maximum number of SCF iterations + + real(real64), public :: lmm_r + + ! several convergence criteria + logical :: conv_eigen_error + logical :: check_conv + + integer :: mix_field + logical :: lcao_restricted + logical :: calc_force + logical, public :: calc_stress + logical :: calc_dipole + logical :: calc_partial_charges + type(mix_t) :: smix + type(mixfield_t), pointer :: mixfield + type(eigensolver_t) :: eigens + integer :: mixdim1 + logical :: forced_finish !< remember if 'touch stop' was triggered earlier. + type(lda_u_mixer_t) :: lda_u_mix + type(berry_t) :: berry + integer :: matvec !< number matrix-vector products + + type(criterion_list_t), public :: criterion_list + real(real64) :: energy_in, energy_diff, abs_dens_diff, evsum_in, evsum_out, evsum_diff + end type scf_t + + interface + module subroutine scf_init(scf, namespace, gr, ions, st, mc, hm, space) + type(scf_t), intent(inout) :: scf + type(grid_t), intent(in) :: gr + type(namespace_t), intent(in) :: namespace + type(ions_t), intent(in) :: ions + type(states_elec_t), intent(in) :: st + type(multicomm_t), intent(in) :: mc + type(hamiltonian_elec_t), intent(inout) :: hm + class(space_t), intent(in) :: space + end subroutine scf_init + + module subroutine scf_mix_clear(scf) + type(scf_t), intent(inout) :: scf + end subroutine scf_mix_clear + + module subroutine scf_run(scf, namespace, space, mc, gr, ions, ext_partners, st, ks, hm, outp, & + verbosity, iters_done, restart_load, restart_dump) + type(scf_t), intent(inout) :: scf !< self consistent cycle + type(namespace_t), intent(in) :: namespace + type(electron_space_t), intent(in) :: space + type(multicomm_t), intent(in) :: mc + type(grid_t), intent(inout) :: gr !< grid + type(ions_t), intent(inout) :: ions !< geometry + type(partner_list_t), intent(in) :: ext_partners + type(states_elec_t), intent(inout) :: st !< States + type(v_ks_t), intent(inout) :: ks !< Kohn-Sham + type(hamiltonian_elec_t), intent(inout) :: hm !< Hamiltonian + type(output_t), optional, intent(in) :: outp + integer, optional, intent(in) :: verbosity + integer, optional, intent(out) :: iters_done + type(restart_t), optional, intent(in) :: restart_load + type(restart_t), optional, intent(in) :: restart_dump + end subroutine scf_run + + module subroutine scf_end(scf) + type(scf_t), intent(inout) :: scf + end subroutine scf_end + + module subroutine scf_state_info(namespace, st) + type(namespace_t), intent(in) :: namespace + class(states_abst_t), intent(in) :: st + end subroutine scf_state_info + + module subroutine scf_print_mem_use(namespace) + type(namespace_t), intent(in) :: namespace + end subroutine scf_print_mem_use + end interface +end module scf_oct_m -- GitLab From 73c8c2927847500cc9b90099500cfc664cceb5bd Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Tue, 23 Apr 2024 20:41:36 +0200 Subject: [PATCH 23/43] Move scf interface subroutines to `scf_interface_oct_m` Signed-off-by: Cristian Le --- src/Makefile.am | 3 +- src/electrons/electrons.F90 | 1 + src/main/geom_opt.F90 | 1 + src/main/phonons_fd.F90 | 1 + src/main/static_pol.F90 | 1 + src/scf/CMakeLists.txt | 3 +- src/scf/electrons_ground_state.F90 | 1 + src/scf/scf_h.F90 | 104 ++++--------------------- src/scf/{scf.F90 => scf_interface.F90} | 7 +- src/scf/scf_interface_h.F90 | 77 ++++++++++++++++++ src/scf/unocc.F90 | 1 + src/td/propagator_elec.F90 | 1 + src/td/td_interface.F90 | 1 + 13 files changed, 112 insertions(+), 90 deletions(-) rename src/scf/{scf.F90 => scf_interface.F90} (99%) create mode 100644 src/scf/scf_interface_h.F90 diff --git a/src/Makefile.am b/src/Makefile.am index 9a2b169c26..9b57ede94f 100644 --- a/src/Makefile.am +++ b/src/Makefile.am @@ -735,7 +735,8 @@ scf_f_srcs = \ scf/mix.F90 \ scf/mixing_preconditioner.F90 \ scf/rdmft.F90 \ - scf/scf.F90 \ + scf/scf_interface.F90 \ + scf/scf_interface_h.F90 \ scf/scf_h.F90 \ scf/unocc.F90 diff --git a/src/electrons/electrons.F90 b/src/electrons/electrons.F90 index d76a94cfaa..8ef4bd8a0d 100644 --- a/src/electrons/electrons.F90 +++ b/src/electrons/electrons.F90 @@ -67,6 +67,7 @@ submodule (electrons_oct_m) impl use profiling_oct_m use quantity_oct_m use regridding_oct_m + use scf_interface_oct_m use space_oct_m use states_abst_oct_m use states_elec_dim_oct_m diff --git a/src/main/geom_opt.F90 b/src/main/geom_opt.F90 index 51a13c1c99..1249dddaa6 100644 --- a/src/main/geom_opt.F90 +++ b/src/main/geom_opt.F90 @@ -46,6 +46,7 @@ module geom_opt_oct_m use profiling_oct_m use read_coords_oct_m use restart_oct_m + use scf_interface_oct_m use scf_oct_m use species_oct_m use states_elec_oct_m diff --git a/src/main/phonons_fd.F90 b/src/main/phonons_fd.F90 index 6eff8e1c60..92ad4e2715 100644 --- a/src/main/phonons_fd.F90 +++ b/src/main/phonons_fd.F90 @@ -39,6 +39,7 @@ module phonons_fd_oct_m use parser_oct_m use profiling_oct_m use restart_oct_m + use scf_interface_oct_m use scf_oct_m use space_oct_m use states_elec_oct_m diff --git a/src/main/static_pol.F90 b/src/main/static_pol.F90 index ac404ef5b5..4af6a1b65b 100644 --- a/src/main/static_pol.F90 +++ b/src/main/static_pol.F90 @@ -39,6 +39,7 @@ module static_pol_oct_m use parser_oct_m use profiling_oct_m use restart_oct_m + use scf_interface_oct_m use scf_oct_m use space_oct_m use states_abst_oct_m diff --git a/src/scf/CMakeLists.txt b/src/scf/CMakeLists.txt index 50f31a2304..1bb8cb1b2a 100644 --- a/src/scf/CMakeLists.txt +++ b/src/scf/CMakeLists.txt @@ -10,8 +10,9 @@ target_sources(Octopus_lib PRIVATE mix.F90 mixing_preconditioner.F90 rdmft.F90 - scf.F90 scf_h.F90 + scf_interface.F90 + scf_interface_h.F90 unocc.F90 ) ## Unused sources diff --git a/src/scf/electrons_ground_state.F90 b/src/scf/electrons_ground_state.F90 index a12c891ca7..1f00a57fcd 100644 --- a/src/scf/electrons_ground_state.F90 +++ b/src/scf/electrons_ground_state.F90 @@ -30,6 +30,7 @@ submodule (electrons_ground_state_oct_m) impl use pcm_oct_m use rdmft_oct_m use restart_oct_m + use scf_interface_oct_m use scf_oct_m use space_oct_m use states_abst_oct_m diff --git a/src/scf/scf_h.F90 b/src/scf/scf_h.F90 index d42d79951d..920eda90d0 100644 --- a/src/scf/scf_h.F90 +++ b/src/scf/scf_h.F90 @@ -2,34 +2,13 @@ module scf_oct_m use berry_oct_m use convergence_criterion_oct_m use eigensolver_oct_m - use electron_space_oct_m use global_oct_m - use grid_oct_m - use hamiltonian_elec_oct_m - use interaction_partner_oct_m - use ions_oct_m use lda_u_mixer_oct_m use mix_oct_m - use multicomm_oct_m - use namespace_oct_m - use output_low_oct_m - use restart_oct_m - use space_oct_m - use states_abst_oct_m - use states_elec_oct_m - use v_ks_oct_m implicit none private - public :: & - scf_t, & - scf_init, & - scf_mix_clear, & - scf_run, & - scf_end, & - scf_state_info, & - scf_print_mem_use integer, public, parameter :: & VERB_NO = 0, & @@ -37,81 +16,32 @@ module scf_oct_m VERB_FULL = 3 !> some variables used for the SCF cycle - type scf_t + type, public :: scf_t private integer, public :: max_iter !< maximum number of SCF iterations real(real64), public :: lmm_r ! several convergence criteria - logical :: conv_eigen_error - logical :: check_conv + logical, public :: conv_eigen_error + logical, public :: check_conv - integer :: mix_field - logical :: lcao_restricted - logical :: calc_force + integer, public :: mix_field + logical, public :: lcao_restricted + logical, public :: calc_force logical, public :: calc_stress - logical :: calc_dipole - logical :: calc_partial_charges - type(mix_t) :: smix - type(mixfield_t), pointer :: mixfield - type(eigensolver_t) :: eigens - integer :: mixdim1 - logical :: forced_finish !< remember if 'touch stop' was triggered earlier. - type(lda_u_mixer_t) :: lda_u_mix - type(berry_t) :: berry - integer :: matvec !< number matrix-vector products + logical, public :: calc_dipole + logical, public :: calc_partial_charges + type(mix_t), public :: smix + type(mixfield_t), public, pointer :: mixfield + type(eigensolver_t), public :: eigens + integer, public :: mixdim1 + logical, public :: forced_finish !< remember if 'touch stop' was triggered earlier. + type(lda_u_mixer_t), public :: lda_u_mix + type(berry_t), public :: berry + integer, public :: matvec !< number matrix-vector products type(criterion_list_t), public :: criterion_list - real(real64) :: energy_in, energy_diff, abs_dens_diff, evsum_in, evsum_out, evsum_diff + real(real64), public :: energy_in, energy_diff, abs_dens_diff, evsum_in, evsum_out, evsum_diff end type scf_t - - interface - module subroutine scf_init(scf, namespace, gr, ions, st, mc, hm, space) - type(scf_t), intent(inout) :: scf - type(grid_t), intent(in) :: gr - type(namespace_t), intent(in) :: namespace - type(ions_t), intent(in) :: ions - type(states_elec_t), intent(in) :: st - type(multicomm_t), intent(in) :: mc - type(hamiltonian_elec_t), intent(inout) :: hm - class(space_t), intent(in) :: space - end subroutine scf_init - - module subroutine scf_mix_clear(scf) - type(scf_t), intent(inout) :: scf - end subroutine scf_mix_clear - - module subroutine scf_run(scf, namespace, space, mc, gr, ions, ext_partners, st, ks, hm, outp, & - verbosity, iters_done, restart_load, restart_dump) - type(scf_t), intent(inout) :: scf !< self consistent cycle - type(namespace_t), intent(in) :: namespace - type(electron_space_t), intent(in) :: space - type(multicomm_t), intent(in) :: mc - type(grid_t), intent(inout) :: gr !< grid - type(ions_t), intent(inout) :: ions !< geometry - type(partner_list_t), intent(in) :: ext_partners - type(states_elec_t), intent(inout) :: st !< States - type(v_ks_t), intent(inout) :: ks !< Kohn-Sham - type(hamiltonian_elec_t), intent(inout) :: hm !< Hamiltonian - type(output_t), optional, intent(in) :: outp - integer, optional, intent(in) :: verbosity - integer, optional, intent(out) :: iters_done - type(restart_t), optional, intent(in) :: restart_load - type(restart_t), optional, intent(in) :: restart_dump - end subroutine scf_run - - module subroutine scf_end(scf) - type(scf_t), intent(inout) :: scf - end subroutine scf_end - - module subroutine scf_state_info(namespace, st) - type(namespace_t), intent(in) :: namespace - class(states_abst_t), intent(in) :: st - end subroutine scf_state_info - - module subroutine scf_print_mem_use(namespace) - type(namespace_t), intent(in) :: namespace - end subroutine scf_print_mem_use - end interface end module scf_oct_m diff --git a/src/scf/scf.F90 b/src/scf/scf_interface.F90 similarity index 99% rename from src/scf/scf.F90 rename to src/scf/scf_interface.F90 index cc25a6c198..a4a362586b 100644 --- a/src/scf/scf.F90 +++ b/src/scf/scf_interface.F90 @@ -18,12 +18,15 @@ #include "global.h" -submodule (scf_oct_m) impl +submodule (scf_interface_oct_m) impl use batch_ops_oct_m + use berry_oct_m + use convergence_criterion_oct_m use criteria_factory_oct_m use debug_oct_m use density_criterion_oct_m use density_oct_m + use eigensolver_oct_m use eigenval_criterion_oct_m use energy_calc_oct_m use energy_criterion_oct_m @@ -33,6 +36,7 @@ submodule (scf_oct_m) impl use lalg_basic_oct_m use lcao_oct_m use lda_u_io_oct_m + use lda_u_mixer_oct_m use lda_u_oct_m use loct_oct_m use magnetic_oct_m @@ -40,6 +44,7 @@ submodule (scf_oct_m) impl use mesh_function_oct_m use mesh_oct_m use messages_oct_m + use mix_oct_m use modelmb_exchange_syms_oct_m use mpi_oct_m use output_modelmb_oct_m diff --git a/src/scf/scf_interface_h.F90 b/src/scf/scf_interface_h.F90 new file mode 100644 index 0000000000..6da78e0c57 --- /dev/null +++ b/src/scf/scf_interface_h.F90 @@ -0,0 +1,77 @@ +module scf_interface_oct_m + use electron_space_oct_m + use global_oct_m + use grid_oct_m + use hamiltonian_elec_oct_m + use interaction_partner_oct_m + use ions_oct_m + use multicomm_oct_m + use namespace_oct_m + use output_low_oct_m + use restart_oct_m + use scf_oct_m + use space_oct_m + use states_abst_oct_m + use states_elec_oct_m + use v_ks_oct_m + + implicit none + + private + public :: & + scf_init, & + scf_mix_clear, & + scf_run, & + scf_end, & + scf_state_info, & + scf_print_mem_use + + interface + module subroutine scf_init(scf, namespace, gr, ions, st, mc, hm, space) + type(scf_t), intent(inout) :: scf + type(grid_t), intent(in) :: gr + type(namespace_t), intent(in) :: namespace + type(ions_t), intent(in) :: ions + type(states_elec_t), intent(in) :: st + type(multicomm_t), intent(in) :: mc + type(hamiltonian_elec_t), intent(inout) :: hm + class(space_t), intent(in) :: space + end subroutine scf_init + + module subroutine scf_mix_clear(scf) + type(scf_t), intent(inout) :: scf + end subroutine scf_mix_clear + + module subroutine scf_run(scf, namespace, space, mc, gr, ions, ext_partners, st, ks, hm, outp, & + verbosity, iters_done, restart_load, restart_dump) + type(scf_t), intent(inout) :: scf !< self consistent cycle + type(namespace_t), intent(in) :: namespace + type(electron_space_t), intent(in) :: space + type(multicomm_t), intent(in) :: mc + type(grid_t), intent(inout) :: gr !< grid + type(ions_t), intent(inout) :: ions !< geometry + type(partner_list_t), intent(in) :: ext_partners + type(states_elec_t), intent(inout) :: st !< States + type(v_ks_t), intent(inout) :: ks !< Kohn-Sham + type(hamiltonian_elec_t), intent(inout) :: hm !< Hamiltonian + type(output_t), optional, intent(in) :: outp + integer, optional, intent(in) :: verbosity + integer, optional, intent(out) :: iters_done + type(restart_t), optional, intent(in) :: restart_load + type(restart_t), optional, intent(in) :: restart_dump + end subroutine scf_run + + module subroutine scf_end(scf) + type(scf_t), intent(inout) :: scf + end subroutine scf_end + + module subroutine scf_state_info(namespace, st) + type(namespace_t), intent(in) :: namespace + class(states_abst_t), intent(in) :: st + end subroutine scf_state_info + + module subroutine scf_print_mem_use(namespace) + type(namespace_t), intent(in) :: namespace + end subroutine scf_print_mem_use + end interface +end module scf_interface_oct_m diff --git a/src/scf/unocc.F90 b/src/scf/unocc.F90 index 6373a84cd6..9318ddf103 100644 --- a/src/scf/unocc.F90 +++ b/src/scf/unocc.F90 @@ -40,6 +40,7 @@ module unocc_oct_m use parser_oct_m use profiling_oct_m use restart_oct_m + use scf_interface_oct_m use scf_oct_m use space_oct_m use states_abst_oct_m diff --git a/src/td/propagator_elec.F90 b/src/td/propagator_elec.F90 index 9febe7acd3..8746360bb4 100644 --- a/src/td/propagator_elec.F90 +++ b/src/td/propagator_elec.F90 @@ -39,6 +39,7 @@ submodule (propagator_elec_oct_m) impl use propagator_qoct_oct_m use propagator_rk_oct_m use propagator_verlet_oct_m + use scf_interface_oct_m use sparskit_oct_m use stress_oct_m use varinfo_oct_m diff --git a/src/td/td_interface.F90 b/src/td/td_interface.F90 index 4492e548c6..f2e954bd1f 100644 --- a/src/td/td_interface.F90 +++ b/src/td/td_interface.F90 @@ -56,6 +56,7 @@ submodule (td_interface_oct_m) impl use propagator_elec_oct_m use propagator_oct_m use restart_oct_m + use scf_interface_oct_m use scf_oct_m use scissor_oct_m use states_abst_oct_m -- GitLab From b6307bb6bff477edb479263a25d758637fe7b0a6 Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Fri, 10 May 2024 19:34:28 +0200 Subject: [PATCH 24/43] Dirty fix for autotools builder Signed-off-by: Cristian Le --- src/basic/global.F90 | 1 + src/electrons/electrons.F90 | 1 + src/hamiltonian/hamiltonian_elec.F90 | 1 + src/maxwell/hamiltonian_mxll.F90 | 1 + src/multisystem/system.F90 | 1 + src/scf/electrons_ground_state.F90 | 1 + src/scf/scf_interface.F90 | 1 + src/td/propagator_elec.F90 | 1 + src/td/td_interface.F90 | 1 + 9 files changed, 9 insertions(+) diff --git a/src/basic/global.F90 b/src/basic/global.F90 index dc588b7f3f..9ffc7fb5fa 100644 --- a/src/basic/global.F90 +++ b/src/basic/global.F90 @@ -19,6 +19,7 @@ #include "global.h" submodule (global_oct_m) impl + use global_oct_m use hardware_oct_m use loct_oct_m use varinfo_oct_m diff --git a/src/electrons/electrons.F90 b/src/electrons/electrons.F90 index 8ef4bd8a0d..862d412607 100644 --- a/src/electrons/electrons.F90 +++ b/src/electrons/electrons.F90 @@ -21,6 +21,7 @@ #include "global.h" submodule (electrons_oct_m) impl + use electrons_oct_m use accel_oct_m use absorbing_boundaries_oct_m use calc_mode_par_oct_m diff --git a/src/hamiltonian/hamiltonian_elec.F90 b/src/hamiltonian/hamiltonian_elec.F90 index ff9d6c813f..3db64544fc 100644 --- a/src/hamiltonian/hamiltonian_elec.F90 +++ b/src/hamiltonian/hamiltonian_elec.F90 @@ -20,6 +20,7 @@ #include "global.h" submodule (hamiltonian_elec_oct_m) impl + use hamiltonian_elec_oct_m use accel_oct_m use affine_coordinates_oct_m use batch_ops_oct_m diff --git a/src/maxwell/hamiltonian_mxll.F90 b/src/maxwell/hamiltonian_mxll.F90 index ca15634cdb..62774d567d 100644 --- a/src/maxwell/hamiltonian_mxll.F90 +++ b/src/maxwell/hamiltonian_mxll.F90 @@ -19,6 +19,7 @@ #include "global.h" submodule (hamiltonian_mxll_oct_m) impl + use hamiltonian_mxll_oct_m use accel_oct_m use batch_ops_oct_m use boundaries_oct_m diff --git a/src/multisystem/system.F90 b/src/multisystem/system.F90 index cb16c27b6e..2c8faaa7de 100644 --- a/src/multisystem/system.F90 +++ b/src/multisystem/system.F90 @@ -21,6 +21,7 @@ #include "global.h" submodule (system_oct_m) impl + use system_oct_m use debug_oct_m use ghost_interaction_oct_m use global_oct_m diff --git a/src/scf/electrons_ground_state.F90 b/src/scf/electrons_ground_state.F90 index 1f00a57fcd..c4a7c70fb1 100644 --- a/src/scf/electrons_ground_state.F90 +++ b/src/scf/electrons_ground_state.F90 @@ -19,6 +19,7 @@ #include "global.h" submodule (electrons_ground_state_oct_m) impl + use electrons_ground_state_oct_m use debug_oct_m use global_oct_m use hamiltonian_elec_oct_m diff --git a/src/scf/scf_interface.F90 b/src/scf/scf_interface.F90 index a4a362586b..0c6fa7cdd4 100644 --- a/src/scf/scf_interface.F90 +++ b/src/scf/scf_interface.F90 @@ -19,6 +19,7 @@ #include "global.h" submodule (scf_interface_oct_m) impl + use scf_interface_oct_m use batch_ops_oct_m use berry_oct_m use convergence_criterion_oct_m diff --git a/src/td/propagator_elec.F90 b/src/td/propagator_elec.F90 index 8746360bb4..20cd7a8fc2 100644 --- a/src/td/propagator_elec.F90 +++ b/src/td/propagator_elec.F90 @@ -19,6 +19,7 @@ #include "global.h" submodule (propagator_elec_oct_m) impl + use propagator_elec_oct_m use debug_oct_m use energy_calc_oct_m use exponential_oct_m diff --git a/src/td/td_interface.F90 b/src/td/td_interface.F90 index f2e954bd1f..2a3e95e6ce 100644 --- a/src/td/td_interface.F90 +++ b/src/td/td_interface.F90 @@ -19,6 +19,7 @@ #include "global.h" submodule (td_interface_oct_m) impl + use td_interface_oct_m use absorbing_boundaries_oct_m use boundaries_oct_m use calc_mode_par_oct_m -- GitLab From 8dfaf82d5218ea37fc6e5c118088314fe2cafcfb Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Tue, 30 May 2023 14:32:17 +0200 Subject: [PATCH 25/43] Change `td_run` signature Signed-off-by: Cristian Le --- src/main/time_dependent.F90 | 3 +- src/td/td_interface.F90 | 70 +++++++++++++++++-------------------- src/td/td_interface_h.F90 | 15 ++------ 3 files changed, 37 insertions(+), 51 deletions(-) diff --git a/src/main/time_dependent.F90 b/src/main/time_dependent.F90 index 468f14985f..3af391c13f 100644 --- a/src/main/time_dependent.F90 +++ b/src/main/time_dependent.F90 @@ -136,8 +136,7 @@ contains electrons%hm, electrons%ext_partners, electrons%outp) call td_init_run(electrons%td, electrons%namespace, electrons%mc, electrons%gr, electrons%ions, electrons%st, electrons%ks, & electrons%hm, electrons%ext_partners, electrons%outp, electrons%space, from_scratch) - call td_run(electrons%td, electrons%namespace, electrons%mc, electrons%gr, electrons%ions, electrons%st, electrons%ks, & - electrons%hm, electrons%ext_partners, electrons%outp, electrons%space, from_scratch) + call td_run(electrons, from_scratch) call td_end_run(electrons%td, electrons%st, electrons%hm) call td_end(electrons%td) diff --git a/src/td/td_interface.F90 b/src/td/td_interface.F90 index 2a3e95e6ce..3e3b704124 100644 --- a/src/td/td_interface.F90 +++ b/src/td/td_interface.F90 @@ -484,18 +484,8 @@ contains end subroutine td_end_run ! --------------------------------------------------------- - module subroutine td_run(td, namespace, mc, gr, ions, st, ks, hm, ext_partners, outp, space, from_scratch) - type(td_t), intent(inout) :: td - type(namespace_t), intent(in) :: namespace - type(multicomm_t), intent(inout) :: mc - type(grid_t), intent(inout) :: gr - type(ions_t), intent(inout) :: ions - type(states_elec_t), intent(inout) :: st - type(v_ks_t), intent(inout) :: ks - type(hamiltonian_elec_t), intent(inout) :: hm - type(partner_list_t), intent(in) :: ext_partners - type(output_t), intent(inout) :: outp - type(electron_space_t), intent(in) :: space + module subroutine td_run(sys, from_scratch) + type(electrons_t), intent(inout) :: sys logical, intent(inout) :: from_scratch logical :: stopping @@ -506,62 +496,68 @@ contains etime = loct_clock() ! This is the time-propagation loop. It starts at t=0 and finishes - ! at td%max_iter*dt. The index i runs from 1 to td%max_iter, and + ! at sys%td%max_iter*dt. The index i runs from 1 to sys%td%max_iter, and ! step "iter" means propagation from (iter-1)*dt to iter*dt. - propagation: do iter = td%iter, td%max_iter + propagation: do iter = sys%td%iter, sys%td%max_iter - stopping = clean_stop(mc%master_comm) .or. walltimer_alarm(mc%master_comm) + stopping = clean_stop(sys%mc%master_comm) .or. walltimer_alarm(sys%mc%master_comm) call profiling_in("TIME_STEP") if (iter > 1) then - if (((iter-1)*td%dt <= hm%kick%time) .and. (iter*td%dt > hm%kick%time)) then - if (.not. hm%pcm%localf) then - call kick_apply(space, gr, st, td%ions_dyn, ions, hm%kick, hm%psolver, hm%kpoints) + if (((iter-1)*sys%td%dt <= sys%hm%kick%time) .and. (iter*sys%td%dt > sys%hm%kick%time)) then + if (.not. sys%hm%pcm%localf) then + call kick_apply(sys%space, sys%gr, sys%st, sys%td%ions_dyn, sys%ions, & + sys%hm%kick, sys%hm%psolver, sys%hm%kpoints) else - call kick_apply(space, gr, st, td%ions_dyn, ions, hm%kick, hm%psolver, hm%kpoints, pcm = hm%pcm) + call kick_apply(sys%space, sys%gr, sys%st, sys%td%ions_dyn, sys%ions, & + sys%hm%kick, sys%hm%psolver, sys%hm%kpoints, pcm = sys%hm%pcm) end if - call td_write_kick(outp, namespace, space, gr, hm%kick, ions, iter) + call td_write_kick(sys%outp, sys%namespace, sys%space, sys%gr, sys%hm%kick, sys%ions, iter) !We activate the sprial BC only after the kick, !to be sure that the first iteration corresponds to the ground state - if (gr%der%boundaries%spiralBC) gr%der%boundaries%spiral = .true. + if (sys%gr%der%boundaries%spiralBC) sys%gr%der%boundaries%spiral = .true. end if end if ! time iterate the system, one time step. - select case (td%dynamics) + select case (sys%td%dynamics) case (EHRENFEST) - call propagator_elec_dt(ks, namespace, space, hm, gr, st, td%tr, iter*td%dt, td%dt, iter, td%ions_dyn, & - ions, ext_partners, outp, td%write_handler, scsteps = scsteps, & - update_energy = (mod(iter, td%energy_update_iter) == 0) .or. (iter == td%max_iter)) + call propagator_elec_dt(sys%ks, sys%namespace, sys%space, sys%hm, sys%gr, sys%st, sys%td%tr, & + iter*sys%td%dt, sys%td%dt, iter, sys%td%ions_dyn, & + sys%ions, sys%ext_partners, sys%outp, sys%td%write_handler, scsteps = scsteps, & + update_energy = (mod(iter, sys%td%energy_update_iter) == 0) .or. (iter == sys%td%max_iter)) case (BO) - call propagator_elec_dt_bo(td%scf, namespace, space, gr, ks, st, hm, ions, ext_partners, mc, outp, iter, & - td%dt, td%ions_dyn, scsteps) + call propagator_elec_dt_bo(sys%td%scf, sys%namespace, sys%space, sys%gr, sys%ks, sys%st, sys%hm, & + sys%ions, sys%ext_partners, sys%mc, sys%outp, iter, & + sys%td%dt, sys%td%ions_dyn, scsteps) end select !Apply mask absorbing boundaries - if (hm%abs_boundaries%abtype == MASK_ABSORBING) then - if (states_are_real(st)) then - call dvmask(gr, hm, st) + if (sys%hm%abs_boundaries%abtype == MASK_ABSORBING) then + if (states_are_real(sys%st)) then + call dvmask(sys%gr, sys%hm, sys%st) else - call zvmask(gr, hm, st) + call zvmask(sys%gr, sys%hm, sys%st) end if end if !Photoelectron stuff - if (td%pesv%calc_spm .or. td%pesv%calc_mask .or. td%pesv%calc_flux) then - call pes_calc(td%pesv, namespace, space, gr, st, td%dt, iter, gr%der, hm%kpoints, ext_partners, stopping) + if (sys%td%pesv%calc_spm .or. sys%td%pesv%calc_mask .or. sys%td%pesv%calc_flux) then + call pes_calc(sys%td%pesv, sys%namespace, sys%space, sys%gr, sys%st, sys%td%dt, iter, sys%gr%der, & + sys%hm%kpoints, sys%ext_partners, stopping) end if - call td_write_iter(td%write_handler, namespace, space, outp, gr, st, hm, ions, ext_partners, & - hm%kick, ks, td%dt, iter, mc, td%recalculate_gs) + call td_write_iter(sys%td%write_handler, sys%namespace, sys%space, sys%outp, sys%gr, sys%st, sys%hm, & + sys%ions, sys%ext_partners, sys%hm%kick, sys%ks, sys%td%dt, iter, sys%mc, sys%td%recalculate_gs) ! write down data - call td_check_point(td, namespace, mc, gr, ions, st, ks, hm, ext_partners, outp, space, & + call td_check_point(sys%td, sys%namespace, sys%mc, sys%gr, sys%ions, sys%st, sys%ks, sys%hm, & + sys%ext_partners, sys%outp, sys%space, & iter, scsteps, etime, stopping, from_scratch) ! check if debug mode should be enabled or disabled on the fly - call io_debug_on_the_fly(namespace) + call io_debug_on_the_fly(sys%namespace) call profiling_out("TIME_STEP") if (stopping) exit diff --git a/src/td/td_interface_h.F90 b/src/td/td_interface_h.F90 index 86f99e6333..f6adca2a80 100644 --- a/src/td/td_interface_h.F90 +++ b/src/td/td_interface_h.F90 @@ -1,4 +1,5 @@ module td_interface_oct_m + use electrons_oct_m use electron_space_oct_m use grid_oct_m use hamiltonian_elec_oct_m @@ -33,18 +34,8 @@ module td_interface_oct_m ! Subroutine/Functions interface - module subroutine td_run(td, namespace, mc, gr, ions, st, ks, hm, ext_partners, outp, space, from_scratch) - type(td_t), intent(inout) :: td - type(namespace_t), intent(in) :: namespace - type(multicomm_t), intent(inout) :: mc - type(grid_t), intent(inout) :: gr - type(ions_t), intent(inout) :: ions - type(states_elec_t), intent(inout) :: st - type(v_ks_t), intent(inout) :: ks - type(hamiltonian_elec_t), intent(inout) :: hm - type(partner_list_t), intent(in) :: ext_partners - type(output_t), intent(inout) :: outp - type(electron_space_t), intent(in) :: space + module subroutine td_run(sys, from_scratch) + type(electrons_t), intent(inout) :: sys logical, intent(inout) :: from_scratch end subroutine td_run -- GitLab From 82d341c45aad72c82396a5c510bbdb6369c60e8c Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Tue, 20 Jun 2023 16:14:30 +0200 Subject: [PATCH 26/43] td_init: Change signature Signed-off-by: Cristian Le --- src/electrons/electrons.F90 | 3 +- src/main/time_dependent.F90 | 3 +- src/opt_control/opt_control.F90 | 43 ++++++----- src/td/td_interface.F90 | 128 +++++++++++++++----------------- src/td/td_interface_h.F90 | 13 +--- 5 files changed, 85 insertions(+), 105 deletions(-) diff --git a/src/electrons/electrons.F90 b/src/electrons/electrons.F90 index 862d412607..5bdc701f1e 100644 --- a/src/electrons/electrons.F90 +++ b/src/electrons/electrons.F90 @@ -443,8 +443,7 @@ contains select type (algo => this%algo) class is (propagator_t) - call td_init(this%td, this%namespace, this%space, this%gr, this%ions, this%st, this%ks, & - this%hm, this%ext_partners, this%outp) + call td_init(this) ! this corresponds to the first part of td_init_run call td_allocate_wavefunctions(this%td, this%namespace, this%mc, this%gr, this%ions, this%st, & diff --git a/src/main/time_dependent.F90 b/src/main/time_dependent.F90 index 3af391c13f..efebd98f88 100644 --- a/src/main/time_dependent.F90 +++ b/src/main/time_dependent.F90 @@ -132,8 +132,7 @@ contains PUSH_SUB(time_dependent_run_legacy) - call td_init(electrons%td, electrons%namespace, electrons%space, electrons%gr, electrons%ions, electrons%st, electrons%ks, & - electrons%hm, electrons%ext_partners, electrons%outp) + call td_init(electrons) call td_init_run(electrons%td, electrons%namespace, electrons%mc, electrons%gr, electrons%ions, electrons%st, electrons%ks, & electrons%hm, electrons%ext_partners, electrons%outp, electrons%space, from_scratch) call td_run(electrons, from_scratch) diff --git a/src/opt_control/opt_control.F90 b/src/opt_control/opt_control.F90 index 2953a3d09b..ba28d650be 100644 --- a/src/opt_control/opt_control.F90 +++ b/src/opt_control/opt_control.F90 @@ -112,7 +112,6 @@ contains subroutine opt_control_run_legacy(sys) type(electrons_t), target, intent(inout) :: sys - type(td_t), target :: td type(controlfunction_t) :: par, par_new, par_prev logical :: stop_loop real(real64) :: j1 @@ -137,16 +136,16 @@ contains ! Initializes the time propagator. Then, it forces the propagation to be self consistent, in case ! the theory level is not "independent particles". - call td_init(td, sys%namespace, sys%space, sys%gr, sys%ions, sys%st, sys%ks, sys%hm, sys%ext_partners, sys%outp) - if (sys%hm%theory_level /= INDEPENDENT_PARTICLES) call propagator_elec_set_scf_prop(td%tr, threshold = 1.0e-14_real64) + call td_init(sys) + if (sys%hm%theory_level /= INDEPENDENT_PARTICLES) call propagator_elec_set_scf_prop(sys%td%tr, threshold = 1.0e-14_real64) ! Read general information about how the OCT run will be made, from inp file. "oct_read_inp" is ! in the opt_control_global_oct_m module (like the definition of the oct_t data type) call oct_read_inp(oct, sys%namespace) ! Read info about, and prepare, the control functions - call controlfunction_mod_init(sys%ext_partners, sys%namespace, td%dt, td%max_iter, oct%mode_fixed_fluence) - call controlfunction_init(par, td%dt, td%max_iter) + call controlfunction_mod_init(sys%ext_partners, sys%namespace, sys%td%dt, sys%td%max_iter, oct%mode_fixed_fluence) + call controlfunction_init(par, sys%td%dt, sys%td%max_iter) call controlfunction_set(par, sys%ext_partners) ! This prints the initial control parameters, exactly as described in the inp file, ! that is, without applying any envelope or filter. @@ -165,7 +164,7 @@ contains ! Initialization of the propagation_oct_m module. - call propagation_mod_init(td%max_iter, oct%eta, oct%delta, oct%number_checkpoints, & + call propagation_mod_init(sys%td%max_iter, oct%eta, oct%delta, oct%number_checkpoints, & (oct%algorithm == OPTION__OCTSCHEME__OCT_ZBR98), & (oct%algorithm == OPTION__OCTSCHEME__OCT_CG) .or. & (oct%algorithm == OPTION__OCTSCHEME__OCT_BFGS) .or. & @@ -173,17 +172,17 @@ contains ! If filters are to be used, they also have to be initialized. - call filter_init(td%max_iter, sys%namespace, td%dt, filter) + call filter_init(sys%td%max_iter, sys%namespace, sys%td%dt, filter) call filter_write(filter, sys%namespace) ! Figure out the starting wavefunction(s), and the target. call initial_state_init(sys, initial_st) - call target_init(sys%gr, sys%kpoints, sys%namespace, sys%space, sys%ions, initial_st, td, & + call target_init(sys%gr, sys%kpoints, sys%namespace, sys%space, sys%ions, initial_st, sys%td, & controlfunction_w0(par), oct_target, oct, sys%hm%ep, sys%mc) ! Sanity checks. - call check_faulty_runmodes(sys, td%tr) + call check_faulty_runmodes(sys, sys%td%tr) ! Informative output. @@ -244,13 +243,13 @@ contains end select ! do final test run: propagate initial state with optimal field - call oct_finalcheck(sys, td) + call oct_finalcheck(sys, sys%td) ! clean up call controlfunction_end(par) call oct_iterator_end(iterator, sys%namespace) call filter_end(filter) - call td_end(td) + call td_end(sys%td) call opt_control_state_end(initial_st) call target_end(oct_target, oct) call controlfunction_mod_close() @@ -268,7 +267,7 @@ contains call controlfunction_copy(par_new, par) ctr_loop: do call controlfunction_copy(par_prev, par) - call f_striter(sys, td, par, j1) + call f_striter(sys, sys%td, par, j1) stop_loop = iteration_manager(sys%namespace, j1, par_prev, par, iterator) if (clean_stop(sys%mc%master_comm) .or. stop_loop) exit ctr_loop end do ctr_loop @@ -293,7 +292,7 @@ contains call controlfunction_copy(par_new, par) ctr_loop: do call controlfunction_copy(par_prev, par) - call f_iter(sys, td, psi, par, prop_psi, prop_chi, j1) + call f_iter(sys, sys%td, psi, par, prop_psi, prop_chi, j1) stop_loop = iteration_manager(sys%namespace, j1, par, par_prev, iterator) if (clean_stop(sys%mc%master_comm) .or. stop_loop) exit ctr_loop end do ctr_loop @@ -325,7 +324,7 @@ contains call controlfunction_copy(par_new, par) ctr_loop: do call controlfunction_copy(par_prev, par) - call f_wg05(sys, td, psi, par, prop_psi, prop_chi, j1) + call f_wg05(sys, sys%td, psi, par, prop_psi, prop_chi, j1) stop_loop = iteration_manager(sys%namespace, j1, par, par_prev, iterator) if (clean_stop(sys%mc%master_comm) .or. stop_loop) exit ctr_loop end do ctr_loop @@ -351,7 +350,7 @@ contains call oct_prop_init(prop_psi, sys%namespace, "psi", sys%gr, sys%mc) call controlfunction_copy(par_prev, par) - call propagate_forward(sys, td, par, oct_target, qcpsi, prop_psi) + call propagate_forward(sys, sys%td, par, oct_target, qcpsi, prop_psi) j1 = target_j1(oct_target, sys%namespace, sys%gr, sys%kpoints, qcpsi) stop_loop = iteration_manager(sys%namespace, j1, par, par_prev, iterator) if (clean_stop(sys%mc%master_comm) .or. stop_loop) then @@ -365,7 +364,7 @@ contains call controlfunction_copy(par_new, par) ctr_loop: do call controlfunction_copy(par_prev, par) - call f_zbr98(sys, td, qcpsi, prop_psi, prop_chi, par) + call f_zbr98(sys, sys%td, qcpsi, prop_psi, prop_chi, par) j1 = target_j1(oct_target, sys%namespace, sys%gr, sys%kpoints, qcpsi) stop_loop = iteration_manager(sys%namespace, j1, par, par_prev, iterator) if (clean_stop(sys%mc%master_comm) .or. stop_loop) exit ctr_loop @@ -395,7 +394,7 @@ contains call opt_control_state_null(qcpsi) call opt_control_state_copy(qcpsi, initial_st) - call propagate_forward(sys, td, par, oct_target, qcpsi) + call propagate_forward(sys, sys%td, par, oct_target, qcpsi) f = - target_j1(oct_target, sys%namespace, sys%gr, sys%kpoints, qcpsi, sys%ions) - controlfunction_j2(par) call opt_control_state_end(qcpsi) call iteration_manager_direct(-f, par, iterator, sys) @@ -412,7 +411,7 @@ contains call controlfunction_copy(par_, par) sys_ => sys hm_ => sys%hm - td_ => td + td_ => sys%td dof = controlfunction_dof(par) SAFE_ALLOCATE(x(1:dof)) @@ -470,7 +469,7 @@ contains call opt_control_state_null(qcpsi) call opt_control_state_copy(qcpsi, initial_st) - call propagate_forward(sys, td, par, oct_target, qcpsi) + call propagate_forward(sys, sys%td, par, oct_target, qcpsi) f = - target_j1(oct_target, sys%namespace, sys%gr, sys%kpoints, qcpsi, sys%ions) - controlfunction_j2(par) call opt_control_state_end(qcpsi) call iteration_manager_direct(-f, par, iterator, sys) @@ -490,7 +489,7 @@ contains call controlfunction_copy(par_, par) sys_ => sys hm_ => sys%hm - td_ => td + td_ => sys%td ! theta may be in single precision, whereas x is always double precision. call controlfunction_get_theta(par, theta) @@ -535,7 +534,7 @@ contains call opt_control_state_null(qcpsi) call opt_control_state_copy(qcpsi, initial_st) - call propagate_forward(sys, td, par, oct_target, qcpsi) + call propagate_forward(sys, sys%td, par, oct_target, qcpsi) f = - target_j1(oct_target, sys%namespace, sys%gr, sys%kpoints, qcpsi, sys%ions) - controlfunction_j2(par) call opt_control_state_end(qcpsi) call iteration_manager_direct(-f, par, iterator, sys) @@ -558,7 +557,7 @@ contains call controlfunction_copy(par_, par) sys_ => sys hm_ => sys%hm - td_ => td + td_ => sys%td call controlfunction_get_theta(par, x) diff --git a/src/td/td_interface.F90 b/src/td/td_interface.F90 index 3e3b704124..f49e351e75 100644 --- a/src/td/td_interface.F90 +++ b/src/td/td_interface.F90 @@ -86,17 +86,8 @@ contains ! --------------------------------------------------------- - module subroutine td_init(td, namespace, space, gr, ions, st, ks, hm, ext_partners, outp) - type(td_t), intent(inout) :: td - type(namespace_t), intent(in) :: namespace - class(space_t), intent(in) :: space - type(grid_t), intent(in) :: gr - type(ions_t), intent(inout) :: ions - type(states_elec_t), intent(in) :: st - type(v_ks_t), intent(in) :: ks - type(hamiltonian_elec_t), intent(in) :: hm - type(partner_list_t), intent(in) :: ext_partners - type(output_t), intent(in) :: outp + module subroutine td_init(sys) + type(electrons_t), intent(inout) :: sys integer :: default real(real64) :: spacing, default_dt, propagation_time @@ -104,24 +95,24 @@ contains PUSH_SUB(td_init) - if (hm%pcm%run_pcm) call messages_experimental("PCM for CalculationMode = td", namespace=namespace) + if (sys%hm%pcm%run_pcm) call messages_experimental("PCM for CalculationMode = td", namespace=sys%namespace) - call ion_dynamics_init(td%ions_dyn, namespace, ions) + call ion_dynamics_init(sys%td%ions_dyn, sys%namespace, sys%ions) - if (ion_dynamics_ions_move(td%ions_dyn)) then - if (hm%kpoints%use_symmetries) then + if (ion_dynamics_ions_move(sys%td%ions_dyn)) then + if (sys%hm%kpoints%use_symmetries) then message(1) = "KPoints symmetries cannot be used with moving ions." message(2) = "Please set KPointsSymmetries = no." - call messages_fatal(2, namespace=namespace) + call messages_fatal(2, namespace=sys%namespace) end if - if (st%symmetrize_density) then + if (sys%st%symmetrize_density) then message(1) = "Symmetrization of the density cannot be used with moving ions." message(2) = "Please set SymmetrizeDensity = no." - call messages_fatal(2, namespace=namespace) + call messages_fatal(2, namespace=sys%namespace) end if end if - td%iter = 0 + sys%td%iter = 0 !%Variable TDTimeStep !%Type float @@ -139,22 +130,22 @@ contains !% However, you might need to adjust this value. !%End - spacing = minval(gr%spacing(1:space%dim)) + spacing = minval(sys%gr%spacing(1:sys%space%dim)) default_dt = 0.0426_real64 - 0.207_real64*spacing + 0.808_real64*spacing**2 - call parse_variable(namespace, 'TDTimeStep', default_dt, td%dt, unit = units_inp%time) + call parse_variable(sys%namespace, 'TDTimeStep', default_dt, sys%td%dt, unit = units_inp%time) - if (td%dt <= M_ZERO) then + if (sys%td%dt <= M_ZERO) then write(message(1),'(a)') 'Input: TDTimeStep must be positive.' - call messages_fatal(1, namespace=namespace) + call messages_fatal(1, namespace=sys%namespace) end if - call messages_print_var_value('TDTimeStep', td%dt, unit = units_out%time, namespace=namespace) + call messages_print_var_value('TDTimeStep', sys%td%dt, unit = units_out%time, namespace=sys%namespace) - if (parse_is_defined(namespace, 'TDMaxSteps') .and. parse_is_defined(namespace, 'TDPropagationTime')) then + if (parse_is_defined(sys%namespace, 'TDMaxSteps') .and. parse_is_defined(sys%namespace, 'TDPropagationTime')) then call messages_write('You cannot set TDMaxSteps and TDPropagationTime at the same time') - call messages_fatal(namespace=namespace) + call messages_fatal(namespace=sys%namespace) end if !%Variable TDPropagationTime @@ -169,9 +160,9 @@ contains !% selected ev_angstrom as input units). The approximate conversions to !% femtoseconds are 1 fs = 41.34 \hbar/Hartree = 1.52 \hbar/eV. !%End - call parse_variable(namespace, 'TDPropagationTime', -1.0_real64, propagation_time, unit = units_inp%time) + call parse_variable(sys%namespace, 'TDPropagationTime', -1.0_real64, propagation_time, unit = units_inp%time) - call messages_obsolete_variable(namespace, 'TDMaximumIter', 'TDMaxSteps') + call messages_obsolete_variable(sys%namespace, 'TDMaximumIter', 'TDMaxSteps') !%Variable TDMaxSteps !%Type integer @@ -182,29 +173,30 @@ contains !% cannot use this variable together with TDPropagationTime. !%End default = 1500 - if (propagation_time > M_ZERO) default = nint(propagation_time/td%dt) - call parse_variable(namespace, 'TDMaxSteps', default, td%max_iter) + if (propagation_time > M_ZERO) default = nint(propagation_time/sys%td%dt) + call parse_variable(sys%namespace, 'TDMaxSteps', default, sys%td%max_iter) - if (propagation_time <= M_ZERO) propagation_time = td%dt*td%max_iter + if (propagation_time <= M_ZERO) propagation_time = sys%td%dt*sys%td%max_iter - call messages_print_var_value('TDPropagationTime', propagation_time, unit = units_out%time, namespace=namespace) - call messages_print_var_value('TDMaxSteps', td%max_iter, namespace=namespace) + call messages_print_var_value('TDPropagationTime', propagation_time, unit = units_out%time, namespace=sys%namespace) + call messages_print_var_value('TDMaxSteps', sys%td%max_iter, namespace=sys%namespace) - if (td%max_iter < 1) then - write(message(1), '(a,i6,a)') "Input: '", td%max_iter, "' is not a valid value for TDMaxSteps." + if (sys%td%max_iter < 1) then + write(message(1), '(a,i6,a)') "Input: '", sys%td%max_iter, "' is not a valid value for TDMaxSteps." message(2) = '(TDMaxSteps <= 1)' - call messages_fatal(2, namespace=namespace) + call messages_fatal(2, namespace=sys%namespace) end if - td%iter = 0 + sys%td%iter = 0 - td%dt = td%dt + sys%td%dt = sys%td%dt - lasers => list_get_lasers(ext_partners) + lasers => list_get_lasers(sys%ext_partners) ! now the photoelectron stuff - call pes_init(td%pesv, namespace, space, gr, gr%box, st, outp%restart_write_interval, hm%kpoints, & - hm%abs_boundaries, ext_partners, td%max_iter, td%dt) + call pes_init(sys%td%pesv, sys%namespace, sys%space, sys%gr, sys%gr%box, & + sys%st, sys%outp%restart_write_interval, sys%hm%kpoints, & + sys%hm%abs_boundaries, sys%ext_partners, sys%td%max_iter, sys%td%dt) !%Variable TDDynamics !%Type integer @@ -219,11 +211,11 @@ contains !% Born-Oppenheimer (Experimental). !%End - call parse_variable(namespace, 'TDDynamics', EHRENFEST, td%dynamics) - if (.not. varinfo_valid_option('TDDynamics', td%dynamics)) call messages_input_error(namespace, 'TDDynamics') - call messages_print_var_option('TDDynamics', td%dynamics, namespace=namespace) - if (td%dynamics .ne. EHRENFEST) then - if (.not. ion_dynamics_ions_move(td%ions_dyn)) call messages_input_error(namespace, 'TDDynamics') + call parse_variable(sys%namespace, 'TDDynamics', EHRENFEST, sys%td%dynamics) + if (.not. varinfo_valid_option('TDDynamics', sys%td%dynamics)) call messages_input_error(sys%namespace, 'TDDynamics') + call messages_print_var_option('TDDynamics', sys%td%dynamics, namespace=sys%namespace) + if (sys%td%dynamics .ne. EHRENFEST) then + if (.not. ion_dynamics_ions_move(sys%td%ions_dyn)) call messages_input_error(sys%namespace, 'TDDynamics') end if !%Variable RecalculateGSDuringEvolution @@ -242,9 +234,9 @@ contains !% The recalculation is not done every time step, but only every !% RestartWriteInterval time steps. !%End - call parse_variable(namespace, 'RecalculateGSDuringEvolution', .false., td%recalculate_gs) - if (hm%lda_u_level /= DFT_U_NONE .and. td%recalculate_gs) then - call messages_not_implemented("DFT+U with RecalculateGSDuringEvolution=yes", namespace=namespace) + call parse_variable(sys%namespace, 'RecalculateGSDuringEvolution', .false., sys%td%recalculate_gs) + if (sys%hm%lda_u_level /= DFT_U_NONE .and. sys%td%recalculate_gs) then + call messages_not_implemented("DFT+U with RecalculateGSDuringEvolution=yes", namespace=sys%namespace) end if !%Variable TDScissor @@ -256,17 +248,17 @@ contains !% Hamiltonian, shifting the excitation energies by the amount !% specified. By default, it is not applied. !%End - call parse_variable(namespace, 'TDScissor', M_ZERO, td%scissor) - td%scissor = units_to_atomic(units_inp%energy, td%scissor) - call messages_print_var_value('TDScissor', td%scissor, namespace=namespace) + call parse_variable(sys%namespace, 'TDScissor', M_ZERO, sys%td%scissor) + sys%td%scissor = units_to_atomic(units_inp%energy, sys%td%scissor) + call messages_print_var_value('TDScissor', sys%td%scissor, namespace=sys%namespace) - call propagator_elec_init(gr, namespace, st, td%tr, ion_dynamics_ions_move(td%ions_dyn) .or. & - list_has_gauge_field(ext_partners), family_is_mgga_with_exc(ks%xc)) + call propagator_elec_init(sys%gr, sys%namespace, sys%st, sys%td%tr, ion_dynamics_ions_move(sys%td%ions_dyn) .or. & + list_has_gauge_field(sys%ext_partners), family_is_mgga_with_exc(sys%ks%xc)) if (associated(lasers) .and. mpi_grp_is_root(mpi_world)) then - call messages_print_with_emphasis(msg="Time-dependent external fields", namespace=namespace) - call laser_write_info(lasers%lasers, dt=td%dt, max_iter=td%max_iter, namespace=namespace) - call messages_print_with_emphasis(namespace=namespace) + call messages_print_with_emphasis(msg="Time-dependent external fields", namespace=sys%namespace) + call laser_write_info(lasers%lasers, dt=sys%td%dt, max_iter=sys%td%max_iter, namespace=sys%namespace) + call messages_print_with_emphasis(namespace=sys%namespace) end if !%Variable TDEnergyUpdateIter @@ -281,17 +273,17 @@ contains !%End default = 10 - call parse_variable(namespace, 'TDEnergyUpdateIter', default, td%energy_update_iter) + call parse_variable(sys%namespace, 'TDEnergyUpdateIter', default, sys%td%energy_update_iter) - if (gr%der%boundaries%spiralBC .and. hm%ep%reltype == SPIN_ORBIT) then + if (sys%gr%der%boundaries%spiralBC .and. sys%hm%ep%reltype == SPIN_ORBIT) then message(1) = "Generalized Bloch theorem cannot be used with spin-orbit coupling." - call messages_fatal(1, namespace=namespace) + call messages_fatal(1, namespace=sys%namespace) end if - if (gr%der%boundaries%spiralBC) then - if (any(abs(hm%kick%easy_axis(1:2)) > M_EPSILON)) then + if (sys%gr%der%boundaries%spiralBC) then + if (any(abs(sys%hm%kick%easy_axis(1:2)) > M_EPSILON)) then message(1) = "Generalized Bloch theorem cannot be used for an easy axis not along the z direction." - call messages_fatal(1, namespace=namespace) + call messages_fatal(1, namespace=sys%namespace) end if end if @@ -316,13 +308,13 @@ contains !% It is almost equivalent to setting TDFreezeOrbitals = N-1, where N is the number !% of orbitals, but not completely. !%End - call parse_variable(namespace, 'TDFreezeOrbitals', 0, td%freeze_orbitals) + call parse_variable(sys%namespace, 'TDFreezeOrbitals', 0, sys%td%freeze_orbitals) - if (td%freeze_orbitals /= 0) then - call messages_experimental('TDFreezeOrbitals', namespace=namespace) + if (sys%td%freeze_orbitals /= 0) then + call messages_experimental('TDFreezeOrbitals', namespace=sys%namespace) - if (hm%lda_u_level /= DFT_U_NONE) then - call messages_not_implemented('TDFreezeOrbitals with DFT+U', namespace=namespace) + if (sys%hm%lda_u_level /= DFT_U_NONE) then + call messages_not_implemented('TDFreezeOrbitals with DFT+U', namespace=sys%namespace) end if end if diff --git a/src/td/td_interface_h.F90 b/src/td/td_interface_h.F90 index f6adca2a80..2ddf06cab0 100644 --- a/src/td/td_interface_h.F90 +++ b/src/td/td_interface_h.F90 @@ -42,17 +42,8 @@ module td_interface_oct_m module subroutine td_run_init() end subroutine td_run_init - module subroutine td_init(td, namespace, space, gr, ions, st, ks, hm, ext_partners, outp) - type(td_t), intent(inout) :: td - type(namespace_t), intent(in) :: namespace - class(space_t), intent(in) :: space - type(grid_t), intent(in) :: gr - type(ions_t), intent(inout) :: ions - type(states_elec_t), intent(in) :: st - type(v_ks_t), intent(in) :: ks - type(hamiltonian_elec_t), intent(in) :: hm - type(partner_list_t), intent(in) :: ext_partners - type(output_t), intent(in) :: outp + module subroutine td_init(sys) + type(electrons_t), intent(inout) :: sys end subroutine td_init module subroutine td_init_run(td, namespace, mc, gr, ions, st, ks, hm, ext_partners, outp, space, from_scratch) -- GitLab From cf8ed17392382c557cb89e02db625ff2a4c0dd32 Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Tue, 20 Jun 2023 16:16:13 +0200 Subject: [PATCH 27/43] td_init_run: Change signature Signed-off-by: Cristian Le --- src/main/time_dependent.F90 | 3 +-- src/td/td_interface.F90 | 44 ++++++++++++++----------------------- src/td/td_interface_h.F90 | 14 ++---------- 3 files changed, 20 insertions(+), 41 deletions(-) diff --git a/src/main/time_dependent.F90 b/src/main/time_dependent.F90 index efebd98f88..8f86398174 100644 --- a/src/main/time_dependent.F90 +++ b/src/main/time_dependent.F90 @@ -133,8 +133,7 @@ contains PUSH_SUB(time_dependent_run_legacy) call td_init(electrons) - call td_init_run(electrons%td, electrons%namespace, electrons%mc, electrons%gr, electrons%ions, electrons%st, electrons%ks, & - electrons%hm, electrons%ext_partners, electrons%outp, electrons%space, from_scratch) + call td_init_run(electrons, from_scratch) call td_run(electrons, from_scratch) call td_end_run(electrons%td, electrons%st, electrons%hm) call td_end(electrons%td) diff --git a/src/td/td_interface.F90 b/src/td/td_interface.F90 index f49e351e75..820a128900 100644 --- a/src/td/td_interface.F90 +++ b/src/td/td_interface.F90 @@ -324,18 +324,8 @@ contains end subroutine td_init ! --------------------------------------------------------- - module subroutine td_init_run(td, namespace, mc, gr, ions, st, ks, hm, ext_partners, outp, space, from_scratch) - type(td_t), intent(inout) :: td - type(namespace_t), intent(in) :: namespace - type(multicomm_t), intent(inout) :: mc - type(grid_t), intent(inout) :: gr - type(ions_t), intent(inout) :: ions - type(states_elec_t), intent(inout) :: st - type(v_ks_t), intent(inout) :: ks - type(hamiltonian_elec_t), intent(inout) :: hm - type(partner_list_t), intent(in) :: ext_partners - type(output_t), intent(inout) :: outp - type(electron_space_t), intent(in) :: space + module subroutine td_init_run(sys, from_scratch) + type(electrons_t), intent(inout) :: sys logical, intent(inout) :: from_scratch PUSH_SUB(td_init_run) @@ -343,34 +333,34 @@ contains ! called from here because the logic of this function is replicated in the ! multisystem framework in different places - call td_allocate_wavefunctions(td, namespace, mc, gr, ions, st, hm, space) - call td_init_gaugefield(td, namespace, gr, st, ks, hm, ext_partners, space) + call td_allocate_wavefunctions(sys%td, sys%namespace, sys%mc, sys%gr, sys%ions, sys%st, sys%hm, sys%space) + call td_init_gaugefield(sys%td, sys%namespace, sys%gr, sys%st, sys%ks, sys%hm, sys%ext_partners, sys%space) - td%from_scratch = from_scratch + sys%td%from_scratch = from_scratch - if (.not. td%from_scratch) then - call td_load_restart_from_td(td, namespace, space, mc, gr, ext_partners, st, ks, hm, td%from_scratch) - if (td%from_scratch) then + if (.not. sys%td%from_scratch) then + call td_load_restart_from_td(sys%td, sys%namespace, sys%space, sys%mc, sys%gr, sys%ext_partners, sys%st, sys%ks, sys%hm, sys%td%from_scratch) + if (sys%td%from_scratch) then message(1) = "Unable to read time-dependent restart information: Starting from scratch" - call messages_warning(1, namespace=namespace) + call messages_warning(1, namespace=sys%namespace) end if end if - if (td%iter >= td%max_iter) then + if (sys%td%iter >= sys%td%max_iter) then message(1) = "All requested iterations have already been done. Use FromScratch = yes if you want to redo them." - call messages_info(1, namespace=namespace) - call states_elec_deallocate_wfns(st) - td%iter = td%iter + 1 - if (ion_dynamics_ions_move(td%ions_dyn) .and. td%recalculate_gs) call restart_end(td%restart_load) + call messages_info(1, namespace=sys%namespace) + call states_elec_deallocate_wfns(sys%st) + sys%td%iter = sys%td%iter + 1 + if (ion_dynamics_ions_move(sys%td%ions_dyn) .and. sys%td%recalculate_gs) call restart_end(sys%td%restart_load) POP_SUB(td_init_run) return end if - if (td%from_scratch) then - call td_load_restart_from_gs(td, namespace, space, mc, gr, ext_partners, st, ks, hm) + if (sys%td%from_scratch) then + call td_load_restart_from_gs(sys%td, sys%namespace, sys%space, sys%mc, sys%gr, sys%ext_partners, sys%st, sys%ks, sys%hm) end if - call td_init_with_wavefunctions(td, namespace, space, mc, gr, ions, ext_partners, st, ks, hm, outp, td%from_scratch) + call td_init_with_wavefunctions(sys%td, sys%namespace, sys%space, sys%mc, sys%gr, sys%ions, sys%ext_partners, sys%st, sys%ks, sys%hm, sys%outp, sys%td%from_scratch) POP_SUB(td_init_run) end subroutine td_init_run diff --git a/src/td/td_interface_h.F90 b/src/td/td_interface_h.F90 index 2ddf06cab0..7d6395bf29 100644 --- a/src/td/td_interface_h.F90 +++ b/src/td/td_interface_h.F90 @@ -46,18 +46,8 @@ module td_interface_oct_m type(electrons_t), intent(inout) :: sys end subroutine td_init - module subroutine td_init_run(td, namespace, mc, gr, ions, st, ks, hm, ext_partners, outp, space, from_scratch) - type(td_t), intent(inout) :: td - type(namespace_t), intent(in) :: namespace - type(multicomm_t), intent(inout) :: mc - type(grid_t), intent(inout) :: gr - type(ions_t), intent(inout) :: ions - type(states_elec_t), intent(inout) :: st - type(v_ks_t), intent(inout) :: ks - type(hamiltonian_elec_t), intent(inout) :: hm - type(partner_list_t), intent(in) :: ext_partners - type(output_t), intent(inout) :: outp - type(electron_space_t), intent(in) :: space + module subroutine td_init_run(sys, from_scratch) + type(electrons_t), intent(inout) :: sys logical, intent(inout) :: from_scratch end subroutine td_init_run -- GitLab From 35e9d94800b2162b5752e8182173094d4a61f579 Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Tue, 20 Jun 2023 16:18:23 +0200 Subject: [PATCH 28/43] td_end_run: Change signature Signed-off-by: Cristian Le --- src/electrons/electrons.F90 | 2 +- src/main/time_dependent.F90 | 2 +- src/td/td_interface.F90 | 16 +++++++--------- src/td/td_interface_h.F90 | 6 ++---- 4 files changed, 11 insertions(+), 15 deletions(-) diff --git a/src/electrons/electrons.F90 b/src/electrons/electrons.F90 index 5bdc701f1e..b31cdf6cc2 100644 --- a/src/electrons/electrons.F90 +++ b/src/electrons/electrons.F90 @@ -1018,7 +1018,7 @@ contains if (associated(sys%algo)) then select type (algo => sys%algo) class is (propagator_t) - call td_end_run(sys%td, sys%st, sys%hm) + call td_end_run(sys) call td_end(sys%td) end select end if diff --git a/src/main/time_dependent.F90 b/src/main/time_dependent.F90 index 8f86398174..e0c2529492 100644 --- a/src/main/time_dependent.F90 +++ b/src/main/time_dependent.F90 @@ -135,7 +135,7 @@ contains call td_init(electrons) call td_init_run(electrons, from_scratch) call td_run(electrons, from_scratch) - call td_end_run(electrons%td, electrons%st, electrons%hm) + call td_end_run(electrons) call td_end(electrons%td) POP_SUB(time_dependent_run_legacy) diff --git a/src/td/td_interface.F90 b/src/td/td_interface.F90 index 820a128900..80953cffd6 100644 --- a/src/td/td_interface.F90 +++ b/src/td/td_interface.F90 @@ -446,21 +446,19 @@ contains end subroutine td_end ! --------------------------------------------------------- - module subroutine td_end_run(td, st, hm) - type(td_t), intent(inout) :: td - type(states_elec_t), intent(inout) :: st - type(hamiltonian_elec_t), intent(inout) :: hm + module subroutine td_end_run(sys) + type(electrons_t), intent(inout) :: sys PUSH_SUB(td_end_run) - if (st%pack_states .and. hm%apply_packed()) call st%unpack() + if (sys%st%pack_states .and. sys%hm%apply_packed()) call sys%st%unpack() - call restart_end(td%restart_dump) - call td_write_end(td%write_handler) + call restart_end(sys%td%restart_dump) + call td_write_end(sys%td%write_handler) ! free memory - call states_elec_deallocate_wfns(st) - if (ion_dynamics_ions_move(td%ions_dyn) .and. td%recalculate_gs) call restart_end(td%restart_load) + call states_elec_deallocate_wfns(sys%st) + if (ion_dynamics_ions_move(sys%td%ions_dyn) .and. sys%td%recalculate_gs) call restart_end(sys%td%restart_load) POP_SUB(td_end_run) end subroutine td_end_run diff --git a/src/td/td_interface_h.F90 b/src/td/td_interface_h.F90 index 7d6395bf29..30a37db39c 100644 --- a/src/td/td_interface_h.F90 +++ b/src/td/td_interface_h.F90 @@ -77,10 +77,8 @@ module td_interface_oct_m type(td_t), intent(inout) :: td end subroutine td_end - module subroutine td_end_run(td, st, hm) - type(td_t), intent(inout) :: td - type(states_elec_t), intent(inout) :: st - type(hamiltonian_elec_t), intent(inout) :: hm + module subroutine td_end_run(sys) + type(electrons_t), intent(inout) :: sys end subroutine td_end_run module subroutine td_check_point(td, namespace, mc, gr, ions, st, ks, hm, ext_partners, outp, space, & -- GitLab From 926d45b57960a22aeb688ca1965ace60157966cb Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Tue, 20 Jun 2023 16:20:58 +0200 Subject: [PATCH 29/43] td_end: Change signature Signed-off-by: Cristian Le --- src/electrons/electrons.F90 | 2 +- src/main/time_dependent.F90 | 2 +- src/opt_control/opt_control.F90 | 2 +- src/td/td_interface.F90 | 12 ++++++------ src/td/td_interface_h.F90 | 4 ++-- 5 files changed, 11 insertions(+), 11 deletions(-) diff --git a/src/electrons/electrons.F90 b/src/electrons/electrons.F90 index b31cdf6cc2..93623b1f63 100644 --- a/src/electrons/electrons.F90 +++ b/src/electrons/electrons.F90 @@ -1019,7 +1019,7 @@ contains select type (algo => sys%algo) class is (propagator_t) call td_end_run(sys) - call td_end(sys%td) + call td_end(sys) end select end if diff --git a/src/main/time_dependent.F90 b/src/main/time_dependent.F90 index e0c2529492..e2343b86a5 100644 --- a/src/main/time_dependent.F90 +++ b/src/main/time_dependent.F90 @@ -136,7 +136,7 @@ contains call td_init_run(electrons, from_scratch) call td_run(electrons, from_scratch) call td_end_run(electrons) - call td_end(electrons%td) + call td_end(electrons) POP_SUB(time_dependent_run_legacy) end subroutine time_dependent_run_legacy diff --git a/src/opt_control/opt_control.F90 b/src/opt_control/opt_control.F90 index ba28d650be..95f4c5e1de 100644 --- a/src/opt_control/opt_control.F90 +++ b/src/opt_control/opt_control.F90 @@ -249,7 +249,7 @@ contains call controlfunction_end(par) call oct_iterator_end(iterator, sys%namespace) call filter_end(filter) - call td_end(sys%td) + call td_end(sys) call opt_control_state_end(initial_st) call target_end(oct_target, oct) call controlfunction_mod_close() diff --git a/src/td/td_interface.F90 b/src/td/td_interface.F90 index 80953cffd6..7778c03542 100644 --- a/src/td/td_interface.F90 +++ b/src/td/td_interface.F90 @@ -431,16 +431,16 @@ contains end subroutine td_init_gaugefield ! --------------------------------------------------------- - module subroutine td_end(td) - type(td_t), intent(inout) :: td + module subroutine td_end(sys) + type(electrons_t), intent(inout) :: sys PUSH_SUB(td_end) - call pes_end(td%pesv) - call propagator_elec_end(td%tr) ! clean the evolution method - call ion_dynamics_end(td%ions_dyn) + call pes_end(sys%td%pesv) + call propagator_elec_end(sys%td%tr) ! clean the evolution method + call ion_dynamics_end(sys%td%ions_dyn) - if (td%dynamics == BO) call scf_end(td%scf) + if (sys%td%dynamics == BO) call scf_end(sys%td%scf) POP_SUB(td_end) end subroutine td_end diff --git a/src/td/td_interface_h.F90 b/src/td/td_interface_h.F90 index 30a37db39c..0d6999ed36 100644 --- a/src/td/td_interface_h.F90 +++ b/src/td/td_interface_h.F90 @@ -73,8 +73,8 @@ module td_interface_oct_m class(space_t), intent(in) :: space end subroutine td_init_gaugefield - module subroutine td_end(td) - type(td_t), intent(inout) :: td + module subroutine td_end(sys) + type(electrons_t), intent(inout) :: sys end subroutine td_end module subroutine td_end_run(sys) -- GitLab From 84c033caa68eb30a3c845dce81a77994eb853191 Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Tue, 19 Sep 2023 15:38:40 +0200 Subject: [PATCH 30/43] td_init_with_wavefunctions: Change signature Signed-off-by: Cristian Le --- src/electrons/electrons.F90 | 3 +- src/td/td_interface.F90 | 215 +++++++++++++++++++----------------- src/td/td_interface_h.F90 | 15 +-- 3 files changed, 114 insertions(+), 119 deletions(-) diff --git a/src/electrons/electrons.F90 b/src/electrons/electrons.F90 index 93623b1f63..9ad79166ef 100644 --- a/src/electrons/electrons.F90 +++ b/src/electrons/electrons.F90 @@ -481,8 +481,7 @@ contains call system_propagation_start(this) ! additional initialization needed for electrons - call td_init_with_wavefunctions(this%td, this%namespace, this%space, this%mc, this%gr, this%ions, & - this%ext_partners, this%st, this%ks, this%hm, this%outp, this%td%from_scratch) + call td_init_with_wavefunctions(this) POP_SUB(electrons_propagation_start) end subroutine electrons_propagation_start diff --git a/src/td/td_interface.F90 b/src/td/td_interface.F90 index 7778c03542..006e5c83bc 100644 --- a/src/td/td_interface.F90 +++ b/src/td/td_interface.F90 @@ -360,7 +360,7 @@ contains call td_load_restart_from_gs(sys%td, sys%namespace, sys%space, sys%mc, sys%gr, sys%ext_partners, sys%st, sys%ks, sys%hm) end if - call td_init_with_wavefunctions(sys%td, sys%namespace, sys%space, sys%mc, sys%gr, sys%ions, sys%ext_partners, sys%st, sys%ks, sys%hm, sys%outp, sys%td%from_scratch) + call td_init_with_wavefunctions(sys) POP_SUB(td_init_run) end subroutine td_init_run @@ -657,23 +657,12 @@ contains end subroutine td_update_elapsed_time ! --------------------------------------------------------- - module subroutine td_init_with_wavefunctions(td, namespace, space, mc, gr, ions, ext_partners, st, ks, hm, outp, from_scratch) - type(td_t), intent(inout) :: td - type(namespace_t), intent(in) :: namespace - type(electron_space_t), intent(in) :: space - type(multicomm_t), intent(in) :: mc - type(grid_t), intent(inout) :: gr - type(ions_t), intent(inout) :: ions - type(partner_list_t), intent(in) :: ext_partners - type(states_elec_t), target, intent(inout) :: st - type(v_ks_t), intent(inout) :: ks - type(hamiltonian_elec_t), intent(inout) :: hm - type(output_t), intent(inout) :: outp - logical, intent(in) :: from_scratch + module subroutine td_init_with_wavefunctions(sys) + type(electrons_t), target, intent(inout) :: sys integer :: ierr real(real64) :: x - real(real64) :: ndinitial(space%dim) + real(real64) :: ndinitial(sys%space%dim) logical :: freeze_hxc, freeze_occ, freeze_u type(restart_t) :: restart, restart_frozen type(gauge_field_t), pointer :: gfield @@ -682,64 +671,69 @@ contains !We activate the sprial BC only after the kick, !to be sure that the first iteration corresponds to the ground state - if (gr%der%boundaries%spiralBC) then - if ((td%iter-1)*td%dt > hm%kick%time) then - gr%der%boundaries%spiral = .true. + if (sys%gr%der%boundaries%spiralBC) then + if ((sys%td%iter-1)*sys%td%dt > sys%hm%kick%time) then + sys%gr%der%boundaries%spiral = .true. end if - hm%vnl%spin => st%spin - hm%phase%spin => st%spin + sys%hm%vnl%spin => sys%st%spin + sys%hm%phase%spin => sys%st%spin !We fill st%spin. In case of restart, we read it in td_load - if (from_scratch) call states_elec_fermi(st, namespace, gr) + if (sys%td%from_scratch) call states_elec_fermi(sys%st, sys%namespace, sys%gr) end if - if (from_scratch) then + if (sys%td%from_scratch) then ! Initialize the occupation matrices and U for DFT+U ! This must be called before parsing TDFreezeOccupations and TDFreezeU ! in order that the code does properly the initialization. - call lda_u_update_occ_matrices(hm%lda_u, namespace, gr, st, hm%hm_base, hm%phase, hm%energy) + call lda_u_update_occ_matrices(sys%hm%lda_u, sys%namespace, sys%gr, & + sys%st, sys%hm%hm_base, sys%hm%phase, sys%hm%energy) end if - if (td%freeze_orbitals > 0) then - if (from_scratch) then + if (sys%td%freeze_orbitals > 0) then + if (sys%td%from_scratch) then ! In this case, we first freeze the orbitals, then calculate the Hxc potential. - call states_elec_freeze_orbitals(st, namespace, space, gr, mc, hm%kpoints, & - td%freeze_orbitals, family_is_mgga(ks%xc_family)) + call states_elec_freeze_orbitals(sys%st, sys%namespace, sys%space, sys%gr, sys%mc, sys%hm%kpoints, & + sys%td%freeze_orbitals, family_is_mgga(sys%ks%xc_family)) else - call restart_init(restart, namespace, RESTART_TD, RESTART_TYPE_LOAD, mc, ierr, mesh=gr) + call restart_init(restart, sys%namespace, RESTART_TD, RESTART_TYPE_LOAD, sys%mc, ierr, mesh=sys%gr) if (ierr == 0) then - call td_load_frozen(namespace, restart, space, gr, st, hm, ierr) + call td_load_frozen(sys%namespace, restart, sys%space, sys%gr, sys%st, sys%hm, ierr) end if if (ierr /= 0) then - td%iter = 0 + sys%td%iter = 0 message(1) = "Unable to read frozen restart information." - call messages_fatal(1, namespace=namespace) + call messages_fatal(1, namespace=sys%namespace) end if call restart_end(restart) end if - write(message(1),'(a,i4,a,i4,a)') 'Info: The lowest', td%freeze_orbitals, & - ' orbitals have been frozen.', st%nst, ' will be propagated.' - call messages_info(1, namespace=namespace) - call states_elec_freeze_adjust_qtot(st) - call density_calc(st, gr, st%rho) - call v_ks_calc(ks, namespace, space, hm, st, ions, ext_partners, calc_eigenval=.true., time = td%iter*td%dt) - else if (td%freeze_orbitals < 0) then + write(message(1),'(a,i4,a,i4,a)') 'Info: The lowest', sys%td%freeze_orbitals, & + ' orbitals have been frozen.', sys%st%nst, ' will be propagated.' + call messages_info(1, namespace=sys%namespace) + call states_elec_freeze_adjust_qtot(sys%st) + call density_calc(sys%st, sys%gr, sys%st%rho) + call v_ks_calc(sys%ks, sys%namespace, sys%space, sys%hm, sys%st, sys%ions, & + sys%ext_partners, calc_eigenval=.true., time = sys%td%iter*sys%td%dt) + else if (sys%td%freeze_orbitals < 0) then ! This means SAE approximation. We calculate the Hxc first, then freeze all ! orbitals minus one. write(message(1),'(a)') 'Info: The single-active-electron approximation will be used.' - call messages_info(1, namespace=namespace) - call v_ks_calc(ks, namespace, space, hm, st, ions, ext_partners, calc_eigenval=.true., time = td%iter*td%dt) - if (from_scratch) then - call states_elec_freeze_orbitals(st, namespace, space, gr, mc, hm%kpoints, st%nst-1, family_is_mgga(ks%xc_family)) + call messages_info(1, namespace=sys%namespace) + call v_ks_calc(sys%ks, sys%namespace, sys%space, sys%hm, sys%st, sys%ions, & + sys%ext_partners, calc_eigenval=.true., time = sys%td%iter*sys%td%dt) + if (sys%td%from_scratch) then + call states_elec_freeze_orbitals(sys%st, sys%namespace, sys%space, sys%gr, & + sys%mc, sys%hm%kpoints, sys%st%nst-1, family_is_mgga(sys%ks%xc_family)) else - call messages_not_implemented("TDFreezeOrbials < 0 with FromScratch=no", namespace=namespace) + call messages_not_implemented("TDFreezeOrbials < 0 with FromScratch=no", namespace=sys%namespace) end if - call states_elec_freeze_adjust_qtot(st) - call v_ks_freeze_hxc(ks) - call density_calc(st, gr, st%rho) + call states_elec_freeze_adjust_qtot(sys%st) + call v_ks_freeze_hxc(sys%ks) + call density_calc(sys%st, sys%gr, sys%st%rho) else ! Normal run. - call density_calc(st, gr, st%rho) - call v_ks_calc(ks, namespace, space, hm, st, ions, ext_partners, calc_eigenval=.true., time = td%iter*td%dt) + call density_calc(sys%st, sys%gr, sys%st%rho) + call v_ks_calc(sys%ks, sys%namespace, sys%space, sys%hm, sys%st, sys%ions, & + sys%ext_partners, calc_eigenval=.true., time = sys%td%iter*sys%td%dt) end if !%Variable TDFreezeHXC @@ -750,40 +744,47 @@ contains !% The electrons are evolved as independent particles feeling the Hartree and !% exchange-correlation potentials from the ground-state electronic configuration. !%End - call parse_variable(namespace, 'TDFreezeHXC', .false., freeze_hxc) + call parse_variable(sys%namespace, 'TDFreezeHXC', .false., freeze_hxc) if (freeze_hxc) then write(message(1),'(a)') 'Info: Freezing Hartree and exchange-correlation potentials.' - call messages_info(1, namespace=namespace) + call messages_info(1, namespace=sys%namespace) - if (.not. from_scratch) then + if (.not. sys%td%from_scratch) then - call restart_init(restart_frozen, namespace, RESTART_GS, RESTART_TYPE_LOAD, mc, ierr, mesh=gr, exact=.true.) - call states_elec_load(restart_frozen, namespace, space, st, gr, hm%kpoints, ierr, label = ": gs") - call states_elec_transform(st, namespace, space, restart_frozen, gr, hm%kpoints) + call restart_init(restart_frozen, sys%namespace, RESTART_GS, & + RESTART_TYPE_LOAD, sys%mc, ierr, mesh=sys%gr, exact=.true.) + call states_elec_load(restart_frozen, sys%namespace, sys%space, & + sys%st, sys%gr, sys%hm%kpoints, ierr, label = ": gs") + call states_elec_transform(sys%st, sys%namespace, sys%space, & + restart_frozen, sys%gr, sys%hm%kpoints) call restart_end(restart_frozen) - call density_calc(st, gr, st%rho) - call v_ks_calc(ks, namespace, space, hm, st, ions, ext_partners, calc_eigenval=.true., time = td%iter*td%dt) + call density_calc(sys%st, sys%gr, sys%st%rho) + call v_ks_calc(sys%ks, sys%namespace, sys%space, sys%hm, sys%st, & + sys%ions, sys%ext_partners, calc_eigenval=.true., & + time = sys%td%iter*sys%td%dt) - call restart_init(restart_frozen, namespace, RESTART_TD, RESTART_TYPE_LOAD, mc, ierr, mesh=gr) - call states_elec_load(restart_frozen, namespace, space, st, gr, hm%kpoints, ierr, iter=td%iter, label = ": td") + call restart_init(restart_frozen, sys%namespace, RESTART_TD, & + RESTART_TYPE_LOAD, sys%mc, ierr, mesh=sys%gr) + call states_elec_load(restart_frozen, sys%namespace, sys%space, & + sys%st, sys%gr, sys%hm%kpoints, ierr, iter=sys%td%iter, label = ": td") call restart_end(restart_frozen) - call propagator_elec_run_zero_iter(hm, gr, td%tr) + call propagator_elec_run_zero_iter(sys%hm, sys%gr, sys%td%tr) end if - call v_ks_freeze_hxc(ks) + call v_ks_freeze_hxc(sys%ks) end if - x = minval(st%eigenval(st%st_start, :)) - if (st%parallel_in_states) then - call st%mpi_grp%bcast(x, 1, MPI_DOUBLE_PRECISION, 0) + x = minval(sys%st%eigenval(sys%st%st_start, :)) + if (sys%st%parallel_in_states) then + call sys%st%mpi_grp%bcast(x, 1, MPI_DOUBLE_PRECISION, 0) end if - call hm%update_span(gr%spacing(1:space%dim), x, namespace) + call sys%hm%update_span(sys%gr%spacing(1:sys%space%dim), x, sys%namespace) ! initialize Fermi energy - call states_elec_fermi(st, namespace, gr, compute_spin = .not. gr%der%boundaries%spiralBC) - call energy_calc_total(namespace, space, hm, gr, st, ext_partners) + call states_elec_fermi(sys%st, sys%namespace, sys%gr, compute_spin = .not. sys%gr%der%boundaries%spiralBC) + call energy_calc_total(sys%namespace, sys%space, sys%hm, sys%gr, sys%st, sys%ext_partners) !%Variable TDFreezeDFTUOccupations !%Type logical @@ -793,16 +794,16 @@ contains !% The occupation matrices than enters in the DFT+U potential !% are not evolved during the time evolution. !%End - call parse_variable(namespace, 'TDFreezeDFTUOccupations', .false., freeze_occ) + call parse_variable(sys%namespace, 'TDFreezeDFTUOccupations', .false., freeze_occ) if (freeze_occ) then write(message(1),'(a)') 'Info: Freezing DFT+U occupation matrices that enters in the DFT+U potential.' - call messages_info(1, namespace=namespace) - call lda_u_freeze_occ(hm%lda_u) + call messages_info(1, namespace=sys%namespace) + call lda_u_freeze_occ(sys%hm%lda_u) !In this case we should reload GS wavefunctions - if (hm%lda_u_level /= DFT_U_NONE .and. .not. from_scratch) then - call restart_init(restart_frozen, namespace, RESTART_GS, RESTART_TYPE_LOAD, mc, ierr, mesh=gr) - call lda_u_load(restart_frozen, hm%lda_u, st, hm%energy%dft_u, ierr, occ_only = .true.) + if (sys%hm%lda_u_level /= DFT_U_NONE .and. .not. sys%td%from_scratch) then + call restart_init(restart_frozen, sys%namespace, RESTART_GS, RESTART_TYPE_LOAD, sys%mc, ierr, mesh=sys%gr) + call lda_u_load(restart_frozen, sys%hm%lda_u, sys%st, sys%hm%energy%dft_u, ierr, occ_only = .true.) call restart_end(restart_frozen) end if end if @@ -814,77 +815,83 @@ contains !%Description !% The effective U of DFT+U is not evolved during the time evolution. !%End - call parse_variable(namespace, 'TDFreezeU', .false., freeze_u) + call parse_variable(sys%namespace, 'TDFreezeU', .false., freeze_u) if (freeze_u) then write(message(1),'(a)') 'Info: Freezing the effective U of DFT+U.' - call messages_info(1, namespace=namespace) - call lda_u_freeze_u(hm%lda_u) + call messages_info(1, namespace=sys%namespace) + call lda_u_freeze_u(sys%hm%lda_u) !In this case we should reload GS wavefunctions - if (hm%lda_u_level == DFT_U_ACBN0 .and. .not. from_scratch) then - call restart_init(restart_frozen, namespace, RESTART_GS, RESTART_TYPE_LOAD, mc, ierr, mesh=gr) - call lda_u_load(restart_frozen, hm%lda_u, st, hm%energy%dft_u, ierr, u_only = .true.) + if (sys%hm%lda_u_level == DFT_U_ACBN0 .and. .not. sys%td%from_scratch) then + call restart_init(restart_frozen, sys%namespace, RESTART_GS, RESTART_TYPE_LOAD, sys%mc, ierr, mesh=sys%gr) + call lda_u_load(restart_frozen, sys%hm%lda_u, sys%st, sys%hm%energy%dft_u, ierr, u_only = .true.) call restart_end(restart_frozen) write(message(1),'(a)') 'Loaded GS effective U of DFT+U' - call messages_info(1, namespace=namespace) - call lda_u_write_u(hm%lda_u, namespace=namespace) - call lda_u_write_v(hm%lda_u, namespace=namespace) + call messages_info(1, namespace=sys%namespace) + call lda_u_write_u(sys%hm%lda_u, namespace=sys%namespace) + call lda_u_write_v(sys%hm%lda_u, namespace=sys%namespace) end if end if ! This needs to be called before the calculation of the forces, ! as we need to test of we output the forces or not - call td_write_init(td%write_handler, namespace, space, outp, gr, st, hm, ions, ext_partners, & - ks, ion_dynamics_ions_move(td%ions_dyn), & - list_has_gauge_field(ext_partners), hm%kick, td%iter, td%max_iter, td%dt, mc) + call td_write_init(sys%td%write_handler, sys%namespace, sys%space, & + sys%outp, sys%gr, sys%st, sys%hm, sys%ions, sys%ext_partners, & + sys%ks, ion_dynamics_ions_move(sys%td%ions_dyn), & + list_has_gauge_field(sys%ext_partners), sys%hm%kick, sys%td%iter, & + sys%td%max_iter, sys%td%dt, sys%mc) ! Resets the nondipole integration after laser-file has been written. - lasers => list_get_lasers(ext_partners) + lasers => list_get_lasers(sys%ext_partners) if(associated(lasers)) then if (lasers_with_nondipole_field(lasers)) then - ndinitial(1:space%dim)=M_ZERO + ndinitial(1:sys%space%dim)=M_ZERO call lasers_set_nondipole_parameters(lasers,ndinitial,M_ZERO) end if end if nullify(lasers) - call td_init_ions_and_forces(td, namespace, space, gr, ions, ext_partners, st, ks, hm, outp) + call td_init_ions_and_forces(sys%td, sys%namespace, sys%space, sys%gr, & + sys%ions, sys%ext_partners, sys%st, sys%ks, sys%hm, sys%outp) - if (td%scissor > M_EPSILON) then - call scissor_init(hm%scissor, namespace, space, st, gr, hm%d, hm%kpoints, hm%phase, td%scissor, mc) + if (sys%td%scissor > M_EPSILON) then + call scissor_init(sys%hm%scissor, sys%namespace, sys%space, sys%st, & + sys%gr, sys%hm%d, sys%hm%kpoints, sys%hm%phase, sys%td%scissor, sys%mc) end if - if (td%iter == 0) call td_run_zero_iter(td, namespace, space, gr, ions, st, ks, hm, ext_partners, outp, mc) + if (sys%td%iter == 0) call td_run_zero_iter(sys%td, sys%namespace, & + sys%space, sys%gr, sys%ions, sys%st, sys%ks, sys%hm, sys%ext_partners, sys%outp, sys%mc) - gfield => list_get_gauge_field(ext_partners) + gfield => list_get_gauge_field(sys%ext_partners) if(associated(gfield)) then if (gauge_field_is_propagated(gfield)) then - if(ks%xc%kernel_lrc_alpha > M_EPSILON) then - call gauge_field_get_force(gfield, gr, st%d%spin_channels, st%current, ks%xc%kernel_lrc_alpha) + if(sys%ks%xc%kernel_lrc_alpha > M_EPSILON) then + call gauge_field_get_force(gfield, sys%gr, sys%st%d%spin_channels, & + sys%st%current, sys%ks%xc%kernel_lrc_alpha) call messages_experimental('TD-LRC kernel') else - call gauge_field_get_force(gfield, gr, st%d%spin_channels, st%current) + call gauge_field_get_force(gfield, sys%gr, sys%st%d%spin_channels, sys%st%current) endif endif end if - !call td_check_trotter(td, sys, h) - td%iter = td%iter + 1 + !call td_check_trotter(sys%td, sys, h) + sys%td%iter = sys%td%iter + 1 - call restart_init(td%restart_dump, namespace, RESTART_TD, RESTART_TYPE_DUMP, mc, ierr, mesh=gr) - if (ion_dynamics_ions_move(td%ions_dyn) .and. td%recalculate_gs) then + call restart_init(sys%td%restart_dump, sys%namespace, RESTART_TD, RESTART_TYPE_DUMP, sys%mc, ierr, mesh=sys%gr) + if (ion_dynamics_ions_move(sys%td%ions_dyn) .and. sys%td%recalculate_gs) then ! We will also use the TD restart directory as temporary storage during the time propagation - call restart_init(td%restart_load, namespace, RESTART_TD, RESTART_TYPE_LOAD, mc, ierr, mesh=gr) + call restart_init(sys%td%restart_load, sys%namespace, RESTART_TD, RESTART_TYPE_LOAD, sys%mc, ierr, mesh=sys%gr) end if - call messages_print_with_emphasis(msg="Time-Dependent Simulation", namespace=namespace) - call td_print_header(namespace) + call messages_print_with_emphasis(msg="Time-Dependent Simulation", namespace=sys%namespace) + call td_print_header(sys%namespace) - if (td%pesv%calc_spm .or. td%pesv%calc_mask .and. from_scratch) then - call pes_init_write(td%pesv,gr,st, namespace) + if (sys%td%pesv%calc_spm .or. sys%td%pesv%calc_mask .and. sys%td%from_scratch) then + call pes_init_write(sys%td%pesv,sys%gr,sys%st, sys%namespace) end if - if (st%pack_states .and. hm%apply_packed()) call st%pack() + if (sys%st%pack_states .and. sys%hm%apply_packed()) call sys%st%pack() POP_SUB(td_init_with_wavefunctions) end subroutine td_init_with_wavefunctions diff --git a/src/td/td_interface_h.F90 b/src/td/td_interface_h.F90 index 0d6999ed36..35f30ad728 100644 --- a/src/td/td_interface_h.F90 +++ b/src/td/td_interface_h.F90 @@ -101,19 +101,8 @@ module td_interface_oct_m logical, intent(inout) :: from_scratch end subroutine td_check_point - module subroutine td_init_with_wavefunctions(td, namespace, space, mc, gr, ions, ext_partners, st, ks, hm, outp, from_scratch) - type(td_t), intent(inout) :: td - type(namespace_t), intent(in) :: namespace - type(electron_space_t), intent(in) :: space - type(multicomm_t), intent(in) :: mc - type(grid_t), intent(inout) :: gr - type(ions_t), intent(inout) :: ions - type(partner_list_t), intent(in) :: ext_partners - type(states_elec_t), target, intent(inout) :: st - type(v_ks_t), intent(inout) :: ks - type(hamiltonian_elec_t), intent(inout) :: hm - type(output_t), intent(inout) :: outp - logical, intent(in) :: from_scratch + module subroutine td_init_with_wavefunctions(sys) + type(electrons_t), target, intent(inout) :: sys end subroutine td_init_with_wavefunctions module subroutine td_load_restart_from_gs(td, namespace, space, mc, gr, ext_partners, st, ks, hm) -- GitLab From b5f4c40d3d40dd1d273ceed829001f16744bf927 Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Tue, 19 Sep 2023 15:43:47 +0200 Subject: [PATCH 31/43] td_run_zero_iter: Change signature Signed-off-by: Cristian Le --- src/td/td_interface.F90 | 47 ++++++++++++++++++----------------------- 1 file changed, 20 insertions(+), 27 deletions(-) diff --git a/src/td/td_interface.F90 b/src/td/td_interface.F90 index 006e5c83bc..7541aab5c0 100644 --- a/src/td/td_interface.F90 +++ b/src/td/td_interface.F90 @@ -859,8 +859,7 @@ contains sys%gr, sys%hm%d, sys%hm%kpoints, sys%hm%phase, sys%td%scissor, sys%mc) end if - if (sys%td%iter == 0) call td_run_zero_iter(sys%td, sys%namespace, & - sys%space, sys%gr, sys%ions, sys%st, sys%ks, sys%hm, sys%ext_partners, sys%outp, sys%mc) + if (sys%td%iter == 0) call td_run_zero_iter(sys) gfield => list_get_gauge_field(sys%ext_partners) if(associated(gfield)) then @@ -1018,43 +1017,37 @@ contains end subroutine td_load_restart_from_gs ! --------------------------------------------------------- - subroutine td_run_zero_iter(td, namespace, space, gr, ions, st, ks, hm, ext_partners, outp, mc) - type(td_t), intent(inout) :: td - type(namespace_t), intent(in) :: namespace - type(electron_space_t), intent(in) :: space - type(grid_t), intent(inout) :: gr - type(ions_t), intent(inout) :: ions - type(states_elec_t), intent(inout) :: st - type(v_ks_t), intent(inout) :: ks - type(hamiltonian_elec_t), intent(inout) :: hm - type(partner_list_t), intent(in) :: ext_partners - type(output_t), intent(in) :: outp - type(multicomm_t), intent(in) :: mc + subroutine td_run_zero_iter(sys) + type(electrons_t), intent(inout) :: sys PUSH_SUB(td_run_zero_iter) - call td_write_iter(td%write_handler, namespace, space, outp, gr, st, hm, ions, ext_partners, & - hm%kick, ks, td%dt, 0, mc, td%recalculate_gs) + call td_write_iter(sys%td%write_handler, sys%namespace, sys%space, & + sys%outp, sys%gr, sys%st, sys%hm, sys%ions, sys%ext_partners, & + sys%hm%kick, sys%ks, sys%td%dt, 0, sys%mc, sys%td%recalculate_gs) ! I apply the delta electric field *after* td_write_iter, otherwise the ! dipole matrix elements in write_proj are wrong - if (abs(hm%kick%time) <= M_EPSILON) then - if (.not. hm%pcm%localf) then - call kick_apply(space, gr, st, td%ions_dyn, ions, hm%kick, hm%psolver, hm%kpoints) + if (abs(sys%hm%kick%time) <= M_EPSILON) then + if (.not. sys%hm%pcm%localf) then + call kick_apply(sys%space, sys%gr, sys%st, sys%td%ions_dyn, sys%ions, & + sys%hm%kick, sys%hm%psolver, sys%hm%kpoints) else - call kick_apply(space, gr, st, td%ions_dyn, ions, hm%kick, hm%psolver, hm%kpoints, pcm = hm%pcm) + call kick_apply(sys%space, sys%gr, sys%st, sys%td%ions_dyn, sys%ions, & + sys%hm%kick, sys%hm%psolver, sys%hm%kpoints, pcm = sys%hm%pcm) end if - call td_write_kick(outp, namespace, space, gr, hm%kick, ions, 0) + call td_write_kick(sys%outp, sys%namespace, sys%space, sys%gr, sys%hm%kick, sys%ions, 0) !We activate the sprial BC only after the kick - if (gr%der%boundaries%spiralBC) then - gr%der%boundaries%spiral = .true. + if (sys%gr%der%boundaries%spiralBC) then + sys%gr%der%boundaries%spiral = .true. end if end if - call propagator_elec_run_zero_iter(hm, gr, td%tr) - if (any(outp%output_interval > 0)) then - call td_write_data(td%write_handler) - call td_write_output(namespace, space, gr, st, hm, ks, outp, ions, ext_partners, 0) + call propagator_elec_run_zero_iter(sys%hm, sys%gr, sys%td%tr) + if (any(sys%outp%output_interval > 0)) then + call td_write_data(sys%td%write_handler) + call td_write_output(sys%namespace, sys%space, sys%gr, sys%st, sys%hm, & + sys%ks, sys%outp, sys%ions, sys%ext_partners, 0) end if POP_SUB(td_run_zero_iter) -- GitLab From 27efa86d222e4c7bbe7f4d95c3094e1935b3c9af Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Mon, 3 Jul 2023 19:39:19 +0200 Subject: [PATCH 32/43] td_check_point: Change signature Signed-off-by: Cristian Le --- src/td/td_interface.F90 | 67 ++++++++++++++++++--------------------- src/td/td_interface_h.F90 | 21 ------------ 2 files changed, 30 insertions(+), 58 deletions(-) diff --git a/src/td/td_interface.F90 b/src/td/td_interface.F90 index 7541aab5c0..b0bbc899e4 100644 --- a/src/td/td_interface.F90 +++ b/src/td/td_interface.F90 @@ -532,9 +532,7 @@ contains sys%ions, sys%ext_partners, sys%hm%kick, sys%ks, sys%td%dt, iter, sys%mc, sys%td%recalculate_gs) ! write down data - call td_check_point(sys%td, sys%namespace, sys%mc, sys%gr, sys%ions, sys%st, sys%ks, sys%hm, & - sys%ext_partners, sys%outp, sys%space, & - iter, scsteps, etime, stopping, from_scratch) + call td_check_point(sys, iter, scsteps, etime, stopping, from_scratch) ! check if debug mode should be enabled or disabled on the fly call io_debug_on_the_fly(sys%namespace) @@ -561,19 +559,8 @@ contains end subroutine td_print_header ! --------------------------------------------------------- - module subroutine td_check_point(td, namespace, mc, gr, ions, st, ks, hm, ext_partners, outp, space, & - iter, scsteps, etime, stopping, from_scratch) - type(td_t), intent(inout) :: td - type(namespace_t), intent(in) :: namespace - type(multicomm_t), intent(in) :: mc - type(grid_t), intent(inout) :: gr - type(ions_t), intent(inout) :: ions - type(states_elec_t), intent(inout) :: st - type(v_ks_t), intent(inout) :: ks - type(hamiltonian_elec_t), intent(inout) :: hm - type(partner_list_t), intent(in) :: ext_partners - type(output_t), intent(in) :: outp - type(electron_space_t), intent(in) :: space + subroutine td_check_point(sys, iter, scsteps, etime, stopping, from_scratch) + type(electrons_t), intent(inout) :: sys integer, intent(in) :: iter integer, intent(in) :: scsteps real(real64), intent(inout) :: etime @@ -584,40 +571,46 @@ contains PUSH_SUB(td_check_point) - call td_print_message(td, namespace, ions, hm, iter, scsteps, etime) + call td_print_message(sys%td, sys%namespace, sys%ions, sys%hm, iter, scsteps, etime) if (outp%anything_now(iter)) then ! output - call td_write_output(namespace, space, gr, st, hm, ks, outp, ions, ext_partners, iter, td%dt) + call td_write_output(sys%namespace, sys%space, sys%gr, sys%st, sys%hm, sys%ks, & + sys%outp, sys%ions, sys%ext_partners, iter, sys%td%dt) end if - if (mod(iter, outp%restart_write_interval) == 0 .or. iter == td%max_iter .or. stopping) then ! restart - !if (iter == td%max_iter) outp%iter = ii - 1 - call td_write_data(td%write_handler) - call td_dump(td, namespace, space, gr, st, hm, ks, ext_partners, iter, ierr) + if (mod(iter, sys%outp%restart_write_interval) == 0 .or. iter == sys%td%max_iter .or. stopping) then ! restart + !if (iter == sys%td%max_iter) sys%outp%iter = ii - 1 + call td_write_data(sys%td%write_handler) + call td_dump(sys%td, sys%namespace, sys%space, sys%gr, sys%st, sys%hm, sys%ks, & + sys%ext_partners, iter, ierr) if (ierr /= 0) then message(1) = "Unable to write time-dependent restart information." - call messages_warning(1, namespace=namespace) + call messages_warning(1, namespace=sys%namespace) end if - call pes_output(td%pesv, namespace, space, gr, st, iter, outp, td%dt, ions) + call pes_output(sys%td%pesv, sys%namespace, sys%space, sys%gr, sys%st, iter, sys%outp, & + sys%td%dt, sys%ions) - if (ion_dynamics_ions_move(td%ions_dyn) .and. td%recalculate_gs) then - call messages_print_with_emphasis(msg='Recalculating the ground state.', namespace=namespace) + if (ion_dynamics_ions_move(sys%td%ions_dyn) .and. sys%td%recalculate_gs) then + call messages_print_with_emphasis(msg='Recalculating the ground state.', namespace=sys%namespace) from_scratch = .false. - call states_elec_deallocate_wfns(st) - call electrons_ground_state_run(namespace, mc, gr, ions, ext_partners, st, ks, hm, outp, space, from_scratch) - call states_elec_allocate_wfns(st, gr, packed=.true.) - call td_load(td%restart_load, namespace, space, gr, st, hm, ext_partners, td, ks, ierr) + call states_elec_deallocate_wfns(sys%st) + call electrons_ground_state_run(sys%namespace, sys%mc, sys%gr, sys%ions, sys%ext_partners, & + sys%st, sys%ks, sys%hm, sys%outp, sys%space, from_scratch) + call states_elec_allocate_wfns(sys%st, sys%gr, packed=.true.) + call td_load(sys%td%restart_load, sys%namespace, sys%space, sys%gr, sys%st, sys%hm, & + sys%ext_partners, sys%td, sys%ks, ierr) if (ierr /= 0) then message(1) = "Unable to load TD states." - call messages_fatal(1, namespace=namespace) + call messages_fatal(1, namespace=sys%namespace) end if - call density_calc(st, gr, st%rho) - call v_ks_calc(ks, namespace, space, hm, st, ions, ext_partners, & - calc_eigenval=.true., time = iter*td%dt, calc_energy=.true.) - call forces_calculate(gr, namespace, ions, hm, ext_partners, st, ks, t = iter*td%dt, dt = td%dt) - call messages_print_with_emphasis(msg="Time-dependent simulation proceeds", namespace=namespace) - call td_print_header(namespace) + call density_calc(sys%st, sys%gr, sys%st%rho) + call v_ks_calc(sys%ks, sys%namespace, sys%space, sys%hm, sys%st, sys%ions, sys%ext_partners, & + calc_eigenval=.true., time = iter*sys%td%dt, calc_energy=.true.) + call forces_calculate(sys%gr, sys%namespace, sys%ions, sys%hm, sys%ext_partners, sys%st, & + sys%ks, t = iter*sys%td%dt, dt = sys%td%dt) + call messages_print_with_emphasis(msg="Time-dependent simulation proceeds", namespace=sys%namespace) + call td_print_header(sys%namespace) end if end if diff --git a/src/td/td_interface_h.F90 b/src/td/td_interface_h.F90 index 35f30ad728..9c4c32215d 100644 --- a/src/td/td_interface_h.F90 +++ b/src/td/td_interface_h.F90 @@ -22,7 +22,6 @@ module td_interface_oct_m td_init_run, & td_end, & td_end_run, & - td_check_point, & td_dump, & td_allocate_wavefunctions, & td_init_gaugefield, & @@ -81,26 +80,6 @@ module td_interface_oct_m type(electrons_t), intent(inout) :: sys end subroutine td_end_run - module subroutine td_check_point(td, namespace, mc, gr, ions, st, ks, hm, ext_partners, outp, space, & - iter, scsteps, etime, stopping, from_scratch) - type(td_t), intent(inout) :: td - type(namespace_t), intent(in) :: namespace - type(multicomm_t), intent(in) :: mc - type(grid_t), intent(inout) :: gr - type(ions_t), intent(inout) :: ions - type(states_elec_t), intent(inout) :: st - type(v_ks_t), intent(inout) :: ks - type(hamiltonian_elec_t), intent(inout) :: hm - type(partner_list_t), intent(in) :: ext_partners - type(output_t), intent(in) :: outp - type(electron_space_t), intent(in) :: space - integer, intent(in) :: iter - integer, intent(in) :: scsteps - real(real64), intent(inout) :: etime - logical, intent(in) :: stopping - logical, intent(inout) :: from_scratch - end subroutine td_check_point - module subroutine td_init_with_wavefunctions(sys) type(electrons_t), target, intent(inout) :: sys end subroutine td_init_with_wavefunctions -- GitLab From 8110f29cc9343d15ac2870d0dfdf842b971d6000 Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Tue, 23 Apr 2024 21:21:40 +0200 Subject: [PATCH 33/43] td_allocate_wavefunctions: Change signature Signed-off-by: Cristian Le --- src/electrons/electrons.F90 | 3 +-- src/td/td_interface.F90 | 29 +++++++++++------------------ src/td/td_interface_h.F90 | 11 ++--------- 3 files changed, 14 insertions(+), 29 deletions(-) diff --git a/src/electrons/electrons.F90 b/src/electrons/electrons.F90 index 9ad79166ef..9e416f44b8 100644 --- a/src/electrons/electrons.F90 +++ b/src/electrons/electrons.F90 @@ -446,8 +446,7 @@ contains call td_init(this) ! this corresponds to the first part of td_init_run - call td_allocate_wavefunctions(this%td, this%namespace, this%mc, this%gr, this%ions, this%st, & - this%hm, this%space) + call td_allocate_wavefunctions(this) call td_init_gaugefield(this%td, this%namespace, this%gr, this%st, this%ks, this%hm, & this%ext_partners, this%space) diff --git a/src/td/td_interface.F90 b/src/td/td_interface.F90 index b0bbc899e4..5a6d2d89af 100644 --- a/src/td/td_interface.F90 +++ b/src/td/td_interface.F90 @@ -366,34 +366,27 @@ contains end subroutine td_init_run ! --------------------------------------------------------- - module subroutine td_allocate_wavefunctions(td, namespace, mc, gr, ions, st, hm, space) - type(td_t), intent(inout) :: td - type(namespace_t), intent(in) :: namespace - type(multicomm_t), intent(inout) :: mc - type(grid_t), intent(inout) :: gr - type(ions_t), intent(inout) :: ions - type(states_elec_t), intent(inout) :: st - type(hamiltonian_elec_t), intent(inout) :: hm - class(space_t), intent(in) :: space + module subroutine td_allocate_wavefunctions(sys) + type(electrons_t), intent(inout) :: sys PUSH_SUB(td_allocate_wavefunctions) ! Allocate wavefunctions during time-propagation - if (td%dynamics == EHRENFEST) then + if (sys%td%dynamics == EHRENFEST) then !Note: this is not really clean to do this - if (hm%lda_u_level /= DFT_U_NONE .and. states_are_real(st)) then - call lda_u_end(hm%lda_u) + if (sys%hm%lda_u_level /= DFT_U_NONE .and. states_are_real(sys%st)) then + call lda_u_end(sys%hm%lda_u) !complex wfs are required for Ehrenfest - call states_elec_allocate_wfns(st, gr, TYPE_CMPLX, packed=.true.) - call lda_u_init(hm%lda_u, namespace, space, hm%lda_u_level, gr, ions, st, mc, & - hm%kpoints, hm%phase%is_allocated()) + call states_elec_allocate_wfns(sys%st, sys%gr, TYPE_CMPLX, packed=.true.) + call lda_u_init(sys%hm%lda_u, sys%namespace, sys%space, sys%hm%lda_u_level, sys%gr, sys%ions, sys%st, sys%mc, & + sys%hm%kpoints, sys%hm%phase%is_allocated()) else !complex wfs are required for Ehrenfest - call states_elec_allocate_wfns(st, gr, TYPE_CMPLX, packed=.true.) + call states_elec_allocate_wfns(sys%st, sys%gr, TYPE_CMPLX, packed=.true.) end if else - call states_elec_allocate_wfns(st, gr, packed=.true.) - call scf_init(td%scf, namespace, gr, ions, st, mc, hm, space) + call states_elec_allocate_wfns(sys%st, sys%gr, packed=.true.) + call scf_init(sys%td%scf, sys%namespace, sys%gr, sys%ions, sys%st, sys%mc, sys%hm, sys%space) end if POP_SUB(td_allocate_wavefunctions) diff --git a/src/td/td_interface_h.F90 b/src/td/td_interface_h.F90 index 9c4c32215d..2c4abd4ece 100644 --- a/src/td/td_interface_h.F90 +++ b/src/td/td_interface_h.F90 @@ -50,15 +50,8 @@ module td_interface_oct_m logical, intent(inout) :: from_scratch end subroutine td_init_run - module subroutine td_allocate_wavefunctions(td, namespace, mc, gr, ions, st, hm, space) - type(td_t), intent(inout) :: td - type(namespace_t), intent(in) :: namespace - type(multicomm_t), intent(inout) :: mc - type(grid_t), intent(inout) :: gr - type(ions_t), intent(inout) :: ions - type(states_elec_t), intent(inout) :: st - type(hamiltonian_elec_t), intent(inout) :: hm - class(space_t), intent(in) :: space + module subroutine td_allocate_wavefunctions(sys) + type(electrons_t), intent(inout) :: sys end subroutine td_allocate_wavefunctions module subroutine td_init_gaugefield(td, namespace, gr, st, ks, hm, ext_partners, space) -- GitLab From 8242708fc2f24f89de8ddd670f8a3838be2ae621 Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Tue, 23 Apr 2024 12:13:30 +0200 Subject: [PATCH 34/43] electrons_ground_state_run: Change signature Signed-off-by: Cristian Le --- src/main/ground_state.F90 | 16 +---- src/scf/electrons_ground_state.F90 | 90 ++++++++++++++-------------- src/scf/electrons_ground_state_h.F90 | 24 +------- src/td/td_interface.F90 | 3 +- 4 files changed, 50 insertions(+), 83 deletions(-) diff --git a/src/main/ground_state.F90 b/src/main/ground_state.F90 index 8e5adb8ead..ee17ad0bc6 100644 --- a/src/main/ground_state.F90 +++ b/src/main/ground_state.F90 @@ -95,31 +95,19 @@ contains message(1) = "Check log of the run in "//trim(system2%namespace%get())//"/log." message(2) = "" call messages_info(2, namespace=global_namespace) - call ground_state_run_legacy(system2, from_scratch) + call electrons_ground_state_run(system2, from_scratch) call messages_print_with_emphasis(namespace=global_namespace) end select end do end if type is (electrons_t) - call ground_state_run_legacy(system, from_scratch) + call electrons_ground_state_run(system, from_scratch) end select POP_SUB(ground_state_run) end subroutine ground_state_run - subroutine ground_state_run_legacy(electrons, from_scratch) - class(electrons_t), intent(inout) :: electrons - logical, intent(inout) :: from_scratch - - PUSH_SUB(ground_state_run_legacy) - - call electrons_ground_state_run(electrons%namespace, electrons%mc, electrons%gr, electrons%ions, electrons%ext_partners, & - electrons%st, electrons%ks, electrons%hm, electrons%outp, electrons%space, from_scratch) - - POP_SUB(ground_state_run_legacy) - end subroutine ground_state_run_legacy - end module ground_state_oct_m !! Local Variables: diff --git a/src/scf/electrons_ground_state.F90 b/src/scf/electrons_ground_state.F90 index c4a7c70fb1..e58a2cc9b8 100644 --- a/src/scf/electrons_ground_state.F90 +++ b/src/scf/electrons_ground_state.F90 @@ -35,24 +35,17 @@ submodule (electrons_ground_state_oct_m) impl use scf_oct_m use space_oct_m use states_abst_oct_m + use states_elec_oct_m use states_elec_restart_oct_m + use v_ks_oct_m implicit none contains ! --------------------------------------------------------- - module subroutine electrons_ground_state_run(namespace, mc, gr, ions, ext_partners, st, ks, hm, outp, space, fromScratch) - type(namespace_t), intent(in) :: namespace - type(multicomm_t), intent(in) :: mc - type(grid_t), intent(inout) :: gr - type(ions_t), intent(inout) :: ions - type(partner_list_t), intent(in) :: ext_partners - type(states_elec_t), intent(inout) :: st - type(v_ks_t), intent(inout) :: ks - type(hamiltonian_elec_t), intent(inout) :: hm - type(output_t), intent(in) :: outp - type(electron_space_t), intent(in) :: space + module subroutine electrons_ground_state_run(sys, fromScratch) + type(electrons_t), intent(inout) :: sys logical, intent(inout) :: fromScratch type(scf_t) :: scfv @@ -64,99 +57,104 @@ contains PUSH_SUB(ground_state_run_legacy) call messages_write('Info: Allocating ground state wave-functions') - call messages_info(namespace=namespace) + call messages_info(namespace=sys%namespace) - if (st%parallel_in_states) then - call messages_experimental('State parallelization for ground state calculations', namespace=namespace) + if (sys%st%parallel_in_states) then + call messages_experimental('State parallelization for ground state calculations', namespace=sys%namespace) end if - if (hm%pcm%run_pcm) then - if (.not. is_close(hm%pcm%epsilon_infty, hm%pcm%epsilon_0) .and. hm%pcm%tdlevel /= PCM_TD_EQ) then + if (sys%hm%pcm%run_pcm) then + if (.not. is_close(sys%hm%pcm%epsilon_infty, sys%hm%pcm%epsilon_0) .and. sys%hm%pcm%tdlevel /= PCM_TD_EQ) then message(1) = 'Non-equilbrium PCM is not active in a time-independent run.' message(2) = 'You set epsilon_infty /= epsilon_0, but epsilon_infty is not relevant for CalculationMode = gs.' message(3) = 'By definition, the ground state is in equilibrium with the solvent.' message(4) = 'Therefore, the only relevant dielectric constant is the static one.' message(5) = 'Nevertheless, the dynamical PCM response matrix is evaluated for benchamarking purposes.' - call messages_warning(5, namespace=namespace) + call messages_warning(5, namespace=sys%namespace) end if end if - call states_elec_allocate_wfns(st, gr, packed=.true.) + call states_elec_allocate_wfns(sys%st, sys%gr, packed=.true.) ! sometimes a deadlock can occur here (if some nodes can allocate and other cannot) - if (st%dom_st_kpt_mpi_grp%comm > 0) call st%dom_st_kpt_mpi_grp%barrier() + if (sys%st%dom_st_kpt_mpi_grp%comm > 0) call sys%st%dom_st_kpt_mpi_grp%barrier() call messages_write('Info: Ground-state allocation done.') - call messages_info(namespace=namespace) + call messages_info(namespace=sys%namespace) if (.not. fromScratch) then ! load wavefunctions ! in RDMFT we need the full ground state - call restart_init(restart_load, namespace, RESTART_GS, RESTART_TYPE_LOAD, mc, ierr, mesh=gr, & - exact = (ks%theory_level == RDMFT)) + call restart_init(restart_load, sys%namespace, RESTART_GS, RESTART_TYPE_LOAD, sys%mc, ierr, mesh=sys%gr, & + exact = (sys%ks%theory_level == RDMFT)) if (ierr == 0) then - call states_elec_load(restart_load, namespace, space, st, gr, hm%kpoints, ierr) + call states_elec_load(restart_load, sys%namespace, sys%space, sys%st, sys%gr, sys%hm%kpoints, ierr) end if if (ierr /= 0) then call messages_write("Unable to read wavefunctions.") call messages_new_line() call messages_write("Starting from scratch!") - call messages_warning(namespace=namespace) + call messages_warning(namespace=sys%namespace) fromScratch = .true. end if end if - call write_canonicalized_xyz_file("exec", "initial_coordinates", space, ions%latt, ions%pos, ions%atom, & - gr%box, namespace) + call write_canonicalized_xyz_file("exec", "initial_coordinates", sys%space, sys%ions%latt, sys%ions%pos, sys%ions%atom, & + sys%gr%box, sys%namespace) - if (ks%theory_level /= RDMFT) then - call scf_init(scfv, namespace, gr, ions, st, mc, hm, space) + if (sys%ks%theory_level /= RDMFT) then + call scf_init(scfv, sys%namespace, sys%gr, sys%ions, sys%st, sys%mc, sys%hm, sys%space) ! only initialize dumping restart files for more than one iteration restart_init_dump = scfv%max_iter > 0 else restart_init_dump = .true. end if - if (fromScratch .and. ks%theory_level /= RDMFT) then - call lcao_run(namespace, space, gr, ions, ext_partners, st, ks, hm, lmm_r = scfv%lmm_r) + if (fromScratch .and. sys%ks%theory_level /= RDMFT) then + call lcao_run(sys%namespace, sys%space, sys%gr, sys%ions, sys%ext_partners, sys%st, sys%ks, sys%hm, lmm_r = scfv%lmm_r) else ! setup Hamiltonian call messages_write('Info: Setting up Hamiltonian.') - call messages_info(namespace=namespace) - call v_ks_h_setup(namespace, space, gr, ions, ext_partners, st, ks, hm, & + call messages_info(namespace=sys%namespace) + call v_ks_h_setup(sys%namespace, sys%space, sys%gr, sys%ions, sys%ext_partners, sys%st, sys%ks, sys%hm, & calc_eigenval = .false., calc_current = .false.) end if if (restart_init_dump) then - call restart_init(restart_dump, namespace, RESTART_GS, RESTART_TYPE_DUMP, mc, ierr, mesh=gr) + call restart_init(restart_dump, sys%namespace, RESTART_GS, RESTART_TYPE_DUMP, sys%mc, ierr, mesh=sys%gr) end if ! run self-consistency - call scf_state_info(namespace, st) + call scf_state_info(sys%namespace, sys%st) - if (st%pack_states .and. hm%apply_packed()) then - call st%pack() + if (sys%st%pack_states .and. sys%hm%apply_packed()) then + call sys%st%pack() end if ! self-consistency for occupation numbers and natural orbitals in RDMFT - if (ks%theory_level == RDMFT) then - call rdmft_init(rdm, namespace, gr, st, mc, space, fromScratch) - call scf_rdmft(rdm, namespace, space, gr, ions, ext_partners, st, ks, hm, outp, restart_dump) + if (sys%ks%theory_level == RDMFT) then + call rdmft_init(rdm, sys%namespace, sys%gr, sys%st, sys%mc, sys%space, fromScratch) + call scf_rdmft(rdm, sys%namespace, sys%space, sys%gr, sys%ions, sys%ext_partners, & + sys%st, sys%ks, sys%hm, sys%outp, restart_dump) call rdmft_end(rdm) else if (.not. fromScratch) then if (restart_init_dump) then - call scf_run(scfv, namespace, space, mc, gr, ions, ext_partners, st, ks, hm, outp=outp, & + call scf_run(scfv, sys%namespace, sys%space, sys%mc, sys%gr, sys%ions, & + sys%ext_partners, sys%st, sys%ks, sys%hm, outp=sys%outp, & restart_load=restart_load, restart_dump=restart_dump) else - call scf_run(scfv, namespace, space, mc, gr, ions, ext_partners, st, ks, hm, outp=outp, restart_load=restart_load) + call scf_run(scfv, sys%namespace, sys%space, sys%mc, sys%gr, sys%ions, sys%ext_partners, & + sys%st, sys%ks, sys%hm, outp=sys%outp, restart_load=restart_load) end if call restart_end(restart_load) else if (restart_init_dump) then - call scf_run(scfv, namespace, space, mc, gr, ions, ext_partners, st, ks, hm, outp=outp, restart_dump=restart_dump) + call scf_run(scfv, sys%namespace, sys%space, sys%mc, sys%gr, sys%ions, sys%ext_partners, & + sys%st, sys%ks, sys%hm, outp=sys%outp, restart_dump=restart_dump) else - call scf_run(scfv, namespace, space, mc, gr, ions, ext_partners, st, ks, hm, outp=outp) + call scf_run(scfv, sys%namespace, sys%space, sys%mc, sys%gr, sys%ions, sys%ext_partners, & + sys%st, sys%ks, sys%hm, outp=sys%outp) end if end if @@ -167,12 +165,12 @@ contains call restart_end(restart_dump) end if - if (st%pack_states .and. hm%apply_packed()) then - call st%unpack() + if (sys%st%pack_states .and. sys%hm%apply_packed()) then + call sys%st%unpack() end if ! clean up - call states_elec_deallocate_wfns(st) + call states_elec_deallocate_wfns(sys%st) POP_SUB(ground_state_run_legacy) end subroutine electrons_ground_state_run diff --git a/src/scf/electrons_ground_state_h.F90 b/src/scf/electrons_ground_state_h.F90 index da0b3ac4e1..25cff7d46a 100644 --- a/src/scf/electrons_ground_state_h.F90 +++ b/src/scf/electrons_ground_state_h.F90 @@ -1,14 +1,5 @@ module electrons_ground_state_oct_m - use electron_space_oct_m - use grid_oct_m - use hamiltonian_elec_oct_m - use interaction_partner_oct_m - use ions_oct_m - use multicomm_oct_m - use namespace_oct_m - use output_low_oct_m - use states_elec_oct_m - use v_ks_oct_m + use electrons_oct_m implicit none @@ -17,17 +8,8 @@ module electrons_ground_state_oct_m electrons_ground_state_run interface - module subroutine electrons_ground_state_run(namespace, mc, gr, ions, ext_partners, st, ks, hm, outp, space, fromScratch) - type(namespace_t), intent(in) :: namespace - type(multicomm_t), intent(in) :: mc - type(grid_t), intent(inout) :: gr - type(ions_t), intent(inout) :: ions - type(partner_list_t), intent(in) :: ext_partners - type(states_elec_t), intent(inout) :: st - type(v_ks_t), intent(inout) :: ks - type(hamiltonian_elec_t), intent(inout) :: hm - type(output_t), intent(in) :: outp - type(electron_space_t), intent(in) :: space + module subroutine electrons_ground_state_run(sys, fromScratch) + type(electrons_t), intent(inout) :: sys logical, intent(inout) :: fromScratch end subroutine electrons_ground_state_run end interface diff --git a/src/td/td_interface.F90 b/src/td/td_interface.F90 index 5a6d2d89af..3a99634574 100644 --- a/src/td/td_interface.F90 +++ b/src/td/td_interface.F90 @@ -588,8 +588,7 @@ contains call messages_print_with_emphasis(msg='Recalculating the ground state.', namespace=sys%namespace) from_scratch = .false. call states_elec_deallocate_wfns(sys%st) - call electrons_ground_state_run(sys%namespace, sys%mc, sys%gr, sys%ions, sys%ext_partners, & - sys%st, sys%ks, sys%hm, sys%outp, sys%space, from_scratch) + call electrons_ground_state_run(sys, from_scratch) call states_elec_allocate_wfns(sys%st, sys%gr, packed=.true.) call td_load(sys%td%restart_load, sys%namespace, sys%space, sys%gr, sys%st, sys%hm, & sys%ext_partners, sys%td, sys%ks, ierr) -- GitLab From 61a5313d20b2ed5f927bfdae9344ed718adeb25a Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Tue, 23 Apr 2024 21:16:10 +0200 Subject: [PATCH 35/43] get_dyn_matrix: Change signature Signed-off-by: Cristian Le --- src/main/phonons_fd.F90 | 62 +++++++++++++++++------------------------ 1 file changed, 26 insertions(+), 36 deletions(-) diff --git a/src/main/phonons_fd.F90 b/src/main/phonons_fd.F90 index 92ad4e2715..a0ce151480 100644 --- a/src/main/phonons_fd.F90 +++ b/src/main/phonons_fd.F90 @@ -130,8 +130,7 @@ contains call parse_variable(sys%namespace, 'Displacement', 0.01_real64, vib%disp, units_inp%length) ! calculate dynamical matrix - call get_dyn_matrix(sys%gr, sys%namespace, sys%mc, sys%ions, sys%ext_partners, sys%st, sys%ks, & - sys%hm, sys%outp, vib, sys%space) + call get_dyn_matrix(sys, vib) call vibrations_output(vib) @@ -144,18 +143,9 @@ contains ! --------------------------------------------------------- !>@brief Computes the second-order force constant from finite differences - subroutine get_dyn_matrix(gr, namespace, mc, ions, ext_partners, st, ks, hm, outp, vib, space) - type(grid_t), target, intent(inout) :: gr - type(namespace_t), intent(in) :: namespace - type(multicomm_t), intent(in) :: mc - type(ions_t), intent(inout) :: ions - type(partner_list_t), intent(in) :: ext_partners - type(states_elec_t), intent(inout) :: st - type(v_ks_t), intent(inout) :: ks - type(hamiltonian_elec_t), intent(inout) :: hm - type(output_t), intent(in) :: outp + subroutine get_dyn_matrix(sys, vib) + type(electrons_t), intent(inout) :: sys type(vibrations_t), intent(inout) :: vib - type(electron_space_t), intent(in) :: space type(scf_t) :: scf integer :: iatom, jatom, alpha, beta, imat, jmat @@ -164,45 +154,45 @@ contains PUSH_SUB(get_dyn_matrix) - call scf_init(scf, namespace, gr, ions, st, mc, hm, space) - SAFE_ALLOCATE(forces0(1:space%dim, 1:ions%natoms)) - SAFE_ALLOCATE(forces (1:space%dim, 1:ions%natoms)) + call scf_init(scf, sys%namespace, sys%gr, sys%ions, sys%st, sys%mc, sys%hm, sys%space) + SAFE_ALLOCATE(forces0(1:sys%space%dim, 1:sys%ions%natoms)) + SAFE_ALLOCATE(forces (1:sys%space%dim, 1:sys%ions%natoms)) forces = M_ZERO forces0 = M_ZERO - do iatom = 1, ions%natoms - do alpha = 1, space%dim + do iatom = 1, sys%ions%natoms + do alpha = 1, sys%space%dim imat = vibrations_get_index(vib, iatom, alpha) call messages_new_line() - call messages_print_with_emphasis(namespace=namespace) + call messages_print_with_emphasis(namespace=sys%namespace) write(message(1), '(a,i3,3a)') 'Info: Moving atom ', iatom, ' in the +', index2axis(alpha), '-direction.' - call messages_info(1, namespace=namespace) - call messages_print_with_emphasis(namespace=namespace) + call messages_info(1, namespace=sys%namespace) + call messages_print_with_emphasis(namespace=sys%namespace) ! move atom iatom in direction alpha by dist - ions%pos(alpha, iatom) = ions%pos(alpha, iatom) + vib%disp + sys%ions%pos(alpha, iatom) = sys%ions%pos(alpha, iatom) + vib%disp ! first force call run_displacement() - forces0 = ions%tot_force + forces0 = sys%ions%tot_force call messages_new_line() - call messages_print_with_emphasis(namespace=namespace) + call messages_print_with_emphasis(namespace=sys%namespace) write(message(1), '(a,i3,3a)') 'Info: Moving atom ', iatom, ' in the -', index2axis(alpha), '-direction.' - call messages_info(1, namespace=namespace) - call messages_print_with_emphasis(namespace=namespace) + call messages_info(1, namespace=sys%namespace) + call messages_print_with_emphasis(namespace=sys%namespace) - ions%pos(alpha, iatom) = ions%pos(alpha, iatom) - M_TWO*vib%disp + sys%ions%pos(alpha, iatom) = sys%ions%pos(alpha, iatom) - M_TWO*vib%disp ! second force call run_displacement() - forces = ions%tot_force + forces = sys%ions%tot_force - ions%pos(alpha, iatom) = ions%pos(alpha, iatom) + vib%disp + sys%ions%pos(alpha, iatom) = sys%ions%pos(alpha, iatom) + vib%disp - do jatom = 1, ions%natoms - do beta = 1, space%dim + do jatom = 1, sys%ions%natoms + do beta = 1, sys%space%dim jmat = vibrations_get_index(vib, jatom, beta) vib%dyn_matrix(jmat, imat) = (forces0(beta, jatom) - forces(beta, jatom)) / (M_TWO*vib%disp) & * vibrations_norm_factor(vib, iatom, jatom) @@ -227,12 +217,12 @@ contains subroutine run_displacement() PUSH_SUB(get_dyn_matrix.run_displacement) - call hamiltonian_elec_epot_generate(hm, namespace, space, gr, ions, ext_partners, st) - call density_calc(st, gr, st%rho) - call v_ks_calc(ks, namespace, space, hm, st, ions, ext_partners, calc_eigenval=.true.) - call energy_calc_total(namespace, space, hm, gr, st, ext_partners) + call hamiltonian_elec_epot_generate(sys%hm, sys%namespace, sys%space, sys%gr, sys%ions, sys%ext_partners, sys%st) + call density_calc(sys%st, sys%gr, sys%st%rho) + call v_ks_calc(sys%ks, sys%namespace, sys%space, sys%hm, sys%st, sys%ions, sys%ext_partners, calc_eigenval=.true.) + call energy_calc_total(sys%namespace, sys%space, sys%hm, sys%gr, sys%st, sys%ext_partners) call scf_mix_clear(scf) - call scf_run(scf, namespace, space, mc, gr, ions, ext_partners, st, ks, hm, verbosity = VERB_COMPACT) + call scf_run(scf, sys%namespace, sys%space, sys%mc, sys%gr, sys%ions, sys%ext_partners, sys%st, sys%ks, sys%hm, verbosity = VERB_COMPACT) POP_SUB(get_dyn_matrix.run_displacement) end subroutine run_displacement -- GitLab From ad9bf34ebe900e31bb0f04d1bf41c35162792d20 Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Tue, 23 Apr 2024 13:16:12 +0200 Subject: [PATCH 36/43] Use system's scf object Signed-off-by: Cristian Le --- src/main/geom_opt.F90 | 15 +++++++-------- src/main/phonons_fd.F90 | 9 ++++----- src/main/static_pol.F90 | 19 +++++++++---------- src/scf/electrons_ground_state.F90 | 17 ++++++++--------- src/td/td_h.F90 | 2 -- src/td/td_interface.F90 | 6 +++--- 6 files changed, 31 insertions(+), 37 deletions(-) diff --git a/src/main/geom_opt.F90 b/src/main/geom_opt.F90 index 1249dddaa6..b7fa4b3117 100644 --- a/src/main/geom_opt.F90 +++ b/src/main/geom_opt.F90 @@ -77,7 +77,6 @@ module geom_opt_oct_m integer :: what2minimize !> shortcuts - type(scf_t) :: scfv type(ions_t), pointer :: ions type(hamiltonian_elec_t), pointer :: hm type(electrons_t), pointer :: syst @@ -172,17 +171,17 @@ contains end if end if - call scf_init(g_opt%scfv, sys%namespace, sys%gr, sys%ions, sys%st, sys%mc, sys%hm, sys%space) + call scf_init(sys%scf, sys%namespace, sys%gr, sys%ions, sys%st, sys%mc, sys%hm, sys%space) if (bitand(g_opt%type, GO_CELL) /= 0 .or. bitand(g_opt%type, GO_VOLUME) /= 0) then - if (.not. g_opt%scfv%calc_stress) then + if (.not. sys%scf%calc_stress) then message(1) = "In order to optimize the cell, one needs to set SCFCalculeStress = yes." call messages_fatal(1, namespace=sys%namespace) end if end if if (fromScratch) then - call lcao_run(sys%namespace, sys%space, sys%gr, sys%ions, sys%ext_partners, sys%st, sys%ks, sys%hm, lmm_r = g_opt%scfv%lmm_r) + call lcao_run(sys%namespace, sys%space, sys%gr, sys%ions, sys%ext_partners, sys%st, sys%ks, sys%hm, lmm_r = sys%scf%lmm_r) else ! setup Hamiltonian message(1) = 'Info: Setting up Hamiltonian.' @@ -247,9 +246,9 @@ contains call g_opt%ions%write_xyz('./min') SAFE_DEALLOCATE_A(coords) - call scf_end(g_opt%scfv) + call scf_end(sys%scf) ! Because g_opt has the "save" atribute, we need to explicitly empty the criteria list here, or there will be a memory leak. - call g_opt%scfv%criterion_list%empty() + call sys%scf%criterion_list%empty() call end_() POP_SUB(geom_opt_run_legacy) @@ -765,7 +764,7 @@ contains call g_opt%ions%write_xyz('./work-geom', append = .true.) - call scf_mix_clear(g_opt%scfv) + call scf_mix_clear(g_opt%syst%scf) ! Update lattice vectors and regenerate grid if (bitand(g_opt%type, GO_CELL) /= 0 .or. bitand(g_opt%type, GO_VOLUME) /= 0 ) then @@ -782,7 +781,7 @@ contains call energy_calc_total(g_opt%syst%namespace, g_opt%syst%space, g_opt%hm, g_opt%syst%gr, g_opt%st, g_opt%syst%ext_partners) ! do SCF calculation - call scf_run(g_opt%scfv, g_opt%syst%namespace, g_opt%syst%space, g_opt%syst%mc, g_opt%syst%gr, & + call scf_run(g_opt%syst%scf, g_opt%syst%namespace, g_opt%syst%space, g_opt%syst%mc, g_opt%syst%gr, & g_opt%ions, g_opt%syst%ext_partners, & g_opt%st, g_opt%syst%ks, g_opt%hm, outp = g_opt%syst%outp, verbosity = VERB_COMPACT, restart_dump=g_opt%restart_dump) diff --git a/src/main/phonons_fd.F90 b/src/main/phonons_fd.F90 index a0ce151480..4429011040 100644 --- a/src/main/phonons_fd.F90 +++ b/src/main/phonons_fd.F90 @@ -147,14 +147,13 @@ contains type(electrons_t), intent(inout) :: sys type(vibrations_t), intent(inout) :: vib - type(scf_t) :: scf integer :: iatom, jatom, alpha, beta, imat, jmat real(real64), allocatable :: forces(:,:), forces0(:,:) PUSH_SUB(get_dyn_matrix) - call scf_init(scf, sys%namespace, sys%gr, sys%ions, sys%st, sys%mc, sys%hm, sys%space) + call scf_init(sys%scf, sys%namespace, sys%gr, sys%ions, sys%st, sys%mc, sys%hm, sys%space) SAFE_ALLOCATE(forces0(1:sys%space%dim, 1:sys%ions%natoms)) SAFE_ALLOCATE(forces (1:sys%space%dim, 1:sys%ions%natoms)) forces = M_ZERO @@ -204,7 +203,7 @@ contains end do SAFE_DEALLOCATE_A(forces0) SAFE_DEALLOCATE_A(forces) - call scf_end(scf) + call scf_end(sys%scf) call vibrations_symmetrize_dyn_matrix(vib) call vibrations_diag_dyn_matrix(vib) @@ -221,8 +220,8 @@ contains call density_calc(sys%st, sys%gr, sys%st%rho) call v_ks_calc(sys%ks, sys%namespace, sys%space, sys%hm, sys%st, sys%ions, sys%ext_partners, calc_eigenval=.true.) call energy_calc_total(sys%namespace, sys%space, sys%hm, sys%gr, sys%st, sys%ext_partners) - call scf_mix_clear(scf) - call scf_run(scf, sys%namespace, sys%space, sys%mc, sys%gr, sys%ions, sys%ext_partners, sys%st, sys%ks, sys%hm, verbosity = VERB_COMPACT) + call scf_mix_clear(sys%scf) + call scf_run(sys%scf, sys%namespace, sys%space, sys%mc, sys%gr, sys%ions, sys%ext_partners, sys%st, sys%ks, sys%hm, verbosity = VERB_COMPACT) POP_SUB(get_dyn_matrix.run_displacement) end subroutine run_displacement diff --git a/src/main/static_pol.F90 b/src/main/static_pol.F90 index 4af6a1b65b..b50791c905 100644 --- a/src/main/static_pol.F90 +++ b/src/main/static_pol.F90 @@ -83,7 +83,6 @@ contains type(electrons_t), intent(inout) :: sys logical, intent(in) :: fromScratch - type(scf_t) :: scfv integer :: iunit, ios, i_start, ii, jj, is, isign, ierr, read_count, verbosity real(real64) :: e_field, e_field_saved real(real64), allocatable :: Vpsl_save(:), trrho(:), dipole(:, :, :) @@ -224,7 +223,7 @@ contains gs_rho = M_ZERO call output_init_() - call scf_init(scfv, sys%namespace, sys%gr, sys%ions, sys%st, sys%mc, sys%hm, sys%space) + call scf_init(sys%scf, sys%namespace, sys%gr, sys%ions, sys%st, sys%mc, sys%hm, sys%space) call born_charges_init(born_charges, sys%namespace, sys%ions%natoms, sys%st%val_charge, & sys%st%qtot, sys%space%dim) @@ -236,7 +235,7 @@ contains write(message(1), '(a)') write(message(2), '(a)') 'Info: Calculating dipole moment for zero field.' call messages_info(2, namespace=sys%namespace) - call scf_run(scfv, sys%namespace, sys%space, sys%mc, sys%gr, sys%ions, sys%ext_partners, sys%st, & + call scf_run(sys%scf, sys%namespace, sys%space, sys%mc, sys%gr, sys%ions, sys%ext_partners, sys%st, & sys%ks, sys%hm, verbosity = verbosity) gs_rho(1:sys%gr%np, 1:sys%st%d%nspin) = sys%st%rho(1:sys%gr%np, 1:sys%st%d%nspin) @@ -306,12 +305,12 @@ contains call v_ks_h_setup(sys%namespace, sys%space, sys%gr, sys%ions, sys%ext_partners, sys%st, sys%ks, sys%hm) else call lcao_run(sys%namespace, sys%space, sys%gr, sys%ions, sys%ext_partners, sys%st, sys%ks, & - sys%hm, lmm_r = scfv%lmm_r) + sys%hm, lmm_r = sys%scf%lmm_r) end if end if - call scf_mix_clear(scfv) - call scf_run(scfv, sys%namespace, sys%space, sys%mc, sys%gr, sys%ions, sys%ext_partners, sys%st, & + call scf_mix_clear(sys%scf) + call scf_run(sys%scf, sys%namespace, sys%space, sys%mc, sys%gr, sys%ions, sys%ext_partners, sys%st, & sys%ks, sys%hm, verbosity = verbosity) trrho = M_ZERO @@ -392,12 +391,12 @@ contains call v_ks_h_setup(sys%namespace, sys%space, sys%gr, sys%ions, sys%ext_partners, sys%st, sys%ks, sys%hm) else call lcao_run(sys%namespace, sys%space, sys%gr, sys%ions, sys%ext_partners, sys%st, sys%ks, & - sys%hm, lmm_r = scfv%lmm_r) + sys%hm, lmm_r = sys%scf%lmm_r) end if end if - call scf_mix_clear(scfv) - call scf_run(scfv, sys%namespace, sys%space, sys%mc, sys%gr, sys%ions, sys%ext_partners, sys%st, & + call scf_mix_clear(sys%scf) + call scf_run(sys%scf, sys%namespace, sys%space, sys%mc, sys%gr, sys%ions, sys%ext_partners, sys%st, & sys%ks, sys%hm, verbosity = verbosity) trrho = M_ZERO @@ -440,7 +439,7 @@ contains end if if (.not. fromScratch) call restart_end(restart_load) - call scf_end(scfv) + call scf_end(sys%scf) call output_end_() call born_charges_end(born_charges) diff --git a/src/scf/electrons_ground_state.F90 b/src/scf/electrons_ground_state.F90 index e58a2cc9b8..f08bebfb1c 100644 --- a/src/scf/electrons_ground_state.F90 +++ b/src/scf/electrons_ground_state.F90 @@ -48,7 +48,6 @@ contains type(electrons_t), intent(inout) :: sys logical, intent(inout) :: fromScratch - type(scf_t) :: scfv type(restart_t) :: restart_load, restart_dump integer :: ierr type(rdm_t) :: rdm @@ -103,15 +102,15 @@ contains sys%gr%box, sys%namespace) if (sys%ks%theory_level /= RDMFT) then - call scf_init(scfv, sys%namespace, sys%gr, sys%ions, sys%st, sys%mc, sys%hm, sys%space) + call scf_init(sys%scf, sys%namespace, sys%gr, sys%ions, sys%st, sys%mc, sys%hm, sys%space) ! only initialize dumping restart files for more than one iteration - restart_init_dump = scfv%max_iter > 0 + restart_init_dump = sys%scf%max_iter > 0 else restart_init_dump = .true. end if if (fromScratch .and. sys%ks%theory_level /= RDMFT) then - call lcao_run(sys%namespace, sys%space, sys%gr, sys%ions, sys%ext_partners, sys%st, sys%ks, sys%hm, lmm_r = scfv%lmm_r) + call lcao_run(sys%namespace, sys%space, sys%gr, sys%ions, sys%ext_partners, sys%st, sys%ks, sys%hm, lmm_r = sys%scf%lmm_r) else ! setup Hamiltonian call messages_write('Info: Setting up Hamiltonian.') @@ -140,25 +139,25 @@ contains else if (.not. fromScratch) then if (restart_init_dump) then - call scf_run(scfv, sys%namespace, sys%space, sys%mc, sys%gr, sys%ions, & + call scf_run(sys%scf, sys%namespace, sys%space, sys%mc, sys%gr, sys%ions, & sys%ext_partners, sys%st, sys%ks, sys%hm, outp=sys%outp, & restart_load=restart_load, restart_dump=restart_dump) else - call scf_run(scfv, sys%namespace, sys%space, sys%mc, sys%gr, sys%ions, sys%ext_partners, & + call scf_run(sys%scf, sys%namespace, sys%space, sys%mc, sys%gr, sys%ions, sys%ext_partners, & sys%st, sys%ks, sys%hm, outp=sys%outp, restart_load=restart_load) end if call restart_end(restart_load) else if (restart_init_dump) then - call scf_run(scfv, sys%namespace, sys%space, sys%mc, sys%gr, sys%ions, sys%ext_partners, & + call scf_run(sys%scf, sys%namespace, sys%space, sys%mc, sys%gr, sys%ions, sys%ext_partners, & sys%st, sys%ks, sys%hm, outp=sys%outp, restart_dump=restart_dump) else - call scf_run(scfv, sys%namespace, sys%space, sys%mc, sys%gr, sys%ions, sys%ext_partners, & + call scf_run(sys%scf, sys%namespace, sys%space, sys%mc, sys%gr, sys%ions, sys%ext_partners, & sys%st, sys%ks, sys%hm, outp=sys%outp) end if end if - call scf_end(scfv) + call scf_end(sys%scf) end if if (restart_init_dump) then diff --git a/src/td/td_h.F90 b/src/td/td_h.F90 index 1867f3a53b..a607b61acd 100644 --- a/src/td/td_h.F90 +++ b/src/td/td_h.F90 @@ -12,7 +12,6 @@ module td_oct_m use pes_oct_m use propagator_base_oct_m use restart_oct_m - use scf_oct_m use space_oct_m use states_elec_oct_m use td_write_oct_m @@ -30,7 +29,6 @@ module td_oct_m type, public :: td_t private type(propagator_base_t), public :: tr !< contains the details of the time-evolution - type(scf_t), public :: scf type(ion_dynamics_t), public :: ions_dyn real(real64), public :: dt !< time step integer, public :: max_iter !< maximum number of iterations to perform diff --git a/src/td/td_interface.F90 b/src/td/td_interface.F90 index 3a99634574..9397ee72f4 100644 --- a/src/td/td_interface.F90 +++ b/src/td/td_interface.F90 @@ -386,7 +386,7 @@ contains end if else call states_elec_allocate_wfns(sys%st, sys%gr, packed=.true.) - call scf_init(sys%td%scf, sys%namespace, sys%gr, sys%ions, sys%st, sys%mc, sys%hm, sys%space) + call scf_init(sys%scf, sys%namespace, sys%gr, sys%ions, sys%st, sys%mc, sys%hm, sys%space) end if POP_SUB(td_allocate_wavefunctions) @@ -433,7 +433,7 @@ contains call propagator_elec_end(sys%td%tr) ! clean the evolution method call ion_dynamics_end(sys%td%ions_dyn) - if (sys%td%dynamics == BO) call scf_end(sys%td%scf) + if (sys%td%dynamics == BO) call scf_end(sys%scf) POP_SUB(td_end) end subroutine td_end @@ -501,7 +501,7 @@ contains sys%ions, sys%ext_partners, sys%outp, sys%td%write_handler, scsteps = scsteps, & update_energy = (mod(iter, sys%td%energy_update_iter) == 0) .or. (iter == sys%td%max_iter)) case (BO) - call propagator_elec_dt_bo(sys%td%scf, sys%namespace, sys%space, sys%gr, sys%ks, sys%st, sys%hm, & + call propagator_elec_dt_bo(sys%scf, sys%namespace, sys%space, sys%gr, sys%ks, sys%st, sys%hm, & sys%ions, sys%ext_partners, sys%mc, sys%outp, iter, & sys%td%dt, sys%td%ions_dyn, scsteps) end select -- GitLab From 5580a823c6e528e32653acb0e70c4575de70370f Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Tue, 23 Apr 2024 21:42:35 +0200 Subject: [PATCH 37/43] propagator_elec_dt_bo: Change signature Signed-off-by: Cristian Le --- src/td/propagator_elec.F90 | 51 +++++++++++++++--------------------- src/td/propagator_elec_h.F90 | 18 +++---------- src/td/td_interface.F90 | 4 +-- 3 files changed, 25 insertions(+), 48 deletions(-) diff --git a/src/td/propagator_elec.F90 b/src/td/propagator_elec.F90 index 20cd7a8fc2..51dca2925a 100644 --- a/src/td/propagator_elec.F90 +++ b/src/td/propagator_elec.F90 @@ -602,22 +602,9 @@ contains ! --------------------------------------------------------- - module subroutine propagator_elec_dt_bo(scf, namespace, space, gr, ks, st, hm, ions, ext_partners, & - mc, outp, iter, dt, ions_dyn, scsteps) - type(scf_t), intent(inout) :: scf - type(namespace_t), intent(in) :: namespace - type(electron_space_t), intent(in) :: space - type(grid_t), intent(inout) :: gr - type(v_ks_t), intent(inout) :: ks - type(states_elec_t), intent(inout) :: st - type(hamiltonian_elec_t), intent(inout) :: hm - type(ions_t), intent(inout) :: ions - type(partner_list_t), intent(in) :: ext_partners - type(multicomm_t), intent(inout) :: mc !< index and domain communicators - type(output_t), intent(inout) :: outp + module subroutine propagator_elec_dt_bo(sys, iter, scsteps) + type(electrons_t), intent(inout) :: sys integer, intent(in) :: iter - real(real64), intent(in) :: dt - type(ion_dynamics_t), intent(inout) :: ions_dyn integer, intent(inout) :: scsteps type(gauge_field_t), pointer :: gfield @@ -625,40 +612,44 @@ contains PUSH_SUB(propagator_elec_dt_bo) ! move the hamiltonian to time t - call ion_dynamics_propagate(ions_dyn, ions, iter*dt, dt, namespace) - call hamiltonian_elec_epot_generate(hm, namespace, space, gr, ions, ext_partners, st, time = iter*dt) + call ion_dynamics_propagate(sys%td%ions_dyn, sys%ions, iter*sys%td%dt, sys%td%dt, sys%namespace) + call hamiltonian_elec_epot_generate(sys%hm, sys%namespace, sys%space, sys%gr, sys%ions, & + sys%ext_partners, sys%st, time = iter*sys%td%dt) ! now calculate the eigenfunctions - call scf_run(scf, namespace, space, mc, gr, ions, ext_partners, st, ks, hm, & + call scf_run(sys%scf, sys%namespace, sys%space, sys%mc, sys%gr, sys%ions, sys%ext_partners, & + sys%st, sys%ks, sys%hm, & verbosity = VERB_COMPACT, iters_done = scsteps) - gfield => list_get_gauge_field(ext_partners) + gfield => list_get_gauge_field(sys%ext_partners) if(associated(gfield)) then if (gauge_field_is_propagated(gfield)) then - call gauge_field_do_algorithmic_operation(gfield, OP_VERLET_COMPUTE_ACC, dt, iter*dt) + call gauge_field_do_algorithmic_operation(gfield, OP_VERLET_COMPUTE_ACC, sys%td%dt, iter*sys%td%dt) end if end if !TODO: we should update the occupation matrices here - if (hm%lda_u_level /= DFT_U_NONE) then - call messages_not_implemented("DFT+U with propagator_elec_dt_bo", namespace=namespace) + if (sys%hm%lda_u_level /= DFT_U_NONE) then + call messages_not_implemented("DFT+U with propagator_elec_dt_bo", namespace=sys%namespace) end if - call hamiltonian_elec_epot_generate(hm, namespace, space, gr, ions, ext_partners, st, time = iter*dt) + call hamiltonian_elec_epot_generate(sys%hm, sys%namespace, sys%space, sys%gr, sys%ions, & + sys%ext_partners, sys%st, time = iter*sys%td%dt) ! update Hamiltonian and eigenvalues (fermi is *not* called) - call v_ks_calc(ks, namespace, space, hm, st, ions, ext_partners, & - calc_eigenval = .true., time = iter*dt, calc_energy = .true.) + call v_ks_calc(sys%ks, sys%namespace, sys%space, sys%hm, sys%st, sys%ions, sys%ext_partners, & + calc_eigenval = .true., time = iter*sys%td%dt, calc_energy = .true.) ! Get the energies. - call energy_calc_total(namespace, space, hm, gr, st, ext_partners, iunit = -1) + call energy_calc_total(sys%namespace, sys%space, sys%hm, sys%gr, sys%st, sys%ext_partners, iunit = -1) - call ion_dynamics_propagate_vel(ions_dyn, ions) - call hamiltonian_elec_epot_generate(hm, namespace, space, gr, ions, ext_partners, st, time = iter*dt) - call ions%update_kinetic_energy() + call ion_dynamics_propagate_vel(sys%td%ions_dyn, sys%ions) + call hamiltonian_elec_epot_generate(sys%hm, sys%namespace, sys%space, sys%gr, sys%ions, & + sys%ext_partners, sys%st, time = iter*sys%td%dt) + call sys%ions%update_kinetic_energy() if(associated(gfield)) then if (gauge_field_is_propagated(gfield)) then - call gauge_field_do_algorithmic_operation(gfield, OP_VERLET_COMPUTE_VEL, dt, iter*dt) + call gauge_field_do_algorithmic_operation(gfield, OP_VERLET_COMPUTE_VEL, sys%td%dt, iter*sys%td%dt) end if end if diff --git a/src/td/propagator_elec_h.F90 b/src/td/propagator_elec_h.F90 index bc6db9574c..851e46c825 100644 --- a/src/td/propagator_elec_h.F90 +++ b/src/td/propagator_elec_h.F90 @@ -1,5 +1,6 @@ module propagator_elec_oct_m use electron_space_oct_m + use electrons_oct_m use global_oct_m use grid_oct_m use hamiltonian_elec_oct_m @@ -92,22 +93,9 @@ module propagator_elec_oct_m logical :: propagated end function propagator_elec_ions_are_propagated - module subroutine propagator_elec_dt_bo(scf, namespace, space, gr, ks, st, hm, ions, ext_partners, & - mc, outp, iter, dt, ions_dyn, scsteps) - type(scf_t), intent(inout) :: scf - type(namespace_t), intent(in) :: namespace - type(electron_space_t), intent(in) :: space - type(grid_t), intent(inout) :: gr - type(v_ks_t), intent(inout) :: ks - type(states_elec_t), intent(inout) :: st - type(hamiltonian_elec_t), intent(inout) :: hm - type(ions_t), intent(inout) :: ions - type(partner_list_t), intent(in) :: ext_partners - type(multicomm_t), intent(inout) :: mc !< index and domain communicators - type(output_t), intent(inout) :: outp + module subroutine propagator_elec_dt_bo(sys, iter, scsteps) + type(electrons_t), intent(inout) :: sys integer, intent(in) :: iter - real(real64), intent(in) :: dt - type(ion_dynamics_t), intent(inout) :: ions_dyn integer, intent(inout) :: scsteps end subroutine propagator_elec_dt_bo end interface diff --git a/src/td/td_interface.F90 b/src/td/td_interface.F90 index 9397ee72f4..29c1133f1e 100644 --- a/src/td/td_interface.F90 +++ b/src/td/td_interface.F90 @@ -501,9 +501,7 @@ contains sys%ions, sys%ext_partners, sys%outp, sys%td%write_handler, scsteps = scsteps, & update_energy = (mod(iter, sys%td%energy_update_iter) == 0) .or. (iter == sys%td%max_iter)) case (BO) - call propagator_elec_dt_bo(sys%scf, sys%namespace, sys%space, sys%gr, sys%ks, sys%st, sys%hm, & - sys%ions, sys%ext_partners, sys%mc, sys%outp, iter, & - sys%td%dt, sys%td%ions_dyn, scsteps) + call propagator_elec_dt_bo(sys, iter, scsteps) end select !Apply mask absorbing boundaries -- GitLab From ab2a8031ec7efd8d812342c474a13f304d8422d2 Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Tue, 23 Apr 2024 21:33:17 +0200 Subject: [PATCH 38/43] scf_init: Change signature Signed-off-by: Cristian Le --- src/electrons/electrons.F90 | 2 +- src/main/geom_opt.F90 | 2 +- src/main/phonons_fd.F90 | 2 +- src/main/static_pol.F90 | 2 +- src/scf/electrons_ground_state.F90 | 2 +- src/scf/scf_interface.F90 | 137 ++++++++++++++--------------- src/scf/scf_interface_h.F90 | 12 +-- src/td/td_interface.F90 | 2 +- 8 files changed, 74 insertions(+), 87 deletions(-) diff --git a/src/electrons/electrons.F90 b/src/electrons/electrons.F90 index 9e416f44b8..338b71ae4e 100644 --- a/src/electrons/electrons.F90 +++ b/src/electrons/electrons.F90 @@ -588,7 +588,7 @@ contains call propagation_ops_elec_restore_ions(this%td%tr%propagation_ops_elec, this%td%ions_dyn, this%ions) case (BOMD_START) - call scf_init(this%scf, this%namespace, this%gr, this%ions, this%st, this%mc, this%hm, this%space) + call scf_init(this) ! the ions are propagated inside the propagation step already, so no need to do it at the end this%ions_propagated = .true. diff --git a/src/main/geom_opt.F90 b/src/main/geom_opt.F90 index b7fa4b3117..73e3d2701f 100644 --- a/src/main/geom_opt.F90 +++ b/src/main/geom_opt.F90 @@ -171,7 +171,7 @@ contains end if end if - call scf_init(sys%scf, sys%namespace, sys%gr, sys%ions, sys%st, sys%mc, sys%hm, sys%space) + call scf_init(sys) if (bitand(g_opt%type, GO_CELL) /= 0 .or. bitand(g_opt%type, GO_VOLUME) /= 0) then if (.not. sys%scf%calc_stress) then diff --git a/src/main/phonons_fd.F90 b/src/main/phonons_fd.F90 index 4429011040..c87f1baa6b 100644 --- a/src/main/phonons_fd.F90 +++ b/src/main/phonons_fd.F90 @@ -153,7 +153,7 @@ contains PUSH_SUB(get_dyn_matrix) - call scf_init(sys%scf, sys%namespace, sys%gr, sys%ions, sys%st, sys%mc, sys%hm, sys%space) + call scf_init(sys) SAFE_ALLOCATE(forces0(1:sys%space%dim, 1:sys%ions%natoms)) SAFE_ALLOCATE(forces (1:sys%space%dim, 1:sys%ions%natoms)) forces = M_ZERO diff --git a/src/main/static_pol.F90 b/src/main/static_pol.F90 index b50791c905..35c38c3c90 100644 --- a/src/main/static_pol.F90 +++ b/src/main/static_pol.F90 @@ -223,7 +223,7 @@ contains gs_rho = M_ZERO call output_init_() - call scf_init(sys%scf, sys%namespace, sys%gr, sys%ions, sys%st, sys%mc, sys%hm, sys%space) + call scf_init(sys) call born_charges_init(born_charges, sys%namespace, sys%ions%natoms, sys%st%val_charge, & sys%st%qtot, sys%space%dim) diff --git a/src/scf/electrons_ground_state.F90 b/src/scf/electrons_ground_state.F90 index f08bebfb1c..a35c8dee88 100644 --- a/src/scf/electrons_ground_state.F90 +++ b/src/scf/electrons_ground_state.F90 @@ -102,7 +102,7 @@ contains sys%gr%box, sys%namespace) if (sys%ks%theory_level /= RDMFT) then - call scf_init(sys%scf, sys%namespace, sys%gr, sys%ions, sys%st, sys%mc, sys%hm, sys%space) + call scf_init(sys) ! only initialize dumping restart files for more than one iteration restart_init_dump = sys%scf%max_iter > 0 else diff --git a/src/scf/scf_interface.F90 b/src/scf/scf_interface.F90 index 0c6fa7cdd4..54a2e18541 100644 --- a/src/scf/scf_interface.F90 +++ b/src/scf/scf_interface.F90 @@ -77,15 +77,8 @@ submodule (scf_interface_oct_m) impl contains ! --------------------------------------------------------- - module subroutine scf_init(scf, namespace, gr, ions, st, mc, hm, space) - type(scf_t), intent(inout) :: scf - type(grid_t), intent(in) :: gr - type(namespace_t), intent(in) :: namespace - type(ions_t), intent(in) :: ions - type(states_elec_t), intent(in) :: st - type(multicomm_t), intent(in) :: mc - type(hamiltonian_elec_t), intent(inout) :: hm - class(space_t), intent(in) :: space + module subroutine scf_init(sys) + type(electrons_t), intent(inout) :: sys real(real64) :: rmin integer :: mixdefault @@ -112,32 +105,32 @@ contains !% where it denotes the maximum number of calls of the eigensolver. In this context, the !% default value is 50. !%End - call parse_variable(namespace, 'MaximumIter', 200, scf%max_iter) + call parse_variable(sys%namespace, 'MaximumIter', 200, sys%scf%max_iter) - if (allocated(hm%vberry)) then - call berry_init(scf%berry, namespace) + if (allocated(sys%hm%vberry)) then + call berry_init(sys%scf%berry, sys%namespace) end if !Create the list of convergence criteria - call criteria_factory_init(scf%criterion_list, namespace, scf%check_conv) + call criteria_factory_init(sys%scf%criterion_list, sys%namespace, sys%scf%check_conv) !Setting the pointers - call iter%start(scf%criterion_list) + call iter%start(sys%scf%criterion_list) do while (iter%has_next()) crit => iter%get_next() select type (crit) type is (energy_criterion_t) - call crit%set_pointers(scf%energy_diff, scf%energy_in) + call crit%set_pointers(sys%scf%energy_diff, sys%scf%energy_in) type is (density_criterion_t) - call crit%set_pointers(scf%abs_dens_diff, st%qtot) + call crit%set_pointers(sys%scf%abs_dens_diff, sys%st%qtot) type is (eigenval_criterion_t) - call crit%set_pointers(scf%evsum_diff, scf%evsum_out) + call crit%set_pointers(sys%scf%evsum_diff, sys%scf%evsum_out) class default ASSERT(.false.) end select end do - if(.not. scf%check_conv .and. scf%max_iter < 0) then + if(.not. sys%scf%check_conv .and. sys%scf%max_iter < 0) then call messages_write("All convergence criteria are disabled. Octopus is cowardly refusing") call messages_new_line() call messages_write("to enter an infinite loop.") @@ -150,7 +143,7 @@ contains call messages_new_line() call messages_write(" | ConvAbsEv | ConvRelEv |") call messages_new_line() - call messages_fatal(namespace=namespace) + call messages_fatal(namespace=sys%namespace) end if !%Variable ConvEigenError @@ -164,11 +157,11 @@ contains !% If this criterion is used, the SCF loop will only stop once it is !% fulfilled for two consecutive iterations. !%End - call parse_variable(namespace, 'ConvEigenError', .false., scf%conv_eigen_error) + call parse_variable(sys%namespace, 'ConvEigenError', .false., sys%scf%conv_eigen_error) - if(scf%max_iter < 0) scf%max_iter = huge(scf%max_iter) + if(sys%scf%max_iter < 0) sys%scf%max_iter = huge(sys%scf%max_iter) - call messages_obsolete_variable(namespace, 'What2Mix', 'MixField') + call messages_obsolete_variable(sys%namespace, 'What2Mix', 'MixField') !%Variable MixField !%Type integer @@ -193,75 +186,75 @@ contains !%End mixdefault = OPTION__MIXFIELD__POTENTIAL - if(hm%theory_level == INDEPENDENT_PARTICLES) mixdefault = OPTION__MIXFIELD__NONE + if(sys%hm%theory_level == INDEPENDENT_PARTICLES) mixdefault = OPTION__MIXFIELD__NONE - call parse_variable(namespace, 'MixField', mixdefault, scf%mix_field) - if(.not.varinfo_valid_option('MixField', scf%mix_field)) call messages_input_error(namespace, 'MixField') - call messages_print_var_option('MixField', scf%mix_field, "what to mix during SCF cycles", namespace=namespace) + call parse_variable(sys%namespace, 'MixField', mixdefault, sys%scf%mix_field) + if(.not.varinfo_valid_option('MixField', sys%scf%mix_field)) call messages_input_error(sys%namespace, 'MixField') + call messages_print_var_option('MixField', sys%scf%mix_field, "what to mix during SCF cycles", namespace=sys%namespace) - if (scf%mix_field == OPTION__MIXFIELD__POTENTIAL .and. hm%theory_level == INDEPENDENT_PARTICLES) then + if (sys%scf%mix_field == OPTION__MIXFIELD__POTENTIAL .and. sys%hm%theory_level == INDEPENDENT_PARTICLES) then call messages_write('Input: Cannot mix the potential for non-interacting particles.') - call messages_fatal(namespace=namespace) + call messages_fatal(namespace=sys%namespace) end if - if (scf%mix_field == OPTION__MIXFIELD__POTENTIAL .and. hm%pcm%run_pcm) then + if (sys%scf%mix_field == OPTION__MIXFIELD__POTENTIAL .and. sys%hm%pcm%run_pcm) then call messages_write('Input: You have selected to mix the potential.', new_line = .true.) call messages_write(' This might produce convergence problems for solvated systems.', new_line = .true.) call messages_write(' Mix the Density instead.') - call messages_warning(namespace=namespace) + call messages_warning(namespace=sys%namespace) end if - if(scf%mix_field == OPTION__MIXFIELD__DENSITY & - .and. bitand(hm%xc%family, XC_FAMILY_OEP + XC_FAMILY_MGGA + XC_FAMILY_HYB_MGGA) /= 0) then + if(sys%scf%mix_field == OPTION__MIXFIELD__DENSITY & + .and. bitand(sys%hm%xc%family, XC_FAMILY_OEP + XC_FAMILY_MGGA + XC_FAMILY_HYB_MGGA) /= 0) then call messages_write('Input: You have selected to mix the density with OEP or MGGA XC functionals.', new_line = .true.) call messages_write(' This might produce convergence problems. Mix the potential instead.') - call messages_warning(namespace=namespace) + call messages_warning(namespace=sys%namespace) end if - if(scf%mix_field == OPTION__MIXFIELD__STATES) then - call messages_experimental('MixField = states', namespace=namespace) + if(sys%scf%mix_field == OPTION__MIXFIELD__STATES) then + call messages_experimental('MixField = states', namespace=sys%namespace) end if ! Handle mixing now... - select case(scf%mix_field) + select case(sys%scf%mix_field) case (OPTION__MIXFIELD__POTENTIAL, OPTION__MIXFIELD__DENSITY) - scf%mixdim1 = gr%np + sys%scf%mixdim1 = sys%gr%np case(OPTION__MIXFIELD__STATES) ! we do not really need the mixer, except for the value of the mixing coefficient - scf%mixdim1 = 1 + sys%scf%mixdim1 = 1 end select mix_type = TYPE_FLOAT - if (scf%mix_field /= OPTION__MIXFIELD__NONE) then - call mix_init(scf%smix, namespace, space, gr%der, scf%mixdim1, st%d%nspin, func_type_ = mix_type) + if (sys%scf%mix_field /= OPTION__MIXFIELD__NONE) then + call mix_init(sys%scf%smix, sys%namespace, sys%space, sys%gr%der, sys%scf%mixdim1, sys%st%d%nspin, func_type_ = mix_type) end if !If we use DFT+U, we also have do mix it - if (scf%mix_field /= OPTION__MIXFIELD__STATES .and. scf%mix_field /= OPTION__MIXFIELD__NONE ) then - call lda_u_mixer_init(hm%lda_u, scf%lda_u_mix, st) - call lda_u_mixer_init_auxmixer(hm%lda_u, namespace, scf%lda_u_mix, scf%smix, st) + if (sys%scf%mix_field /= OPTION__MIXFIELD__STATES .and. sys%scf%mix_field /= OPTION__MIXFIELD__NONE ) then + call lda_u_mixer_init(sys%hm%lda_u, sys%scf%lda_u_mix, sys%st) + call lda_u_mixer_init_auxmixer(sys%hm%lda_u, sys%namespace, sys%scf%lda_u_mix, sys%scf%smix, sys%st) end if - call mix_get_field(scf%smix, scf%mixfield) + call mix_get_field(sys%scf%smix, sys%scf%mixfield) ! now the eigensolver stuff - call eigensolver_init(scf%eigens, namespace, gr, st, mc, space) + call eigensolver_init(sys%scf%eigens, sys%namespace, sys%gr, sys%st, sys%mc, sys%space) !The evolution operator is a very specific propagation that requires a specific !setting to work in the current framework - if(scf%eigens%es_type == RS_EVO) then - if(scf%mix_field /= OPTION__MIXFIELD__DENSITY) then + if(sys%scf%eigens%es_type == RS_EVO) then + if(sys%scf%mix_field /= OPTION__MIXFIELD__DENSITY) then message(1) = "Evolution eigensolver is only compatible with MixField = density." - call messages_fatal(1, namespace=namespace) + call messages_fatal(1, namespace=sys%namespace) end if - if(.not. is_close(mix_coefficient(scf%smix), M_ONE)) then + if(.not. is_close(mix_coefficient(sys%scf%smix), M_ONE)) then message(1) = "Evolution eigensolver is only compatible with Mixing = 1." - call messages_fatal(1, namespace=namespace) + call messages_fatal(1, namespace=sys%namespace) end if - if(mix_scheme(scf%smix) /= OPTION__MIXINGSCHEME__LINEAR) then + if(mix_scheme(sys%scf%smix) /= OPTION__MIXINGSCHEME__LINEAR) then message(1) = "Evolution eigensolver is only compatible with MixingScheme = linear." - call messages_fatal(1, namespace=namespace) + call messages_fatal(1, namespace=sys%namespace) end if end if @@ -275,15 +268,15 @@ contains !% calculation within the LCAO subspace, then restart from that point for !% an unrestricted calculation). !%End - call parse_variable(namespace, 'SCFinLCAO', .false., scf%lcao_restricted) - if(scf%lcao_restricted) then - call messages_experimental('SCFinLCAO', namespace=namespace) + call parse_variable(sys%namespace, 'SCFinLCAO', .false., sys%scf%lcao_restricted) + if(sys%scf%lcao_restricted) then + call messages_experimental('SCFinLCAO', namespace=sys%namespace) message(1) = 'Info: SCF restricted to LCAO subspace.' - call messages_info(1, namespace=namespace) + call messages_info(1, namespace=sys%namespace) - if(scf%conv_eigen_error) then + if(sys%scf%conv_eigen_error) then message(1) = "ConvEigenError cannot be used with SCFinLCAO, since error is unknown." - call messages_fatal(1, namespace=namespace) + call messages_fatal(1, namespace=sys%namespace) end if end if @@ -297,19 +290,19 @@ contains !% default is yes, unless the system only has user-defined !% species. !%End - call parse_variable(namespace, 'SCFCalculateForces', .not. ions%only_user_def, scf%calc_force) + call parse_variable(sys%namespace, 'SCFCalculateForces', .not. sys%ions%only_user_def, sys%scf%calc_force) - if(scf%calc_force .and. gr%der%boundaries%spiralBC) then + if(sys%scf%calc_force .and. sys%gr%der%boundaries%spiralBC) then message(1) = 'Forces cannot be calculated when using spiral boundary conditions.' write(message(2),'(a)') 'Please use SCFCalculateForces = no.' - call messages_fatal(2, namespace=namespace) + call messages_fatal(2, namespace=sys%namespace) end if - if(scf%calc_force) then - if (allocated(hm%ep%b_field) .or. allocated(hm%ep%a_static)) then + if(sys%scf%calc_force) then + if (allocated(sys%hm%ep%b_field) .or. allocated(sys%hm%ep%a_static)) then write(message(1),'(a)') 'The forces are currently not properly calculated if static' write(message(2),'(a)') 'magnetic fields or static vector potentials are present.' write(message(3),'(a)') 'Please use SCFCalculateForces = no.' - call messages_fatal(3, namespace=namespace) + call messages_fatal(3, namespace=sys%namespace) end if end if @@ -321,7 +314,7 @@ contains !% calculated at the end of a self-consistent iteration. The !% default is no. !%End - call parse_variable(namespace, 'SCFCalculateStress', .false. , scf%calc_stress) + call parse_variable(sys%namespace, 'SCFCalculateStress', .false. , sys%scf%calc_stress) !%Variable SCFCalculateDipole !%Type logical @@ -335,8 +328,8 @@ contains !% periodic directions. Ref: !% E Yaschenko, L Fu, L Resca, and R Resta, Phys. Rev. B 58, 1222-1229 (1998). !%End - call parse_variable(namespace, 'SCFCalculateDipole', .not. space%is_periodic(), scf%calc_dipole) - if (allocated(hm%vberry)) scf%calc_dipole = .true. + call parse_variable(sys%namespace, 'SCFCalculateDipole', .not. sys%space%is_periodic(), sys%scf%calc_dipole) + if (allocated(sys%hm%vberry)) sys%scf%calc_dipole = .true. !%Variable SCFCalculatePartialCharges !%Type logical @@ -346,10 +339,10 @@ contains !% (Experimental) This variable controls whether partial charges !% are calculated at the end of a self-consistent iteration. !%End - call parse_variable(namespace, 'SCFCalculatePartialCharges', .false., scf%calc_partial_charges) - if (scf%calc_partial_charges) call messages_experimental('SCFCalculatePartialCharges', namespace=namespace) + call parse_variable(sys%namespace, 'SCFCalculatePartialCharges', .false., sys%scf%calc_partial_charges) + if (sys%scf%calc_partial_charges) call messages_experimental('SCFCalculatePartialCharges', namespace=sys%namespace) - rmin = ions%min_distance() + rmin = sys%ions%min_distance() !%Variable LocalMagneticMomentsSphereRadius !%Type float @@ -361,11 +354,11 @@ contains !% The default is half the minimum distance between two atoms !% in the input coordinates, or 100 a.u. if there is only one atom (for isolated systems). !%End - call parse_variable(namespace, 'LocalMagneticMomentsSphereRadius', min(M_HALF*rmin, 100.0_real64), scf%lmm_r, & + call parse_variable(sys%namespace, 'LocalMagneticMomentsSphereRadius', min(M_HALF*rmin, 100.0_real64), sys%scf%lmm_r, & unit=units_inp%length) ! this variable is also used in td/td_write.F90 - scf%forced_finish = .false. + sys%scf%forced_finish = .false. POP_SUB(scf_init) end subroutine scf_init diff --git a/src/scf/scf_interface_h.F90 b/src/scf/scf_interface_h.F90 index 6da78e0c57..9646e148ce 100644 --- a/src/scf/scf_interface_h.F90 +++ b/src/scf/scf_interface_h.F90 @@ -1,5 +1,6 @@ module scf_interface_oct_m use electron_space_oct_m + use electrons_oct_m use global_oct_m use grid_oct_m use hamiltonian_elec_oct_m @@ -27,15 +28,8 @@ module scf_interface_oct_m scf_print_mem_use interface - module subroutine scf_init(scf, namespace, gr, ions, st, mc, hm, space) - type(scf_t), intent(inout) :: scf - type(grid_t), intent(in) :: gr - type(namespace_t), intent(in) :: namespace - type(ions_t), intent(in) :: ions - type(states_elec_t), intent(in) :: st - type(multicomm_t), intent(in) :: mc - type(hamiltonian_elec_t), intent(inout) :: hm - class(space_t), intent(in) :: space + module subroutine scf_init(sys) + type(electrons_t), intent(inout) :: sys end subroutine scf_init module subroutine scf_mix_clear(scf) diff --git a/src/td/td_interface.F90 b/src/td/td_interface.F90 index 29c1133f1e..d7181fe444 100644 --- a/src/td/td_interface.F90 +++ b/src/td/td_interface.F90 @@ -386,7 +386,7 @@ contains end if else call states_elec_allocate_wfns(sys%st, sys%gr, packed=.true.) - call scf_init(sys%scf, sys%namespace, sys%gr, sys%ions, sys%st, sys%mc, sys%hm, sys%space) + call scf_init(sys) end if POP_SUB(td_allocate_wavefunctions) -- GitLab From 26902f51778b1c2f4df0d1375588636728085557 Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Tue, 23 Apr 2024 22:02:10 +0200 Subject: [PATCH 39/43] scf_run: Change signature Signed-off-by: Cristian Le --- src/electrons/electrons.F90 | 3 +- src/main/geom_opt.F90 | 4 +- src/main/phonons_fd.F90 | 2 +- src/main/static_pol.F90 | 9 +- src/scf/electrons_ground_state.F90 | 13 +- src/scf/scf_interface.F90 | 505 ++++++++++++++--------------- src/scf/scf_interface_h.F90 | 14 +- src/td/propagator_elec.F90 | 4 +- 8 files changed, 262 insertions(+), 292 deletions(-) diff --git a/src/electrons/electrons.F90 b/src/electrons/electrons.F90 index 338b71ae4e..8d5c9ef5be 100644 --- a/src/electrons/electrons.F90 +++ b/src/electrons/electrons.F90 @@ -601,8 +601,7 @@ contains call hamiltonian_elec_epot_generate(this%hm, this%namespace, this%space, this%gr, this%ions, & this%ext_partners, this%st, time = time+algo%dt) ! now calculate the eigenfunctions - call scf_run(this%scf, this%namespace, this%space, this%mc, this%gr, this%ions, & - this%ext_partners, this%st, this%ks, this%hm, verbosity = VERB_COMPACT) + call scf_run(this, verbosity = VERB_COMPACT) ! TODO: Check if this call is realy needed. - NTD call hamiltonian_elec_epot_generate(this%hm, this%namespace, this%space, this%gr, this%ions, & this%ext_partners, this%st, time = time+algo%dt) diff --git a/src/main/geom_opt.F90 b/src/main/geom_opt.F90 index 73e3d2701f..5315e49380 100644 --- a/src/main/geom_opt.F90 +++ b/src/main/geom_opt.F90 @@ -781,9 +781,7 @@ contains call energy_calc_total(g_opt%syst%namespace, g_opt%syst%space, g_opt%hm, g_opt%syst%gr, g_opt%st, g_opt%syst%ext_partners) ! do SCF calculation - call scf_run(g_opt%syst%scf, g_opt%syst%namespace, g_opt%syst%space, g_opt%syst%mc, g_opt%syst%gr, & - g_opt%ions, g_opt%syst%ext_partners, & - g_opt%st, g_opt%syst%ks, g_opt%hm, outp = g_opt%syst%outp, verbosity = VERB_COMPACT, restart_dump=g_opt%restart_dump) + call scf_run(g_opt%syst, outp = g_opt%syst%outp, verbosity = VERB_COMPACT, restart_dump=g_opt%restart_dump) call scf_print_mem_use(g_opt%syst%namespace) diff --git a/src/main/phonons_fd.F90 b/src/main/phonons_fd.F90 index c87f1baa6b..69d5693f9b 100644 --- a/src/main/phonons_fd.F90 +++ b/src/main/phonons_fd.F90 @@ -221,7 +221,7 @@ contains call v_ks_calc(sys%ks, sys%namespace, sys%space, sys%hm, sys%st, sys%ions, sys%ext_partners, calc_eigenval=.true.) call energy_calc_total(sys%namespace, sys%space, sys%hm, sys%gr, sys%st, sys%ext_partners) call scf_mix_clear(sys%scf) - call scf_run(sys%scf, sys%namespace, sys%space, sys%mc, sys%gr, sys%ions, sys%ext_partners, sys%st, sys%ks, sys%hm, verbosity = VERB_COMPACT) + call scf_run(sys, verbosity = VERB_COMPACT) POP_SUB(get_dyn_matrix.run_displacement) end subroutine run_displacement diff --git a/src/main/static_pol.F90 b/src/main/static_pol.F90 index 35c38c3c90..d1119e2535 100644 --- a/src/main/static_pol.F90 +++ b/src/main/static_pol.F90 @@ -235,8 +235,7 @@ contains write(message(1), '(a)') write(message(2), '(a)') 'Info: Calculating dipole moment for zero field.' call messages_info(2, namespace=sys%namespace) - call scf_run(sys%scf, sys%namespace, sys%space, sys%mc, sys%gr, sys%ions, sys%ext_partners, sys%st, & - sys%ks, sys%hm, verbosity = verbosity) + call scf_run(sys, verbosity = verbosity) gs_rho(1:sys%gr%np, 1:sys%st%d%nspin) = sys%st%rho(1:sys%gr%np, 1:sys%st%d%nspin) trrho = M_ZERO @@ -310,8 +309,7 @@ contains end if call scf_mix_clear(sys%scf) - call scf_run(sys%scf, sys%namespace, sys%space, sys%mc, sys%gr, sys%ions, sys%ext_partners, sys%st, & - sys%ks, sys%hm, verbosity = verbosity) + call scf_run(sys, verbosity = verbosity) trrho = M_ZERO do is = 1, sys%st%d%spin_channels @@ -396,8 +394,7 @@ contains end if call scf_mix_clear(sys%scf) - call scf_run(sys%scf, sys%namespace, sys%space, sys%mc, sys%gr, sys%ions, sys%ext_partners, sys%st, & - sys%ks, sys%hm, verbosity = verbosity) + call scf_run(sys, verbosity = verbosity) trrho = M_ZERO do is = 1, sys%st%d%spin_channels diff --git a/src/scf/electrons_ground_state.F90 b/src/scf/electrons_ground_state.F90 index a35c8dee88..837b5c9acd 100644 --- a/src/scf/electrons_ground_state.F90 +++ b/src/scf/electrons_ground_state.F90 @@ -139,21 +139,16 @@ contains else if (.not. fromScratch) then if (restart_init_dump) then - call scf_run(sys%scf, sys%namespace, sys%space, sys%mc, sys%gr, sys%ions, & - sys%ext_partners, sys%st, sys%ks, sys%hm, outp=sys%outp, & - restart_load=restart_load, restart_dump=restart_dump) + call scf_run(sys, outp=sys%outp, restart_load=restart_load, restart_dump=restart_dump) else - call scf_run(sys%scf, sys%namespace, sys%space, sys%mc, sys%gr, sys%ions, sys%ext_partners, & - sys%st, sys%ks, sys%hm, outp=sys%outp, restart_load=restart_load) + call scf_run(sys, outp=sys%outp, restart_load=restart_load) end if call restart_end(restart_load) else if (restart_init_dump) then - call scf_run(sys%scf, sys%namespace, sys%space, sys%mc, sys%gr, sys%ions, sys%ext_partners, & - sys%st, sys%ks, sys%hm, outp=sys%outp, restart_dump=restart_dump) + call scf_run(sys, outp=sys%outp, restart_dump=restart_dump) else - call scf_run(sys%scf, sys%namespace, sys%space, sys%mc, sys%gr, sys%ions, sys%ext_partners, & - sys%st, sys%ks, sys%hm, outp=sys%outp) + call scf_run(sys, outp=sys%outp) end if end if diff --git a/src/scf/scf_interface.F90 b/src/scf/scf_interface.F90 index 54a2e18541..01de3dae83 100644 --- a/src/scf/scf_interface.F90 +++ b/src/scf/scf_interface.F90 @@ -406,18 +406,8 @@ contains ! --------------------------------------------------------- - module subroutine scf_run(scf, namespace, space, mc, gr, ions, ext_partners, st, ks, hm, outp, & - verbosity, iters_done, restart_load, restart_dump) - type(scf_t), intent(inout) :: scf !< self consistent cycle - type(namespace_t), intent(in) :: namespace - type(electron_space_t), intent(in) :: space - type(multicomm_t), intent(in) :: mc - type(grid_t), intent(inout) :: gr !< grid - type(ions_t), intent(inout) :: ions !< geometry - type(partner_list_t), intent(in) :: ext_partners - type(states_elec_t), intent(inout) :: st !< States - type(v_ks_t), intent(inout) :: ks !< Kohn-Sham - type(hamiltonian_elec_t), intent(inout) :: hm !< Hamiltonian + module subroutine scf_run(sys, outp, verbosity, iters_done, restart_load, restart_dump) + type(electrons_t), intent(inout) :: sys type(output_t), optional, intent(in) :: outp integer, optional, intent(in) :: verbosity integer, optional, intent(out) :: iters_done @@ -439,9 +429,9 @@ contains PUSH_SUB(scf_run) - if(scf%forced_finish) then + if(sys%scf%forced_finish) then message(1) = "Previous clean stop, not doing SCF and quitting." - call messages_fatal(1, only_root_writes = .true., namespace=namespace) + call messages_fatal(1, only_root_writes = .true., namespace=sys%namespace) end if verbosity_ = VERB_FULL @@ -455,78 +445,78 @@ contains ! if the user has activated output=stress but not SCFCalculateStress, ! we assume that is implied if (outp%what(OPTION__OUTPUT__STRESS)) then - scf%calc_stress = .true. + sys%scf%calc_stress = .true. end if output_during_scf = outp%duringscf - calc_current = output_needs_current(outp, states_are_real(st)) + calc_current = output_needs_current(outp, states_are_real(sys%st)) if (outp%duringscf .and. outp%what(OPTION__OUTPUT__FORCES)) then output_forces = .true. end if end if - if(scf%lcao_restricted) then - call lcao_init(lcao, namespace, space, gr, ions, st) + if(sys%scf%lcao_restricted) then + call lcao_init(lcao, sys%namespace, sys%space, sys%gr, sys%ions, sys%st) if(.not. lcao_is_available(lcao)) then message(1) = 'LCAO is not available. Cannot do SCF in LCAO.' - call messages_fatal(1, namespace=namespace) + call messages_fatal(1, namespace=sys%namespace) end if end if - nspin = st%d%nspin + nspin = sys%st%d%nspin if (present(restart_load)) then if (restart_has_flag(restart_load, RESTART_FLAG_RHO)) then ! Load density and used it to recalculated the KS potential. - call states_elec_load_rho(restart_load, space, st, gr, ierr) + call states_elec_load_rho(restart_load, sys%space, sys%st, sys%gr, ierr) if (ierr /= 0) then message(1) = 'Unable to read density. Density will be calculated from states.' - call messages_warning(1, namespace=namespace) + call messages_warning(1, namespace=sys%namespace) else - if (bitand(ks%xc_family, XC_FAMILY_OEP) == 0) then - call v_ks_calc(ks, namespace, space, hm, st, ions, ext_partners) + if (bitand(sys%ks%xc_family, XC_FAMILY_OEP) == 0) then + call v_ks_calc(sys%ks, sys%namespace, sys%space, sys%hm, sys%st, sys%ions, sys%ext_partners) else - if (.not. restart_has_flag(restart_load, RESTART_FLAG_VHXC) .and. ks%oep%level /= OEP_LEVEL_FULL) then - call v_ks_calc(ks, namespace, space, hm, st, ions, ext_partners) + if (.not. restart_has_flag(restart_load, RESTART_FLAG_VHXC) .and. sys%ks%oep%level /= OEP_LEVEL_FULL) then + call v_ks_calc(sys%ks, sys%namespace, sys%space, sys%hm, sys%st, sys%ions, sys%ext_partners) end if end if end if end if if (restart_has_flag(restart_load, RESTART_FLAG_VHXC)) then - call hamiltonian_elec_load_vhxc(restart_load, hm, space, gr, ierr) + call hamiltonian_elec_load_vhxc(restart_load, sys%hm, sys%space, sys%gr, ierr) if (ierr /= 0) then message(1) = 'Unable to read Vhxc. Vhxc will be calculated from states.' - call messages_warning(1, namespace=namespace) + call messages_warning(1, namespace=sys%namespace) else - call hm%update(gr, namespace, space, ext_partners) - if (bitand(ks%xc_family, XC_FAMILY_OEP) /= 0) then - if (ks%oep%level == OEP_LEVEL_FULL) then - do is = 1, st%d%nspin - ks%oep%vxc(1:gr%np, is) = hm%vhxc(1:gr%np, is) - hm%vhartree(1:gr%np) + call sys%hm%update(sys%gr, sys%namespace, sys%space, sys%ext_partners) + if (bitand(sys%ks%xc_family, XC_FAMILY_OEP) /= 0) then + if (sys%ks%oep%level == OEP_LEVEL_FULL) then + do is = 1, sys%st%d%nspin + sys%ks%oep%vxc(1:sys%gr%np, is) = sys%hm%vhxc(1:sys%gr%np, is) - sys%hm%vhartree(1:sys%gr%np) end do - call v_ks_calc(ks, namespace, space, hm, st, ions, ext_partners) + call v_ks_calc(sys%ks, sys%namespace, sys%space, sys%hm, sys%st, sys%ions, sys%ext_partners) end if end if end if end if if (restart_has_flag(restart_load, RESTART_FLAG_MIX)) then - if (scf%mix_field == OPTION__MIXFIELD__DENSITY .or. scf%mix_field == OPTION__MIXFIELD__POTENTIAL) then - call mix_load(namespace, restart_load, scf%smix, space, gr, ierr) + if (sys%scf%mix_field == OPTION__MIXFIELD__DENSITY .or. sys%scf%mix_field == OPTION__MIXFIELD__POTENTIAL) then + call mix_load(sys%namespace, restart_load, sys%scf%smix, sys%space, sys%gr, ierr) end if if (ierr /= 0) then message(1) = "Unable to read mixing information. Mixing will start from scratch." - call messages_warning(1, namespace=namespace) + call messages_warning(1, namespace=sys%namespace) end if end if - if(hm%lda_u_level /= DFT_U_NONE) then - call lda_u_load(restart_load, hm%lda_u, st, hm%energy%dft_u, ierr) + if(sys%hm%lda_u_level /= DFT_U_NONE) then + call lda_u_load(restart_load, sys%hm%lda_u, sys%st, sys%hm%energy%dft_u, ierr) if (ierr /= 0) then message(1) = "Unable to read DFT+U information. DFT+U data will be calculated from states." - call messages_warning(1, namespace=namespace) + call messages_warning(1, namespace=sys%namespace) end if end if else @@ -535,157 +525,158 @@ contains end if end if - SAFE_ALLOCATE(rhoout(1:gr%np, 1:nspin)) - SAFE_ALLOCATE(rhoin (1:gr%np, 1:nspin)) + SAFE_ALLOCATE(rhoout(1:sys%gr%np, 1:nspin)) + SAFE_ALLOCATE(rhoin (1:sys%gr%np, 1:nspin)) - call lalg_copy(gr%np, nspin, st%rho, rhoin) + call lalg_copy(sys%gr%np, nspin, sys%st%rho, rhoin) rhoout = M_ZERO - if (scf%calc_force .or. output_forces) then + if (sys%scf%calc_force .or. output_forces) then !We store the Hxc potential for the contribution to the forces - SAFE_ALLOCATE(vhxc_old(1:gr%np, 1:nspin)) - call lalg_copy(gr%np, nspin, hm%vhxc, vhxc_old) + SAFE_ALLOCATE(vhxc_old(1:sys%gr%np, 1:nspin)) + call lalg_copy(sys%gr%np, nspin, sys%hm%vhxc, vhxc_old) end if - select case(scf%mix_field) + select case(sys%scf%mix_field) case(OPTION__MIXFIELD__POTENTIAL) - call mixfield_set_vin(scf%mixfield, hm%vhxc) + call mixfield_set_vin(sys%scf%mixfield, sys%hm%vhxc) case(OPTION__MIXFIELD__DENSITY) - call mixfield_set_vin(scf%mixfield, rhoin) + call mixfield_set_vin(sys%scf%mixfield, rhoin) case(OPTION__MIXFIELD__STATES) - SAFE_ALLOCATE_TYPE_ARRAY(wfs_elec_t, psioutb, (st%group%block_start:st%group%block_end, st%d%kpt%start:st%d%kpt%end)) + SAFE_ALLOCATE_TYPE_ARRAY(wfs_elec_t, psioutb, (sys%st%group%block_start:sys%st%group%block_end, sys%st%d%kpt%start:sys%st%d%kpt%end)) - do iqn = st%d%kpt%start, st%d%kpt%end - do ib = st%group%block_start, st%group%block_end - call st%group%psib(ib, iqn)%copy_to(psioutb(ib, iqn)) + do iqn = sys%st%d%kpt%start, sys%st%d%kpt%end + do ib = sys%st%group%block_start, sys%st%group%block_end + call sys%st%group%psib(ib, iqn)%copy_to(psioutb(ib, iqn)) end do end do end select - call lda_u_update_occ_matrices(hm%lda_u, namespace, gr, st, hm%hm_base, hm%phase, hm%energy) + call lda_u_update_occ_matrices(sys%hm%lda_u, sys%namespace, sys%gr, sys%st, sys%hm%hm_base, sys%hm%phase, sys%hm%energy) ! If we use DFT+U, we also have do mix it - if (scf%mix_field /= OPTION__MIXFIELD__STATES) call lda_u_mixer_set_vin(hm%lda_u, scf%lda_u_mix) + if (sys%scf%mix_field /= OPTION__MIXFIELD__STATES) call lda_u_mixer_set_vin(sys%hm%lda_u, sys%scf%lda_u_mix) call create_convergence_file(STATIC_DIR, "convergence") if ( verbosity_ /= VERB_NO ) then - if(scf%max_iter > 0) then + if(sys%scf%max_iter > 0) then write(message(1),'(a)') 'Info: Starting SCF iteration.' else write(message(1),'(a)') 'Info: No SCF iterations will be done.' ! we cannot tell whether it is converged. finish = .false. end if - call messages_info(1, namespace=namespace) + call messages_info(1, namespace=sys%namespace) end if converged_current = .false. - scf%matvec = 0 + sys%scf%matvec = 0 ! SCF cycle itime = loct_clock() - do iter = 1, scf%max_iter + do iter = 1, sys%scf%max_iter call profiling_in("SCF_CYCLE") ! this initialization seems redundant but avoids improper optimization at -O3 by PGI 7 on chum, ! which would cause a failure of testsuite/linear_response/04-vib_modes.03-vib_modes_fd.inp - scf%eigens%converged = 0 + sys%scf%eigens%converged = 0 - !We update the quantities at the begining of the scf cycle + !We update the quantities at the begining of the sys%scf cycle if (iter == 1) then - scf%evsum_in = states_elec_eigenvalues_sum(st) + sys%scf%evsum_in = states_elec_eigenvalues_sum(sys%st) end if - call iterator%start(scf%criterion_list) + call iterator%start(sys%scf%criterion_list) do while (iterator%has_next()) crit => iterator%get_next() - call scf_update_initial_quantity(scf, hm, crit) + call scf_update_initial_quantity(sys%scf, sys%hm, crit) end do - if (scf%calc_force .or. output_forces) then + if (sys%scf%calc_force .or. output_forces) then !Used for computing the imperfect convegence contribution to the forces - vhxc_old(1:gr%np, 1:nspin) = hm%vhxc(1:gr%np, 1:nspin) + vhxc_old(1:sys%gr%np, 1:nspin) = sys%hm%vhxc(1:sys%gr%np, 1:nspin) end if - if(scf%lcao_restricted) then - call lcao_init_orbitals(lcao, namespace, st, gr, ions) - call lcao_wf(lcao, st, gr, ions, hm, namespace) + if(sys%scf%lcao_restricted) then + call lcao_init_orbitals(lcao, sys%namespace, sys%st, sys%gr, sys%ions) + call lcao_wf(lcao, sys%st, sys%gr, sys%ions, sys%hm, sys%namespace) else !We check if the system is coupled with a partner that requires self-consistency - ! if(hamiltonian_has_scf_partner(hm)) then - if (allocated(hm%vberry)) then + ! if(hamiltonian_has_scf_partner(sys%hm)) then + if (allocated(sys%hm%vberry)) then !In this case, v_Hxc is frozen and we do an internal SCF loop over the ! partners that require SCF - ks%frozen_hxc = .true. + sys%ks%frozen_hxc = .true. ! call perform_scf_partners() - call berry_perform_internal_scf(scf%berry, namespace, space, scf%eigens, gr, st, hm, iter, ks, ions, ext_partners) + call berry_perform_internal_scf(sys%scf%berry, sys%namespace, sys%space, sys%scf%eigens, & + sys%gr, sys%st, sys%hm, iter, sys%ks, sys%ions, sys%ext_partners) !and we unfreeze the potential once finished - ks%frozen_hxc = .false. + sys%ks%frozen_hxc = .false. else - scf%eigens%converged = 0 - call scf%eigens%run(namespace, gr, st, hm, iter) + sys%scf%eigens%converged = 0 + call sys%scf%eigens%run(sys%namespace, sys%gr, sys%st, sys%hm, iter) end if end if - scf%matvec = scf%matvec + scf%eigens%matvec + sys%scf%matvec = sys%scf%matvec + sys%scf%eigens%matvec ! occupations - call states_elec_fermi(st, namespace, gr) - call lda_u_update_occ_matrices(hm%lda_u, namespace, gr, st, hm%hm_base, hm%phase, hm%energy) + call states_elec_fermi(sys%st, sys%namespace, sys%gr) + call lda_u_update_occ_matrices(sys%hm%lda_u, sys%namespace, sys%gr, sys%st, sys%hm%hm_base, sys%hm%phase, sys%hm%energy) ! compute output density, potential (if needed) and eigenvalues sum - call density_calc(st, gr, st%rho) + call density_calc(sys%st, sys%gr, sys%st%rho) - call lalg_copy(gr%np, nspin, st%rho, rhoout) + call lalg_copy(sys%gr%np, nspin, sys%st%rho, rhoout) - select case (scf%mix_field) + select case (sys%scf%mix_field) case (OPTION__MIXFIELD__POTENTIAL) - call v_ks_calc(ks, namespace, space, hm, st, ions, ext_partners, calc_current=output_during_scf) - call mixfield_set_vout(scf%mixfield, hm%vhxc) + call v_ks_calc(sys%ks, sys%namespace, sys%space, sys%hm, sys%st, sys%ions, sys%ext_partners, calc_current=output_during_scf) + call mixfield_set_vout(sys%scf%mixfield, sys%hm%vhxc) case (OPTION__MIXFIELD__DENSITY) - call mixfield_set_vout(scf%mixfield, rhoout) + call mixfield_set_vout(sys%scf%mixfield, rhoout) case(OPTION__MIXFIELD__STATES) - do iqn = st%d%kpt%start, st%d%kpt%end - do ib = st%group%block_start, st%group%block_end - call st%group%psib(ib, iqn)%copy_data_to(gr%np, psioutb(ib, iqn)) + do iqn = sys%st%d%kpt%start, sys%st%d%kpt%end + do ib = sys%st%group%block_start, sys%st%group%block_end + call sys%st%group%psib(ib, iqn)%copy_data_to(sys%gr%np, psioutb(ib, iqn)) end do end do end select - if (scf%mix_field /= OPTION__MIXFIELD__STATES .and. scf%mix_field /= OPTION__MIXFIELD__NONE) then - call lda_u_mixer_set_vout(hm%lda_u, scf%lda_u_mix) + if (sys%scf%mix_field /= OPTION__MIXFIELD__STATES .and. sys%scf%mix_field /= OPTION__MIXFIELD__NONE) then + call lda_u_mixer_set_vout(sys%hm%lda_u, sys%scf%lda_u_mix) endif ! recalculate total energy - call energy_calc_total(namespace, space, hm, gr, st, ext_partners, iunit = 0) + call energy_calc_total(sys%namespace, sys%space, sys%hm, sys%gr, sys%st, sys%ext_partners, iunit = 0) if (present(outp)) then ! compute forces only if requested if (outp%duringscf .and. outp%what_now(OPTION__OUTPUT__FORCES, iter)) then - call forces_calculate(gr, namespace, ions, hm, ext_partners, st, ks, vhxc_old=vhxc_old) + call forces_calculate(sys%gr, sys%namespace, sys%ions, sys%hm, sys%ext_partners, sys%st, sys%ks, vhxc_old=vhxc_old) end if end if !We update the quantities at the end of the scf cycle - call iterator%start(scf%criterion_list) + call iterator%start(sys%scf%criterion_list) do while (iterator%has_next()) crit => iterator%get_next() - call scf_update_diff_quantity(scf, hm, st, gr, rhoout, rhoin, crit) + call scf_update_diff_quantity(sys%scf, sys%hm, sys%st, sys%gr, rhoout, rhoin, crit) end do ! are we finished? converged_last = converged_current - converged_current = scf%check_conv .and. & - (.not. scf%conv_eigen_error .or. all(scf%eigens%converged == st%nst)) + converged_current = sys%scf%check_conv .and. & + (.not. sys%scf%conv_eigen_error .or. all(sys%scf%eigens%converged == sys%st%nst)) !Loop over the different criteria - call iterator%start(scf%criterion_list) + call iterator%start(sys%scf%criterion_list) do while (iterator%has_next()) crit => iterator%get_next() call crit%is_converged(is_crit_conv) @@ -698,97 +689,97 @@ contains etime = loct_clock() - itime itime = etime + itime - call scf_write_iter(namespace) + call scf_write_iter(sys%namespace) ! mixing - select case (scf%mix_field) + select case (sys%scf%mix_field) case (OPTION__MIXFIELD__DENSITY) ! mix input and output densities and compute new potential - call mixing(namespace, scf%smix) - call mixfield_get_vnew(scf%mixfield, st%rho) + call mixing(sys%namespace, sys%scf%smix) + call mixfield_get_vnew(sys%scf%mixfield, sys%st%rho) ! for spinors, having components 3 or 4 be negative is not unphysical - if (minval(st%rho(1:gr%np, 1:st%d%spin_channels)) < -1e-6_real64) then + if (minval(sys%st%rho(1:sys%gr%np, 1:sys%st%d%spin_channels)) < -1e-6_real64) then write(message(1),*) 'Negative density after mixing. Minimum value = ', & - minval(st%rho(1:gr%np, 1:st%d%spin_channels)) - call messages_warning(1, namespace=namespace) + minval(sys%st%rho(1:sys%gr%np, 1:sys%st%d%spin_channels)) + call messages_warning(1, namespace=sys%namespace) end if - call lda_u_mixer_get_vnew(hm%lda_u, scf%lda_u_mix, st) - call v_ks_calc(ks, namespace, space, hm, st, ions, ext_partners, calc_current=output_during_scf) + call lda_u_mixer_get_vnew(sys%hm%lda_u, sys%scf%lda_u_mix, sys%st) + call v_ks_calc(sys%ks, sys%namespace, sys%space, sys%hm, sys%st, sys%ions, sys%ext_partners, calc_current=output_during_scf) case (OPTION__MIXFIELD__POTENTIAL) ! mix input and output potentials - call mixing(namespace, scf%smix) - call mixfield_get_vnew(scf%mixfield, hm%vhxc) - call lda_u_mixer_get_vnew(hm%lda_u, scf%lda_u_mix, st) - call hamiltonian_elec_update_pot(hm, gr) + call mixing(sys%namespace, sys%scf%smix) + call mixfield_get_vnew(sys%scf%mixfield, sys%hm%vhxc) + call lda_u_mixer_get_vnew(sys%hm%lda_u, sys%scf%lda_u_mix, sys%st) + call hamiltonian_elec_update_pot(sys%hm, sys%gr) case(OPTION__MIXFIELD__STATES) - do iqn = st%d%kpt%start, st%d%kpt%end - do ib = st%group%block_start, st%group%block_end - call batch_scal(gr%np, M_ONE - mix_coefficient(scf%smix), st%group%psib(ib, iqn)) - call batch_axpy(gr%np, mix_coefficient(scf%smix), psioutb(ib, iqn), st%group%psib(ib, iqn)) + do iqn = sys%st%d%kpt%start, sys%st%d%kpt%end + do ib = sys%st%group%block_start, sys%st%group%block_end + call batch_scal(sys%gr%np, M_ONE - mix_coefficient(sys%scf%smix), sys%st%group%psib(ib, iqn)) + call batch_axpy(sys%gr%np, mix_coefficient(sys%scf%smix), psioutb(ib, iqn), sys%st%group%psib(ib, iqn)) end do end do - call density_calc(st, gr, st%rho) - call v_ks_calc(ks, namespace, space, hm, st, ions, ext_partners, calc_current=output_during_scf) + call density_calc(sys%st, sys%gr, sys%st%rho) + call v_ks_calc(sys%ks, sys%namespace, sys%space, sys%hm, sys%st, sys%ions, sys%ext_partners, calc_current=output_during_scf) case (OPTION__MIXFIELD__NONE) - call v_ks_calc(ks, namespace, space, hm, st, ions, ext_partners, calc_current=output_during_scf) + call v_ks_calc(sys%ks, sys%namespace, sys%space, sys%hm, sys%st, sys%ions, sys%ext_partners, calc_current=output_during_scf) end select ! Are we asked to stop? (Whenever Fortran is ready for signals, this should go away) - scf%forced_finish = clean_stop(mc%master_comm) .or. walltimer_alarm(mc%master_comm) + sys%scf%forced_finish = clean_stop(sys%mc%master_comm) .or. walltimer_alarm(sys%mc%master_comm) - if (finish .and. st%modelmbparticles%nparticle > 0) then - call modelmb_sym_all_states(space, gr, st) + if (finish .and. sys%st%modelmbparticles%nparticle > 0) then + call modelmb_sym_all_states(sys%space, sys%gr, sys%st) end if if (present(outp) .and. present(restart_dump)) then ! save restart information if ( (finish .or. (modulo(iter, outp%restart_write_interval) == 0) & - .or. iter == scf%max_iter .or. scf%forced_finish) ) then + .or. iter == sys%scf%max_iter .or. sys%scf%forced_finish) ) then - call states_elec_dump(restart_dump, space, st, gr, hm%kpoints, ierr, iter=iter) + call states_elec_dump(restart_dump, sys%space, sys%st, sys%gr, sys%hm%kpoints, ierr, iter=iter) if (ierr /= 0) then message(1) = 'Unable to write states wavefunctions.' - call messages_warning(1, namespace=namespace) + call messages_warning(1, namespace=sys%namespace) end if - call states_elec_dump_rho(restart_dump, space, st, gr, ierr, iter=iter) + call states_elec_dump_rho(restart_dump, sys%space, sys%st, sys%gr, ierr, iter=iter) if (ierr /= 0) then message(1) = 'Unable to write density.' - call messages_warning(1, namespace=namespace) + call messages_warning(1, namespace=sys%namespace) end if - if(hm%lda_u_level /= DFT_U_NONE) then - call lda_u_dump(restart_dump, namespace, hm%lda_u, st, gr, ierr) + if(sys%hm%lda_u_level /= DFT_U_NONE) then + call lda_u_dump(restart_dump, sys%namespace, sys%hm%lda_u, sys%st, sys%gr, ierr) if (ierr /= 0) then message(1) = 'Unable to write DFT+U information.' - call messages_warning(1, namespace=namespace) + call messages_warning(1, namespace=sys%namespace) end if end if - select case (scf%mix_field) + select case (sys%scf%mix_field) case (OPTION__MIXFIELD__DENSITY) - call mix_dump(namespace, restart_dump, scf%smix, space, gr, ierr) + call mix_dump(sys%namespace, restart_dump, sys%scf%smix, sys%space, sys%gr, ierr) if (ierr /= 0) then message(1) = 'Unable to write mixing information.' - call messages_warning(1, namespace=namespace) + call messages_warning(1, namespace=sys%namespace) end if case (OPTION__MIXFIELD__POTENTIAL) - call hamiltonian_elec_dump_vhxc(restart_dump, hm, space, gr, ierr) + call hamiltonian_elec_dump_vhxc(restart_dump, sys%hm, sys%space, sys%gr, ierr) if (ierr /= 0) then message(1) = 'Unable to write Vhxc.' - call messages_warning(1, namespace=namespace) + call messages_warning(1, namespace=sys%namespace) end if - call mix_dump(namespace, restart_dump, scf%smix, space, gr, ierr) + call mix_dump(sys%namespace, restart_dump, sys%scf%smix, sys%space, sys%gr, ierr) if (ierr /= 0) then message(1) = 'Unable to write mixing information.' - call messages_warning(1, namespace=namespace) + call messages_warning(1, namespace=sys%namespace) end if end select end if @@ -801,7 +792,7 @@ contains if(verbosity_ >= VERB_COMPACT) then write(message(1), '(a, i4, a)') 'Info: SCF converged in ', iter, ' iterations' write(message(2), '(a)') '' - call messages_info(2, namespace=namespace) + call messages_info(2, namespace=sys%namespace) end if call profiling_out("SCF_CYCLE") exit @@ -811,8 +802,8 @@ contains do what_i = lbound(outp%what, 1), ubound(outp%what, 1) if (outp%what_now(what_i, iter)) then write(dirname,'(a,a,i4.4)') trim(outp%iter_dir),"scf.",iter - call output_all(outp, namespace, space, dirname, gr, ions, iter, st, hm, ks) - call output_modelmb(outp, namespace, space, dirname, gr, ions, iter, st) + call output_all(outp, sys%namespace, sys%space, dirname, sys%gr, sys%ions, iter, sys%st, sys%hm, sys%ks) + call output_modelmb(outp, sys%namespace, sys%space, dirname, sys%gr, sys%ions, iter, sys%st) exit end if end do @@ -820,50 +811,50 @@ contains end if ! save information for the next iteration - call lalg_copy(gr%np, nspin, st%rho, rhoin) + call lalg_copy(sys%gr%np, nspin, sys%st%rho, rhoin) ! restart mixing - if (scf%mix_field /= OPTION__MIXFIELD__NONE) then - if (scf%smix%ns_restart > 0) then - if (mod(iter, scf%smix%ns_restart) == 0) then + if (sys%scf%mix_field /= OPTION__MIXFIELD__NONE) then + if (sys%scf%smix%ns_restart > 0) then + if (mod(iter, sys%scf%smix%ns_restart) == 0) then message(1) = "Info: restarting mixing." - call messages_info(1, namespace=namespace) - call scf_mix_clear(scf) + call messages_info(1, namespace=sys%namespace) + call scf_mix_clear(sys%scf) end if end if end if - select case(scf%mix_field) + select case(sys%scf%mix_field) case(OPTION__MIXFIELD__POTENTIAL) - call mixfield_set_vin(scf%mixfield, hm%vhxc(1:gr%np, 1:nspin)) + call mixfield_set_vin(sys%scf%mixfield, sys%hm%vhxc(1:sys%gr%np, 1:nspin)) case (OPTION__MIXFIELD__DENSITY) - call mixfield_set_vin(scf%mixfield, rhoin) + call mixfield_set_vin(sys%scf%mixfield, rhoin) end select - if(scf%mix_field /= OPTION__MIXFIELD__STATES) call lda_u_mixer_set_vin(hm%lda_u, scf%lda_u_mix) + if(sys%scf%mix_field /= OPTION__MIXFIELD__STATES) call lda_u_mixer_set_vin(sys%hm%lda_u, sys%scf%lda_u_mix) - if(scf%forced_finish) then + if(sys%scf%forced_finish) then call profiling_out("SCF_CYCLE") exit end if ! check if debug mode should be enabled or disabled on the fly - call io_debug_on_the_fly(namespace) + call io_debug_on_the_fly(sys%namespace) call profiling_out("SCF_CYCLE") end do !iter - if(scf%lcao_restricted) call lcao_end(lcao) + if(sys%scf%lcao_restricted) call lcao_end(lcao) - if ((scf%max_iter > 0 .and. scf%mix_field == OPTION__MIXFIELD__POTENTIAL) .or. calc_current) then - call v_ks_calc(ks, namespace, space, hm, st, ions, ext_partners, & + if ((sys%scf%max_iter > 0 .and. sys%scf%mix_field == OPTION__MIXFIELD__POTENTIAL) .or. calc_current) then + call v_ks_calc(sys%ks, sys%namespace, sys%space, sys%hm, sys%st, sys%ions, sys%ext_partners, & calc_current=calc_current) end if - select case(scf%mix_field) + select case(sys%scf%mix_field) case(OPTION__MIXFIELD__STATES) - do iqn = st%d%kpt%start, st%d%kpt%end - do ib = st%group%block_start, st%group%block_end + do iqn = sys%st%d%kpt%start, sys%st%d%kpt%end + do ib = sys%st%group%block_start, sys%st%group%block_end call psioutb(ib, iqn)%end() end do end do @@ -874,48 +865,48 @@ contains SAFE_DEALLOCATE_A(rhoout) SAFE_DEALLOCATE_A(rhoin) - if(scf%max_iter > 0 .and. any(scf%eigens%converged < st%nst) .and. .not. scf%lcao_restricted) then + if(sys%scf%max_iter > 0 .and. any(sys%scf%eigens%converged < sys%st%nst) .and. .not. sys%scf%lcao_restricted) then write(message(1),'(a)') 'Some of the states are not fully converged!' - call messages_warning(1, namespace=namespace) + call messages_warning(1, namespace=sys%namespace) end if if(.not.finish) then write(message(1), '(a,i4,a)') 'SCF *not* converged after ', iter - 1, ' iterations.' - call messages_warning(1, namespace=namespace) + call messages_warning(1, namespace=sys%namespace) end if - write(message(1), '(a,i10)') 'Info: Number of matrix-vector products: ', scf%matvec + write(message(1), '(a,i10)') 'Info: Number of matrix-vector products: ', sys%scf%matvec call messages_info(1) - if (scf%calc_force) then - call forces_calculate(gr, namespace, ions, hm, ext_partners, st, ks, vhxc_old=vhxc_old) + if (sys%scf%calc_force) then + call forces_calculate(sys%gr, sys%namespace, sys%ions, sys%hm, sys%ext_partners, sys%st, sys%ks, vhxc_old=vhxc_old) end if - if (scf%calc_stress) call stress_calculate(namespace, gr, hm, st, ions, ks, ext_partners) + if (sys%scf%calc_stress) call stress_calculate(sys%namespace, sys%gr, sys%hm, sys%st, sys%ions, sys%ks, sys%ext_partners) - if(scf%max_iter == 0) then - call energy_calc_eigenvalues(namespace, hm, gr%der, st) - call states_elec_fermi(st, namespace, gr) - call states_elec_write_eigenvalues(st%nst, st, space, hm%kpoints, namespace=namespace) + if(sys%scf%max_iter == 0) then + call energy_calc_eigenvalues(sys%namespace, sys%hm, sys%gr%der, sys%st) + call states_elec_fermi(sys%st, sys%namespace, sys%gr) + call states_elec_write_eigenvalues(sys%st%nst, sys%st, sys%space, sys%hm%kpoints, namespace=sys%namespace) end if if(present(outp)) then ! output final information call scf_write_static(STATIC_DIR, "info") - call output_all(outp, namespace, space, STATIC_DIR, gr, ions, -1, st, hm, ks) - call output_modelmb(outp, namespace, space, STATIC_DIR, gr, ions, -1, st) + call output_all(outp, sys%namespace, sys%space, STATIC_DIR, sys%gr, sys%ions, -1, sys%st, sys%hm, sys%ks) + call output_modelmb(outp, sys%namespace, sys%space, STATIC_DIR, sys%gr, sys%ions, -1, sys%st) end if - if (space%is_periodic() .and. st%nik > st%d%nspin) then - if (bitand(hm%kpoints%method, KPOINTS_PATH) /= 0) then - call states_elec_write_bandstructure(STATIC_DIR, namespace, st%nst, st, & - ions, gr, hm%kpoints, hm%phase, vec_pot = hm%hm_base%uniform_vector_potential, & - vec_pot_var = hm%hm_base%vector_potential) + if (sys%space%is_periodic() .and. sys%st%nik > sys%st%d%nspin) then + if (bitand(sys%hm%kpoints%method, KPOINTS_PATH) /= 0) then + call states_elec_write_bandstructure(STATIC_DIR, sys%namespace, sys%st%nst, sys%st, & + sys%ions, sys%gr, sys%hm%kpoints, sys%hm%phase, vec_pot = sys%hm%hm_base%uniform_vector_potential, & + vec_pot_var = sys%hm%hm_base%vector_potential) end if end if - if (ks%vdw%vdw_correction == OPTION__VDWCORRECTION__VDW_TS) then - call vdw_ts_write_c6ab(ks%vdw%vdw_ts, ions, STATIC_DIR, 'c6ab_eff', namespace) + if (sys%ks%vdw%vdw_correction == OPTION__VDWCORRECTION__VDW_TS) then + call vdw_ts_write_c6ab(sys%ks%vdw%vdw_ts, sys%ions, STATIC_DIR, 'c6ab_eff', sys%namespace) end if SAFE_DEALLOCATE_A(vhxc_old) @@ -930,7 +921,7 @@ contains type(namespace_t), intent(in) :: namespace character(len=50) :: str - real(real64) :: dipole(1:space%dim) + real(real64) :: dipole(1:sys%space%dim) PUSH_SUB(scf_run.scf_write_iter) @@ -938,35 +929,37 @@ contains write(str, '(a,i5)') 'SCF CYCLE ITER #' ,iter call messages_print_with_emphasis(msg=trim(str), namespace=namespace) - write(message(1),'(a,es15.8,2(a,es9.2))') ' etot = ', units_from_atomic(units_out%energy, hm%energy%total), & - ' abs_ev = ', units_from_atomic(units_out%energy, scf%evsum_diff), & - ' rel_ev = ', scf%evsum_diff/(abs(scf%evsum_out)+1e-20) + write(message(1),'(a,es15.8,2(a,es9.2))') ' etot = ', units_from_atomic(units_out%energy, sys%hm%energy%total), & + ' abs_ev = ', units_from_atomic(units_out%energy, sys%scf%evsum_diff), & + ' rel_ev = ', sys%scf%evsum_diff/(abs(sys%scf%evsum_out)+1e-20) write(message(2),'(a,es15.2,2(a,es9.2))') & - ' ediff = ', scf%energy_diff, ' abs_dens = ', scf%abs_dens_diff, & - ' rel_dens = ', scf%abs_dens_diff/st%qtot + ' ediff = ', sys%scf%energy_diff, ' abs_dens = ', sys%scf%abs_dens_diff, & + ' rel_dens = ', sys%scf%abs_dens_diff/sys%st%qtot call messages_info(2, namespace=namespace) - if(.not.scf%lcao_restricted) then - write(message(1),'(a,i6)') 'Matrix vector products: ', scf%eigens%matvec - write(message(2),'(a,i6)') 'Converged eigenvectors: ', sum(scf%eigens%converged(1:st%nik)) + if(.not.sys%scf%lcao_restricted) then + write(message(1),'(a,i6)') 'Matrix vector products: ', sys%scf%eigens%matvec + write(message(2),'(a,i6)') 'Converged eigenvectors: ', sum(sys%scf%eigens%converged(1:sys%st%nik)) call messages_info(2, namespace=namespace) - call states_elec_write_eigenvalues(st%nst, st, space, hm%kpoints, scf%eigens%diff, compact = .true., namespace=namespace) + call states_elec_write_eigenvalues(sys%st%nst, sys%st, sys%space, sys%hm%kpoints, & + sys%scf%eigens%diff, compact = .true., namespace=namespace) else - call states_elec_write_eigenvalues(st%nst, st, space, hm%kpoints, compact = .true., namespace=namespace) + call states_elec_write_eigenvalues(sys%st%nst, sys%st, sys%space, sys%hm%kpoints, & + compact = .true., namespace=namespace) end if - if (allocated(hm%vberry)) then - call calc_dipole(dipole, space, gr, st, ions) + if (allocated(sys%hm%vberry)) then + call calc_dipole(dipole, sys%space, sys%gr, sys%st, sys%ions) call write_dipole(dipole, namespace=namespace) end if - if(st%d%ispin > UNPOLARIZED) then - call write_magnetic_moments(gr, st, ions, gr%der%boundaries, scf%lmm_r, namespace=namespace) + if(sys%st%d%ispin > UNPOLARIZED) then + call write_magnetic_moments(sys%gr, sys%st, sys%ions, sys%gr%der%boundaries, sys%scf%lmm_r, namespace=namespace) end if - if(hm%lda_u_level == DFT_U_ACBN0) then - call lda_u_write_U(hm%lda_u, namespace=namespace) - call lda_u_write_V(hm%lda_u, namespace=namespace) + if(sys%hm%lda_u_level == DFT_U_ACBN0) then + call lda_u_write_U(sys%hm%lda_u, namespace=namespace) + call lda_u_write_V(sys%hm%lda_u, namespace=namespace) end if write(message(1),'(a)') '' @@ -982,8 +975,8 @@ contains if ( verbosity_ == VERB_COMPACT ) then write(message(1),'(a,i4,a,es15.8, a,es9.2, a, f7.1, a)') & 'iter ', iter, & - ' : etot ', units_from_atomic(units_out%energy, hm%energy%total), & - ' : abs_dens', scf%abs_dens_diff, & + ' : etot ', units_from_atomic(units_out%energy, sys%hm%energy%total), & + ' : abs_dens', sys%scf%abs_dens_diff, & ' : etime ', etime, 's' call messages_info(1, namespace=namespace) end if @@ -998,25 +991,25 @@ contains integer :: iunit, iatom real(real64), allocatable :: hirshfeld_charges(:) - real(real64) :: dipole(1:space%dim) + real(real64) :: dipole(1:sys%space%dim) real(real64) :: ex_virial PUSH_SUB(scf_run.scf_write_static) if(mpi_grp_is_root(mpi_world)) then ! this the absolute master writes - call io_mkdir(dir, namespace) - iunit = io_open(trim(dir) // "/" // trim(fname), namespace, action='write') + call io_mkdir(dir, sys%namespace) + iunit = io_open(trim(dir) // "/" // trim(fname), sys%namespace, action='write') - call grid_write_info(gr, iunit=iunit) + call grid_write_info(sys%gr, iunit=iunit) - call symmetries_write_info(gr%symm, space, iunit=iunit) + call symmetries_write_info(sys%gr%symm, sys%space, iunit=iunit) - if (space%is_periodic()) then - call hm%kpoints%write_info(iunit=iunit) + if (sys%space%is_periodic()) then + call sys%hm%kpoints%write_info(iunit=iunit) write(iunit,'(1x)') end if - call v_ks_write_info(ks, iunit=iunit) + call v_ks_write_info(sys%ks, iunit=iunit) ! scf information if(finish) then @@ -1026,15 +1019,15 @@ contains end if write(iunit, '(1x)') - if(any(scf%eigens%converged < st%nst) .and. .not. scf%lcao_restricted) then + if(any(sys%scf%eigens%converged < sys%st%nst) .and. .not. sys%scf%lcao_restricted) then write(iunit,'(a)') 'Some of the states are not fully converged!' end if - call states_elec_write_eigenvalues(st%nst, st, space, hm%kpoints, iunit=iunit) + call states_elec_write_eigenvalues(sys%st%nst, sys%st, sys%space, sys%hm%kpoints, iunit=iunit) write(iunit, '(1x)') - if (space%is_periodic()) then - call states_elec_write_gaps(iunit, st, space) + if (sys%space%is_periodic()) then + call states_elec_write_gaps(iunit, sys%st, sys%space) write(iunit, '(1x)') end if @@ -1043,48 +1036,48 @@ contains iunit = 0 end if - call energy_calc_total(namespace, space, hm, gr, st, ext_partners, iunit, full = .true.) + call energy_calc_total(sys%namespace, sys%space, sys%hm, sys%gr, sys%st, sys%ext_partners, iunit, full = .true.) if(mpi_grp_is_root(mpi_world)) write(iunit, '(1x)') - if(st%d%ispin > UNPOLARIZED) then - call write_magnetic_moments(gr, st, ions, gr%der%boundaries, scf%lmm_r, iunit=iunit) + if(sys%st%d%ispin > UNPOLARIZED) then + call write_magnetic_moments(sys%gr, sys%st, sys%ions, sys%gr%der%boundaries, sys%scf%lmm_r, iunit=iunit) if (mpi_grp_is_root(mpi_world)) write(iunit, '(1x)') end if - if(st%d%ispin == SPINORS .and. space%dim == 3 .and. & - (ks%theory_level == KOHN_SHAM_DFT .or. ks%theory_level == GENERALIZED_KOHN_SHAM_DFT) ) then - call write_total_xc_torque(iunit, gr, hm%vxc, st) + if(sys%st%d%ispin == SPINORS .and. sys%space%dim == 3 .and. & + (sys%ks%theory_level == KOHN_SHAM_DFT .or. sys%ks%theory_level == GENERALIZED_KOHN_SHAM_DFT) ) then + call write_total_xc_torque(iunit, sys%gr, sys%hm%vxc, sys%st) if(mpi_grp_is_root(mpi_world)) write(iunit, '(1x)') end if - if(hm%lda_u_level == DFT_U_ACBN0) then - call lda_u_write_U(hm%lda_u, iunit=iunit) - call lda_u_write_V(hm%lda_u, iunit=iunit) + if(sys%hm%lda_u_level == DFT_U_ACBN0) then + call lda_u_write_U(sys%hm%lda_u, iunit=iunit) + call lda_u_write_V(sys%hm%lda_u, iunit=iunit) if(mpi_grp_is_root(mpi_world)) write(iunit, '(1x)') end if - if(scf%calc_dipole) then - call calc_dipole(dipole, space, gr, st, ions) + if(sys%scf%calc_dipole) then + call calc_dipole(dipole, sys%space, sys%gr, sys%st, sys%ions) call write_dipole(dipole, iunit=iunit) end if ! This only works when we do not have a correlation part - if(ks%theory_level == KOHN_SHAM_DFT .and. & - hm%xc%functional(FUNC_C,1)%family == XC_FAMILY_NONE .and. st%d%ispin /= SPINORS) then - call energy_calc_virial_ex(gr%der, hm%vxc, st, ex_virial) + if(sys%ks%theory_level == KOHN_SHAM_DFT .and. & + sys%hm%xc%functional(FUNC_C,1)%family == XC_FAMILY_NONE .and. sys%st%d%ispin /= SPINORS) then + call energy_calc_virial_ex(sys%gr%der, sys%hm%vxc, sys%st, ex_virial) if (mpi_grp_is_root(mpi_world)) then write(iunit, '(3a)') 'Virial relation for exchange [', trim(units_abbrev(units_out%energy)), ']:' - write(iunit,'(a,es14.6)') "Energy from the orbitals ", units_from_atomic(units_out%energy, hm%energy%exchange) + write(iunit,'(a,es14.6)') "Energy from the orbitals ", units_from_atomic(units_out%energy, sys%hm%energy%exchange) write(iunit,'(a,es14.6)') "Energy from the potential (virial) ", units_from_atomic(units_out%energy, ex_virial) write(iunit, '(1x)') end if end if if(mpi_grp_is_root(mpi_world)) then - if(scf%max_iter > 0) then + if(sys%scf%max_iter > 0) then write(iunit, '(a)') 'Convergence:' - call iterator%start(scf%criterion_list) + call iterator%start(sys%scf%criterion_list) do while (iterator%has_next()) crit => iterator%get_next() call crit%write_info(iunit) @@ -1093,37 +1086,37 @@ contains end if ! otherwise, these values are uninitialized, and unknown. - if (bitand(ks%xc_family, XC_FAMILY_OEP) /= 0 .and. ks%theory_level /= HARTREE_FOCK & - .and. ks%theory_level /= GENERALIZED_KOHN_SHAM_DFT) then - if ((ks%oep_photon%level == OEP_LEVEL_FULL) .or. (ks%oep_photon%level == OEP_LEVEL_KLI)) then + if (bitand(sys%ks%xc_family, XC_FAMILY_OEP) /= 0 .and. sys%ks%theory_level /= HARTREE_FOCK & + .and. sys%ks%theory_level /= GENERALIZED_KOHN_SHAM_DFT) then + if ((sys%ks%oep_photon%level == OEP_LEVEL_FULL) .or. (sys%ks%oep_photon%level == OEP_LEVEL_KLI)) then write(iunit, '(a)') 'Photon observables:' - write(iunit, '(6x, a, es15.8,a,es15.8,a)') 'Photon number = ', ks%oep_photon%pt%number(1) - write(iunit, '(6x, a, es15.8,a,es15.8,a)') 'Photon ex. = ', ks%oep_photon%pt%ex + write(iunit, '(6x, a, es15.8,a,es15.8,a)') 'Photon number = ', sys%ks%oep_photon%pt%number(1) + write(iunit, '(6x, a, es15.8,a,es15.8,a)') 'Photon ex. = ', sys%ks%oep_photon%pt%ex write(iunit,'(1x)') end if end if - if (scf%calc_force) call forces_write_info(iunit, ions, dir, namespace) + if (sys%scf%calc_force) call forces_write_info(iunit, sys%ions, dir, sys%namespace) - if (scf%calc_stress) then - call output_stress(iunit, space%periodic_dim, st%stress_tensors, all_terms=.false.) - call output_pressure(iunit, space%periodic_dim, st%stress_tensors%total) + if (sys%scf%calc_stress) then + call output_stress(iunit, sys%space%periodic_dim, sys%st%stress_tensors, all_terms=.false.) + call output_pressure(iunit, sys%space%periodic_dim, sys%st%stress_tensors%total) end if end if - if(scf%calc_partial_charges) then - SAFE_ALLOCATE(hirshfeld_charges(1:ions%natoms)) + if(sys%scf%calc_partial_charges) then + SAFE_ALLOCATE(hirshfeld_charges(1:sys%ions%natoms)) - call partial_charges_calculate(gr, st, ions, hirshfeld_charges) + call partial_charges_calculate(sys%gr, sys%st, sys%ions, hirshfeld_charges) if(mpi_grp_is_root(mpi_world)) then write(iunit,'(a)') 'Partial ionic charges' write(iunit,'(a)') ' Ion Hirshfeld' - do iatom = 1, ions%natoms - write(iunit,'(i4,a10,f16.3)') iatom, trim(ions%atom(iatom)%species%get_label()), hirshfeld_charges(iatom) + do iatom = 1, sys%ions%natoms + write(iunit,'(i4,a10,f16.3)') iatom, trim(sys%ions%atom(iatom)%species%get_label()), hirshfeld_charges(iatom) end do @@ -1149,21 +1142,21 @@ contains PUSH_SUB(scf_run.write_dipole) if(mpi_grp_is_root(mpi_world)) then - call output_dipole(dipole, space%dim, iunit=iunit, namespace=namespace) + call output_dipole(dipole, sys%space%dim, iunit=iunit, namespace=namespace) - if (space%is_periodic()) then + if (sys%space%is_periodic()) then message(1) = "Defined only up to quantum of polarization (e * lattice vector)." message(2) = "Single-point Berry's phase method only accurate for large supercells." call messages_info(2, iunit=iunit, namespace=namespace) - if (hm%kpoints%full%npoints > 1) then + if (sys%hm%kpoints%full%npoints > 1) then message(1) = & "WARNING: Single-point Berry's phase method for dipole should not be used when there is more than one k-point." message(2) = "Instead, finite differences on k-points (not yet implemented) are needed." call messages_info(2, iunit=iunit, namespace=namespace) end if - if(.not. smear_is_semiconducting(st%smear)) then + if(.not. smear_is_semiconducting(sys%st%smear)) then message(1) = "Single-point Berry's phase dipole calculation not correct without integer occupations." call messages_info(1, iunit=iunit, namespace=namespace) end if @@ -1184,8 +1177,8 @@ contains integer :: iunit character(len=12) :: label if(mpi_grp_is_root(mpi_world)) then ! this the absolute master writes - call io_mkdir(dir, namespace) - iunit = io_open(trim(dir) // "/" // trim(fname), namespace, action='write') + call io_mkdir(dir, sys%namespace) + iunit = io_open(trim(dir) // "/" // trim(fname), sys%namespace, action='write') write(iunit, '(a)', advance = 'no') '#iter energy ' label = 'energy_diff' write(iunit, '(1x,a)', advance = 'no') label @@ -1197,9 +1190,9 @@ contains write(iunit, '(1x,a)', advance = 'no') label label = 'rel_ev' write(iunit, '(1x,a)', advance = 'no') label - if (bitand(ks%xc_family, XC_FAMILY_OEP) /= 0 .and. ks%theory_level /= HARTREE_FOCK & - .and. ks%theory_level /= GENERALIZED_KOHN_SHAM_DFT) then - if (ks%oep%level == OEP_LEVEL_FULL) then + if (bitand(sys%ks%xc_family, XC_FAMILY_OEP) /= 0 .and. sys%ks%theory_level /= HARTREE_FOCK & + .and. sys%ks%theory_level /= GENERALIZED_KOHN_SHAM_DFT) then + if (sys%ks%oep%level == OEP_LEVEL_FULL) then label = 'OEP norm2ss' write(iunit, '(1x,a)', advance = 'no') label end if @@ -1219,10 +1212,10 @@ contains integer :: iunit if(mpi_grp_is_root(mpi_world)) then ! this the absolute master writes - call io_mkdir(dir, namespace) - iunit = io_open(trim(dir) // "/" // trim(fname), namespace, action='write', position='append') - write(iunit, '(i5,es18.8)', advance = 'no') iter, units_from_atomic(units_out%energy, hm%energy%total) - call iterator%start(scf%criterion_list) + call io_mkdir(dir, sys%namespace) + iunit = io_open(trim(dir) // "/" // trim(fname), sys%namespace, action='write', position='append') + write(iunit, '(i5,es18.8)', advance = 'no') iter, units_from_atomic(units_out%energy, sys%hm%energy%total) + call iterator%start(sys%scf%criterion_list) do while (iterator%has_next()) crit => iterator%get_next() select type (crit) @@ -1237,10 +1230,10 @@ contains ASSERT(.false.) end select end do - if (bitand(ks%xc_family, XC_FAMILY_OEP) /= 0 .and. ks%theory_level /= HARTREE_FOCK & - .and. ks%theory_level /= GENERALIZED_KOHN_SHAM_DFT) then - if (ks%oep%level == OEP_LEVEL_FULL) then - write(iunit, '(es13.5)', advance = 'no') ks%oep%norm2ss + if (bitand(sys%ks%xc_family, XC_FAMILY_OEP) /= 0 .and. sys%ks%theory_level /= HARTREE_FOCK & + .and. sys%ks%theory_level /= GENERALIZED_KOHN_SHAM_DFT) then + if (sys%ks%oep%level == OEP_LEVEL_FULL) then + write(iunit, '(es13.5)', advance = 'no') sys%ks%oep%norm2ss end if end if write(iunit,'(a)') '' diff --git a/src/scf/scf_interface_h.F90 b/src/scf/scf_interface_h.F90 index 9646e148ce..a1532f383c 100644 --- a/src/scf/scf_interface_h.F90 +++ b/src/scf/scf_interface_h.F90 @@ -36,18 +36,8 @@ module scf_interface_oct_m type(scf_t), intent(inout) :: scf end subroutine scf_mix_clear - module subroutine scf_run(scf, namespace, space, mc, gr, ions, ext_partners, st, ks, hm, outp, & - verbosity, iters_done, restart_load, restart_dump) - type(scf_t), intent(inout) :: scf !< self consistent cycle - type(namespace_t), intent(in) :: namespace - type(electron_space_t), intent(in) :: space - type(multicomm_t), intent(in) :: mc - type(grid_t), intent(inout) :: gr !< grid - type(ions_t), intent(inout) :: ions !< geometry - type(partner_list_t), intent(in) :: ext_partners - type(states_elec_t), intent(inout) :: st !< States - type(v_ks_t), intent(inout) :: ks !< Kohn-Sham - type(hamiltonian_elec_t), intent(inout) :: hm !< Hamiltonian + module subroutine scf_run(sys, outp, verbosity, iters_done, restart_load, restart_dump) + type(electrons_t), intent(inout) :: sys type(output_t), optional, intent(in) :: outp integer, optional, intent(in) :: verbosity integer, optional, intent(out) :: iters_done diff --git a/src/td/propagator_elec.F90 b/src/td/propagator_elec.F90 index 51dca2925a..98631a5d6d 100644 --- a/src/td/propagator_elec.F90 +++ b/src/td/propagator_elec.F90 @@ -616,9 +616,7 @@ contains call hamiltonian_elec_epot_generate(sys%hm, sys%namespace, sys%space, sys%gr, sys%ions, & sys%ext_partners, sys%st, time = iter*sys%td%dt) ! now calculate the eigenfunctions - call scf_run(sys%scf, sys%namespace, sys%space, sys%mc, sys%gr, sys%ions, sys%ext_partners, & - sys%st, sys%ks, sys%hm, & - verbosity = VERB_COMPACT, iters_done = scsteps) + call scf_run(sys, verbosity = VERB_COMPACT, iters_done = scsteps) gfield => list_get_gauge_field(sys%ext_partners) if(associated(gfield)) then -- GitLab From ba54701dcf5786a169ca7039e2d3f4bc4a4736ac Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Tue, 23 Apr 2024 21:35:38 +0200 Subject: [PATCH 40/43] scf_mix_clear: Change signature Signed-off-by: Cristian Le --- src/main/geom_opt.F90 | 2 +- src/main/phonons_fd.F90 | 2 +- src/main/static_pol.F90 | 4 ++-- src/scf/scf_interface.F90 | 10 +++++----- src/scf/scf_interface_h.F90 | 4 ++-- 5 files changed, 11 insertions(+), 11 deletions(-) diff --git a/src/main/geom_opt.F90 b/src/main/geom_opt.F90 index 5315e49380..136bc42dff 100644 --- a/src/main/geom_opt.F90 +++ b/src/main/geom_opt.F90 @@ -764,7 +764,7 @@ contains call g_opt%ions%write_xyz('./work-geom', append = .true.) - call scf_mix_clear(g_opt%syst%scf) + call scf_mix_clear(g_opt%syst) ! Update lattice vectors and regenerate grid if (bitand(g_opt%type, GO_CELL) /= 0 .or. bitand(g_opt%type, GO_VOLUME) /= 0 ) then diff --git a/src/main/phonons_fd.F90 b/src/main/phonons_fd.F90 index 69d5693f9b..c0b247d2d7 100644 --- a/src/main/phonons_fd.F90 +++ b/src/main/phonons_fd.F90 @@ -220,7 +220,7 @@ contains call density_calc(sys%st, sys%gr, sys%st%rho) call v_ks_calc(sys%ks, sys%namespace, sys%space, sys%hm, sys%st, sys%ions, sys%ext_partners, calc_eigenval=.true.) call energy_calc_total(sys%namespace, sys%space, sys%hm, sys%gr, sys%st, sys%ext_partners) - call scf_mix_clear(sys%scf) + call scf_mix_clear(sys) call scf_run(sys, verbosity = VERB_COMPACT) POP_SUB(get_dyn_matrix.run_displacement) diff --git a/src/main/static_pol.F90 b/src/main/static_pol.F90 index d1119e2535..00a071fae8 100644 --- a/src/main/static_pol.F90 +++ b/src/main/static_pol.F90 @@ -308,7 +308,7 @@ contains end if end if - call scf_mix_clear(sys%scf) + call scf_mix_clear(sys) call scf_run(sys, verbosity = verbosity) trrho = M_ZERO @@ -393,7 +393,7 @@ contains end if end if - call scf_mix_clear(sys%scf) + call scf_mix_clear(sys) call scf_run(sys, verbosity = verbosity) trrho = M_ZERO diff --git a/src/scf/scf_interface.F90 b/src/scf/scf_interface.F90 index 01de3dae83..100812c226 100644 --- a/src/scf/scf_interface.F90 +++ b/src/scf/scf_interface.F90 @@ -392,14 +392,14 @@ contains ! --------------------------------------------------------- - module subroutine scf_mix_clear(scf) - type(scf_t), intent(inout) :: scf + module subroutine scf_mix_clear(sys) + type(electrons_t), intent(inout) :: sys PUSH_SUB(scf_mix_clear) - call mix_clear(scf%smix) + call mix_clear(sys%scf%smix) - if(scf%mix_field /= OPTION__MIXFIELD__STATES) call lda_u_mixer_clear(scf%lda_u_mix, scf%smix) + if(sys%scf%mix_field /= OPTION__MIXFIELD__STATES) call lda_u_mixer_clear(sys%scf%lda_u_mix, sys%scf%smix) POP_SUB(scf_mix_clear) end subroutine scf_mix_clear @@ -819,7 +819,7 @@ contains if (mod(iter, sys%scf%smix%ns_restart) == 0) then message(1) = "Info: restarting mixing." call messages_info(1, namespace=sys%namespace) - call scf_mix_clear(sys%scf) + call scf_mix_clear(sys) end if end if end if diff --git a/src/scf/scf_interface_h.F90 b/src/scf/scf_interface_h.F90 index a1532f383c..6016e370ed 100644 --- a/src/scf/scf_interface_h.F90 +++ b/src/scf/scf_interface_h.F90 @@ -32,8 +32,8 @@ module scf_interface_oct_m type(electrons_t), intent(inout) :: sys end subroutine scf_init - module subroutine scf_mix_clear(scf) - type(scf_t), intent(inout) :: scf + module subroutine scf_mix_clear(sys) + type(electrons_t), intent(inout) :: sys end subroutine scf_mix_clear module subroutine scf_run(sys, outp, verbosity, iters_done, restart_load, restart_dump) -- GitLab From ae8a7a150eb1daf371867de6713ce4ddec2a1fd7 Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Tue, 23 Apr 2024 22:10:01 +0200 Subject: [PATCH 41/43] scf_end: Change signature Signed-off-by: Cristian Le --- src/electrons/electrons.F90 | 2 +- src/main/geom_opt.F90 | 2 +- src/main/phonons_fd.F90 | 2 +- src/main/static_pol.F90 | 2 +- src/scf/electrons_ground_state.F90 | 2 +- src/scf/scf_interface.F90 | 14 +++++++------- src/scf/scf_interface_h.F90 | 4 ++-- src/td/td_interface.F90 | 2 +- 8 files changed, 15 insertions(+), 15 deletions(-) diff --git a/src/electrons/electrons.F90 b/src/electrons/electrons.F90 index 8d5c9ef5be..b0c7372b44 100644 --- a/src/electrons/electrons.F90 +++ b/src/electrons/electrons.F90 @@ -635,7 +635,7 @@ contains done = .false. case (BOMD_FINISH) - call scf_end(this%scf) + call scf_end(this) case (EXPMID_FINISH, AETRS_FINISH) case default diff --git a/src/main/geom_opt.F90 b/src/main/geom_opt.F90 index 136bc42dff..ca069abc11 100644 --- a/src/main/geom_opt.F90 +++ b/src/main/geom_opt.F90 @@ -246,7 +246,7 @@ contains call g_opt%ions%write_xyz('./min') SAFE_DEALLOCATE_A(coords) - call scf_end(sys%scf) + call scf_end(sys) ! Because g_opt has the "save" atribute, we need to explicitly empty the criteria list here, or there will be a memory leak. call sys%scf%criterion_list%empty() call end_() diff --git a/src/main/phonons_fd.F90 b/src/main/phonons_fd.F90 index c0b247d2d7..002957bf4c 100644 --- a/src/main/phonons_fd.F90 +++ b/src/main/phonons_fd.F90 @@ -203,7 +203,7 @@ contains end do SAFE_DEALLOCATE_A(forces0) SAFE_DEALLOCATE_A(forces) - call scf_end(sys%scf) + call scf_end(sys) call vibrations_symmetrize_dyn_matrix(vib) call vibrations_diag_dyn_matrix(vib) diff --git a/src/main/static_pol.F90 b/src/main/static_pol.F90 index 00a071fae8..265c715d25 100644 --- a/src/main/static_pol.F90 +++ b/src/main/static_pol.F90 @@ -436,7 +436,7 @@ contains end if if (.not. fromScratch) call restart_end(restart_load) - call scf_end(sys%scf) + call scf_end(sys) call output_end_() call born_charges_end(born_charges) diff --git a/src/scf/electrons_ground_state.F90 b/src/scf/electrons_ground_state.F90 index 837b5c9acd..c53ab6fdf3 100644 --- a/src/scf/electrons_ground_state.F90 +++ b/src/scf/electrons_ground_state.F90 @@ -152,7 +152,7 @@ contains end if end if - call scf_end(sys%scf) + call scf_end(sys) end if if (restart_init_dump) then diff --git a/src/scf/scf_interface.F90 b/src/scf/scf_interface.F90 index 100812c226..1060fdd6a6 100644 --- a/src/scf/scf_interface.F90 +++ b/src/scf/scf_interface.F90 @@ -365,23 +365,23 @@ contains ! --------------------------------------------------------- - module subroutine scf_end(scf) - type(scf_t), intent(inout) :: scf + module subroutine scf_end(sys) + type(electrons_t), intent(inout) :: sys class(convergence_criterion_t), pointer :: crit type(criterion_iterator_t) :: iter PUSH_SUB(scf_end) - call eigensolver_end(scf%eigens) + call eigensolver_end(sys%scf%eigens) - if(scf%mix_field /= OPTION__MIXFIELD__NONE) call mix_end(scf%smix) + if(sys%scf%mix_field /= OPTION__MIXFIELD__NONE) call mix_end(sys%scf%smix) - nullify(scf%mixfield) + nullify(sys%scf%mixfield) - if(scf%mix_field /= OPTION__MIXFIELD__STATES) call lda_u_mixer_end(scf%lda_u_mix, scf%smix) + if(sys%scf%mix_field /= OPTION__MIXFIELD__STATES) call lda_u_mixer_end(sys%scf%lda_u_mix, sys%scf%smix) - call iter%start(scf%criterion_list) + call iter%start(sys%scf%criterion_list) do while (iter%has_next()) crit => iter%get_next() SAFE_DEALLOCATE_P(crit) diff --git a/src/scf/scf_interface_h.F90 b/src/scf/scf_interface_h.F90 index 6016e370ed..38c09e5b87 100644 --- a/src/scf/scf_interface_h.F90 +++ b/src/scf/scf_interface_h.F90 @@ -45,8 +45,8 @@ module scf_interface_oct_m type(restart_t), optional, intent(in) :: restart_dump end subroutine scf_run - module subroutine scf_end(scf) - type(scf_t), intent(inout) :: scf + module subroutine scf_end(sys) + type(electrons_t), intent(inout) :: sys end subroutine scf_end module subroutine scf_state_info(namespace, st) diff --git a/src/td/td_interface.F90 b/src/td/td_interface.F90 index d7181fe444..a53146fc4f 100644 --- a/src/td/td_interface.F90 +++ b/src/td/td_interface.F90 @@ -433,7 +433,7 @@ contains call propagator_elec_end(sys%td%tr) ! clean the evolution method call ion_dynamics_end(sys%td%ions_dyn) - if (sys%td%dynamics == BO) call scf_end(sys%scf) + if (sys%td%dynamics == BO) call scf_end(sys) POP_SUB(td_end) end subroutine td_end -- GitLab From 9b29acfa917260baee8c73e97900261eebbb5b2d Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Tue, 23 Apr 2024 22:12:13 +0200 Subject: [PATCH 42/43] scf_state_info: Change signature Signed-off-by: Cristian Le --- src/scf/electrons_ground_state.F90 | 2 +- src/scf/scf_interface.F90 | 9 ++++----- src/scf/scf_interface_h.F90 | 5 ++--- src/scf/unocc.F90 | 2 +- 4 files changed, 8 insertions(+), 10 deletions(-) diff --git a/src/scf/electrons_ground_state.F90 b/src/scf/electrons_ground_state.F90 index c53ab6fdf3..af9750665a 100644 --- a/src/scf/electrons_ground_state.F90 +++ b/src/scf/electrons_ground_state.F90 @@ -124,7 +124,7 @@ contains end if ! run self-consistency - call scf_state_info(sys%namespace, sys%st) + call scf_state_info(sys) if (sys%st%pack_states .and. sys%hm%apply_packed()) then call sys%st%pack() diff --git a/src/scf/scf_interface.F90 b/src/scf/scf_interface.F90 index 1060fdd6a6..57a68d9023 100644 --- a/src/scf/scf_interface.F90 +++ b/src/scf/scf_interface.F90 @@ -1245,18 +1245,17 @@ contains end subroutine scf_run ! --------------------------------------------------------- - module subroutine scf_state_info(namespace, st) - type(namespace_t), intent(in) :: namespace - class(states_abst_t), intent(in) :: st + module subroutine scf_state_info(sys) + type(electrons_t), intent(in) :: sys PUSH_SUB(scf_state_info) - if (states_are_real(st)) then + if (states_are_real(sys%st)) then call messages_write('Info: SCF using real wavefunctions.') else call messages_write('Info: SCF using complex wavefunctions.') end if - call messages_info(namespace=namespace) + call messages_info(namespace=sys%namespace) POP_SUB(scf_state_info) diff --git a/src/scf/scf_interface_h.F90 b/src/scf/scf_interface_h.F90 index 38c09e5b87..9188cc8b8b 100644 --- a/src/scf/scf_interface_h.F90 +++ b/src/scf/scf_interface_h.F90 @@ -49,9 +49,8 @@ module scf_interface_oct_m type(electrons_t), intent(inout) :: sys end subroutine scf_end - module subroutine scf_state_info(namespace, st) - type(namespace_t), intent(in) :: namespace - class(states_abst_t), intent(in) :: st + module subroutine scf_state_info(sys) + type(electrons_t), intent(in) :: sys end subroutine scf_state_info module subroutine scf_print_mem_use(namespace) diff --git a/src/scf/unocc.F90 b/src/scf/unocc.F90 index 9318ddf103..f5d55f5b33 100644 --- a/src/scf/unocc.F90 +++ b/src/scf/unocc.F90 @@ -231,7 +231,7 @@ contains call density_calc(sys%st, sys%gr, sys%st%rho) end if - call scf_state_info(sys%namespace, sys%st) + call scf_state_info(sys) if (fromScratch .or. ierr /= 0) then if (fromScratch) then -- GitLab From d4a64370097b4111822902698028f583511f0a70 Mon Sep 17 00:00:00 2001 From: Cristian Le Date: Wed, 15 May 2024 18:00:29 +0200 Subject: [PATCH 43/43] [Debug] Avoid experimental message Temporarily disabling in order to run tests Signed-off-by: Cristian Le --- src/multisystem/system.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/multisystem/system.F90 b/src/multisystem/system.F90 index 2c8faaa7de..0356afb771 100644 --- a/src/multisystem/system.F90 +++ b/src/multisystem/system.F90 @@ -635,7 +635,7 @@ contains PUSH_SUB(system_init_algorithm) - call messages_experimental('Multi-system framework') +! call messages_experimental('Multi-system framework') this%algo => factory%create(this) -- GitLab