LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-22 03:23:29 +01:00
Code Releases Activity

clarified the TC-CASSCF gradients

Browse Source
This commit is contained in:
eginer 2023-08-10 15:53:35 +02:00
parent 1a2632c280
commit ee2c470054
3 changed files with 45 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
src/casscf_tc_bi/grad_dm.irp.f
View File

@ -24,8 +24,7 @@
do a=1,n_virt_orb do a=1,n_virt_orb
indx = mat_idx_c_v(i,a) indx = mat_idx_c_v(i,a)
aa=list_virt(a) aa=list_virt(a)
call gradvec_tc_ia(ii,aa,res_l) call gradvec_tc_ia(ii,aa,res_l,res_r)
call gradvec_tc_ia(aa,ii,res_r)
do fff = 0,3 do fff = 0,3
gradvec_tc_l(fff,indx)=res_l(fff) gradvec_tc_l(fff,indx)=res_l(fff)
gradvec_tc_r(fff,indx)=res_r(fff) gradvec_tc_r(fff,indx)=res_r(fff)
@ -41,17 +40,21 @@
end do end do
END_PROVIDER END_PROVIDER
subroutine gradvec_tc_ia(i,a,res) subroutine gradvec_tc_ia(i,a,res_l, res_r)
implicit none implicit none
BEGIN_DOC BEGIN_DOC
! doubly occupied --> virtual TC gradient ! doubly occupied --> virtual TC gradient
! !
! Corresponds to <X0|H E_i^a|Phi_0> ! Corresponds to res_r = <X0|H E_i^a|Phi_0>,
!
! res_l = <X0|E_a^i H|Phi_0>
END_DOC END_DOC
integer, intent(in) :: i,a integer, intent(in) :: i,a
double precision, intent(out) :: res(0:3) double precision, intent(out) :: res_l(0:3), res_r(0:3)
res = 0.d0 res_l = 0.d0
res(1) = -2 * mo_bi_ortho_tc_one_e(i,a) res_r = 0.d0
res_l(1) = -2 * mo_bi_ortho_tc_one_e(a,i)
res_r(1) = -2 * mo_bi_ortho_tc_one_e(i,a)
end end

42
src/casscf_tc_bi/grad_old.irp.f
View File

@ -69,45 +69,51 @@ END_PROVIDER
subroutine calc_grad_elem_h_tc(ihole,ipart,res_l, res_r) subroutine calc_grad_elem_h_tc(ihole,ipart,res_l, res_r)
BEGIN_DOC BEGIN_DOC
! eq 18 of Siegbahn et al, Physica Scripta 1980 ! Computes the gradient with respect to orbital rotation BRUT FORCE
! we calculate res_r = <Phi| H^tc E_pq | Psi>, and res_r = <Phi| E_qp H^tc | Psi> !
! q=hole, p=particle ! res_l = <Chi| E_qp H^tc | Phi>
! res_l(0) = total matrix element !
! res_l(1) = one-electron part ! res_r = <Chi| H^tc E_pq | Phi>
! res_l(2) = two-electron part !
! res_l(3) = three-electron part ! q=hole, p=particle. NOTE that on res_l it is E_qp and on res_r it is E_pq
!
! res_l(0) = total matrix element, res_l(1) = one-electron part,
!
! res_l(2) = two-electron part, res_l(3) = three-electron part
!
END_DOC END_DOC
implicit none implicit none
integer, intent(in) :: ihole,ipart integer, intent(in) :: ihole,ipart
double precision, intent(out) :: res_l(0:3), res_r(0:3) double precision, intent(out) :: res_l(0:3), res_r(0:3)
integer :: mu,iii,ispin,ierr,nu,istate,ll integer :: mu,iii,ispin,ierr,nu,istate,ll
integer(bit_kind), allocatable :: det_mu(:,:),det_mu_ex(:,:) integer(bit_kind), allocatable :: det_mu(:,:),det_mu_ex(:,:)
real*8 :: i_H_chi_array(0:3,N_states),i_H_phi_array(0:3,N_states),phase real*8 :: chi_H_mu_ex_array(0:3,N_states),mu_ex_H_phi_array(0:3,N_states),phase
allocate(det_mu(N_int,2)) allocate(det_mu(N_int,2))
allocate(det_mu_ex(N_int,2)) allocate(det_mu_ex(N_int,2))
res_l=0.D0 res_l=0.D0
res_r=0.D0 res_r=0.D0
! print*,'in i_h_psi'
! print*,ihole,ipart
do mu=1,n_det do mu=1,n_det
! get the string of the determinant ! get the string of the determinant |mu>
call det_extract(det_mu,mu,N_int) call det_extract(det_mu,mu,N_int)
do ispin=1,2 do ispin=1,2
! do the monoexcitation on it ! do the monoexcitation on it: |det_mu_ex> = a^dagger_{p,ispin} a_{q,ispin} |mu>
call det_copy(det_mu,det_mu_ex,N_int) call det_copy(det_mu,det_mu_ex,N_int)
call do_signed_mono_excitation(det_mu,det_mu_ex,nu & call do_signed_mono_excitation(det_mu,det_mu_ex,nu &
,ihole,ipart,ispin,phase,ierr) ,ihole,ipart,ispin,phase,ierr)
! |det_mu_ex> = a^dagger_{p,ispin} a_{q,ispin} |mu>
if (ierr.eq.1) then if (ierr.eq.1) then
call i_H_tc_psi_phi(det_mu_ex,psi_det,psi_l_coef_bi_ortho,psi_r_coef_bi_ortho,N_int & call i_H_tc_psi_phi(det_mu_ex,psi_det,psi_l_coef_bi_ortho,psi_r_coef_bi_ortho,N_int &
,N_det,psi_det_size,N_states,i_H_chi_array,i_H_phi_array) ,N_det,psi_det_size,N_states,chi_H_mu_ex_array,mu_ex_H_phi_array)
! print*,i_H_chi_array(1,1),i_H_phi_array(1,1) ! chi_H_mu_ex_array = <Chi|H E_qp |mu >
! mu_ex_H_phi_array = <mu |E_qp H |Phi>
do istate=1,N_states do istate=1,N_states
do ll = 0,3 do ll = 0,3 ! loop over the body components (1e,2e,3e)
res_l(ll)+=i_H_phi_array(ll,istate)*psi_l_coef_bi_ortho(mu,istate)*phase !res_l = \sum_mu c_mu^l <mu|E_qp H |Phi> = <Chi|E_qp H |Phi>
res_r(ll)+=i_H_chi_array(ll,istate)*psi_r_coef_bi_ortho(mu,istate)*phase res_l(ll)+= mu_ex_H_phi_array(ll,istate)*psi_l_coef_bi_ortho(mu,istate)*phase
!res_r = \sum_mu c_mu^r <Chi|H E_qp |mu> = <Chi|H E_qp |Phi>
res_r(ll)+= chi_H_mu_ex_array(ll,istate)*psi_r_coef_bi_ortho(mu,istate)*phase
enddo enddo
end do end do
end if end if

22
src/tc_bi_ortho/h_tc_bi_ortho_psi.irp.f
View File

@ -90,7 +90,7 @@ subroutine htcdag_bi_ortho_calc_tdav_slow(v, u, N_st, sze)
end end
subroutine i_H_tc_psi_phi(key,keys,coef_l,coef_r,Nint,Ndet,Ndet_max,Nstate,i_H_chi_array,i_H_phi_array) subroutine i_H_tc_psi_phi(key,keys,coef_l,coef_r,Nint,Ndet,Ndet_max,Nstate,chi_H_i_array,i_H_phi_array)
use bitmasks use bitmasks
implicit none implicit none
BEGIN_DOC BEGIN_DOC
@ -116,7 +116,7 @@ subroutine i_H_tc_psi_phi(key,keys,coef_l,coef_r,Nint,Ndet,Ndet_max,Nstate,i_H_c
integer(bit_kind), intent(in) :: keys(Nint,2,Ndet) integer(bit_kind), intent(in) :: keys(Nint,2,Ndet)
integer(bit_kind), intent(in) :: key(Nint,2) integer(bit_kind), intent(in) :: key(Nint,2)
double precision, intent(in) :: coef_l(Ndet_max,Nstate),coef_r(Ndet_max,Nstate) double precision, intent(in) :: coef_l(Ndet_max,Nstate),coef_r(Ndet_max,Nstate)
double precision, intent(out) :: i_H_chi_array(0:3,Nstate),i_H_phi_array(0:3,Nstate) double precision, intent(out) :: chi_H_i_array(0:3,Nstate),i_H_phi_array(0:3,Nstate)
integer :: i, ii,j integer :: i, ii,j
double precision :: phase double precision :: phase
@ -131,7 +131,7 @@ subroutine i_H_tc_psi_phi(key,keys,coef_l,coef_r,Nint,Ndet,Ndet_max,Nstate,i_H_c
ASSERT (Ndet_max >= Ndet) ASSERT (Ndet_max >= Ndet)
allocate(idx(0:Ndet)) allocate(idx(0:Ndet))
i_H_chi_array = 0.d0 chi_H_i_array = 0.d0
i_H_phi_array = 0.d0 i_H_phi_array = 0.d0
call filter_connected_i_H_psi0(keys,key,Nint,Ndet,idx) call filter_connected_i_H_psi0(keys,key,Nint,Ndet,idx)
@ -142,10 +142,10 @@ subroutine i_H_tc_psi_phi(key,keys,coef_l,coef_r,Nint,Ndet,Ndet_max,Nstate,i_H_c
! computes <Chi|H_tc|i> ! computes <Chi|H_tc|i>
!DIR$ FORCEINLINE !DIR$ FORCEINLINE
call htilde_mu_mat_opt_bi_ortho(keys(1,1,i), key, Nint, hmono, htwoe, hthree, htot) call htilde_mu_mat_opt_bi_ortho(keys(1,1,i), key, Nint, hmono, htwoe, hthree, htot)
i_H_chi_array(0,1) = i_H_chi_array(0,1) + coef_l(i,1)*htot chi_H_i_array(0,1) = chi_H_i_array(0,1) + coef_l(i,1)*htot
i_H_chi_array(1,1) = i_H_chi_array(1,1) + coef_l(i,1)*hmono chi_H_i_array(1,1) = chi_H_i_array(1,1) + coef_l(i,1)*hmono
i_H_chi_array(2,1) = i_H_chi_array(2,1) + coef_l(i,1)*htwoe chi_H_i_array(2,1) = chi_H_i_array(2,1) + coef_l(i,1)*htwoe
i_H_chi_array(3,1) = i_H_chi_array(3,1) + coef_l(i,1)*hthree chi_H_i_array(3,1) = chi_H_i_array(3,1) + coef_l(i,1)*hthree
! computes <i|H_tc|Phi> ! computes <i|H_tc|Phi>
!DIR$ FORCEINLINE !DIR$ FORCEINLINE
call htilde_mu_mat_opt_bi_ortho(key,keys(1,1,i), Nint, hmono, htwoe, hthree, htot) call htilde_mu_mat_opt_bi_ortho(key,keys(1,1,i), Nint, hmono, htwoe, hthree, htot)
@ -163,10 +163,10 @@ subroutine i_H_tc_psi_phi(key,keys,coef_l,coef_r,Nint,Ndet,Ndet_max,Nstate,i_H_c
!DIR$ FORCEINLINE !DIR$ FORCEINLINE
call htilde_mu_mat_opt_bi_ortho(keys(1,1,i), key, Nint, hmono, htwoe, hthree, htot) call htilde_mu_mat_opt_bi_ortho(keys(1,1,i), key, Nint, hmono, htwoe, hthree, htot)
do j = 1, Nstate do j = 1, Nstate
i_H_chi_array(0,j) = i_H_chi_array(0,j) + coef_l(i,j)*htot chi_H_i_array(0,j) = chi_H_i_array(0,j) + coef_l(i,j)*htot
i_H_chi_array(1,j) = i_H_chi_array(1,j) + coef_l(i,j)*hmono chi_H_i_array(1,j) = chi_H_i_array(1,j) + coef_l(i,j)*hmono
i_H_chi_array(2,j) = i_H_chi_array(2,j) + coef_l(i,j)*htwoe chi_H_i_array(2,j) = chi_H_i_array(2,j) + coef_l(i,j)*htwoe
i_H_chi_array(3,j) = i_H_chi_array(3,j) + coef_l(i,j)*hthree chi_H_i_array(3,j) = chi_H_i_array(3,j) + coef_l(i,j)*hthree
enddo enddo
! computes <i|H_tc|Phi> ! computes <i|H_tc|Phi>
!DIR$ FORCEINLINE !DIR$ FORCEINLINE