prg_quantumdynamics_mod.F90

Go to the documentation of this file.

 
module prg_quantumdynamics_mod
  use bml
  implicit none
 
  private
  integer, parameter :: dp = kind(1.0d0)
 
 
  public::prg_kick_density, prg_kick_density_bml,&
       prg_get_sparsity_cplxmat, prg_getcharge,&
       prg_getdipole, prg_get_sparsity_realmat, prg_lvni_bml,&
       prg_excitation
 
contains
 
  subroutine prg_kick_density(kick_direc,kick_mag,dens,norbs,mdim,S,SINV,&
       which_atom,r,bmltype,thresh)
    integer                                     :: i
    integer, intent(in)                         :: kick_direc, norbs, mdim
    integer, allocatable, intent(in)            :: which_atom(:)
    real(dp), allocatable                       :: r(:,:)
    real(dp)                                    :: kick_mag, thresh
    complex(dp), allocatable, intent(inout)     :: dens(:,:)
    complex(dp), allocatable                    :: tmat1(:), tmat2(:), s(:,:), sinv(:,:)
    complex(dp)                                 :: telem
    type(bml_matrix_t)                          :: t1, t2, rho_bml, s_bml, sinv_bml
    character(len=*), intent(in)                :: bmltype
 
    allocate (tmat1(norbs))
    allocate (tmat2(norbs))
 
    do i=1,norbs
      telem = cmplx(0.0_dp,-kick_mag*r(which_atom(i),kick_direc))
      tmat1(i) = exp(telem)
      tmat2(i) = exp(-telem)
    enddo
 
    call bml_zero_matrix(bmltype, bml_element_complex,dp,norbs,mdim, t1)
    call bml_set_diagonal(t1,tmat1,thresh)
    deallocate (tmat1)
    call bml_import_from_dense(bmltype,dens,rho_bml,thresh,mdim)
    call bml_zero_matrix(bmltype, bml_element_complex,dp,norbs,mdim, t2)
    call bml_multiply(t1,rho_bml,t2)
    call bml_import_from_dense(bmltype,s,s_bml,thresh,mdim)
    call bml_multiply(t2,s_bml,rho_bml)
    call bml_deallocate(s_bml)
 
    call bml_set_diagonal(t1,tmat2,thresh)
    deallocate (tmat2)
    call bml_multiply(rho_bml,t1,t2)
    call bml_deallocate(t1)
    call bml_import_from_dense(bmltype,sinv,sinv_bml,thresh,mdim)
    call bml_multiply(t2,sinv_bml,rho_bml)
    call bml_deallocate(sinv_bml)
    call bml_deallocate(t2)
 
    call bml_export_to_dense(rho_bml,dens)
 
  end subroutine prg_kick_density
 
 
  subroutine prg_get_sparsity_cplxmat(matrix_type,element_type,thresh,a_dense)
    character(len=*), intent(in)         :: matrix_type ,element_type
    complex(dp),intent(in)               :: a_dense(:,:)
    type(bml_matrix_t)                   :: a
    real(dp),intent(in)                  :: thresh
    integer                              :: asize
    character(len=20)                    :: test_type
 
    asize=size(a_dense,1)
    call bml_import_from_dense(matrix_type, a_dense, a, thresh,asize)
    call bml_deallocate(a)
 
  end subroutine prg_get_sparsity_cplxmat
 
  subroutine prg_get_sparsity_realmat(matrix_type,element_type,thresh,a_dense)
    character(len=*), intent(in)         :: matrix_type ,element_type
    real(dp),intent(in)                  :: a_dense(:,:)
    type(bml_matrix_t)                   :: a
    real(dp),intent(in)                  :: thresh
    integer                              :: asize
 
    asize=size(a_dense,1)
    call bml_import_from_dense(matrix_type,a_dense,a,thresh,asize)
    call bml_deallocate(a)
 
  end subroutine prg_get_sparsity_realmat
 
 
  subroutine prg_kick_density_bml(kick_direc,kick_mag,rho_bml,s_bml,sinv_bml,mdim,which_atom,&
       r,matrix_type,thresh)
    integer                             :: i, norbs, mdim
    integer, intent(in)                 :: kick_direc
    integer, allocatable, intent(in)    :: which_atom(:)
    real(dp), allocatable               :: r(:,:)
    real(dp)                            :: kick_mag, thresh
    complex(dp), allocatable            :: tmat1(:), tmat2(:)
    complex(dp)                         :: telem
    type(bml_matrix_t)                  :: t1, t2, rho_bml,s_bml,sinv_bml
    character(len=*), intent(in)        :: matrix_type
 
    norbs=bml_get_n(rho_bml)
    allocate (tmat1(norbs))
    allocate (tmat2(norbs))
 
    do i=1,norbs
      telem = cmplx(0.0_dp,-kick_mag*r(which_atom(i),kick_direc))
      tmat1(i) = exp(telem)
      tmat2(i) = exp(-telem)
    enddo
 
    call bml_zero_matrix(matrix_type, bml_element_complex,dp,norbs,mdim, t1)
    call bml_zero_matrix(matrix_type, bml_element_complex,dp,norbs,mdim, t2)
    call bml_set_diagonal(t1,tmat1,thresh)
    deallocate (tmat1)
 
    call bml_multiply(t1,rho_bml,t2)
    call bml_multiply(t2,s_bml,rho_bml)
    call bml_set_diagonal(t1,tmat2,thresh)
    deallocate (tmat2)
    call bml_multiply(rho_bml,t1,t2)
    call bml_deallocate(t1)
 
    call bml_multiply(t2,sinv_bml,rho_bml)
 
    call bml_deallocate(t2)
 
  end subroutine prg_kick_density_bml
 
 
  subroutine prg_lvni_bml(h1_bml, sinv_bml, dt, hbar, rhoold_bml, rho_bml,aux_bml,matrix_type,mdim,thresh)
    integer                             :: norbs, mdim
    real(dp)                            :: hbar, dt
    type(bml_matrix_t)                  :: h1_bml, sinv_bml
    type(bml_matrix_t)                  :: rho_bml, rhoold_bml, aux_bml,aux_1
    complex(dp)                         :: dr
    real(dp), intent(in)                :: thresh
    character(len=*), intent(in)        :: matrix_type
 
    norbs=bml_get_n(rho_bml)
    dr = 2.0_dp*dt*cmplx(0.0_dp,-1.0_dp/hbar)
    call bml_multiply(h1_bml,rho_bml,aux_bml,1.0_dp,0.0_dp,thresh)
    call bml_zero_matrix(matrix_type,bml_element_complex,dp,norbs,mdim,aux_1)
    call bml_multiply(sinv_bml,aux_bml,aux_1,1.0_dp,0.0_dp,thresh)
    call bml_multiply(rho_bml,h1_bml,aux_bml,1.0_dp,0.0_dp,thresh)
    call bml_multiply(aux_bml,sinv_bml,aux_1,-1.0_dp,1.0d0)
    call bml_scale(dr,aux_1,aux_bml)
    call bml_deallocate(aux_1)
    call bml_add(aux_bml,rhoold_bml,1.0_dp,1.0_dp,thresh)
    call bml_copy(rho_bml,rhoold_bml)
    call bml_copy(aux_bml,rho_bml)
 
  end subroutine prg_lvni_bml
 
 
  subroutine prg_getcharge(rho_bml,s_bml,charges,aux_bml,z,spindex,N,nats,thresh)
    integer                               ::  i, j, k, nats,norbs
    integer, allocatable,intent(in)       ::  n(:), spindex(:)
    complex(dp),allocatable               ::  auxd(:,:)
    real(dp), allocatable                 ::  charges(:)
    real(dp), intent(in)                  ::  thresh,z(:)
    type(bml_matrix_t), intent(in)        ::  s_bml, rho_bml
    type(bml_matrix_t)                    ::  aux_bml
 
    norbs=bml_get_n(rho_bml)
    allocate(auxd(norbs,norbs))
    auxd=cmplx(0.0_dp,0.0_dp)
    if(.not.allocated(charges)) allocate(charges(nats))
    call bml_multiply(rho_bml,s_bml,aux_bml,1.0_dp,0.0_dp,thresh)
    call bml_export_to_dense(aux_bml,auxd)
    k=0
    do i = 1,nats
      charges(i)=0.0_dp
      do j = 1, n(spindex(i))
        k = k+1
        charges(i) = charges(i) + 2.0_dp*auxd(k,k)
      enddo
      charges(i) = -charges(i) + z(spindex(i))
    enddo
    deallocate(auxd)
 
  end subroutine prg_getcharge
 
 
  subroutine prg_getdipole(charges,r,mu)
    integer                  ::  i, norbs
    real(dp), intent(in)     ::  charges(:), r(:,:)
    real(dp), intent(inout)  ::  mu(3)
 
    norbs = size(charges,1)
    mu = 0.0_dp
 
    do i=1,norbs
      mu=mu+r(:,i)*charges(i)
    enddo
 
  end subroutine prg_getdipole
 
 
  !simulate
  !! photo-excitation.
  !! This routine does:
  !! Manually induces electronic excitation based on the initial filling matrix
  !! by promoting an electron.
  !! \param fill_mat the initial filling matrix
  !! \param orbit_orig the origin orbital with an electron to be promoted
  !! \param orbit_exci the destination orbital of the promoted electron
  !!
  subroutine prg_excitation(fill_mat, orbit_orig, orbit_exci)
    integer, intent(inout)      :: fill_mat(:)
    integer, intent(in)         :: orbit_orig, orbit_exci
 
    fill_mat(orbit_orig) = fill_mat(orbit_orig) - 1.0d0
    fill_mat(orbit_exci) = fill_mat(orbit_exci) + 1.0d0
 
  end subroutine prg_excitation
 
end module prg_quantumdynamics_mod