mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-06-02 02:35:18 +02:00
156 lines
3.9 KiB
Fortran
156 lines
3.9 KiB
Fortran
|
||
! ---
|
||
|
||
subroutine get_delta_bitc_right(psidet, psicoef, ndet, Nint, delta)
|
||
|
||
BEGIN_DOC
|
||
!
|
||
! delta(I) = < I_left | H_TC - H | Psi_right >
|
||
!
|
||
END_DOC
|
||
|
||
use bitmasks
|
||
|
||
implicit none
|
||
|
||
integer, intent(in) :: ndet, Nint
|
||
double precision, intent(in) :: psicoef(ndet)
|
||
integer(bit_kind), intent(in) :: psidet(Nint,2,ndet)
|
||
double precision, intent(out) :: delta(ndet)
|
||
|
||
integer :: i, j
|
||
double precision :: h_mono, h_twoe, h_tot
|
||
double precision :: htc_mono, htc_twoe, htc_three, htc_tot
|
||
double precision :: delta_mat
|
||
|
||
print *, ' get_delta_bitc_right ...'
|
||
|
||
i = 1
|
||
j = 1
|
||
call htilde_mu_mat_bi_ortho(psidet(1,1,i), psidet(1,1,j), Nint, htc_mono, htc_twoe, htc_three, htc_tot)
|
||
call hmat_bi_ortho (psidet(1,1,i), psidet(1,1,j), Nint, h_mono, h_twoe, h_tot)
|
||
|
||
delta = 0.d0
|
||
!$OMP PARALLEL DO DEFAULT(NONE) SCHEDULE(dynamic,8) &
|
||
!$OMP SHARED(delta, ndet, psidet, psicoef, Nint) &
|
||
!$OMP PRIVATE(i, j, delta_mat, h_mono, h_twoe, h_tot, &
|
||
!$OMP htc_mono, htc_twoe, htc_three, htc_tot)
|
||
do i = 1, ndet
|
||
do j = 1, ndet
|
||
|
||
! < I | Htilde | J >
|
||
call htilde_mu_mat_bi_ortho(psidet(1,1,i), psidet(1,1,j), Nint, htc_mono, htc_twoe, htc_three, htc_tot)
|
||
! < I | H | J >
|
||
call hmat_bi_ortho(psidet(1,1,i), psidet(1,1,j), Nint, h_mono, h_twoe, h_tot)
|
||
|
||
delta_mat = htc_tot - h_tot
|
||
|
||
delta(i) = delta(i) + psicoef(j) * delta_mat
|
||
enddo
|
||
enddo
|
||
!$OMP END PARALLEL DO
|
||
|
||
end subroutine get_delta_bitc_right
|
||
|
||
! ---
|
||
|
||
subroutine get_htc_bitc_right(psidet, psicoef, ndet, Nint, delta)
|
||
|
||
BEGIN_DOC
|
||
!
|
||
! delta(I) = < I_left | H_TC | Psi_right >
|
||
!
|
||
END_DOC
|
||
|
||
use bitmasks
|
||
|
||
implicit none
|
||
|
||
integer, intent(in) :: ndet, Nint
|
||
double precision, intent(in) :: psicoef(ndet)
|
||
integer(bit_kind), intent(in) :: psidet(Nint,2,ndet)
|
||
double precision, intent(out) :: delta(ndet)
|
||
|
||
integer :: i, j
|
||
double precision :: htc_mono, htc_twoe, htc_three, htc_tot
|
||
|
||
print *, ' get_htc_bitc_right ...'
|
||
|
||
i = 1
|
||
j = 1
|
||
call htilde_mu_mat_bi_ortho(psidet(1,1,i), psidet(1,1,j), Nint, htc_mono, htc_twoe, htc_three, htc_tot)
|
||
|
||
delta = 0.d0
|
||
!$OMP PARALLEL DO DEFAULT(NONE) SCHEDULE(dynamic,8) &
|
||
!$OMP SHARED(delta, ndet, psidet, psicoef, Nint) &
|
||
!$OMP PRIVATE(i, j, htc_mono, htc_twoe, htc_three, htc_tot)
|
||
do i = 1, ndet
|
||
do j = 1, ndet
|
||
|
||
! < I | Htilde | J >
|
||
call htilde_mu_mat_bi_ortho(psidet(1,1,i), psidet(1,1,j), Nint, htc_mono, htc_twoe, htc_three, htc_tot)
|
||
|
||
delta(i) = delta(i) + psicoef(j) * htc_tot
|
||
enddo
|
||
enddo
|
||
!$OMP END PARALLEL DO
|
||
|
||
end subroutine get_htc_bitc_right
|
||
|
||
! ---
|
||
|
||
subroutine get_h_bitc_right(psidet, psicoef, ndet, Nint, delta)
|
||
|
||
BEGIN_DOC
|
||
!
|
||
! delta(I) = < I_left | H | Psi_right >
|
||
!
|
||
END_DOC
|
||
|
||
use bitmasks
|
||
|
||
implicit none
|
||
|
||
integer, intent(in) :: ndet, Nint
|
||
double precision, intent(in) :: psicoef(ndet)
|
||
integer(bit_kind), intent(in) :: psidet(Nint,2,ndet)
|
||
double precision, intent(out) :: delta(ndet)
|
||
|
||
integer :: i, j
|
||
double precision :: h_mono, h_twoe, h_tot
|
||
|
||
print *, ' get_h_bitc_right ...'
|
||
|
||
i = 1
|
||
j = 1
|
||
call hmat_bi_ortho(psidet(1,1,i), psidet(1,1,j), Nint, h_mono, h_twoe, h_tot)
|
||
|
||
!double precision :: norm
|
||
!norm = 0.d0
|
||
!do i = 1, ndet
|
||
! norm += psicoef(i) * psicoef(i)
|
||
!enddo
|
||
!print*, ' norm = ', norm
|
||
|
||
call hmat_bi_ortho(psidet(1,1,i), psidet(1,1,j), Nint, h_mono, h_twoe, h_tot)
|
||
|
||
delta = 0.d0
|
||
! !$OMP PARALLEL DO DEFAULT(NONE) SCHEDULE(dynamic,8) &
|
||
! !$OMP SHARED(delta, ndet, psidet, psicoef, Nint) &
|
||
! !$OMP PRIVATE(i, j, h_mono, h_twoe, h_tot)
|
||
do i = 1, ndet
|
||
do j = 1, ndet
|
||
|
||
! < I | H | J >
|
||
call hmat_bi_ortho(psidet(1,1,i), psidet(1,1,j), Nint, h_mono, h_twoe, h_tot)
|
||
|
||
delta(i) = delta(i) + psicoef(j) * h_tot
|
||
enddo
|
||
enddo
|
||
! !$OMP END PARALLEL DO
|
||
|
||
end subroutine get_h_bitc_right
|
||
|
||
! ---
|
||
|