LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-12-22 12:23:48 +01:00
Code Issues Releases Wiki Activity

Removed integer*2

Browse Source
This commit is contained in:
Anthony Scemama 2017-04-12 19:50:56 +02:00
parent 1d6593a288
commit 11aeaa91c7
4 changed files with 33 additions and 98 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
plugins/Full_CI_ZMQ/pt2_stoch.irp.f
View File

@ -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

61
plugins/MRCC_Utils/mrcc_utils.irp.f
View File

@ -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

66
src/Determinants/slater_rules.irp.f
View File

@ -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

2
src/MO_Basis/ao_ortho_canonical.irp.f
View File

@ -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