mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-12-23 12:55:37 +01:00
testing get_d1
This commit is contained in:
Kevin Gasperich
parent
882dd0f2b1
commit
735e4d591b
@ -2533,6 +2533,7 @@ subroutine get_d1_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp
|
|||||||
complex*16 :: hij, tmp_row(N_states, mo_num), tmp_row2(N_states, mo_num)
|
complex*16 :: hij, tmp_row(N_states, mo_num), tmp_row2(N_states, mo_num)
|
||||||
complex*16 :: tmp_row_kpts(N_states, mo_num), tmp_row2_kpts(N_states, mo_num)
|
complex*16 :: tmp_row_kpts(N_states, mo_num), tmp_row2_kpts(N_states, mo_num)
|
||||||
complex*16 :: tmp_row_kpts2(N_states, mo_num_per_kpt), tmp_row2_kpts2(N_states,mo_num_per_kpt)
|
complex*16 :: tmp_row_kpts2(N_states, mo_num_per_kpt), tmp_row2_kpts2(N_states,mo_num_per_kpt)
|
||||||
|
complex*16 :: tmp_mat1(N_states,mo_num,mo_num), tmp_mat2(N_states,mo_num,mo_num)
|
||||||
PROVIDE mo_integrals_map N_int
|
PROVIDE mo_integrals_map N_int
|
||||||
|
|
||||||
allocate (lbanned(mo_num, 2))
|
allocate (lbanned(mo_num, 2))
|
||||||
@ -2821,9 +2822,23 @@ subroutine get_d1_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp
|
|||||||
puti = p(i, ma)
|
puti = p(i, ma)
|
||||||
p1 = p(turn3(1,i), ma)
|
p1 = p(turn3(1,i), ma)
|
||||||
p2 = p(turn3(2,i), ma)
|
p2 = p(turn3(2,i), ma)
|
||||||
|
kputi = (puti-1)/mo_num_per_kpt + 1
|
||||||
|
khfix = (hfix-1)/mo_num_per_kpt + 1
|
||||||
|
kp1 = (p1-1)/mo_num_per_kpt + 1
|
||||||
|
kp2 = (p2-1)/mo_num_per_kpt + 1
|
||||||
|
iputi = mod(puti-1,mo_num_per_kpt) + 1
|
||||||
|
ihfix = mod(hfix-1,mo_num_per_kpt) + 1
|
||||||
|
ip1 = mod(p1-1, mo_num_per_kpt) + 1
|
||||||
|
ip2 = mod(p2-1, mo_num_per_kpt) + 1
|
||||||
call get_mo_two_e_integrals_complex(hfix,p1,p2,mo_num,hij_cache(1,1),mo_integrals_map,mo_integrals_map_2)
|
call get_mo_two_e_integrals_complex(hfix,p1,p2,mo_num,hij_cache(1,1),mo_integrals_map,mo_integrals_map_2)
|
||||||
call get_mo_two_e_integrals_complex(hfix,p2,p1,mo_num,hij_cache(1,2),mo_integrals_map,mo_integrals_map_2)
|
call get_mo_two_e_integrals_complex(hfix,p2,p1,mo_num,hij_cache(1,2),mo_integrals_map,mo_integrals_map_2)
|
||||||
|
call get_mo_two_e_integrals_kpts(hfix,ihfix,khfix,p1,ip1,kp1,p2,ip2,kp2,mo_num_per_kpt,hij_cache2(1,1),mo_integrals_map,mo_integrals_map_2)
|
||||||
|
call get_mo_two_e_integrals_kpts(hfix,ihfix,khfix,p2,ip2,kp2,p1,ip1,kp1,mo_num_per_kpt,hij_cache2(1,2),mo_integrals_map,mo_integrals_map_2)
|
||||||
tmp_row = (0.d0,0.d0)
|
tmp_row = (0.d0,0.d0)
|
||||||
|
!tmp_row_kpts = (0.d0,0.d0)
|
||||||
|
tmp_row_kpts2 = (0.d0,0.d0)
|
||||||
|
!===================
|
||||||
|
!begin ref
|
||||||
do putj=1,hfix-1
|
do putj=1,hfix-1
|
||||||
if(banned(putj,puti,1)) cycle
|
if(banned(putj,puti,1)) cycle
|
||||||
if(lbanned(putj,ma)) cycle
|
if(lbanned(putj,ma)) cycle
|
||||||
@ -2842,7 +2857,89 @@ subroutine get_d1_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp
|
|||||||
tmp_row(:,putj) = tmp_row(:,putj) + hij * coefs(:)
|
tmp_row(:,putj) = tmp_row(:,putj) + hij * coefs(:)
|
||||||
endif
|
endif
|
||||||
end do
|
end do
|
||||||
|
!end ref
|
||||||
|
!=================
|
||||||
|
!begin kpts
|
||||||
|
kputj = kconserv(kp1,kp2,khfix)
|
||||||
|
putj0 = (kputj-1)*mo_num_per_kpt
|
||||||
|
do putj = putj0+1,hfix-1
|
||||||
|
iputj = putj - putj0
|
||||||
|
if(banned(putj,puti,1)) cycle
|
||||||
|
if(lbanned(putj,ma)) cycle
|
||||||
|
hij = hij_cache2(iputj,1) - hij_cache2(iputj,2)
|
||||||
|
if (hij /= (0.d0,0.d0)) then
|
||||||
|
hij = hij * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2, N_int)
|
||||||
|
!tmp_row_kpts(:,putj) = tmp_row_kpts(:,putj) + hij * coefs(:)
|
||||||
|
tmp_row_kpts2(:,iputj) = tmp_row_kpts2(:,iputj) + hij * coefs(:)
|
||||||
|
endif
|
||||||
|
end do
|
||||||
|
do putj=hfix+1,putj0+mo_num_per_kpt
|
||||||
|
iputj = putj - putj0
|
||||||
|
if(banned(putj,puti,1)) cycle
|
||||||
|
if(lbanned(putj,ma)) cycle
|
||||||
|
hij = hij_cache2(iputj,2) - hij_cache2(iputj,1)
|
||||||
|
if (hij /= (0.d0,0.d0)) then
|
||||||
|
hij = hij * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2, N_int)
|
||||||
|
!tmp_row_kpts(:,putj) = tmp_row_kpts(:,putj) + hij * coefs(:)
|
||||||
|
tmp_row_kpts2(:,iputj) = tmp_row_kpts2(:,iputj) + hij * coefs(:)
|
||||||
|
endif
|
||||||
|
end do
|
||||||
|
|
||||||
|
!end kpts
|
||||||
|
!do ii0=1,mo_num
|
||||||
|
! if (cdabs(tmp_row_kpts(1,ii0)-tmp_row(1,ii0)).gt.1.d-12) then
|
||||||
|
! print'((A),4(I5),2(2(E25.15),2X))','WarNInG 1a, ',ii0,hfix,pfix,p2,tmp_row_kpts(1,ii0),tmp_row(1,ii0)
|
||||||
|
!! else if ((cdabs(tmp_row_kpts(1,ii0))+cdabs(tmp_row(1,ii0))).gt.1.d-12) then
|
||||||
|
!! print'((A),4(I5),2(2(E25.15),2X))','WarNInG 1b, ',ii0,hfix,pfix,p2,tmp_row_kpts(1,ii0),tmp_row(1,ii0)
|
||||||
|
! endif
|
||||||
|
!enddo
|
||||||
|
!=================
|
||||||
|
tmp_mat1 = (0.d0,0.d0)
|
||||||
|
tmp_mat2 = (0.d0,0.d0)
|
||||||
|
tmp_mat1(:, :puti-1, puti) = tmp_mat1(:, :puti-1, puti) + tmp_row(:,:puti-1)
|
||||||
|
do l=puti,mo_num
|
||||||
|
!DIR$ LOOP COUNT AVG(4)
|
||||||
|
do k=1,N_states
|
||||||
|
tmp_mat1(k, puti, l) = tmp_mat1(k, puti,l) + tmp_row(k,l)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!=================
|
||||||
|
if (kputj.lt.kputi) then
|
||||||
|
tmp_mat2(1:N_states,putj0+1:putj0+mo_num_per_kpt,puti) = &
|
||||||
|
tmp_mat2(1:N_states,putj0+1:putj0+mo_num_per_kpt,puti) + &
|
||||||
|
tmp_row_kpts2(1:N_states,1:mo_num_per_kpt)
|
||||||
|
else if (kputj.gt.kputi) then
|
||||||
|
do l=1,mo_num_per_kpt
|
||||||
|
!DIR$ LOOP COUNT AVG(4)
|
||||||
|
do k=1,N_states
|
||||||
|
tmp_mat2(k, puti, l+putj0) = tmp_mat2(k, puti,l+putj0) + tmp_row_kpts2(k,l)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
else !kputj == kputi
|
||||||
|
tmp_mat2(1:N_states,putj0+1:puti-1,puti) = &
|
||||||
|
tmp_mat2(1:N_states,putj0+1:puti-1,puti) + &
|
||||||
|
tmp_row_kpts2(1:N_states,1:iputi-1)
|
||||||
|
do l=iputi,mo_num_per_kpt
|
||||||
|
!DIR$ LOOP COUNT AVG(4)
|
||||||
|
do k=1,N_states
|
||||||
|
tmp_mat2(k, puti, l+putj0) = tmp_mat2(k, puti,l+putj0) + tmp_row_kpts2(k,l)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
!=================
|
||||||
|
do k=1,N_states
|
||||||
|
do l=1,mo_num
|
||||||
|
do ii0=1,mo_num
|
||||||
|
if (cdabs(tmp_mat2(k,l,ii0)-tmp_mat1(k,l,ii0)).gt.1.d-12) then
|
||||||
|
print'((A),6(I5),2(2(E25.15),2X))','WarNInG 3a, ',k,l,ii0,hfix,p1,p2,tmp_mat2(k,l,ii0),tmp_mat1(k,l,ii0)
|
||||||
|
! else if ((cdabs(tmp_row_kpts(1,ii0))+cdabs(tmp_row(1,ii0))).gt.1.d-12) then
|
||||||
|
! print'((A),4(I5),2(2(E25.15),2X))','WarNInG 1b, ',ii0,hfix,pfix,p2,tmp_row_kpts(1,ii0),tmp_row(1,ii0)
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!=================
|
||||||
mat(:, :puti-1, puti) = mat(:, :puti-1, puti) + tmp_row(:,:puti-1)
|
mat(:, :puti-1, puti) = mat(:, :puti-1, puti) + tmp_row(:,:puti-1)
|
||||||
do l=puti,mo_num
|
do l=puti,mo_num
|
||||||
!DIR$ LOOP COUNT AVG(4)
|
!DIR$ LOOP COUNT AVG(4)
|
||||||
@ -2850,16 +2947,54 @@ subroutine get_d1_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp
|
|||||||
mat(k, puti, l) = mat(k, puti,l) + tmp_row(k,l)
|
mat(k, puti, l) = mat(k, puti,l) + tmp_row(k,l)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
!!=================
|
||||||
|
!!todo: check for iputi=1,2
|
||||||
|
!if (kputj.lt.kputi) then
|
||||||
|
! mat(1:N_states,putj0+1:putj0+mo_num_per_kpt,puti) = &
|
||||||
|
! mat(1:N_states,putj0+1:putj0+mo_num_per_kpt,puti) + &
|
||||||
|
! tmp_row_kpts2(1:N_states,1:mo_num_per_kpt)
|
||||||
|
!else if (kputj.gt.kputi) then
|
||||||
|
! do l=1,mo_num_per_kpt
|
||||||
|
! !DIR$ LOOP COUNT AVG(4)
|
||||||
|
! do k=1,N_states
|
||||||
|
! mat(k, puti, l+putj0) = mat(k, puti,l+putj0) + tmp_row_kpts2(k,l)
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
!else !kputj == kputi
|
||||||
|
! mat(1:N_states,putj0+1:puti-1,puti) = &
|
||||||
|
! mat(1:N_states,putj0+1:puti-1,puti) + &
|
||||||
|
! tmp_row_kpts2(1:N_states,1:iputi-1)
|
||||||
|
! do l=iputi,mo_num_per_kpt
|
||||||
|
! !DIR$ LOOP COUNT AVG(4)
|
||||||
|
! do k=1,N_states
|
||||||
|
! mat(k, puti, l+putj0) = mat(k, puti,l+putj0) + tmp_row_kpts2(k,l)
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
!endif
|
||||||
end do
|
end do
|
||||||
else
|
else
|
||||||
hfix = h(1,mi)
|
hfix = h(1,mi)
|
||||||
pfix = p(1,mi)
|
pfix = p(1,mi)
|
||||||
p1 = p(1,ma)
|
p1 = p(1,ma)
|
||||||
p2 = p(2,ma)
|
p2 = p(2,ma)
|
||||||
|
kpfix = (pfix-1)/mo_num_per_kpt + 1
|
||||||
|
khfix = (hfix-1)/mo_num_per_kpt + 1
|
||||||
|
kp1 = (p1-1)/mo_num_per_kpt + 1
|
||||||
|
kp2 = (p2-1)/mo_num_per_kpt + 1
|
||||||
|
ipfix = mod(pfix-1,mo_num_per_kpt) + 1
|
||||||
|
ihfix = mod(hfix-1,mo_num_per_kpt) + 1
|
||||||
|
ip1 = mod(p1-1, mo_num_per_kpt) + 1
|
||||||
|
ip2 = mod(p2-1, mo_num_per_kpt) + 1
|
||||||
tmp_row = (0.d0,0.d0)
|
tmp_row = (0.d0,0.d0)
|
||||||
tmp_row2 = (0.d0,0.d0)
|
tmp_row2 = (0.d0,0.d0)
|
||||||
|
!tmp_row_kpts = (0.d0,0.d0)
|
||||||
|
!tmp_row2_kpts = (0.d0,0.d0)
|
||||||
call get_mo_two_e_integrals_complex(hfix,p1,pfix,mo_num,hij_cache(1,1),mo_integrals_map,mo_integrals_map_2)
|
call get_mo_two_e_integrals_complex(hfix,p1,pfix,mo_num,hij_cache(1,1),mo_integrals_map,mo_integrals_map_2)
|
||||||
call get_mo_two_e_integrals_complex(hfix,p2,pfix,mo_num,hij_cache(1,2),mo_integrals_map,mo_integrals_map_2)
|
call get_mo_two_e_integrals_complex(hfix,p2,pfix,mo_num,hij_cache(1,2),mo_integrals_map,mo_integrals_map_2)
|
||||||
|
!call get_mo_two_e_integrals_kpts(hfix,ihfix,khfix,p1,ip1,kp1,pfix,ipfix,kpfix,mo_num_per_kpt,hij_cache2(1,1),mo_integrals_map,mo_integrals_map_2)
|
||||||
|
!call get_mo_two_e_integrals_kpts(hfix,ihfix,khfix,p2,ip2,kp2,pfix,ipfix,kpfix,mo_num_per_kpt,hij_cache2(1,2),mo_integrals_map,mo_integrals_map_2)
|
||||||
|
!===============
|
||||||
|
!begin ref
|
||||||
putj = p2
|
putj = p2
|
||||||
do puti=1,mo_num
|
do puti=1,mo_num
|
||||||
if(lbanned(puti,ma)) cycle
|
if(lbanned(puti,ma)) cycle
|
||||||
@ -2886,6 +3021,61 @@ subroutine get_d1_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp
|
|||||||
endif
|
endif
|
||||||
end if
|
end if
|
||||||
end do
|
end do
|
||||||
|
!end ref
|
||||||
|
!===============
|
||||||
|
!begin kpts
|
||||||
|
!todo: combine if kp1==kp2
|
||||||
|
! putj = p2
|
||||||
|
! kputi1 = kconserv(kp1,kpfix,khfix)
|
||||||
|
! puti01 = (kputi1-1)*mo_num_per_kpt
|
||||||
|
! do iputi=1,mo_num_per_kpt
|
||||||
|
! puti = puti01 + iputi
|
||||||
|
! if(lbanned(puti,ma)) cycle
|
||||||
|
! if(.not. banned(puti,putj,1)) then
|
||||||
|
! hij = hij_cache2(iputi,1)
|
||||||
|
! if (hij /= (0.d0,0.d0)) then
|
||||||
|
! 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_row_kpts(k,puti) = tmp_row_kpts(k,puti) + hij * coefs(k)
|
||||||
|
! enddo
|
||||||
|
! endif
|
||||||
|
! end if
|
||||||
|
! enddo
|
||||||
|
! putj = p1
|
||||||
|
! kputi2 = kconserv(kp2,kpfix,khfix)
|
||||||
|
! puti02 = (kputi2-1)*mo_num_per_kpt
|
||||||
|
! do iputi=1,mo_num_per_kpt
|
||||||
|
! puti = puti02 + iputi
|
||||||
|
! if(lbanned(puti,ma)) cycle
|
||||||
|
! if(.not. banned(puti,putj,1)) then
|
||||||
|
! hij = hij_cache2(iputi,2)
|
||||||
|
! if (hij /= (0.d0,0.d0)) then
|
||||||
|
! hij = hij * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p2, N_int)
|
||||||
|
! do k=1,N_states
|
||||||
|
! tmp_row2_kpts(k,puti) = tmp_row2_kpts(k,puti) + hij * coefs(k)
|
||||||
|
! enddo
|
||||||
|
! endif
|
||||||
|
! end if
|
||||||
|
! end do
|
||||||
|
! !end kpts
|
||||||
|
! !===============
|
||||||
|
! !test printing
|
||||||
|
! !print'((A),5(I5))','kpt info1: ',kconserv(kpfix,kp2,khfix),khfix,kpfix,kp2,kputi2
|
||||||
|
! !print'((A),5(I5))','kpt info2: ',kconserv(kpfix,kp1,khfix),khfix,kpfix,kp1,kputi1
|
||||||
|
! do ii0=1,mo_num
|
||||||
|
! if (cdabs(tmp_row_kpts(1,ii0)-tmp_row(1,ii0)).gt.1.d-12) then
|
||||||
|
! print'((A),4(I5),2(2(E25.15),2X))','WarNInG 1a, ',ii0,hfix,p1,pfix,tmp_row_kpts(1,ii0),tmp_row(1,ii0)
|
||||||
|
! ! else if ((cdabs(tmp_row_kpts(1,ii0))+cdabs(tmp_row(1,ii0))).gt.1.d-12) then
|
||||||
|
! ! print'((A),4(I5),2(2(E25.15),2X))','WarNInG 1b, ',ii0,hfix,pfix,p2,tmp_row_kpts(1,ii0),tmp_row(1,ii0)
|
||||||
|
! endif
|
||||||
|
! if (cdabs(tmp_row2_kpts(1,ii0)-tmp_row2(1,ii0)).gt.1.d-12) then
|
||||||
|
! print'((A),4(I5),2(2(E25.15),2X))','WarNInG 2a, ',ii0,hfix,p2,pfix,tmp_row2_kpts(1,ii0),tmp_row2(1,ii0)
|
||||||
|
! ! else if ((cdabs(tmp_row2_kpts(1,ii0))+cdabs(tmp_row2(1,ii0))).gt.1.d-12) then
|
||||||
|
! ! print'((A),4(I5),2(2(E25.15),2X))','WarNInG 2b, ',ii0,hfix,pfix,p1,tmp_row2_kpts(1,ii0),tmp_row2(1,ii0)
|
||||||
|
! endif
|
||||||
|
! enddo
|
||||||
|
!===================
|
||||||
mat(:,:p2-1,p2) = mat(:,:p2-1,p2) + tmp_row(:,:p2-1)
|
mat(:,:p2-1,p2) = mat(:,:p2-1,p2) + tmp_row(:,:p2-1)
|
||||||
do l=p2,mo_num
|
do l=p2,mo_num
|
||||||
!DIR$ LOOP COUNT AVG(4)
|
!DIR$ LOOP COUNT AVG(4)
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user