(T)

plugins/Full_CI/jmmrpt2.irp.f

@@ -1,29 +0,0 @@
-program pouet
-  implicit none
-  integer                        :: i,k
-
-
-  double precision, allocatable  :: pt2(:), norm_pert(:), H_pert_diag(:)
-  integer                        :: N_st, degree
-  N_st = N_states
-  allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st))
-  character*(64)                 :: perturbation
-  double precision :: i_H_psi_array(N_states),diag_H_mat_elem,h,i_O1_psi_array(N_states)
-  double precision :: E_CI_before(N_states)
-  integer :: n_det_before
-  threshold_generators = threshold_generators_pt2
-  threshold_selectors = threshold_selectors_pt2
-  SOFT_TOUCH threshold_generators threshold_selectors
-  call H_apply_FCI_PT2_new(pt2, norm_pert, H_pert_diag,  N_st)
-
-  print *,  'Final step'
-  print *,  'N_det    = ', N_det
-  print *,  'N_states = ', N_states
-  print *,  'PT2      = ', pt2
-  print *,  'E        = ', CI_energy(1:N_states)
-  print *,  'E+PT2    = ', CI_energy(1:N_states)+pt2(1:N_states)
-  print *,  '-----'
-  call ezfio_set_full_ci_energy_pt2(CI_energy(1)+pt2(1))
-  deallocate(pt2,norm_pert)
-end
-

plugins/MRPT/jm_mrpt2.irp.f

@@ -15,11 +15,17 @@ subroutine routine_3
  
  print *,  'N_det    = ', N_det
  print *,  'N_states = ', N_states
- print *,  'PT2      = ', second_order_pt_new(1)
- print *,  'E        = ', CI_energy(1)
- print *,  'E+PT2    = ', CI_energy(1)+second_order_pt_new(1)
+
+ integer :: i
+ do i=1,N_states
+  print *,  'State    = ', i
+  print *,  'PT2      = ', second_order_pt_new(i)
+  print *,  'E        = ', CI_energy(i)
+  print *,  'E+PT2    = ', CI_energy(i)+second_order_pt_new(i)
+  print *,  '-----------------------------'
+ enddo
  print *,'****** DIAGONALIZATION OF DRESSED MATRIX ******'
- print *,  'E dressed= ', CI_dressed_pt2_new_energy(1)
+ print *,  'E dressed= ', CI_dressed_pt2_new_energy(i)
 
 end
 

plugins/mrcepa0/dressing.irp.f

@@ -98,6 +98,7 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,delta_ij_s2_, delta_ii_s2_,i_gen
   integer :: mobiles(2), smallerlist
   logical, external :: detEq, is_generable
   !double precision, external :: get_dij, get_dij_index
+  double precision :: Delta_E_inv(N_states)
   
   if (perturbative_triples) then
     PROVIDE one_anhil fock_virt_total fock_core_inactive_total one_creat
@@ -107,7 +108,6 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,delta_ij_s2_, delta_ii_s2_,i_gen
   leng = max(N_det_generators, N_det_non_ref)
   allocate(miniList(Nint, 2, leng), tq(Nint,2,n_selected), idx_minilist(leng), hij_cache(N_det_non_ref), sij_cache(N_det_non_ref))
   allocate(idx_alpha(0:psi_det_size), degree_alpha(psi_det_size))
-  !create_minilist_find_previous(key_mask, fullList, miniList, N_fullList, N_miniList, fullMatch, Nint)
   call create_minilist_find_previous(key_mask, psi_det_generators, miniList, i_generator-1, N_miniList, fullMatch, Nint)
   
 !   if(fullMatch) then
@@ -231,9 +231,6 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,delta_ij_s2_, delta_ii_s2_,i_gen
         enddo
         logical :: ok
         call apply_excitation(psi_ref(1,1,i_I), exc, tmp_det, ok, Nint)
-        if (perturbative_triples) then
-          ok = ok .and. ( (degree2 /= 1).and.(degree /=1) )
-        endif
         
         do i_state=1,N_states
           dIK(i_state) = dij(i_I, idx_alpha(k_sd), i_state)
@@ -257,14 +254,27 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,delta_ij_s2_, delta_ii_s2_,i_gen
           enddo
 
         else if (perturbative_triples) then
+           ! Linked
 
-         call get_delta_e_dyall_general_mp(psi_ref(1,1,i_I),tq(1,1,i_alpha),Delta_E_inv)
+            call get_delta_e_dyall_general_mp(psi_ref(1,1,i_I),tq(1,1,i_alpha),Delta_E_inv)
 
-          hka = hij_cache(idx_alpha(k_sd))
-          do i_state=1,N_states
-            ASSERT (Delta_E_inv(i_state) < 0.d0)
-            dka(i_state) = hka / Delta_E_inv(i_state)
-          enddo
+            hka = hij_cache(idx_alpha(k_sd))
+            do i_state=1,N_states
+              ASSERT (Delta_E_inv(i_state) < 0.d0)
+              dka(i_state) = hka / Delta_E_inv(i_state)
+            enddo
+
+        endif
+
+        if (perturbative_triples.and. (degree2 == 1) ) then
+            call get_delta_e_dyall_general_mp(psi_ref(1,1,i_I),tq(1,1,i_alpha),Delta_E_inv)
+            call i_h_j(psi_ref(1,1,i_I),tmp_det,Nint,hka)
+            hka = hij_cache(idx_alpha(k_sd)) - hka
+
+            do i_state=1,N_states
+              ASSERT (Delta_E_inv(i_state) < 0.d0)
+              dka(i_state) = hka / Delta_E_inv(i_state)
+            enddo
 
         endif
 

plugins/mrcepa0/mrcepa0_general.irp.f

@@ -47,6 +47,9 @@ subroutine run(N_st,energy)
       enddo
       call diagonalize_ci_dressed(lambda)
       E_new = sum(ci_energy_dressed(1:N_states))
+!  if (.true.) then
+!    provide delta_ij_mrcc_pouet
+!  endif
       delta_E = (E_new - E_old)/dble(N_states)
       print *,  ''
       call write_double(6,thresh_mrcc,"thresh_mrcc")