30 use,
intrinsic :: iso_fortran_env
93 type(target_t),
intent(inout) :: tg
110 type(target_t),
intent(in) :: tg
111 type(states_elec_t),
intent(inout) :: st
123 subroutine target_init(gr, kpoints, namespace, space, ions, qcs, td, w0, tg, oct, ep, mc)
124 type(grid_t),
intent(in) :: gr
125 type(kpoints_t),
intent(in) :: kpoints
126 type(namespace_t),
intent(in) :: namespace
127 class(space_t),
intent(in) :: space
128 type(ions_t),
intent(in) :: ions
129 type(opt_control_state_t),
intent(inout) :: qcs
130 type(td_t),
intent(in) :: td
131 real(real64),
intent(in) :: w0
132 type(target_t),
intent(inout) :: tg
133 type(oct_t),
intent(in) :: oct
134 type(epot_t),
intent(inout) :: ep
135 type(multicomm_t),
intent(in) :: mc
138 type(states_elec_t),
pointer :: stin
139 type(restart_t) :: restart
218 message(1) =
"Could not read gs for OCTTargetOperator."
224 select case (tg%type)
256 write(
message(1),
'(a)')
"Target Operator not properly defined."
271 type(
oct_t),
intent(in) :: oct
277 select case (tg%type)
302 subroutine target_output(tg, namespace, space, gr, dir, ions, hm, outp)
305 class(
space_t),
intent(in) :: space
306 type(
grid_t),
intent(in) :: gr
307 character(len=*),
intent(in) :: dir
308 type(
ions_t),
intent(in) :: ions
314 select case (tg%type)
350 subroutine target_tdcalc(tg, namespace, space, hm, gr, ions, ext_partners, psi, time, max_time)
353 class(
space_t),
intent(in) :: space
355 type(
grid_t),
intent(in) :: gr
356 type(
ions_t),
intent(inout) :: ions
359 integer,
intent(in) :: time
360 integer,
intent(in) :: max_time
366 tg%td_fitness(time) =
m_zero
368 select case (tg%type)
376 call target_tdcalc_hhg(tg, namespace, space, hm, gr, ions, ext_partners, psi, time)
380 message(1) =
'Error in target.target_tdcalc: default.'
393 subroutine target_inh(psi, gr, kpoints, tg, time, inh, iter)
398 real(real64),
intent(in) :: time
400 integer,
intent(in) :: iter
402 integer :: ik, ist, ip, idim, ib
403 complex(real64),
allocatable :: zpsi(:)
404 complex(real64) :: gvec(gr%box%dim)
408 safe_allocate(zpsi(1:gr%np))
410 select case (tg%type)
415 do ik = inh%d%kpt%start, inh%d%kpt%end
416 do ist = inh%st_start, inh%st_end
417 do idim = 1, inh%d%dim
419 zpsi(1:gr%np) = -psi%occ(ist, ik)*tg%rho(1:gr%np)*zpsi(1:gr%np)
426 gvec(:) = real(tg%gvec(iter + 1, :), real64)
428 do ik = inh%d%kpt%start, inh%d%kpt%end
429 do ist = inh%st_start, inh%st_end
430 do idim = 1, inh%d%dim
433 zpsi(ip) = -psi%occ(ist, ik)*
m_two*sum(tg%grad_local_pot(1, ip, 1:gr%box%dim)*gvec(:))*zpsi(ip)
442 do ik = inh%d%kpt%start, inh%d%kpt%end
443 do ist = inh%st_start, inh%st_end
444 do idim = 1, inh%d%dim
447 zpsi(ip) = -psi%occ(ist, ik)*tg%rho(ip)*zpsi(ip)
456 do ik = inh%d%kpt%start, inh%d%kpt%end
457 do ib = inh%group%block_start, inh%group%block_end
462 if (abs(nint(time/tg%dt)) >= tg%strt_iter_curr_tg)
then
463 call chi_current(tg, gr, kpoints, -1.0_real64, psi, inh)
467 write(
message(1),
'(a)')
'Internal error in target_inh'
472 safe_deallocate_a(zpsi)
484 real(real64) function
target_j1(tg, namespace, gr, kpoints, qcpsi, ions) result(j1)
487 type(
grid_t),
intent(in) :: gr
490 type(
ions_t),
optional,
intent(in) :: ions
499 select case (tg%type)
536 subroutine target_chi(tg, namespace, gr, kpoints, qcpsi_in, qcchi_out, ions)
537 type(target_t),
intent(inout) :: tg
538 type(namespace_t),
intent(in) :: namespace
539 type(grid_t),
intent(in) :: gr
540 type(kpoints_t),
intent(in) :: kpoints
541 type(opt_control_state_t),
target,
intent(inout) :: qcpsi_in
542 type(opt_control_state_t),
target,
intent(inout) :: qcchi_out
543 type(ions_t),
intent(in) :: ions
545 real(real64),
pointer :: q(:, :), p(:, :)
546 type(states_elec_t),
pointer :: psi_in, chi_out
549 psi_in => opt_control_point_qs(qcpsi_in)
550 chi_out => opt_control_point_qs(qcchi_out)
552 select case (tg%type)
553 case (oct_tg_groundstate)
555 call target_chi_groundstate(tg, gr, psi_in, chi_out)
556 case (oct_tg_excited)
557 call target_chi_excited(tg, namespace, gr, psi_in, chi_out)
558 case (oct_tg_gstransformation)
559 call target_chi_gstransformation(tg, gr, psi_in, chi_out)
560 case (oct_tg_userdefined)
561 call target_chi_userdefined(tg, gr, psi_in, chi_out)
562 case (oct_tg_jdensity)
563 call target_chi_density(tg, gr, kpoints, psi_in, chi_out)
565 call target_chi_local(tg, gr, psi_in, chi_out)
566 case (oct_tg_td_local)
567 call target_chi_tdlocal(chi_out)
568 case (oct_tg_exclude_state)
569 call target_chi_exclude(tg, gr, psi_in, chi_out)
571 call target_chi_hhg(chi_out)
573 call target_chi_hhg(chi_out)
574 case (oct_tg_velocity)
575 call target_chi_velocity(gr, tg, chi_out, ions)
576 case (oct_tg_classical)
577 call target_chi_classical(tg, qcpsi_in, qcchi_out, ions)
579 call target_chi_spin(tg, gr, psi_in, chi_out)
583 if (tg%type .ne. oct_tg_classical)
then
584 q => opt_control_point_q(qcchi_out)
585 p => opt_control_point_p(qcchi_out)
This module implements common operations on batches of mesh functions.
subroutine, public batch_set_zero(this, np, async)
fill all mesh functions of the batch with zero
real(real64), parameter, public m_two
real(real64), parameter, public m_zero
complex(real64), parameter, public m_z0
This module implements the underlying real-space grid.
This module defines classes and functions for interaction partners.
This module defines the meshes, which are used in Octopus.
character(len=256), dimension(max_lines), public message
to be output by fatal, warning
subroutine, public messages_fatal(no_lines, only_root_writes, namespace)
subroutine, public messages_input_error(namespace, var, details, row, column)
subroutine, public messages_experimental(name, namespace)
This module handles the communicators for the various parallelization strategies.
This module contains the definition of the oct_t data type, which contains some of the basic informat...
This module holds the "opt_control_state_t" datatype, which contains a quantum-classical state.
type(states_elec_t) function, pointer, public opt_control_point_qs(ocs)
this module contains the low-level part of the output system
integer, parameter, public restart_gs
subroutine, public restart_init(restart, namespace, data_type, type, mc, ierr, mesh, dir, exact)
Initializes a restart object.
integer, parameter, public restart_type_load
subroutine, public restart_end(restart)
subroutine, public states_elec_end(st)
finalize the states_elec_t object
subroutine, public states_elec_deallocate_wfns(st)
Deallocates the KS wavefunctions defined within a states_elec_t structure.
subroutine, public states_elec_allocate_wfns(st, mesh, wfs_type, skip, packed)
Allocates the KS wavefunctions defined within a states_elec_t structure.
subroutine, public states_elec_copy(stout, stin, exclude_wfns, exclude_eigenval, special)
make a (selective) copy of a states_elec_t object
real(real64) function, public target_j1_classical(tg, qcpsi)
subroutine, public target_init_classical(ions, namespace, tg, td, oct)
subroutine, public target_end_classical(tg)
subroutine, public target_output_classical
subroutine, public chi_current(tg, gr, kpoints, factor, psi_in, chi)
real(real64) function, public target_j1_density(gr, kpoints, tg, psi)
subroutine, public target_end_density(tg)
subroutine, public target_init_density(gr, kpoints, namespace, space, tg, stin, td, restart)
subroutine, public target_output_density(tg, namespace, space, mesh, dir, ions, outp)
subroutine, public target_tdcalc_density(tg, gr, kpoints, psi, time)
subroutine, public target_init_excited(mesh, namespace, space, tg, td, restart, kpoints)
subroutine, public target_output_excited(tg, namespace, space, gr, dir, ions, hm, outp)
real(real64) function, public target_j1_excited(tg, namespace, gr, psi)
subroutine, public target_init_exclude(mesh, namespace, space, tg, td, restart, kpoints)
subroutine, public target_end_exclude()
real(real64) function, public target_j1_exclude(gr, tg, psi)
subroutine, public target_output_exclude(tg, namespace, space, gr, dir, ions, hm, outp)
subroutine, public target_output_groundstate(tg, namespace, space, gr, dir, ions, hm, outp)
subroutine, public target_init_groundstate(mesh, namespace, space, tg, td, restart, kpoints)
real(real64) function, public target_j1_groundstate(tg, gr, psi)
subroutine, public target_end_hhg(tg)
subroutine, public target_init_hhg(tg, namespace, td, w0)
subroutine, public target_tdcalc_hhgnew(tg, gr, psi, time, max_time)
subroutine, public target_tdcalc_hhg(tg, namespace, space, hm, gr, ions, ext_partners, psi, time)
real(real64) function, public target_j1_hhg(tg, namespace)
subroutine, public target_init_hhgnew(gr, namespace, tg, td, ions, ep)
real(real64) function, public target_j1_hhgnew(gr, tg)
subroutine, public target_end_hhgnew(tg, oct)
subroutine, public target_output_hhg(tg, namespace, space, gr, dir, ions, hm, outp)
real(real64) function, public target_j1_local(mesh, tg, psi)
subroutine, public target_init_local(gr, namespace, tg, td)
subroutine, public target_output_local(tg, namespace, space, mesh, dir, ions, outp)
subroutine, public target_end_local(tg)
integer, parameter, public oct_tg_velocity
integer, parameter, public oct_tg_hhgnew
integer, parameter, public oct_tg_excited
integer, parameter, public oct_tg_hhg
integer pure function, public target_curr_functional(tg)
integer, parameter, public oct_tg_spin
integer pure function, public target_type(tg)
integer, parameter, public oct_targetmode_td
integer, parameter, public oct_tg_groundstate
integer, parameter, public oct_tg_classical
integer, parameter, public oct_no_curr
integer, parameter, public oct_tg_exclude_state
integer pure function, public target_mode(tg)
integer, parameter, public oct_tg_jdensity
integer, parameter, public oct_tg_gstransformation
logical pure function, public target_move_ions(tg)
integer, parameter, public oct_tg_local
integer, parameter, public oct_tg_td_local
integer, parameter, public oct_tg_userdefined
subroutine, public target_init_propagation(tg)
This routine performs all the things that must be initialized prior to a forward evolution,...
real(real64) function, public target_j1(tg, namespace, gr, kpoints, qcpsi, ions)
Calculates the J1 functional, i.e.: in the time-independent case, or else in the time-dependent cas...
subroutine, public target_init(gr, kpoints, namespace, space, ions, qcs, td, w0, tg, oct, ep, mc)
The target is initialized, mainly by reading from the inp file.
subroutine, public target_get_state(tg, st)
This just copies the states_elec_t variable present in target, into st.
subroutine, public target_inh(psi, gr, kpoints, tg, time, inh, iter)
Calculates the inhomogeneous term that appears in the equation for chi, and places it into inh.
subroutine, public target_output(tg, namespace, space, gr, dir, ions, hm, outp)
subroutine, public target_tdcalc(tg, namespace, space, hm, gr, ions, ext_partners, psi, time, max_time)
Calculates, at a given point in time marked by the integer index, the integrand of the target functio...
subroutine, public target_chi(tg, namespace, gr, kpoints, qcpsi_in, qcchi_out, ions)
Calculate .
subroutine, public target_end(tg, oct)
subroutine, public target_init_spin(tg, namespace)
real(real64) function, public target_j1_spin(tg, gr, psi)
subroutine, public target_output_tdlocal(tg, namespace, space, gr, dir, ions, outp)
subroutine, public target_init_tdlocal(gr, namespace, tg, td)
subroutine, public target_end_tdlocal(tg)
subroutine, public target_tdcalc_tdlocal(tg, gr, psi, time)
real(real64) function, public target_j1_tdlocal(tg)
subroutine, public target_build_tdlocal(tg, gr, time)
real(real64) function, public target_j1_userdefined(tg, gr, psi)
subroutine, public target_init_userdefined(gr, namespace, tg, td)
subroutine, public target_output_userdefined(tg, namespace, space, gr, dir, ions, hm, outp)
real(real64) function, public target_j1_velocity(tg, ions)
subroutine, public target_output_velocity(tg, namespace, space, gr, dir, ions, hm, outp)
subroutine, public target_tdcalc_velocity(tg, hm, gr, ions, psi, time, max_time)
subroutine, public target_init_velocity(gr, namespace, ions, tg, oct, td, ep)
subroutine, public target_end_velocity(tg, oct)
type(type_t), public type_cmplx
brief This module defines the class unit_t which is used by the unit_systems_oct_m module.
This module defines the unit system, used for input and output.
Description of the grid, containing information on derivatives, stencil, and symmetries.
!brief The oct_t datatype stores the basic information about how the OCT run is done.
This is the datatype that contains the objects that are propagated: in principle this could be both t...
The states_elec_t class contains all electronic wave functions.