opt_control_state.F90

Go to the documentation of this file.

!! Copyright (C) 2002-2006 M. Marques, A. Castro, A. Rubio, G. Bertsch
!!
!! This program is free software; you can redistribute it and/or modify
!! it under the terms of the GNU General Public License as published by
!! the Free Software Foundation; either version 2, or (at your option)
!! any later version.
!!
!! This program is distributed in the hope that it will be useful,
!! but WITHOUT ANY WARRANTY; without even the implied warranty of
!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!! GNU General Public License for more details.
!!
!! You should have received a copy of the GNU General Public License
!! along with this program; if not, write to the Free Software
!! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
!! 02110-1301, USA.
!!
 
#include "global.h"
 
 
module opt_control_state_oct_m
  use debug_oct_m
  use global_oct_m
  use ions_oct_m
  use messages_oct_m
  use profiling_oct_m
  use states_abst_oct_m
  use states_elec_oct_m
 
  implicit none
 
  private
  public ::                    &
    opt_control_state_t,       &
    opt_control_state_init,    &
    opt_control_get_qs,        &
    opt_control_get_classical, &
    opt_control_set_classical, &
    opt_control_point_qs,      &
    opt_control_point_q,       &
    opt_control_point_p,       &
    opt_control_state_copy,    &
    opt_control_state_end,     &
    opt_control_state_null
 
 
  type opt_control_state_t
    private
    type(states_elec_t) :: psi
    real(real64), allocatable :: q(:, :)
    real(real64), allocatable :: p(:, :)
    integer :: natoms, ndim
  end type opt_control_state_t
 
contains
 
 
  subroutine opt_control_state_null(ocs)
    type(opt_control_state_t), intent(inout) :: ocs
 
    push_sub(opt_control_state_null)
 
    safe_deallocate_a(ocs%q)
    safe_deallocate_a(ocs%p)
    call ocs%psi%nullify()
 
    pop_sub(opt_control_state_null)
  end subroutine opt_control_state_null
 
 
  function opt_control_point_qs(ocs)
    type(opt_control_state_t), target, intent(in) :: ocs
    type(states_elec_t), pointer :: opt_control_point_qs
 
    push_sub(opt_control_point_qs)
 
    opt_control_point_qs => ocs%psi
 
    pop_sub(opt_control_point_qs)
  end function opt_control_point_qs
 
  function opt_control_point_q(ocs)
    type(opt_control_state_t), target, intent(in) :: ocs
    real(real64), pointer :: opt_control_point_q(:, :)
 
    push_sub(opt_control_point_q)
 
    opt_control_point_q => ocs%q
 
    pop_sub(opt_control_point_q)
  end function opt_control_point_q
 
  function opt_control_point_p(ocs)
    type(opt_control_state_t), target, intent(in) :: ocs
    real(real64), pointer :: opt_control_point_p(:, :)
 
    push_sub(opt_control_point_p)
 
    opt_control_point_p => ocs%p
 
    pop_sub(opt_control_point_p)
  end function opt_control_point_p
 
  subroutine opt_control_get_qs(qstate, ocs)
    type(states_elec_t),       intent(inout) :: qstate
    type(opt_control_state_t), intent(in)    :: ocs
 
    push_sub(opt_control_get_qs)
 
    call states_elec_copy(qstate, ocs%psi)
 
    pop_sub(opt_control_get_qs)
  end subroutine opt_control_get_qs
 
  subroutine opt_control_get_classical(ions, ocs)
    type(ions_t),              intent(inout) :: ions
    type(opt_control_state_t), intent(in)    :: ocs
 
    integer :: idim, iatom
 
    push_sub(opt_control_get_classical)
 
    do idim = 1, ions%space%dim
      do iatom = 1, ions%natoms
        ions%pos(idim, iatom) = ocs%q(iatom, idim)
        ions%vel(idim, iatom) = ocs%p(iatom, idim) / ions%mass(iatom)
      end do
    end do
 
    pop_sub(opt_control_get_classical)
  end subroutine opt_control_get_classical
 
  subroutine opt_control_set_classical(ions, ocs)
    type(ions_t),              intent(inout) :: ions
    type(opt_control_state_t), intent(inout) :: ocs
 
    integer :: idim, iatom
 
    push_sub(opt_control_set_classical)
 
    do idim = 1, ions%space%dim
      do iatom = 1, ions%natoms
        ocs%q(iatom, idim) = ions%pos(idim, iatom)
        ocs%p(iatom, idim) = ions%vel(idim, iatom) * ions%mass(iatom)
      end do
    end do
 
    pop_sub(opt_control_set_classical)
  end subroutine opt_control_set_classical
 
  subroutine opt_control_state_init(ocs, qstate, ions)
    type(opt_control_state_t), intent(inout) :: ocs
    type(states_elec_t),       intent(in)    :: qstate
    type(ions_t),              intent(in)    :: ions
 
    integer :: iatom, idim
 
    push_sub(opt_control_state_init)
 
    call states_elec_copy(ocs%psi, qstate)
 
    safe_deallocate_a(ocs%q)
    safe_deallocate_a(ocs%p)
 
    ocs%ndim   = ions%space%dim
    ocs%natoms = ions%natoms
 
    safe_allocate(ocs%q(1:ocs%natoms, 1:ocs%ndim))
    safe_allocate(ocs%p(1:ocs%natoms, 1:ocs%ndim))
 
    do idim = 1, ions%space%dim
      do iatom = 1, ions%natoms
        ocs%q(iatom, idim) = ions%pos(idim, iatom)
        ocs%p(iatom, idim) = ions%mass(iatom) * ions%vel(idim, iatom)
      end do
    end do
 
    pop_sub(opt_control_state_init)
  end subroutine opt_control_state_init
 
  subroutine opt_control_state_end(ocs)
    type(opt_control_state_t), intent(inout) :: ocs
 
    push_sub(opt_control_state_end)
 
    call states_elec_end(ocs%psi)
 
    safe_deallocate_a(ocs%q)
    safe_deallocate_a(ocs%p)
 
    pop_sub(opt_control_state_end)
  end subroutine opt_control_state_end
 
  subroutine opt_control_state_copy(ocsout, ocsin)
    type(opt_control_state_t), intent(in)    :: ocsin
    type(opt_control_state_t), intent(inout) :: ocsout
 
    push_sub(opt_control_state_copy)
 
    call states_elec_end(ocsout%psi)
    call states_elec_copy(ocsout%psi, ocsin%psi)
    ocsout%ndim = ocsin%ndim
    ocsout%natoms = ocsin%natoms
    safe_deallocate_a(ocsout%q)
    safe_deallocate_a(ocsout%p)
    if (allocated(ocsin%q)) then
      safe_allocate(ocsout%q(1:ocsout%natoms, 1:ocsout%ndim))
      ocsout%q = ocsin%q
    end if
    if (allocated(ocsin%p)) then
      safe_allocate(ocsout%p(1:ocsout%natoms, 1:ocsout%ndim))
      ocsout%p = ocsin%p
    end if
 
    pop_sub(opt_control_state_copy)
  end subroutine opt_control_state_copy
 
end module opt_control_state_oct_m