mirror of
https://github.com/LCPQ/quantum_package
synced 2024-12-22 20:35:19 +01:00
Removed integer*2
This commit is contained in:
parent
1d6593a288
commit
11aeaa91c7
@ -21,7 +21,7 @@ subroutine run
|
||||
allocate (pt2(N_states))
|
||||
pt2 = 0.d0
|
||||
|
||||
E_CI_before = pt2_E0_denominator(1)
|
||||
E_CI_before = pt2_E0_denominator(1) + nuclear_repulsion
|
||||
threshold_selectors = 1.d0
|
||||
threshold_generators = 1d0
|
||||
relative_error = 1.d-3
|
||||
|
||||
@ -351,11 +351,11 @@ logical function is_generable(det1, det2, Nint)
|
||||
integer, intent(in) :: Nint
|
||||
integer(bit_kind) :: det1(Nint, 2), det2(Nint, 2)
|
||||
integer :: degree, f, exc(0:2, 2, 2), t
|
||||
integer*2 :: h1, h2, p1, p2, s1, s2
|
||||
integer :: h1, h2, p1, p2, s1, s2
|
||||
integer, external :: searchExc
|
||||
logical, external :: excEq
|
||||
double precision :: phase
|
||||
integer*2 :: tmp_array(4)
|
||||
integer :: tmp_array(4)
|
||||
|
||||
is_generable = .false.
|
||||
call get_excitation(det1, det2, exc, degree, phase, Nint)
|
||||
@ -366,7 +366,7 @@ logical function is_generable(det1, det2, Nint)
|
||||
end if
|
||||
if(degree > 2) stop "?22??"
|
||||
|
||||
call decode_exc_int2(exc,degree,h1,p1,h2,p2,s1,s2)
|
||||
call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2)
|
||||
|
||||
if(degree == 1) then
|
||||
h2 = h1
|
||||
@ -454,7 +454,7 @@ integer function searchExc(excs, exc, n)
|
||||
use bitmasks
|
||||
|
||||
integer, intent(in) :: n
|
||||
integer*2,intent(in) :: excs(4,n), exc(4)
|
||||
integer,intent(in) :: excs(4,n), exc(4)
|
||||
integer :: l, h, c
|
||||
integer, external :: excCmp
|
||||
logical, external :: excEq
|
||||
@ -519,8 +519,8 @@ subroutine sort_exc(key, N_key)
|
||||
|
||||
|
||||
integer, intent(in) :: N_key
|
||||
integer*2,intent(inout) :: key(4,N_key)
|
||||
integer*2 :: tmp(4)
|
||||
integer,intent(inout) :: key(4,N_key)
|
||||
integer :: tmp(4)
|
||||
integer :: i,ni
|
||||
|
||||
|
||||
@ -542,7 +542,7 @@ end subroutine
|
||||
|
||||
logical function exc_inf(exc1, exc2)
|
||||
implicit none
|
||||
integer*2,intent(in) :: exc1(4), exc2(4)
|
||||
integer,intent(in) :: exc1(4), exc2(4)
|
||||
integer :: i
|
||||
exc_inf = .false.
|
||||
do i=1,4
|
||||
@ -564,9 +564,9 @@ subroutine tamise_exc(key, no, n, N_key)
|
||||
! Uncodumented : TODO
|
||||
END_DOC
|
||||
integer,intent(in) :: no, n, N_key
|
||||
integer*2,intent(inout) :: key(4, N_key)
|
||||
integer,intent(inout) :: key(4, N_key)
|
||||
integer :: k,j
|
||||
integer*2 :: tmp(4)
|
||||
integer :: tmp(4)
|
||||
logical :: exc_inf
|
||||
integer :: ni
|
||||
|
||||
@ -595,8 +595,9 @@ end subroutine
|
||||
|
||||
subroutine dec_exc(exc, h1, h2, p1, p2)
|
||||
implicit none
|
||||
integer :: exc(0:2,2,2), s1, s2, degree
|
||||
integer*2, intent(out) :: h1, h2, p1, p2
|
||||
integer, intent(in) :: exc(0:2,2,2)
|
||||
integer, intent(out) :: h1, h2, p1, p2
|
||||
integer :: degree, s1, s2
|
||||
|
||||
degree = exc(0,1,1) + exc(0,1,2)
|
||||
|
||||
@ -607,7 +608,7 @@ subroutine dec_exc(exc, h1, h2, p1, p2)
|
||||
|
||||
if(degree == 0) return
|
||||
|
||||
call decode_exc_int2(exc, degree, h1, p1, h2, p2, s1, s2)
|
||||
call decode_exc(exc, degree, h1, p1, h2, p2, s1, s2)
|
||||
|
||||
h1 += mo_tot_num * (s1-1)
|
||||
p1 += mo_tot_num * (s1-1)
|
||||
@ -639,7 +640,7 @@ end subroutine
|
||||
&BEGIN_PROVIDER [ integer, N_ex_exists ]
|
||||
implicit none
|
||||
integer :: exc(0:2, 2, 2), degree, n, on, s, l, i
|
||||
integer*2 :: h1, h2, p1, p2
|
||||
integer :: h1, h2, p1, p2
|
||||
double precision :: phase
|
||||
logical,allocatable :: hh(:,:) , pp(:,:)
|
||||
|
||||
@ -977,11 +978,11 @@ double precision function get_dij(det1, det2, s, Nint)
|
||||
integer, intent(in) :: s, Nint
|
||||
integer(bit_kind) :: det1(Nint, 2), det2(Nint, 2)
|
||||
integer :: degree, f, exc(0:2, 2, 2), t
|
||||
integer*2 :: h1, h2, p1, p2, s1, s2
|
||||
integer :: h1, h2, p1, p2, s1, s2
|
||||
integer, external :: searchExc
|
||||
logical, external :: excEq
|
||||
double precision :: phase
|
||||
integer*2 :: tmp_array(4)
|
||||
integer :: tmp_array(4)
|
||||
|
||||
get_dij = 0d0
|
||||
call get_excitation(det1, det2, exc, degree, phase, Nint)
|
||||
@ -990,7 +991,7 @@ double precision function get_dij(det1, det2, s, Nint)
|
||||
stop "get_dij"
|
||||
end if
|
||||
|
||||
call decode_exc_int2(exc,degree,h1,p1,h2,p2,s1,s2)
|
||||
call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2)
|
||||
|
||||
if(degree == 1) then
|
||||
h2 = h1
|
||||
@ -1023,8 +1024,8 @@ double precision function get_dij(det1, det2, s, Nint)
|
||||
end function
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ integer*2, hh_exists, (4, N_hh_exists) ]
|
||||
&BEGIN_PROVIDER [ integer*2, pp_exists, (4, N_pp_exists) ]
|
||||
BEGIN_PROVIDER [ integer, hh_exists, (4, N_hh_exists) ]
|
||||
&BEGIN_PROVIDER [ integer, pp_exists, (4, N_pp_exists) ]
|
||||
&BEGIN_PROVIDER [ integer, hh_shortcut, (0:N_hh_exists + 1) ]
|
||||
&BEGIN_PROVIDER [ integer, hh_nex ]
|
||||
implicit none
|
||||
@ -1039,9 +1040,9 @@ end function
|
||||
! hh_nex : Total number of excitation operators
|
||||
!
|
||||
END_DOC
|
||||
integer*2,allocatable :: num(:,:)
|
||||
integer,allocatable :: num(:,:)
|
||||
integer :: exc(0:2, 2, 2), degree, n, on, s, l, i
|
||||
integer*2 :: h1, h2, p1, p2
|
||||
integer :: h1, h2, p1, p2
|
||||
double precision :: phase
|
||||
logical, external :: excEq
|
||||
|
||||
@ -1067,19 +1068,19 @@ end function
|
||||
|
||||
hh_shortcut(0) = 1
|
||||
hh_shortcut(1) = 1
|
||||
hh_exists(:,1) = (/1_2, num(1,1), 1_2, num(2,1)/)
|
||||
pp_exists(:,1) = (/1_2, num(3,1), 1_2, num(4,1)/)
|
||||
hh_exists(:,1) = (/1, num(1,1), 1, num(2,1)/)
|
||||
pp_exists(:,1) = (/1, num(3,1), 1, num(4,1)/)
|
||||
s = 1
|
||||
do i=2,n
|
||||
if(.not. excEq(num(1,i), num(1,s))) then
|
||||
s += 1
|
||||
num(:, s) = num(:, i)
|
||||
pp_exists(:,s) = (/1_2, num(3,s), 1_2, num(4,s)/)
|
||||
pp_exists(:,s) = (/1, num(3,s), 1, num(4,s)/)
|
||||
if(hh_exists(2, hh_shortcut(0)) /= num(1,s) .or. &
|
||||
hh_exists(4, hh_shortcut(0)) /= num(2,s)) then
|
||||
hh_shortcut(0) += 1
|
||||
hh_shortcut(hh_shortcut(0)) = s
|
||||
hh_exists(:,hh_shortcut(0)) = (/1_2, num(1,s), 1_2, num(2,s)/)
|
||||
hh_exists(:,hh_shortcut(0)) = (/1, num(1,s), 1, num(2,s)/)
|
||||
end if
|
||||
end if
|
||||
end do
|
||||
@ -1127,7 +1128,7 @@ END_PROVIDER
|
||||
|
||||
logical function excEq(exc1, exc2)
|
||||
implicit none
|
||||
integer*2, intent(in) :: exc1(4), exc2(4)
|
||||
integer, intent(in) :: exc1(4), exc2(4)
|
||||
integer :: i
|
||||
excEq = .false.
|
||||
do i=1, 4
|
||||
@ -1139,7 +1140,7 @@ end function
|
||||
|
||||
integer function excCmp(exc1, exc2)
|
||||
implicit none
|
||||
integer*2, intent(in) :: exc1(4), exc2(4)
|
||||
integer, intent(in) :: exc1(4), exc2(4)
|
||||
integer :: i
|
||||
excCmp = 0
|
||||
do i=1, 4
|
||||
@ -1158,8 +1159,8 @@ subroutine apply_hole_local(det, exc, res, ok, Nint)
|
||||
use bitmasks
|
||||
implicit none
|
||||
integer, intent(in) :: Nint
|
||||
integer*2, intent(in) :: exc(4)
|
||||
integer*2 :: s1, s2, h1, h2
|
||||
integer, intent(in) :: exc(4)
|
||||
integer :: s1, s2, h1, h2
|
||||
integer(bit_kind),intent(in) :: det(Nint, 2)
|
||||
integer(bit_kind),intent(out) :: res(Nint, 2)
|
||||
logical, intent(out) :: ok
|
||||
@ -1195,8 +1196,8 @@ subroutine apply_particle_local(det, exc, res, ok, Nint)
|
||||
use bitmasks
|
||||
implicit none
|
||||
integer, intent(in) :: Nint
|
||||
integer*2, intent(in) :: exc(4)
|
||||
integer*2 :: s1, s2, p1, p2
|
||||
integer, intent(in) :: exc(4)
|
||||
integer :: s1, s2, p1, p2
|
||||
integer(bit_kind),intent(in) :: det(Nint, 2)
|
||||
integer(bit_kind),intent(out) :: res(Nint, 2)
|
||||
logical, intent(out) :: ok
|
||||
|
||||
@ -166,72 +166,6 @@ subroutine decode_exc(exc,degree,h1,p1,h2,p2,s1,s2)
|
||||
end
|
||||
|
||||
|
||||
subroutine decode_exc_int2(exc,degree,h1,p1,h2,p2,s1,s2)
|
||||
use bitmasks
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Decodes the exc arrays returned by get_excitation.
|
||||
! h1,h2 : Holes
|
||||
! p1,p2 : Particles
|
||||
! s1,s2 : Spins (1:alpha, 2:beta)
|
||||
! degree : Degree of excitation
|
||||
END_DOC
|
||||
integer, intent(in) :: exc(0:2,2,2),degree
|
||||
integer*2, intent(out) :: h1,h2,p1,p2,s1,s2
|
||||
ASSERT (degree > 0)
|
||||
ASSERT (degree < 3)
|
||||
|
||||
select case(degree)
|
||||
case(2)
|
||||
if (exc(0,1,1) == 2) then
|
||||
h1 = int(exc(1,1,1),2)
|
||||
h2 = int(exc(2,1,1),2)
|
||||
p1 = int(exc(1,2,1),2)
|
||||
p2 = int(exc(2,2,1),2)
|
||||
s1 = 1_2
|
||||
s2 = 1_2
|
||||
else if (exc(0,1,2) == 2) then
|
||||
h1 = int(exc(1,1,2),2)
|
||||
h2 = int(exc(2,1,2),2)
|
||||
p1 = int(exc(1,2,2),2)
|
||||
p2 = int(exc(2,2,2),2)
|
||||
s1 = 2_2
|
||||
s2 = 2_2
|
||||
else
|
||||
h1 = int(exc(1,1,1),2)
|
||||
h2 = int(exc(1,1,2),2)
|
||||
p1 = int(exc(1,2,1),2)
|
||||
p2 = int(exc(1,2,2),2)
|
||||
s1 = 1_2
|
||||
s2 = 2_2
|
||||
endif
|
||||
case(1)
|
||||
if (exc(0,1,1) == 1) then
|
||||
h1 = int(exc(1,1,1),2)
|
||||
h2 = 0_2
|
||||
p1 = int(exc(1,2,1),2)
|
||||
p2 = 0_2
|
||||
s1 = 1_2
|
||||
s2 = 0_2
|
||||
else
|
||||
h1 = int(exc(1,1,2),2)
|
||||
h2 = 0_2
|
||||
p1 = int(exc(1,2,2),2)
|
||||
p2 = 0_2
|
||||
s1 = 2_2
|
||||
s2 = 0_2
|
||||
endif
|
||||
case(0)
|
||||
h1 = 0_2
|
||||
p1 = 0_2
|
||||
h2 = 0_2
|
||||
p2 = 0_2
|
||||
s1 = 0_2
|
||||
s2 = 0_2
|
||||
end select
|
||||
end
|
||||
|
||||
|
||||
subroutine get_double_excitation(det1,det2,exc,phase,Nint)
|
||||
use bitmasks
|
||||
implicit none
|
||||
|
||||
@ -42,7 +42,7 @@
|
||||
9;;
|
||||
END_TEMPLATE
|
||||
case default
|
||||
stop 'Error in ao_cart_to_sphe'
|
||||
stop 'Error in ao_cart_to_sphe : angular momentum too high'
|
||||
end select
|
||||
enddo
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user