diff --git a/plugins/Full_CI_ZMQ/selection.irp.f b/plugins/Full_CI_ZMQ/selection.irp.f index 357d42f7..8e1e43ae 100644 --- a/plugins/Full_CI_ZMQ/selection.irp.f +++ b/plugins/Full_CI_ZMQ/selection.irp.f @@ -86,7 +86,10 @@ subroutine select_connected(i_generator,E0,pt2,b,subset) double precision, intent(in) :: E0(N_states) integer(bit_kind) :: hole_mask(N_int,2), particle_mask(N_int,2) - double precision :: fock_diag_tmp(2,mo_tot_num+1) + + double precision, allocatable :: fock_diag_tmp(:,:) + + allocate(fock_diag_tmp(2,mo_tot_num+1)) call build_fock_tmp(fock_diag_tmp,psi_det_generators(1,1,i_generator),N_int) @@ -100,6 +103,7 @@ subroutine select_connected(i_generator,E0,pt2,b,subset) enddo call select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,pt2,b,subset) enddo + deallocate(fock_diag_tmp) end subroutine @@ -188,18 +192,21 @@ 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), mask(N_int, 2) - integer(1), intent(in) :: phasemask(2,N_int*bit_kind_size) - logical, intent(in) :: bannedOrb(mo_tot_num) - double precision, intent(in) :: coefs(N_states) + integer(bit_kind), intent(in) :: gen(N_int, 2), mask(N_int, 2) + integer(1), intent(in) :: phasemask(2,N_int*bit_kind_size) + logical, intent(in) :: bannedOrb(mo_tot_num) + double precision, intent(in) :: coefs(N_states) double precision, intent(inout) :: vect(N_states, mo_tot_num) - integer, intent(in) :: sp, h(0:2, 2), p(0:3, 2) - integer :: i, hole, p1, p2, sh - logical :: ok, lbanned(mo_tot_num) - integer(bit_kind) :: det(N_int, 2) - double precision :: hij - double precision, external :: get_phase_bi, integral8 + integer, intent(in) :: sp, h(0:2, 2), p(0:3, 2) + integer :: i, hole, p1, p2, sh + logical :: ok + + logical, allocatable :: lbanned(:) + integer(bit_kind) :: det(N_int, 2) + double precision :: hij + double precision, external :: get_phase_bi, integral8 + allocate (lbanned(mo_tot_num)) lbanned = bannedOrb sh = 1 if(h(0,2) == 1) sh = 2 @@ -239,6 +246,7 @@ subroutine get_m1(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs) vect(:,i) += hij * coefs end do end if + deallocate(lbanned) call apply_particle(mask, sp, p1, det, ok, N_int) call i_h_j(gen, det, N_int, hij) @@ -250,17 +258,20 @@ 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), mask(N_int, 2) - integer(1), intent(in) :: phasemask(2,N_int*bit_kind_size) - logical, intent(in) :: bannedOrb(mo_tot_num) - double precision, intent(in) :: coefs(N_states) + integer(bit_kind), intent(in) :: gen(N_int, 2), mask(N_int, 2) + integer(1), intent(in) :: phasemask(2,N_int*bit_kind_size) + logical, intent(in) :: bannedOrb(mo_tot_num) + double precision, intent(in) :: coefs(N_states) double precision, intent(inout) :: vect(N_states, mo_tot_num) - integer, intent(in) :: sp, h(0:2, 2), p(0:3, 2) - integer :: i - logical :: ok, lbanned(mo_tot_num) - integer(bit_kind) :: det(N_int, 2) - double precision :: hij + integer, intent(in) :: sp, h(0:2, 2), p(0:3, 2) + integer :: i + logical :: ok + + logical, allocatable :: lbanned(:) + integer(bit_kind) :: det(N_int, 2) + double precision :: hij + allocate(lbanned(mo_tot_num)) lbanned = bannedOrb lbanned(p(1,sp)) = .true. do i=1,mo_tot_num @@ -269,6 +280,7 @@ subroutine get_m0(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs) call i_h_j(gen, det, N_int, hij) vect(:, i) += hij * coefs end do + deallocate(lbanned) end subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,pt2,buf,subset) @@ -286,7 +298,6 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d double precision, intent(inout) :: pt2(N_states) type(selection_buffer), intent(inout) :: buf - double precision :: mat(N_states, mo_tot_num, mo_tot_num) integer :: h1,h2,s1,s2,s3,i1,i2,ib,sp,k,i,j,nt,ii integer(bit_kind) :: hole(N_int,2), particle(N_int,2), mask(N_int, 2), pmask(N_int, 2) logical :: fullMatch, ok @@ -295,6 +306,8 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d integer,allocatable :: preinteresting(:), prefullinteresting(:), interesting(:), fullinteresting(:) integer(bit_kind), allocatable :: minilist(:, :, :), fullminilist(:, :, :) logical, allocatable :: banned(:,:,:), bannedOrb(:,:) + + double precision, allocatable :: mat(:,:,:) logical :: monoAdo, monoBdo integer :: maskInd @@ -413,6 +426,7 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d allocate(minilist(N_int, 2, N_det_selectors), fullminilist(N_int, 2, N_det)) allocate(banned(mo_tot_num, mo_tot_num,2), bannedOrb(mo_tot_num, 2)) + allocate (mat(N_states, mo_tot_num, mo_tot_num)) maskInd = -1 integer :: nb_count do s1=1,2 @@ -533,7 +547,7 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d enddo enddo deallocate(preinteresting, prefullinteresting, interesting, fullinteresting) - deallocate(minilist, fullminilist, banned, bannedOrb) + deallocate(minilist, fullminilist, banned, bannedOrb,mat) end subroutine @@ -814,26 +828,28 @@ 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) - integer(1),intent(in) :: phasemask(2,N_int*bit_kind_size) - 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) + integer(bit_kind), intent(in) :: mask(N_int, 2), gen(N_int, 2) + integer(1),intent(in) :: phasemask(2,N_int*bit_kind_size) + 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) double precision, intent(inout) :: mat(N_states, mo_tot_num, mo_tot_num) - double precision :: hij, tmp_row(N_states, mo_tot_num), tmp_row2(N_states, mo_tot_num) - double precision, external :: get_phase_bi, integral8 + integer, intent(in) :: h(0:2,2), p(0:4,2), sp + double precision :: hij, tmp_row(N_states, mo_tot_num), tmp_row2(N_states, mo_tot_num) + double precision, external :: get_phase_bi, integral8 + logical :: ok + + logical, allocatable :: lbanned(:,:) + integer :: puti, putj, ma, mi, s1, s2, i, i1, i2, j + integer :: hfix, pfix, h1, h2, p1, p2, ib - logical :: lbanned(mo_tot_num, 2), ok - integer :: puti, putj, ma, mi, s1, s2, i, i1, i2, j, hfix, pfix, h1, h2, p1, p2, ib + integer, parameter :: turn2(2) = (/2,1/) + integer, parameter :: turn3(2,3) = reshape((/2,3, 1,3, 1,2/), (/2,3/)) - integer, intent(in) :: h(0:2,2), p(0:4,2), sp - - integer, parameter :: turn2(2) = (/2,1/) - integer, parameter :: turn3(2,3) = reshape((/2,3, 1,3, 1,2/), (/2,3/)) - - integer :: bant + integer :: bant + allocate (lbanned(mo_tot_num, 2)) lbanned = bannedOrb do i=1, p(0,1) @@ -952,6 +968,7 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) mat(:,p1,p1:) += tmp_row2(:,p1:) end if end if + deallocate(lbanned) !! MONO if(sp == 3) then diff --git a/src/Determinants/filter_connected.irp.f b/src/Determinants/filter_connected.irp.f index b76540f7..84775770 100644 --- a/src/Determinants/filter_connected.irp.f +++ b/src/Determinants/filter_connected.irp.f @@ -235,7 +235,9 @@ subroutine create_microlist(minilist, N_minilist, key_mask, microlist, idx_micro integer(bit_kind), intent(out) :: microlist(Nint,2,N_minilist*4) integer :: i,j,k,nt,n_element(2) - integer :: list(Nint*bit_kind_size,2), cur_microlist(0:mo_tot_num*2+1) + integer :: list(Nint*bit_kind_size,2) + integer, allocatable :: cur_microlist(:) + allocate (cur_microlist(0:mo_tot_num*2+1)) integer(bit_kind) :: key_mask_neg(Nint,2), mobileMask(Nint,2) integer :: mo_tot_num_2 mo_tot_num_2 = mo_tot_num+mo_tot_num @@ -324,6 +326,7 @@ subroutine create_microlist(minilist, N_minilist, key_mask, microlist, idx_micro end do end if end do + deallocate(cur_microlist) end subroutine diff --git a/src/Determinants/mono_excitations.irp.f b/src/Determinants/mono_excitations.irp.f index 01af4c25..ab0d5af3 100644 --- a/src/Determinants/mono_excitations.irp.f +++ b/src/Determinants/mono_excitations.irp.f @@ -36,7 +36,8 @@ BEGIN_PROVIDER [double precision, fock_operator_closed_shell_ref_bitmask, (mo_to key_virt(i,1) = xor(key_virt(i,1),ref_closed_shell_bitmask(i,1)) key_virt(i,2) = xor(key_virt(i,2),ref_closed_shell_bitmask(i,2)) enddo - double precision :: array_coulomb(mo_tot_num),array_exchange(mo_tot_num) + double precision, allocatable :: array_coulomb(:),array_exchange(:) + allocate (array_coulomb(mo_tot_num),array_exchange(mo_tot_num)) call bitstring_to_list_ab(key_virt, occ_virt, n_occ_ab_virt, N_int) ! docc ---> virt mono excitations do i0 = 1, n_occ_ab(1) @@ -89,6 +90,7 @@ BEGIN_PROVIDER [double precision, fock_operator_closed_shell_ref_bitmask, (mo_to fock_operator_closed_shell_ref_bitmask(j,i) = accu+ mo_mono_elec_integral(i,j) enddo enddo + deallocate(array_coulomb,array_exchange) END_PROVIDER diff --git a/src/Determinants/occ_pattern.irp.f b/src/Determinants/occ_pattern.irp.f index 38460f87..89350543 100644 --- a/src/Determinants/occ_pattern.irp.f +++ b/src/Determinants/occ_pattern.irp.f @@ -109,7 +109,8 @@ recursive subroutine rec_occ_pattern_to_dets(list_todo,nt,list_a,na,d,nd,sze,am endif else integer :: i, j, k - integer :: list_todo_tmp(nt) + integer, allocatable :: list_todo_tmp(:) + allocate (list_todo_tmp(nt)) do i=1,nt if (na > 0) then if (list_todo(i) < list_a(na)) then @@ -126,6 +127,7 @@ recursive subroutine rec_occ_pattern_to_dets(list_todo,nt,list_a,na,d,nd,sze,am enddo call rec_occ_pattern_to_dets(list_todo_tmp,nt-1,list_a,na+1,d,nd,sze,amax,Nint) enddo + deallocate(list_todo_tmp) endif end