LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-06-08 22:35:30 +02:00
Code Issues Releases Wiki Activity

changed phasemask representation

Browse Source
This commit is contained in:
Yann Garniron 2016-09-08 17:34:56 +02:00
parent 90b84581b0
commit e78f316936
3 changed files with 47 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
plugins/Full_CI_ZMQ/selection.irp.f
View File

@ -25,7 +25,7 @@ double precision function integral8(i,j,k,l)
end function
BEGIN_PROVIDER [ integer(bit_kind), psi_phasemask, (N_int, 2, N_det)]
BEGIN_PROVIDER [ integer(1), psi_phasemask, (N_int*bit_kind_size, 2, N_det)]
use bitmasks
implicit none
@ -52,17 +52,19 @@ subroutine get_mask_phase(det, phasemask)
implicit none
integer(bit_kind), intent(in) :: det(N_int, 2)
integer(bit_kind), intent(out) :: phasemask(N_int, 2)
integer(1), intent(out) :: phasemask(N_int*bit_kind_size, 2)
integer :: s, ni, i
logical :: change
phasemask = 0_8
! phasemask = 0_8
phasemask = 0_1
do s=1,2
change = .false.
do ni=1,N_int
do i=0,bit_kind_size-1
if(BTEST(det(ni, s), i)) change = .not. change
if(change) phasemask(ni, s) = ibset(phasemask(ni, s), i)
! if(change) phasemask(ni, s) = ibset(phasemask(ni, s), i)
if(change) phasemask((ni-1)*bit_kind_size + i + 1, s) = 1_1
end do
end do
end do
@ -120,41 +122,28 @@ double precision function get_phase_bi(phasemask, s1, s2, h1, p1, h2, p2)
use bitmasks
implicit none
integer(bit_kind), intent(in) :: phasemask(N_int, 2)
integer(1), intent(in) :: phasemask(N_int*bit_kind_size, 2)
integer, intent(in) :: s1, s2, h1, h2, p1, p2
logical :: change
integer :: np
integer(1) :: np
double precision, parameter :: res(0:1) = (/1d0, -1d0/)
call assert(s1 /= s2 .or. (h1 <= h2 .and. p1 <= p2), irp_here)
np = 0
change = btest(phasemask(1+ishft(h1, -6), s1), iand(h1-1, 63))
change = xor(change, btest(phasemask(1+ishft(p1, -6), s1), iand(p1-1, 63)))
if(xor(change, p1 < h1)) np = 1
change = btest(phasemask(1+ishft(h2, -6), s2), iand(h2-1, 63))
change = xor(change, btest(phasemask(1+ishft(p2, -6), s2), iand(p2-1, 63)))
if(xor(change, p2 < h2)) np = np + 1
! call assert(s1 /= s2 .or. (h1 <= h2 .and. p1 <= p2), irp_here)
! np = 0
! change = btest(phasemask(1+ishft(h1, -6), s1), iand(h1-1, 63))
! change = xor(change, btest(phasemask(1+ishft(p1, -6), s1), iand(p1-1, 63)))
! if(xor(change, p1 < h1)) np = 1
!
! change = btest(phasemask(1+ishft(h2, -6), s2), iand(h2-1, 63))
! change = xor(change, btest(phasemask(1+ishft(p2, -6), s2), iand(p2-1, 63)))
! if(xor(change, p2 < h2)) np = np + 1
if(s1 == s2 .and. max(h1, p1) > min(h2, p2)) np = np + 1
get_phase_bi = res(iand(np,1))
end subroutine
double precision function get_phase_mono(phasemask, s1, h1, p1)
use bitmasks
implicit none
integer(bit_kind), intent(in) :: phasemask(N_int, 2)
integer, intent(in) :: s1, h1, p1
logical :: change
stop "phase moni BUGGED"
change = btest(phasemask(ishft(h1, bit_kind_shift), s1), iand(h1, 63_8))
change = xor(change, btest(phasemask(ishft(p1, bit_kind_shift), s1), iand(p1, 63_8)))
get_phase_mono = 1d0
if(change) get_phase_mono = -1d0
np = phasemask(h1,s1) + phasemask(p1,s1) + phasemask(h2,s2) + phasemask(p2,s2)
if(p1 < h1) np = np + 1_1
if(p2 < h2) np = np + 1_1
if(s1 == s2 .and. max(h1, p1) > min(h2, p2)) np = np + 1_1
get_phase_bi = res(iand(np,1_1))
end subroutine

36
plugins/Full_CI_ZMQ/selection_double.irp.f
View File

@ -212,7 +212,8 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
use bitmasks
implicit none
integer(bit_kind), intent(in) :: mask(N_int, 2), gen(N_int, 2), phasemask(N_int, 2)
integer(bit_kind), intent(in) :: mask(N_int, 2), gen(N_int, 2)
integer(1), intent(in) :: phasemask(N_int*bit_kind_size, 2)
logical, intent(in) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num,2)
double precision, intent(in) :: coefs(N_states)
double precision, intent(inout) :: mat(N_states, mo_tot_num, mo_tot_num)
@ -246,16 +247,13 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
puti = p(1, mi)
do i = 1, 3
putj = p(i, ma)
if(banned(putj,puti,bant)) cycle
i1 = turn3(1,i)
i2 = turn3(2,i)
p1 = p(i1, ma)
p2 = p(i2, ma)
!call assert(h(0,ma) == 2, "dmdmd")
!call assert(p(0, ma) == 3, "dmdm2")
h1 = h(1, ma)
h2 = h(2, ma)
if(banned(putj,puti,bant)) cycle
hij = (integral8(p1, p2, h1, h2) - integral8(p2,p1, h1, h2)) * get_phase_bi(phasemask, ma, ma, h1, p1, h2, p2)
!call debug_hij(hij, gen, mask, mi, ma, puti, putj)
@ -271,16 +269,15 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
do j = 1,2
puti = p(i, 1)
putj = p(j, 2)
if(banned(puti,putj,bant)) cycle
p1 = p(turn2(i), 1)
p2 = p(turn2(j), 2)
h1 = h(1,1)
h2 = h(1,2)
if(banned(puti,putj,bant)) cycle
hij = integral8(p1, p2, h1, h2) * get_phase_bi(phasemask, 1, 2, h1, p1, h2, p2)
!call debug_hij(hij, gen, mask, 1, 2, puti, putj)
mat(:, puti, putj) += coefs * hij
end do
end do
@ -294,13 +291,12 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
puti = p(i, ma)
do j=i+1,4
putj = p(j, ma)
if(banned(puti,putj,1)) cycle
i1 = turn2d(1, i, j)
i2 = turn2d(2, i, j)
p1 = p(i1, ma)
p2 = p(i2, ma)
if(banned(puti,putj,1)) cycle
hij = (integral8(p1, p2, h1, h2) - integral8(p2,p1, h1, h2)) * get_phase_bi(phasemask, ma, ma, h1, p1, h2, p2)
!call debug_hij(hij, gen, mask, ma, ma, puti, putj)
mat(:, puti, putj) += coefs * hij
@ -312,11 +308,10 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
p1 = p(1, mi)
!call assert(ma == sp, "dldl")
do i=1,3
p2 = p(i, ma)
puti = p(turn3(1,i), ma)
putj = p(turn3(2,i), ma)
if(banned(puti,putj,1)) cycle
p2 = p(i, ma)
hij = integral8(p1, p2, h1, h2) * get_phase_bi(phasemask, mi, ma, h1, p1, h2, p2)
!call debug_hij(hij, gen, mask, ma, ma, puti, putj)
@ -326,12 +321,11 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
!call assert(tip == 4, "qsdf")
puti = p(1, sp)
putj = p(2, sp)
p1 = p(1, mi)
p2 = p(2, mi)
h1 = h(1, mi)
h2 = h(2, mi)
if(.not. banned(puti,putj,1)) then
p1 = p(1, mi)
p2 = p(2, mi)
h1 = h(1, mi)
h2 = h(2, mi)
hij = (integral8(p1, p2, h1, h2) - integral8(p2,p1, h1, h2)) * get_phase_bi(phasemask, mi, mi, h1, p1, h2, p2)
!call debug_hij(hij, gen, mask,ma,ma, puti, putj)
mat(:, puti, putj) += coefs * hij
@ -373,7 +367,8 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
use bitmasks
implicit none
integer(bit_kind), intent(in) :: mask(N_int, 2), gen(N_int, 2), phasemask(N_int, 2)
integer(bit_kind), intent(in) :: mask(N_int, 2), gen(N_int, 2)
integer(1),intent(in) :: phasemask(N_int*bit_kind_size, 2)
logical, intent(in) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num,2)
integer(bit_kind) :: det(N_int, 2)
double precision, intent(in) :: coefs(N_states)
@ -552,7 +547,8 @@ subroutine get_d0(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
use bitmasks
implicit none
integer(bit_kind), intent(in) :: gen(N_int, 2), mask(N_int, 2), phasemask(N_int, 2)
integer(bit_kind), intent(in) :: gen(N_int, 2), mask(N_int, 2)
integer(1), intent(in) :: phasemask(N_int*bit_kind_size, 2)
logical, intent(in) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num,2)
integer(bit_kind) :: det(N_int, 2)
double precision, intent(in) :: coefs(N_states)

12
plugins/Full_CI_ZMQ/selection_single.irp.f
View File

@ -103,7 +103,8 @@ subroutine splash_p(mask, sp, det, phasemask, coefs, N_sel, bannedOrb, vect)
use bitmasks
implicit none
integer(bit_kind),intent(in) :: mask(N_int, 2), det(N_int,2,N_sel), phasemask(N_int,2,N_sel)
integer(bit_kind),intent(in) :: mask(N_int, 2), det(N_int,2,N_sel)
integer(1), intent(in) :: phasemask(N_int*bit_kind_size, 2, N_sel)
double precision, intent(in) :: coefs(N_states, N_sel)
integer, intent(in) :: sp, N_sel
logical, intent(inout) :: bannedOrb(mo_tot_num)
@ -153,7 +154,8 @@ subroutine get_m2(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs)
use bitmasks
implicit none
integer(bit_kind), intent(in) :: gen(N_int, 2), phasemask(N_int, 2), mask(N_int, 2)
integer(bit_kind), intent(in) :: gen(N_int, 2), mask(N_int, 2)
integer(1), intent(in) :: phasemask(N_int*bit_kind_size, 2)
logical, intent(in) :: bannedOrb(mo_tot_num)
double precision, intent(in) :: coefs(N_states)
double precision, intent(inout) :: vect(N_states, mo_tot_num)
@ -214,7 +216,8 @@ subroutine get_m1(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs)
use bitmasks
implicit none
integer(bit_kind), intent(in) :: gen(N_int, 2), phasemask(N_int, 2), mask(N_int, 2)
integer(bit_kind), intent(in) :: gen(N_int, 2), mask(N_int, 2)
integer(1), intent(in) :: phasemask(N_int*bit_kind_size, 2)
logical, intent(in) :: bannedOrb(mo_tot_num)
double precision, intent(in) :: coefs(N_states)
double precision, intent(inout) :: vect(N_states, mo_tot_num)
@ -282,7 +285,8 @@ subroutine get_m0(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs)
use bitmasks
implicit none
integer(bit_kind), intent(in) :: gen(N_int, 2), phasemask(N_int, 2), mask(N_int, 2)
integer(bit_kind), intent(in) :: gen(N_int, 2), mask(N_int, 2)
integer(1), intent(in) :: phasemask(N_int*bit_kind_size, 2)
logical, intent(in) :: bannedOrb(mo_tot_num)
double precision, intent(in) :: coefs(N_states)
double precision, intent(inout) :: vect(N_states, mo_tot_num)