Reduced stask size

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

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
   
   

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
 

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