LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2025-01-03 18:16:12 +01: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 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 use bitmasks
implicit none implicit none
@ -52,17 +52,19 @@ subroutine get_mask_phase(det, phasemask)
implicit none implicit none
integer(bit_kind), intent(in) :: det(N_int, 2) 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 integer :: s, ni, i
logical :: change logical :: change
phasemask = 0_8 ! phasemask = 0_8
phasemask = 0_1
do s=1,2 do s=1,2
change = .false. change = .false.
do ni=1,N_int do ni=1,N_int
do i=0,bit_kind_size-1 do i=0,bit_kind_size-1
if(BTEST(det(ni, s), i)) change = .not. change 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 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 use bitmasks
implicit none 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 integer, intent(in) :: s1, s2, h1, h2, p1, p2
logical :: change logical :: change
integer :: np integer(1) :: np
double precision, parameter :: res(0:1) = (/1d0, -1d0/) double precision, parameter :: res(0:1) = (/1d0, -1d0/)
call assert(s1 /= s2 .or. (h1 <= h2 .and. p1 <= p2), irp_here) ! call assert(s1 /= s2 .or. (h1 <= h2 .and. p1 <= p2), irp_here)
np = 0 ! np = 0
change = btest(phasemask(1+ishft(h1, -6), s1), iand(h1-1, 63)) ! 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))) ! change = xor(change, btest(phasemask(1+ishft(p1, -6), s1), iand(p1-1, 63)))
if(xor(change, p1 < h1)) np = 1 ! if(xor(change, p1 < h1)) np = 1
!
change = btest(phasemask(1+ishft(h2, -6), s2), iand(h2-1, 63)) ! 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))) ! change = xor(change, btest(phasemask(1+ishft(p2, -6), s2), iand(p2-1, 63)))
if(xor(change, p2 < h2)) np = np + 1 ! if(xor(change, p2 < h2)) np = np + 1
if(s1 == s2 .and. max(h1, p1) > min(h2, p2)) np = np + 1 np = phasemask(h1,s1) + phasemask(p1,s1) + phasemask(h2,s2) + phasemask(p2,s2)
get_phase_bi = res(iand(np,1)) if(p1 < h1) np = np + 1_1
end subroutine if(p2 < h2) np = np + 1_1
if(s1 == s2 .and. max(h1, p1) > min(h2, p2)) np = np + 1_1
double precision function get_phase_mono(phasemask, s1, h1, p1) get_phase_bi = res(iand(np,1_1))
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
end subroutine 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 use bitmasks
implicit none 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) 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(in) :: coefs(N_states)
double precision, intent(inout) :: mat(N_states, mo_tot_num, mo_tot_num) 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) puti = p(1, mi)
do i = 1, 3 do i = 1, 3
putj = p(i, ma) putj = p(i, ma)
if(banned(putj,puti,bant)) cycle
i1 = turn3(1,i) i1 = turn3(1,i)
i2 = turn3(2,i) i2 = turn3(2,i)
p1 = p(i1, ma) p1 = p(i1, ma)
p2 = p(i2, ma) p2 = p(i2, ma)
!call assert(h(0,ma) == 2, "dmdmd")
!call assert(p(0, ma) == 3, "dmdm2")
h1 = h(1, ma) h1 = h(1, ma)
h2 = h(2, 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) 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) !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 do j = 1,2
puti = p(i, 1) puti = p(i, 1)
putj = p(j, 2) putj = p(j, 2)
if(banned(puti,putj,bant)) cycle
p1 = p(turn2(i), 1) p1 = p(turn2(i), 1)
p2 = p(turn2(j), 2) p2 = p(turn2(j), 2)
h1 = h(1,1) h1 = h(1,1)
h2 = h(1,2) 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) 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) !call debug_hij(hij, gen, mask, 1, 2, puti, putj)
mat(:, puti, putj) += coefs * hij mat(:, puti, putj) += coefs * hij
end do end do
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) puti = p(i, ma)
do j=i+1,4 do j=i+1,4
putj = p(j, ma) putj = p(j, ma)
if(banned(puti,putj,1)) cycle
i1 = turn2d(1, i, j) i1 = turn2d(1, i, j)
i2 = turn2d(2, i, j) i2 = turn2d(2, i, j)
p1 = p(i1, ma) p1 = p(i1, ma)
p2 = p(i2, 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) 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) !call debug_hij(hij, gen, mask, ma, ma, puti, putj)
mat(:, puti, putj) += coefs * hij 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) p1 = p(1, mi)
!call assert(ma == sp, "dldl") !call assert(ma == sp, "dldl")
do i=1,3 do i=1,3
p2 = p(i, ma)
puti = p(turn3(1,i), ma) puti = p(turn3(1,i), ma)
putj = p(turn3(2,i), ma) putj = p(turn3(2,i), ma)
if(banned(puti,putj,1)) cycle 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) 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) !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") !call assert(tip == 4, "qsdf")
puti = p(1, sp) puti = p(1, sp)
putj = p(2, 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 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) 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) !call debug_hij(hij, gen, mask,ma,ma, puti, putj)
mat(:, puti, putj) += coefs * hij mat(:, puti, putj) += coefs * hij
@ -373,7 +367,8 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
use bitmasks use bitmasks
implicit none 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) logical, intent(in) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num,2)
integer(bit_kind) :: det(N_int, 2) integer(bit_kind) :: det(N_int, 2)
double precision, intent(in) :: coefs(N_states) 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 use bitmasks
implicit none 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) logical, intent(in) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num,2)
integer(bit_kind) :: det(N_int, 2) integer(bit_kind) :: det(N_int, 2)
double precision, intent(in) :: coefs(N_states) 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 use bitmasks
implicit none 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) double precision, intent(in) :: coefs(N_states, N_sel)
integer, intent(in) :: sp, N_sel integer, intent(in) :: sp, N_sel
logical, intent(inout) :: bannedOrb(mo_tot_num) 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 use bitmasks
implicit none 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) logical, intent(in) :: bannedOrb(mo_tot_num)
double precision, intent(in) :: coefs(N_states) double precision, intent(in) :: coefs(N_states)
double precision, intent(inout) :: vect(N_states, mo_tot_num) 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 use bitmasks
implicit none 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) logical, intent(in) :: bannedOrb(mo_tot_num)
double precision, intent(in) :: coefs(N_states) double precision, intent(in) :: coefs(N_states)
double precision, intent(inout) :: vect(N_states, mo_tot_num) 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 use bitmasks
implicit none 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) logical, intent(in) :: bannedOrb(mo_tot_num)
double precision, intent(in) :: coefs(N_states) double precision, intent(in) :: coefs(N_states)
double precision, intent(inout) :: vect(N_states, mo_tot_num) double precision, intent(inout) :: vect(N_states, mo_tot_num)