From 11aeaa91c718bec9378370789500146d80281824 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 12 Apr 2017 19:50:56 +0200 Subject: [PATCH] Removed integer*2 --- plugins/Full_CI_ZMQ/pt2_stoch.irp.f | 2 +- plugins/MRCC_Utils/mrcc_utils.irp.f | 61 +++++++++++++------------ src/Determinants/slater_rules.irp.f | 66 --------------------------- src/MO_Basis/ao_ortho_canonical.irp.f | 2 +- 4 files changed, 33 insertions(+), 98 deletions(-) diff --git a/plugins/Full_CI_ZMQ/pt2_stoch.irp.f b/plugins/Full_CI_ZMQ/pt2_stoch.irp.f index 0bdca3b0..914e7138 100644 --- a/plugins/Full_CI_ZMQ/pt2_stoch.irp.f +++ b/plugins/Full_CI_ZMQ/pt2_stoch.irp.f @@ -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 diff --git a/plugins/MRCC_Utils/mrcc_utils.irp.f b/plugins/MRCC_Utils/mrcc_utils.irp.f index f7bf1d2b..0958b8d1 100644 --- a/plugins/MRCC_Utils/mrcc_utils.irp.f +++ b/plugins/MRCC_Utils/mrcc_utils.irp.f @@ -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 diff --git a/src/Determinants/slater_rules.irp.f b/src/Determinants/slater_rules.irp.f index c4bdcdc0..56ad5617 100644 --- a/src/Determinants/slater_rules.irp.f +++ b/src/Determinants/slater_rules.irp.f @@ -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 diff --git a/src/MO_Basis/ao_ortho_canonical.irp.f b/src/MO_Basis/ao_ortho_canonical.irp.f index 95a771b0..48341129 100644 --- a/src/MO_Basis/ao_ortho_canonical.irp.f +++ b/src/MO_Basis/ao_ortho_canonical.irp.f @@ -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