LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-06-26 06:22:04 +02:00
Code Releases Activity

fixed a bug in psi_selectors_coef

Browse Source
This commit is contained in:
eginer 2023-08-07 16:56:10 +02:00
parent c6b50d5f50
commit c945e027c0
3 changed files with 36 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/cipsi_tc_bi_ortho/get_d0_good.irp.f
View File

@ -53,7 +53,7 @@ subroutine get_d0_new(gen, phasemask, bannedOrb, banned, mat_l, mat_r, mask, h,
if (hij == (0.d0,0.d0)) cycle
!DIR$ LOOP COUNT AVG(4)
do k=1,N_states
mat_r(k, p1, p2) = mat_r(k, p1, p2) + coefs(k,1) * hij ! HOTSPOT
mat_r(k, p1, p2) = mat_r(k, p1, p2) + coefs(k,2) * hij ! HOTSPOT
enddo
end do
!!!!!!!!!! <phi|H|alpha>
@ -72,7 +72,7 @@ subroutine get_d0_new(gen, phasemask, bannedOrb, banned, mat_l, mat_r, mask, h,
if (hji == (0.d0,0.d0)) cycle
!DIR$ LOOP COUNT AVG(4)
do k=1,N_states
mat_l(k, p1, p2) = mat_l(k, p1, p2) + coefs(k,2) * hji ! HOTSPOT
mat_l(k, p1, p2) = mat_l(k, p1, p2) + coefs(k,1) * hji ! HOTSPOT
enddo
end do
end do
@ -109,7 +109,7 @@ subroutine get_d0_new(gen, phasemask, bannedOrb, banned, mat_l, mat_r, mask, h,
end if
!DIR$ LOOP COUNT AVG(4)
do k=1,N_states
mat_r(k, puti, putj) = mat_r(k, puti, putj) + coefs(k,1) * hij
mat_r(k, puti, putj) = mat_r(k, puti, putj) + coefs(k,2) * hij
enddo
end do
@ -128,7 +128,7 @@ subroutine get_d0_new(gen, phasemask, bannedOrb, banned, mat_l, mat_r, mask, h,
end if
!DIR$ LOOP COUNT AVG(4)
do k=1,N_states
mat_l(k, puti, putj) = mat_l(k, puti, putj) + coefs(k,2) * hji
mat_l(k, puti, putj) = mat_l(k, puti, putj) + coefs(k,1) * hji
enddo
end do
end do

36
src/cipsi_tc_bi_ortho/get_d1_good.irp.f
View File

@ -76,7 +76,7 @@ subroutine get_d1_new(gen, phasemask, bannedOrb, banned, mat_l, mat_r, mask, h,
hij = hij * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2, N_int)
!DIR$ LOOP COUNT AVG(4)
do k=1,N_states
tmp_rowij(k,putj) = tmp_rowij(k,putj) + hij * coefs(k,1)
tmp_rowij(k,putj) = tmp_rowij(k,putj) + hij * coefs(k,2)
enddo
endif
end do
@ -88,7 +88,7 @@ subroutine get_d1_new(gen, phasemask, bannedOrb, banned, mat_l, mat_r, mask, h,
hij = hij * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2, N_int)
!DIR$ LOOP COUNT AVG(4)
do k=1,N_states
tmp_rowij(k,putj) = tmp_rowij(k,putj) + hij * coefs(k,1)
tmp_rowij(k,putj) = tmp_rowij(k,putj) + hij * coefs(k,2)
enddo
endif
end do
@ -114,7 +114,7 @@ subroutine get_d1_new(gen, phasemask, bannedOrb, banned, mat_l, mat_r, mask, h,
hji = hji * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2, N_int)
!DIR$ LOOP COUNT AVG(4)
do k=1,N_states
tmp_rowji(k,putj) = tmp_rowji(k,putj) + hji * coefs(k,2)
tmp_rowji(k,putj) = tmp_rowji(k,putj) + hji * coefs(k,1)
enddo
endif
end do
@ -126,7 +126,7 @@ subroutine get_d1_new(gen, phasemask, bannedOrb, banned, mat_l, mat_r, mask, h,
hji = hji * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2, N_int)
!DIR$ LOOP COUNT AVG(4)
do k=1,N_states
tmp_rowji(k,putj) = tmp_rowji(k,putj) + hji * coefs(k,2)
tmp_rowji(k,putj) = tmp_rowji(k,putj) + hji * coefs(k,1)
enddo
endif
end do
@ -169,7 +169,7 @@ subroutine get_d1_new(gen, phasemask, bannedOrb, banned, mat_l, mat_r, mask, h,
hij = hij * get_phase_bi(phasemask, ma, mi, hfix, p2, puti, pfix, N_int)
!DIR$ LOOP COUNT AVG(4)
do k=1,N_states
tmp_rowij(k,puti) = tmp_rowij(k,puti) + hij * coefs(k,1)
tmp_rowij(k,puti) = tmp_rowij(k,puti) + hij * coefs(k,2)
enddo
endif
end if
@ -180,7 +180,7 @@ subroutine get_d1_new(gen, phasemask, bannedOrb, banned, mat_l, mat_r, mask, h,
if (hij /= 0.d0) then
hij = hij * get_phase_bi(phasemask, ma, mi, hfix, p1, puti, pfix, N_int)
do k=1,N_states
tmp_rowij2(k,puti) = tmp_rowij2(k,puti) + hij * coefs(k,1)
tmp_rowij2(k,puti) = tmp_rowij2(k,puti) + hij * coefs(k,2)
enddo
endif
end if
@ -211,7 +211,7 @@ subroutine get_d1_new(gen, phasemask, bannedOrb, banned, mat_l, mat_r, mask, h,
hji = hji * get_phase_bi(phasemask, ma, mi, hfix, p2, puti, pfix, N_int)
!DIR$ LOOP COUNT AVG(4)
do k=1,N_states
tmp_rowji(k,puti) = tmp_rowji(k,puti) + hji * coefs(k,2)
tmp_rowji(k,puti) = tmp_rowji(k,puti) + hji * coefs(k,1)
enddo
endif
end if
@ -222,7 +222,7 @@ subroutine get_d1_new(gen, phasemask, bannedOrb, banned, mat_l, mat_r, mask, h,
if (hji /= 0.d0) then
hji = hji * get_phase_bi(phasemask, ma, mi, hfix, p1, puti, pfix, N_int)
do k=1,N_states
tmp_rowji2(k,puti) = tmp_rowji2(k,puti) + hji * coefs(k,2)
tmp_rowji2(k,puti) = tmp_rowji2(k,puti) + hji * coefs(k,1)
enddo
endif
end if
@ -265,7 +265,7 @@ subroutine get_d1_new(gen, phasemask, bannedOrb, banned, mat_l, mat_r, mask, h,
hij = hij_cache(putj,1) - hij_cache(putj,2)
if (hij /= 0.d0) then
hij = hij * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2, N_int)
tmp_rowij(:,putj) = tmp_rowij(:,putj) + hij * coefs(:,1)
tmp_rowij(:,putj) = tmp_rowij(:,putj) + hij * coefs(:,2)
endif
end do
do putj=hfix+1,mo_num
@ -274,7 +274,7 @@ subroutine get_d1_new(gen, phasemask, bannedOrb, banned, mat_l, mat_r, mask, h,
hij = hij_cache(putj,2) - hij_cache(putj,1)
if (hij /= 0.d0) then
hij = hij * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2, N_int)
tmp_rowij(:,putj) = tmp_rowij(:,putj) + hij * coefs(:,1)
tmp_rowij(:,putj) = tmp_rowij(:,putj) + hij * coefs(:,2)
endif
end do
@ -293,7 +293,7 @@ subroutine get_d1_new(gen, phasemask, bannedOrb, banned, mat_l, mat_r, mask, h,
hji = hji_cache(putj,1) - hji_cache(putj,2)
if (hji /= 0.d0) then
hji = hji * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2, N_int)
tmp_rowji(:,putj) = tmp_rowji(:,putj) + hji * coefs(:,2)
tmp_rowji(:,putj) = tmp_rowji(:,putj) + hji * coefs(:,1)
endif
end do
do putj=hfix+1,mo_num
@ -302,7 +302,7 @@ subroutine get_d1_new(gen, phasemask, bannedOrb, banned, mat_l, mat_r, mask, h,
hji = hji_cache(putj,2) - hji_cache(putj,1)
if (hji /= 0.d0) then
hji = hji * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2, N_int)
tmp_rowji(:,putj) = tmp_rowji(:,putj) + hji * coefs(:,2)
tmp_rowji(:,putj) = tmp_rowji(:,putj) + hji * coefs(:,1)
endif
end do
@ -342,7 +342,7 @@ subroutine get_d1_new(gen, phasemask, bannedOrb, banned, mat_l, mat_r, mask, h,
hij = hij * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p1, N_int)
!DIR$ LOOP COUNT AVG(4)
do k=1,N_states
tmp_rowij(k,puti) = tmp_rowij(k,puti) + hij * coefs(k,1)
tmp_rowij(k,puti) = tmp_rowij(k,puti) + hij * coefs(k,2)
enddo
endif
end if
@ -353,7 +353,7 @@ subroutine get_d1_new(gen, phasemask, bannedOrb, banned, mat_l, mat_r, mask, h,
if (hij /= 0.d0) then
hij = hij * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p2, N_int)
do k=1,N_states
tmp_rowij2(k,puti) = tmp_rowij2(k,puti) + hij * coefs(k,1)
tmp_rowij2(k,puti) = tmp_rowij2(k,puti) + hij * coefs(k,2)
enddo
endif
end if
@ -385,7 +385,7 @@ subroutine get_d1_new(gen, phasemask, bannedOrb, banned, mat_l, mat_r, mask, h,
hji = hji * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p1, N_int)
!DIR$ LOOP COUNT AVG(4)
do k=1,N_states
tmp_rowji(k,puti) = tmp_rowji(k,puti) + hji * coefs(k,2)
tmp_rowji(k,puti) = tmp_rowji(k,puti) + hji * coefs(k,1)
enddo
endif
end if
@ -396,7 +396,7 @@ subroutine get_d1_new(gen, phasemask, bannedOrb, banned, mat_l, mat_r, mask, h,
if (hji /= 0.d0) then
hji = hji * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p2, N_int)
do k=1,N_states
tmp_rowji2(k,puti) = tmp_rowji2(k,puti) + hji * coefs(k,2)
tmp_rowji2(k,puti) = tmp_rowji2(k,puti) + hji * coefs(k,1)
enddo
endif
end if
@ -445,8 +445,8 @@ subroutine get_d1_new(gen, phasemask, bannedOrb, banned, mat_l, mat_r, mask, h,
do k=1,N_states
! take conjugate to get contribution to <alpha|H|psi> instead of <psi|H|alpha>
! mat_r(k, p1, p2) = mat_r(k, p1, p2) + coefs(k,1) * dconjg(hij)
mat_r(k, p1, p2) = mat_r(k, p1, p2) + coefs(k,1) * hij
mat_l(k, p1, p2) = mat_l(k, p1, p2) + coefs(k,2) * hji
mat_r(k, p1, p2) = mat_r(k, p1, p2) + coefs(k,2) * hij
mat_l(k, p1, p2) = mat_l(k, p1, p2) + coefs(k,1) * hji
enddo
end do
end do

28
src/cipsi_tc_bi_ortho/get_d2_good.irp.f
View File

@ -79,12 +79,12 @@ subroutine get_d2_new(gen, phasemask, bannedOrb, banned, mat_l, mat_r, mask, h,
if(ma == 1) then ! if particle spins are (alpha,alpha,alpha,beta), then puti is beta and putj is alpha
!DIR$ LOOP COUNT AVG(4)
do k=1,N_states
mat_r(k, putj, puti) = mat_r(k, putj, puti) + coefs(k,1) * hij
mat_r(k, putj, puti) = mat_r(k, putj, puti) + coefs(k,2) * hij
enddo
else ! if particle spins are (beta,beta,beta,alpha), then puti is alpha and putj is beta
!DIR$ LOOP COUNT AVG(4)
do k=1,N_states
mat_r(k, puti, putj) = mat_r(k, puti, putj) + coefs(k,1) * hij
mat_r(k, puti, putj) = mat_r(k, puti, putj) + coefs(k,2) * hij
enddo
end if
end do
@ -103,12 +103,12 @@ subroutine get_d2_new(gen, phasemask, bannedOrb, banned, mat_l, mat_r, mask, h,
if(ma == 1) then ! if particle spins are (alpha,alpha,alpha,beta), then puti is beta and putj is alpha
!DIR$ LOOP COUNT AVG(4)
do k=1,N_states
mat_l(k, putj, puti) = mat_l(k, putj, puti) + coefs(k,2) * hji
mat_l(k, putj, puti) = mat_l(k, putj, puti) + coefs(k,1) * hji
enddo
else ! if particle spins are (beta,beta,beta,alpha), then puti is alpha and putj is beta
!DIR$ LOOP COUNT AVG(4)
do k=1,N_states
mat_l(k, puti, putj) = mat_l(k, puti, putj) + coefs(k,2) * hji
mat_l(k, puti, putj) = mat_l(k, puti, putj) + coefs(k,1) * hji
enddo
end if
end do
@ -135,7 +135,7 @@ subroutine get_d2_new(gen, phasemask, bannedOrb, banned, mat_l, mat_r, mask, h,
hij = hij * get_phase_bi(phasemask, 1, 2, h1, p1, h2, p2, N_int)
!DIR$ LOOP COUNT AVG(4)
do k=1,N_states
mat_r(k, puti, putj) = mat_r(k, puti, putj) + coefs(k,1) * hij
mat_r(k, puti, putj) = mat_r(k, puti, putj) + coefs(k,2) * hij
enddo
endif
end do
@ -154,7 +154,7 @@ subroutine get_d2_new(gen, phasemask, bannedOrb, banned, mat_l, mat_r, mask, h,
hji = hji * get_phase_bi(phasemask, 1, 2, h1, p1, h2, p2, N_int)
!DIR$ LOOP COUNT AVG(4)
do k=1,N_states
mat_l(k, puti, putj) = mat_l(k, puti, putj) + coefs(k,2) * hji
mat_l(k, puti, putj) = mat_l(k, puti, putj) + coefs(k,1) * hji
enddo
endif
end do
@ -189,7 +189,7 @@ subroutine get_d2_new(gen, phasemask, bannedOrb, banned, mat_l, mat_r, mask, h,
hij = hij * get_phase_bi(phasemask, ma, ma, h1, p1, h2, p2, N_int)
!DIR$ LOOP COUNT AVG(4)
do k=1,N_states
mat_r(k, puti, putj) = mat_r(k, puti, putj) +coefs(k,1) * hij
mat_r(k, puti, putj) = mat_r(k, puti, putj) +coefs(k,2) * hij
enddo
end do
end do
@ -210,7 +210,7 @@ subroutine get_d2_new(gen, phasemask, bannedOrb, banned, mat_l, mat_r, mask, h,
hji = hji * get_phase_bi(phasemask, ma, ma, h1, p1, h2, p2, N_int)
!DIR$ LOOP COUNT AVG(4)
do k=1,N_states
mat_l(k, puti, putj) = mat_l(k, puti, putj) +coefs(k,2) * hji
mat_l(k, puti, putj) = mat_l(k, puti, putj) +coefs(k,1) * hji
enddo
end do
end do
@ -239,12 +239,12 @@ subroutine get_d2_new(gen, phasemask, bannedOrb, banned, mat_l, mat_r, mask, h,
if (puti < putj) then
!DIR$ LOOP COUNT AVG(4)
do k=1,N_states
mat_r(k, puti, putj) = mat_r(k, puti, putj) + coefs(k,1) * hij
mat_r(k, puti, putj) = mat_r(k, puti, putj) + coefs(k,2) * hij
enddo
else
!DIR$ LOOP COUNT AVG(4)
do k=1,N_states
mat_r(k, putj, puti) = mat_r(k, putj, puti) + coefs(k,1) * hij
mat_r(k, putj, puti) = mat_r(k, putj, puti) + coefs(k,2) * hij
enddo
endif
end do
@ -262,12 +262,12 @@ subroutine get_d2_new(gen, phasemask, bannedOrb, banned, mat_l, mat_r, mask, h,
if (puti < putj) then
!DIR$ LOOP COUNT AVG(4)
do k=1,N_states
mat_l(k, puti, putj) = mat_l(k, puti, putj) + coefs(k,2) * hji
mat_l(k, puti, putj) = mat_l(k, puti, putj) + coefs(k,1) * hji
enddo
else
!DIR$ LOOP COUNT AVG(4)
do k=1,N_states
mat_l(k, putj, puti) = mat_l(k, putj, puti) + coefs(k,2) * hji
mat_l(k, putj, puti) = mat_l(k, putj, puti) + coefs(k,1) * hji
enddo
endif
end do
@ -290,7 +290,7 @@ subroutine get_d2_new(gen, phasemask, bannedOrb, banned, mat_l, mat_r, mask, h,
hij = hij * get_phase_bi(phasemask, mi, mi, h1, p1, h2, p2, N_int)
!DIR$ LOOP COUNT AVG(4)
do k=1,N_states
mat_r(k, puti, putj) = mat_r(k, puti, putj) + coefs(k,1) * hij
mat_r(k, puti, putj) = mat_r(k, puti, putj) + coefs(k,2) * hij
enddo
end if
!! <phi|H|alpha>
@ -299,7 +299,7 @@ subroutine get_d2_new(gen, phasemask, bannedOrb, banned, mat_l, mat_r, mask, h,
hji = hji * get_phase_bi(phasemask, mi, mi, h1, p1, h2, p2, N_int)
!DIR$ LOOP COUNT AVG(4)
do k=1,N_states
mat_l(k, puti, putj) = mat_l(k, puti, putj) + coefs(k,2) * hji
mat_l(k, puti, putj) = mat_l(k, puti, putj) + coefs(k,1) * hji
enddo
end if
end if