diff --git a/src/Makefile.am b/src/Makefile.am
index 444d68d7da3d1c1c068a21fca7237163b6f446c8..9b57ede94f95e4a23135e630305d4e3f4cb17b69 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 \
@@ -466,9 +467,10 @@ 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 \
hamiltonian/hgh_projector.F90 \
hamiltonian/hirshfeld.F90 \
hamiltonian/ion_interaction.F90 \
@@ -551,6 +553,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)
@@ -658,6 +661,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 \
@@ -704,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 \
@@ -722,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 \
@@ -729,7 +735,9 @@ 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
scf_srcs = $(scf_f_srcs)
@@ -750,6 +758,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 \
@@ -757,7 +766,9 @@ 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 \
td/propagation_ops_elec.F90
diff --git a/src/basic/CMakeLists.txt b/src/basic/CMakeLists.txt
index 96efa8109495d6eb432b7bd5321d845b121df6f3..fdf90ef09c7d5a330675c6be35322e4185cba258 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 1d610352feeae4e458fd0ea0dab83bbd2d2e6a34..9ffc7fb5fa39a6785998b7a820c650d72aeacfcf 100644
--- a/src/basic/global.F90
+++ b/src/basic/global.F90
@@ -18,197 +18,20 @@
#include "global.h"
-module global_oct_m
- use, intrinsic :: iso_fortran_env
+submodule (global_oct_m) impl
+ use global_oct_m
use hardware_oct_m
use loct_oct_m
- use mpi_oct_m
use varinfo_oct_m
#ifdef HAVE_OPENMP
use omp_lib
#endif
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
-
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 +48,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 +77,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 +105,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 +113,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 +124,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 +135,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 +146,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 +157,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 +168,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 +179,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
diff --git a/src/basic/global_h.F90 b/src/basic/global_h.F90
new file mode 100644
index 0000000000000000000000000000000000000000..fd28c70b26386fc06450df4436197493fc38a38a
--- /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
diff --git a/src/electrons/CMakeLists.txt b/src/electrons/CMakeLists.txt
index f87ba1d062cf6f881dbdba40f9c95555d29ce175..d602c56ffb27dad707310979de83214464f70749 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 9d42228f18f7c0bd90b32899721173c0757f0d74..b0c7372b4474d6fac85733ffb9b9a5e3519465ac 100644
--- a/src/electrons/electrons.F90
+++ b/src/electrons/electrons.F90
@@ -20,58 +20,39 @@
#include "global.h"
-
-module electrons_oct_m
+submodule (electrons_oct_m) impl
+ use 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 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
@@ -87,100 +68,27 @@ module electrons_oct_m
use profiling_oct_m
use quantity_oct_m
use regridding_oct_m
- use scf_oct_m
+ use scf_interface_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_interface_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
- 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
-
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 +176,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 +239,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 +432,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
@@ -535,12 +443,10 @@ 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, &
- 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)
@@ -550,7 +456,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 +472,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)
@@ -574,17 +480,17 @@ 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, td_get_from_scratch(this%td))
+ call td_init_with_wavefunctions(this)
POP_SUB(electrons_propagation_start)
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
@@ -682,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.
@@ -695,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)
@@ -730,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
@@ -744,9 +649,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 +662,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 +689,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 +707,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 +729,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 +738,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 +764,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 +773,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 +892,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 +921,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 +938,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 +950,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,19 +1007,16 @@ 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
- class(interaction_partner_t), pointer :: partner
-
PUSH_SUB(electrons_finalize)
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(sys%td)
+ call td_end_run(sys)
+ call td_end(sys)
end select
end if
@@ -1119,12 +1024,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)
@@ -1156,9 +1056,22 @@ 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 module electrons_oct_m
+end submodule impl
!! Local Variables:
!! mode: f90
diff --git a/src/electrons/electrons_h.F90 b/src/electrons/electrons_h.F90
new file mode 100644
index 0000000000000000000000000000000000000000..56d8d402d6e20c2b88f6faadfdd3702e976b4f9d
--- /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
diff --git a/src/fdep/fortran_dependencies.pl b/src/fdep/fortran_dependencies.pl
index d9644ea6b71b40ae4bab6d619b7d396fa257f3e6..51bf106b3936241dafb06e18f14d0f87b29bc38f 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 {
diff --git a/src/hamiltonian/CMakeLists.txt b/src/hamiltonian/CMakeLists.txt
index 803f9218f56b7ad0b9301925139084d124d144da..b72bbeac074328b0c0cab2e069644931e6f5ed12 100644
--- a/src/hamiltonian/CMakeLists.txt
+++ b/src/hamiltonian/CMakeLists.txt
@@ -6,9 +6,10 @@ 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
hgh_projector.F90
hirshfeld.F90
ion_interaction.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 7ae72767d51559f80eb1829d22a0c4aa2a9849fc..8e3976d228bc0c6f0ba9c21ce7a18ed228306124 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
diff --git a/src/hamiltonian/hamiltonian_elec.F90 b/src/hamiltonian/hamiltonian_elec.F90
index 1a9a97b196a572b55010034ee230b05fb7aa0af9..3db64544fca27bc5cf4bfe212a20a272bd539d66 100644
--- a/src/hamiltonian/hamiltonian_elec.F90
+++ b/src/hamiltonian/hamiltonian_elec.F90
@@ -19,228 +19,46 @@
#include "global.h"
-module hamiltonian_elec_oct_m
- use absorbing_boundaries_oct_m
+submodule (hamiltonian_elec_oct_m) impl
+ use hamiltonian_elec_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 epot_oct_m
use ext_partner_list_oct_m
+ use external_potential_oct_m
use gauge_field_oct_m
use global_oct_m
- use grid_oct_m
- use hamiltonian_abst_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 parser_oct_m
use profiling_oct_m
use projector_oct_m
- use pcm_oct_m
- use phase_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 symmetries_oct_m
use types_oct_m
use unit_oct_m
use unit_system_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
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
-
-
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 +505,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 +574,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 +587,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 +624,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 +648,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 +662,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 +679,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 +697,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 +928,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 +1048,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 +1131,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 +1150,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 +1180,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 +1276,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 +1346,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 +1542,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 +1558,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 +1577,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 +1626,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 +1678,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 +1698,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 +1735,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 +1773,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_h.F90 b/src/hamiltonian/hamiltonian_elec_h.F90
new file mode 100644
index 0000000000000000000000000000000000000000..bf15740e4fca4516a3d54c67eecd86ddd5292c8f
--- /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
diff --git a/src/hamiltonian/hamiltonian_elec_inc.F90 b/src/hamiltonian/hamiltonian_elec_inc.F90
index 898297ed27644dd98681a9468c415ac010cc7de1..a71db78c8cef6363028a002deaea29cd10c42aa6 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)
diff --git a/src/main/geom_opt.F90 b/src/main/geom_opt.F90
index 51a13c1c99111e381938a438b82180784f58a224..ca069abc11749e4401c8ca4eee0e03a87e128fce 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
@@ -76,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
@@ -171,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)
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.'
@@ -246,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)
! 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)
@@ -764,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)
! Update lattice vectors and regenerate grid
if (bitand(g_opt%type, GO_CELL) /= 0 .or. bitand(g_opt%type, GO_VOLUME) /= 0 ) then
@@ -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%scfv, 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/ground_state.F90 b/src/main/ground_state.F90
index 8e5adb8ead5c21bf887906d87a36579ec865ef8b..ee17ad0bc6093ac0ed7041f4638694e0185895fb 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/main/phonons_fd.F90 b/src/main/phonons_fd.F90
index 6eff8e1c605b7f044413a3398290107ca79a7c0e..002957bf4c3ce2570727867123fcbe01da10d54e 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
@@ -129,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)
@@ -143,65 +143,55 @@ 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
real(real64), allocatable :: forces(:,:), forces0(:,:)
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(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
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)
@@ -213,7 +203,7 @@ contains
end do
SAFE_DEALLOCATE_A(forces0)
SAFE_DEALLOCATE_A(forces)
- call scf_end(scf)
+ call scf_end(sys)
call vibrations_symmetrize_dyn_matrix(vib)
call vibrations_diag_dyn_matrix(vib)
@@ -226,12 +216,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 scf_mix_clear(scf)
- call scf_run(scf, namespace, space, mc, gr, ions, ext_partners, st, ks, hm, verbosity = VERB_COMPACT)
+ 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(sys)
+ call scf_run(sys, verbosity = VERB_COMPACT)
POP_SUB(get_dyn_matrix.run_displacement)
end subroutine run_displacement
diff --git a/src/main/run.F90 b/src/main/run.F90
index 708273bdf962a85e4652618a7cdc00460fa0939a..dc15b4ee4e41e76c8cfdea751f99bce031021469 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/static_pol.F90 b/src/main/static_pol.F90
index ac404ef5b56f96b30d3a4d4dbfa4b5017c3511eb..265c715d256e0c059f9e6ced330c1e31f1a15a4c 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
@@ -82,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(:, :, :)
@@ -223,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)
call born_charges_init(born_charges, sys%namespace, sys%ions%natoms, sys%st%val_charge, &
sys%st%qtot, sys%space%dim)
@@ -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(scfv, 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
@@ -305,13 +304,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, &
- sys%ks, sys%hm, verbosity = verbosity)
+ call scf_mix_clear(sys)
+ call scf_run(sys, verbosity = verbosity)
trrho = M_ZERO
do is = 1, sys%st%d%spin_channels
@@ -391,13 +389,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, &
- sys%ks, sys%hm, verbosity = verbosity)
+ call scf_mix_clear(sys)
+ call scf_run(sys, verbosity = verbosity)
trrho = M_ZERO
do is = 1, sys%st%d%spin_channels
@@ -439,7 +436,7 @@ contains
end if
if (.not. fromScratch) call restart_end(restart_load)
- call scf_end(scfv)
+ call scf_end(sys)
call output_end_()
call born_charges_end(born_charges)
diff --git a/src/main/time_dependent.F90 b/src/main/time_dependent.F90
index 556c733da5d67338f83c60ee3b6fc0e7310985a0..e2343b86a55a5407f7e3bf286dd7f29373af09da 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
@@ -132,14 +132,11 @@ 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_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_end_run(electrons%td, electrons%st, electrons%hm)
- call td_end(electrons%td)
+ call td_init(electrons)
+ call td_init_run(electrons, from_scratch)
+ call td_run(electrons, from_scratch)
+ call td_end_run(electrons)
+ call td_end(electrons)
POP_SUB(time_dependent_run_legacy)
end subroutine time_dependent_run_legacy
diff --git a/src/maxwell/CMakeLists.txt b/src/maxwell/CMakeLists.txt
index 74a639c24ed05817facf9ae366cbd2854541c665..6a6ffcb669da746dae6914a708a7189de862bf56 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 599ff2c43b1ef0b6fa626246c46145b3ee2eef11..62774d567de65985d84af6fca49c75377f763ce2 100644
--- a/src/maxwell/hamiltonian_mxll.F90
+++ b/src/maxwell/hamiltonian_mxll.F90
@@ -18,146 +18,28 @@
#include "global.h"
-module hamiltonian_mxll_oct_m
+submodule (hamiltonian_mxll_oct_m) impl
+ use 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
-
- 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
-
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 +140,7 @@ contains
! ---------------------------------------------------------
- subroutine hamiltonian_mxll_end(hm)
+ module subroutine hamiltonian_mxll_end(hm)
type(hamiltonian_mxll_t), intent(inout) :: hm
integer :: il
@@ -284,16 +166,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 +184,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 +220,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 +234,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 +249,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 +263,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 +273,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 +284,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 +565,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 +607,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 +664,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 +723,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 +760,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 +827,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 +843,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 +889,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 +1037,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 +1061,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 +1085,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 +1130,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 +1181,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 +1243,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 +1306,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 +1320,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 +1332,7 @@ contains
end subroutine zhamiltonian_mxll_magnus_apply
-end module hamiltonian_mxll_oct_m
+end submodule impl
!! Local Variables:
!! mode: f90
diff --git a/src/maxwell/hamiltonian_mxll_h.F90 b/src/maxwell/hamiltonian_mxll_h.F90
new file mode 100644
index 0000000000000000000000000000000000000000..e4b90ec990729ed9675c4b08bf4f2cad25f86eaa
--- /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
diff --git a/src/multisystem/CMakeLists.txt b/src/multisystem/CMakeLists.txt
index 51bc99876c3c4ac2002168b06c21330b4df1d421..1c30e995de14b2474fe208f1d5fe2a8019f4d5ee 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 7cd8c44b7da7f511c729981770b398acc3d20e10..0356afb7710f2eab4bb924de0c6aafe76d1b45b6 100644
--- a/src/multisystem/system.F90
+++ b/src/multisystem/system.F90
@@ -20,23 +20,14 @@
#include "global.h"
-!> This module implements the abstract system type.
-!!
-module system_oct_m
- use algorithm_oct_m
- use algorithm_factory_oct_m
+submodule (system_oct_m) impl
+ use system_oct_m
use debug_oct_m
use ghost_interaction_oct_m
use global_oct_m
- use interactions_factory_abst_oct_m
- use interaction_partner_oct_m
- use interaction_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
@@ -44,181 +35,6 @@ module system_oct_m
use unit_system_oct_m
use varinfo_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
-
contains
! ---------------------------------------------------------
@@ -234,7 +50,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 +168,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 +221,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 +372,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 +410,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 +483,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 +495,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 +507,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 +546,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 +558,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 +580,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 +591,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 +603,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 +615,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 +627,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
@@ -817,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)
@@ -832,7 +650,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 +665,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 +698,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 +752,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 +785,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 +814,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 +852,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 +869,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 +898,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 +918,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 +933,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 +947,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 +960,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 +981,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 +1004,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 +1031,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 +1056,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 +1075,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
diff --git a/src/multisystem/system_h.F90 b/src/multisystem/system_h.F90
new file mode 100644
index 0000000000000000000000000000000000000000..709db1a6bcd4b34110d34e8fe51dd4f572e28e63
--- /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
diff --git a/src/opt_control/opt_control.F90 b/src/opt_control/opt_control.F90
index 4530b3d3c7459f66b4cef85fadf7fe4f5ffb901c..95f4c5e1dec49e35c4d63cdd8f65d58cec21cb45 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
@@ -111,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
@@ -136,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.
@@ -164,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. &
@@ -172,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.
@@ -243,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)
call opt_control_state_end(initial_st)
call target_end(oct_target, oct)
call controlfunction_mod_close()
@@ -267,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
@@ -292,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
@@ -324,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
@@ -350,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
@@ -364,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
@@ -394,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)
@@ -411,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))
@@ -469,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)
@@ -489,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)
@@ -534,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)
@@ -557,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/scf/CMakeLists.txt b/src/scf/CMakeLists.txt
index 75f20d3a9894a4e9f6d690f335bc8fd849d8c657..1bb8cb1b2a712a49d1909bac7f1e8fa99133cbb7 100644
--- a/src/scf/CMakeLists.txt
+++ b/src/scf/CMakeLists.txt
@@ -3,13 +3,16 @@ 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
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 0e608c8e9c595ad1f257bbac67f108ea7ccf7012..af9750665a65ae826cc6ce1fa49e61122fd44ed1 100644
--- a/src/scf/electrons_ground_state.F90
+++ b/src/scf/electrons_ground_state.F90
@@ -18,25 +18,20 @@
#include "global.h"
-module electrons_ground_state_oct_m
+submodule (electrons_ground_state_oct_m) impl
+ use 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 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_interface_oct_m
use scf_oct_m
use space_oct_m
use states_abst_oct_m
@@ -46,27 +41,13 @@ module electrons_ground_state_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)
- 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
type(restart_t) :: restart_load, restart_dump
integer :: ierr
type(rdm_t) :: rdm
@@ -75,120 +56,120 @@ 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(sys)
! 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. 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 = sys%scf%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)
- 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, &
- 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(scfv, namespace, space, mc, gr, ions, ext_partners, st, ks, hm, outp=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(scfv, namespace, space, mc, gr, ions, ext_partners, st, ks, hm, outp=outp, restart_dump=restart_dump)
+ call scf_run(sys, 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(sys, outp=sys%outp)
end if
end if
- call scf_end(scfv)
+ call scf_end(sys)
end if
if (restart_init_dump) then
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
-end module electrons_ground_state_oct_m
+end submodule impl
!! Local Variables:
!! mode: f90
diff --git a/src/scf/electrons_ground_state_h.F90 b/src/scf/electrons_ground_state_h.F90
new file mode 100644
index 0000000000000000000000000000000000000000..25cff7d46a3595832a80b983bacb53bab51ccb63
--- /dev/null
+++ b/src/scf/electrons_ground_state_h.F90
@@ -0,0 +1,16 @@
+module electrons_ground_state_oct_m
+ use electrons_oct_m
+
+ implicit none
+
+ private
+ public :: &
+ electrons_ground_state_run
+
+ interface
+ 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
+end module electrons_ground_state_oct_m
diff --git a/src/scf/scf_h.F90 b/src/scf/scf_h.F90
new file mode 100644
index 0000000000000000000000000000000000000000..920eda90d05d1a4d61edf9b7d73c80dd3256c7a5
--- /dev/null
+++ b/src/scf/scf_h.F90
@@ -0,0 +1,47 @@
+module scf_oct_m
+ use berry_oct_m
+ use convergence_criterion_oct_m
+ use eigensolver_oct_m
+ use global_oct_m
+ use lda_u_mixer_oct_m
+ use mix_oct_m
+
+ implicit none
+
+ private
+
+ integer, public, parameter :: &
+ VERB_NO = 0, &
+ VERB_COMPACT = 1, &
+ VERB_FULL = 3
+
+ !> some variables used for the SCF cycle
+ type, public :: scf_t
+ private
+ integer, public :: max_iter !< maximum number of SCF iterations
+
+ real(real64), public :: lmm_r
+
+ ! several convergence criteria
+ logical, public :: conv_eigen_error
+ logical, public :: check_conv
+
+ integer, public :: mix_field
+ logical, public :: lcao_restricted
+ logical, public :: calc_force
+ logical, public :: calc_stress
+ 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), public :: energy_in, energy_diff, abs_dens_diff, evsum_in, evsum_out, evsum_diff
+ end type scf_t
+end module scf_oct_m
diff --git a/src/scf/scf.F90 b/src/scf/scf_interface.F90
similarity index 57%
rename from src/scf/scf.F90
rename to src/scf/scf_interface.F90
index 2b8eb87c97bdd708c05545cb2037c9e9bc6a662b..57a68d9023340b32ebc59305c59dfc4c4bb52cf2 100644
--- a/src/scf/scf.F90
+++ b/src/scf/scf_interface.F90
@@ -18,56 +18,43 @@
#include "global.h"
-module scf_oct_m
+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
use criteria_factory_oct_m
use debug_oct_m
- use density_oct_m
use density_criterion_oct_m
+ use density_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 lalg_basic_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 lda_u_oct_m
use loct_oct_m
use magnetic_oct_m
use math_oct_m
- use mesh_oct_m
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 multicomm_oct_m
- use namespace_oct_m
- use output_oct_m
- use output_low_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 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
@@ -76,76 +63,22 @@ module scf_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_oct_m
use xc_oep_oct_m
use xc_oep_photon_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
-
contains
! ---------------------------------------------------------
- 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
@@ -172,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.")
@@ -210,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
@@ -224,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
@@ -253,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
@@ -335,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
@@ -357,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
@@ -381,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
@@ -395,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
@@ -406,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
@@ -421,34 +354,34 @@ 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
! ---------------------------------------------------------
- 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)
@@ -459,32 +392,22 @@ contains
! ---------------------------------------------------------
- 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
! ---------------------------------------------------------
- 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
@@ -506,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
@@ -522,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
@@ -602,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)
@@ -765,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
@@ -868,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
@@ -878,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
@@ -887,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)
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
@@ -941,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)
@@ -997,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)
@@ -1005,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)') ''
@@ -1049,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
@@ -1065,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
@@ -1093,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
@@ -1110,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)
@@ -1160,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
@@ -1216,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
@@ -1251,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
@@ -1264,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
@@ -1286,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)
@@ -1304,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)') ''
@@ -1319,25 +1245,24 @@ contains
end subroutine scf_run
! ---------------------------------------------------------
- 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)
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 +1344,7 @@ contains
end subroutine scf_update_diff_quantity
-end module scf_oct_m
+end submodule impl
!! Local Variables:
diff --git a/src/scf/scf_interface_h.F90 b/src/scf/scf_interface_h.F90
new file mode 100644
index 0000000000000000000000000000000000000000..9188cc8b8b18c8cee75751d6e4b58c03097c4e11
--- /dev/null
+++ b/src/scf/scf_interface_h.F90
@@ -0,0 +1,60 @@
+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
+ 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(sys)
+ type(electrons_t), intent(inout) :: sys
+ end subroutine scf_init
+
+ 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)
+ type(electrons_t), intent(inout) :: sys
+ 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(sys)
+ type(electrons_t), intent(inout) :: sys
+ end subroutine scf_end
+
+ module subroutine scf_state_info(sys)
+ type(electrons_t), intent(in) :: sys
+ 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 6373a84cd622003b3778379334594cf38fe87650..f5d55f5b33747d8625b1be26ce465bb151579367 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
@@ -230,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
diff --git a/src/td/CMakeLists.txt b/src/td/CMakeLists.txt
index 7d266368fd1e19334a5d24526599af309d6f61cf..819f0ca6484e51fb94c066423a30c4e765e13be8 100644
--- a/src/td/CMakeLists.txt
+++ b/src/td/CMakeLists.txt
@@ -9,14 +9,17 @@ 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
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/propagator_elec.F90 b/src/td/propagator_elec.F90
index 68f9f50b48976855ee3ff72042633c7d96817ca2..98631a5d6d175ad28d498bfe0f5550cc86dd6f58 100644
--- a/src/td/propagator_elec.F90
+++ b/src/td/propagator_elec.F90
@@ -18,33 +18,21 @@
#include "global.h"
-module propagator_elec_oct_m
+submodule (propagator_elec_oct_m) impl
+ use 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 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
@@ -52,34 +40,17 @@ module propagator_elec_oct_m
use propagator_qoct_oct_m
use propagator_rk_oct_m
use propagator_verlet_oct_m
- use scf_oct_m
+ use scf_interface_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
- 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
-
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 +88,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 +360,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 +377,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 +390,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 +413,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 +430,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 +585,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,21 +602,9 @@ contains
! ---------------------------------------------------------
- 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
@@ -652,47 +612,49 @@ 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, &
- verbosity = VERB_COMPACT, iters_done = scsteps)
+ call scf_run(sys, 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
POP_SUB(propagator_elec_dt_bo)
end subroutine propagator_elec_dt_bo
-end module propagator_elec_oct_m
+end submodule impl
!! Local Variables:
diff --git a/src/td/propagator_elec_h.F90 b/src/td/propagator_elec_h.F90
new file mode 100644
index 0000000000000000000000000000000000000000..851e46c825398bb7519ba65b0b21f9658b0130c6
--- /dev/null
+++ b/src/td/propagator_elec_h.F90
@@ -0,0 +1,102 @@
+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
+ 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(sys, iter, scsteps)
+ type(electrons_t), intent(inout) :: sys
+ integer, intent(in) :: iter
+ integer, intent(inout) :: scsteps
+ end subroutine propagator_elec_dt_bo
+ end interface
+end module propagator_elec_oct_m
diff --git a/src/td/td_h.F90 b/src/td/td_h.F90
new file mode 100644
index 0000000000000000000000000000000000000000..a607b61acd0c887ea384579710e9ac8bacba12d5
--- /dev/null
+++ b/src/td/td_h.F90
@@ -0,0 +1,54 @@
+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 space_oct_m
+ use states_elec_oct_m
+ use td_write_oct_m
+ use v_ks_oct_m
+
+ implicit none
+
+ private
+
+ !> Parameters.
+ integer, parameter, public :: &
+ EHRENFEST = 1, &
+ BO = 2
+
+ type, public :: td_t
+ private
+ type(propagator_base_t), public :: tr !< contains the details of the time-evolution
+ 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), public :: scissor
+
+ logical :: freeze_occ
+ logical :: freeze_u
+ integer, public :: freeze_orbitals
+
+ logical, public :: from_scratch = .false.
+
+ type(td_write_t), public :: write_handler
+ type(restart_t), public :: restart_load
+ type(restart_t), public :: restart_dump
+ end type td_t
+end module td_oct_m
diff --git a/src/td/td.F90 b/src/td/td_interface.F90
similarity index 58%
rename from src/td/td.F90
rename to src/td/td_interface.F90
index 7f267f0a56d110f35865a393e6ae1c845d1bb52d..a53146fc4f58d4f405d44768ed8e995ffdc6b323 100644
--- a/src/td/td.F90
+++ b/src/td/td_interface.F90
@@ -18,43 +18,35 @@
#include "global.h"
-module td_oct_m
+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
- use current_oct_m
use classical_particle_oct_m
+ use current_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 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 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 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 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
@@ -62,84 +54,28 @@ module td_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 propagator_oct_m
use restart_oct_m
+ use scf_interface_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
- private
- public :: &
- td_t, &
- td_run, &
- td_run_init, &
- td_init, &
- td_init_run, &
- td_end, &
- td_end_run, &
- td_write_iter, &
- 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
-
-
contains
- subroutine td_run_init()
+ module subroutine td_run_init()
PUSH_SUB(td_run_init)
@@ -150,17 +86,8 @@ contains
! ---------------------------------------------------------
- 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
@@ -168,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
@@ -203,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
@@ -233,9 +160,9 @@ contains
!% selected ev_angstrom as input units). The approximate conversions to
!% femtoseconds are 1 fs = 41.34 /Hartree = 1.52 /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
@@ -246,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
@@ -283,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
@@ -306,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
@@ -320,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
@@ -345,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
@@ -380,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
@@ -396,18 +324,8 @@ contains
end subroutine td_init
! ---------------------------------------------------------
- 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)
@@ -415,74 +333,67 @@ 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)
POP_SUB(td_init_run)
end subroutine td_init_run
! ---------------------------------------------------------
- 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)
end if
POP_SUB(td_allocate_wavefunctions)
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,53 +424,41 @@ contains
end subroutine td_init_gaugefield
! ---------------------------------------------------------
- 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)
POP_SUB(td_end)
end subroutine td_end
! ---------------------------------------------------------
- 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
! ---------------------------------------------------------
- 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
@@ -570,62 +469,64 @@ 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, iter, 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, &
- 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(namespace)
+ call io_debug_on_the_fly(sys%namespace)
call profiling_out("TIME_STEP")
if (stopping) exit
@@ -649,19 +550,8 @@ contains
end subroutine td_print_header
! ---------------------------------------------------------
- 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
@@ -672,40 +562,45 @@ 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, 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
@@ -745,23 +640,12 @@ 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)
- 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
@@ -770,64 +654,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
@@ -838,40 +727,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
@@ -881,16 +777,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
@@ -902,77 +798,82 @@ 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)
- 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
@@ -1021,7 +922,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 +958,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
@@ -1099,43 +1000,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)
@@ -1189,7 +1084,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 +1308,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 +1330,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
diff --git a/src/td/td_interface_h.F90 b/src/td/td_interface_h.F90
new file mode 100644
index 0000000000000000000000000000000000000000..2c4abd4ece40a9bafe5656be102474cdec180292
--- /dev/null
+++ b/src/td/td_interface_h.F90
@@ -0,0 +1,128 @@
+module td_interface_oct_m
+ use electrons_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_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(sys, from_scratch)
+ type(electrons_t), intent(inout) :: sys
+ logical, intent(inout) :: from_scratch
+ end subroutine td_run
+
+ module subroutine td_run_init()
+ end subroutine td_run_init
+
+ module subroutine td_init(sys)
+ type(electrons_t), intent(inout) :: sys
+ end subroutine td_init
+
+ module subroutine td_init_run(sys, from_scratch)
+ type(electrons_t), intent(inout) :: sys
+ logical, intent(inout) :: from_scratch
+ end subroutine td_init_run
+
+ 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)
+ 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(sys)
+ type(electrons_t), intent(inout) :: sys
+ end subroutine td_end
+
+ module subroutine td_end_run(sys)
+ type(electrons_t), intent(inout) :: sys
+ end subroutine td_end_run
+
+ 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)
+ 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