From e78f316936e0d45fb99110c2098aeeb2082cf11e Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Thu, 8 Sep 2016 17:34:56 +0200 Subject: [PATCH] changed phasemask representation --- plugins/Full_CI_ZMQ/selection.irp.f | 57 +++++++++------------- plugins/Full_CI_ZMQ/selection_double.irp.f | 36 ++++++-------- plugins/Full_CI_ZMQ/selection_single.irp.f | 12 +++-- 3 files changed, 47 insertions(+), 58 deletions(-) diff --git a/plugins/Full_CI_ZMQ/selection.irp.f b/plugins/Full_CI_ZMQ/selection.irp.f index 43d252bd..c1f529dc 100644 --- a/plugins/Full_CI_ZMQ/selection.irp.f +++ b/plugins/Full_CI_ZMQ/selection.irp.f @@ -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 diff --git a/plugins/Full_CI_ZMQ/selection_double.irp.f b/plugins/Full_CI_ZMQ/selection_double.irp.f index 4c938951..d31f9a6a 100644 --- a/plugins/Full_CI_ZMQ/selection_double.irp.f +++ b/plugins/Full_CI_ZMQ/selection_double.irp.f @@ -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) diff --git a/plugins/Full_CI_ZMQ/selection_single.irp.f b/plugins/Full_CI_ZMQ/selection_single.irp.f index 79fe91c1..a49ae879 100644 --- a/plugins/Full_CI_ZMQ/selection_single.irp.f +++ b/plugins/Full_CI_ZMQ/selection_single.irp.f @@ -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)