Commit f1b68663 authored by Micael Oliveira's avatar Micael Oliveira

Merge branch 'improved_update' into 'develop'

Improving the update routine to avoid code and operation duplication.

See merge request !886
parents 42a1f880 2e54b3ee
Pipeline #147862252 passed with stage
in 0 seconds
......@@ -92,6 +92,7 @@ module hamiltonian_elec_oct_m
hamiltonian_elec_epot_generate, &
hamiltonian_elec_needs_current, &
hamiltonian_elec_update, &
hamiltonian_elec_update_pot, &
hamiltonian_elec_update2, &
hamiltonian_elec_get_time, &
hamiltonian_elec_apply_packed, &
......@@ -164,7 +165,7 @@ module hamiltonian_elec_oct_m
type(lda_u_t) :: lda_u
integer :: lda_u_level
logical, private :: time_zero
logical, public :: time_zero
type(exchange_operator_t), public :: exxop
type(namespace_t), pointer :: namespace
......@@ -816,49 +817,7 @@ contains
call hamiltonian_elec_base_allocate(this%hm_base, mesh, FIELD_POTENTIAL, &
complex_potential = this%bc%abtype == IMAGINARY_ABSORBING)
do ispin = 1, this%d%nspin
if(ispin <= 2) then
!$omp parallel do simd schedule(static)
do ip = 1, mesh%np
this%hm_base%potential(ip, ispin) = this%vhxc(ip, ispin) + this%ep%vpsl(ip)
end do
!> Adds PCM contributions
if (this%pcm%run_pcm) then
if (this%pcm%solute) then
!$omp parallel do simd schedule(static)
do ip = 1, mesh%np
this%hm_base%potential(ip, ispin) = this%hm_base%potential(ip, ispin) + &
this%pcm%v_e_rs(ip) + this%pcm%v_n_rs(ip)
end do
end if
if (this%pcm%localf) then
!$omp parallel do simd schedule(static)
do ip = 1, mesh%np
this%hm_base%potential(ip, ispin) = this%hm_base%potential(ip, ispin) + &
this%pcm%v_ext_rs(ip)
end do
end if
end if
if(this%bc%abtype == IMAGINARY_ABSORBING) then
!$omp parallel do simd schedule(static)
do ip = 1, mesh%np
this%hm_base%Impotential(ip, ispin) = this%hm_base%Impotential(ip, ispin) + this%bc%mf(ip)
end do
end if
else !Spinors
!$omp parallel do simd schedule(static)
do ip = 1, mesh%np
this%hm_base%potential(ip, ispin) = this%vhxc(ip, ispin)
end do
end if
end do
call hamiltonian_elec_update_pot(this, mesh, accel_copy=.false.)
! the lasers
if (present(time) .or. this%time_zero) then
......@@ -922,6 +881,9 @@ contains
end do
end if
!The electric field was added to the KS potential
call hamiltonian_elec_base_accel_copy_pot(this%hm_base, mesh)
! and the static magnetic field
if(associated(this%ep%b_field)) then
call hamiltonian_elec_base_allocate(this%hm_base, mesh, FIELD_UNIFORM_MAGNETIC_FIELD, .false.)
......@@ -1060,6 +1022,67 @@ contains
end subroutine hamiltonian_elec_update
!----------------------------------------------------------------
! Update the KS potential of the electronic Hamiltonian
subroutine hamiltonian_elec_update_pot(this, mesh, accel_copy)
type(hamiltonian_elec_t), intent(inout) :: this
type(mesh_t), intent(in) :: mesh
logical, intent(in) :: accel_copy
integer :: ispin, ip
PUSH_SUB(hamiltonian_elec_update_pot)
do ispin = 1, this%d%nspin
if(ispin <= 2) then
!$omp parallel do simd schedule(static)
do ip = 1, mesh%np
this%hm_base%potential(ip, ispin) = this%vhxc(ip, ispin) + this%ep%vpsl(ip)
end do
!> Adds PCM contributions
if (this%pcm%run_pcm) then
if (this%pcm%solute) then
!$omp parallel do simd schedule(static)
do ip = 1, mesh%np
this%hm_base%potential(ip, ispin) = this%hm_base%potential(ip, ispin) + &
this%pcm%v_e_rs(ip) + this%pcm%v_n_rs(ip)
end do
end if
if (this%pcm%localf) then
!$omp parallel do simd schedule(static)
do ip = 1, mesh%np
this%hm_base%potential(ip, ispin) = this%hm_base%potential(ip, ispin) + &
this%pcm%v_ext_rs(ip)
end do
end if
end if
if(this%bc%abtype == IMAGINARY_ABSORBING) then
!$omp parallel do simd schedule(static)
do ip = 1, mesh%np
this%hm_base%Impotential(ip, ispin) = this%hm_base%Impotential(ip, ispin) + this%bc%mf(ip)
end do
end if
else !Spinors
!$omp parallel do simd schedule(static)
do ip = 1, mesh%np
this%hm_base%potential(ip, ispin) = this%vhxc(ip, ispin)
end do
end if
end do
if(accel_copy) then
call hamiltonian_elec_base_accel_copy_pot(this%hm_base, mesh)
end if
POP_SUB(hamiltonian_elec_update_pot)
end subroutine hamiltonian_elec_update_pot
! ---------------------------------------------------------
subroutine hamiltonian_elec_epot_generate(this, namespace, gr, geo, st, time)
type(hamiltonian_elec_t), intent(inout) :: this
......@@ -1347,48 +1370,7 @@ contains
call hamiltonian_elec_base_allocate(this%hm_base, mesh, FIELD_POTENTIAL, &
complex_potential = this%bc%abtype == IMAGINARY_ABSORBING)
do ispin = 1, this%d%nspin
if(ispin <= 2) then
!$omp parallel do simd schedule(static)
do ip = 1, mesh%np
this%hm_base%potential(ip, ispin) = this%vhxc(ip, ispin) + this%ep%vpsl(ip)
end do
!> Adds PCM contributions
if (this%pcm%run_pcm) then
if (this%pcm%solute) then
!$omp parallel do simd schedule(static)
do ip = 1, mesh%np
this%hm_base%potential(ip, ispin) = this%hm_base%potential(ip, ispin) + &
this%pcm%v_e_rs(ip) + this%pcm%v_n_rs(ip)
end do
end if
if (this%pcm%localf) then
!$omp parallel do simd schedule(static)
do ip = 1, mesh%np
this%hm_base%potential(ip, ispin) = this%hm_base%potential(ip, ispin) + &
this%pcm%v_ext_rs(ip)
end do
end if
end if
if(this%bc%abtype == IMAGINARY_ABSORBING) then
!$omp parallel do simd schedule(static)
do ip = 1, mesh%np
this%hm_base%Impotential(ip, ispin) = this%hm_base%Impotential(ip, ispin) + this%bc%mf(ip)
end do
end if
else !Spinors
!$omp parallel do simd schedule(static)
do ip = 1, mesh%np
this%hm_base%potential(ip, ispin) = this%vhxc(ip, ispin)
end do
end if
end do
call hamiltonian_elec_update_pot(this, mesh, accel_copy=.false.)
do itime = 1, 2
time_ = time(itime)
......@@ -1459,6 +1441,9 @@ contains
end do
end if
!The electric field is added to the KS potential
call hamiltonian_elec_base_accel_copy_pot(this%hm_base, mesh)
! and the static magnetic field
if(associated(this%ep%b_field)) then
call hamiltonian_elec_base_allocate(this%hm_base, mesh, FIELD_UNIFORM_MAGNETIC_FIELD, .false.)
......
......@@ -75,6 +75,7 @@ module hamiltonian_elec_base_oct_m
hamiltonian_elec_base_clear, &
hamiltonian_elec_base_build_proj, &
hamiltonian_elec_base_update, &
hamiltonian_elec_base_accel_copy_pot, &
dhamiltonian_elec_base_phase, &
zhamiltonian_elec_base_phase, &
dhamiltonian_elec_base_phase_spiral, &
......@@ -283,34 +284,11 @@ contains
type(hamiltonian_elec_base_t), intent(inout) :: this
type(mesh_t), intent(in) :: mesh
integer :: ispin
integer :: offset
integer :: idir, ip
PUSH_SUB(hamiltonian_elec_base_update)
if(allocated(this%uniform_vector_potential) .and. allocated(this%vector_potential)) then
call unify_vector_potentials()
end if
if(allocated(this%potential) .and. accel_is_enabled()) then
offset = 0
do ispin = 1, this%nspin
call accel_write_buffer(this%potential_opencl, mesh%np, this%potential(:, ispin), offset = offset)
offset = offset + accel_padded_size(mesh%np)
end do
end if
POP_SUB(hamiltonian_elec_base_update)
contains
subroutine unify_vector_potentials()
integer :: idir, ip
PUSH_SUB(hamiltonian_elec_base_update.unify_vector_potentials)
! copy the uniform vector potential onto the non-uniform one
do idir = 1, mesh%sb%dim
!$omp parallel do schedule(static)
......@@ -319,13 +297,34 @@ contains
this%vector_potential(idir, ip) + this%uniform_vector_potential(idir)
end do
end do
! and deallocate
SAFE_DEALLOCATE_A(this%uniform_vector_potential)
POP_SUB(hamiltonian_elec_base_update.unify_vector_potentials)
end subroutine unify_vector_potentials
end if
POP_SUB(hamiltonian_elec_base_update)
end subroutine hamiltonian_elec_base_update
!--------------------------------------------------------
subroutine hamiltonian_elec_base_accel_copy_pot(this, mesh)
type(hamiltonian_elec_base_t), intent(inout) :: this
type(mesh_t), intent(in) :: mesh
integer :: offset, ispin
PUSH_SUB(hamiltonian_elec_base_accel_copy_pot)
if(allocated(this%potential) .and. accel_is_enabled()) then
offset = 0
do ispin = 1, this%nspin
call accel_write_buffer(this%potential_opencl, mesh%np, this%potential(:, ispin), offset = offset)
offset = offset + accel_padded_size(mesh%np)
end do
end if
POP_SUB(hamiltonian_elec_base_accel_copy_pot)
end subroutine hamiltonian_elec_base_accel_copy_pot
!--------------------------------------------------------
......
......@@ -883,7 +883,7 @@ contains
call mixing(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(hm, gr%mesh, namespace)
call hamiltonian_elec_update_pot(hm, gr%mesh, accel_copy=.true.)
case(OPTION__MIXFIELD__STATES)
......
......@@ -1236,10 +1236,10 @@ contains
hm%ep%vdw_forces(1:ks%gr%sb%dim, 1:ks%calc%geo%natoms) = CNST(0.0)
end if
if(ks%calc%time_present) then
if(ks%calc%time_present .or. hm%time_zero) then
call hamiltonian_elec_update(hm, ks%gr%mesh, namespace, time = ks%calc%time)
else
call hamiltonian_elec_update(hm, ks%gr%mesh, namespace)
call hamiltonian_elec_update_pot(hm, ks%gr%mesh, accel_copy=.true.)
end if
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment