From 22b2870b9fa78e632a543a9ac4e0ef44a30ed40d Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Thu, 1 Mar 2018 11:35:00 +0100 Subject: [PATCH 1/3] corrected assert(N_states>1) --- plugins/dress_zmq/dress_stoch_routines.irp.f | 30 ++++++++------- plugins/mrcc_sto/mrcc_sto.irp.f | 39 ++++++++++---------- plugins/mrcepa0/mrcc_stoch_routines.irp.f | 9 +++-- 3 files changed, 43 insertions(+), 35 deletions(-) diff --git a/plugins/dress_zmq/dress_stoch_routines.irp.f b/plugins/dress_zmq/dress_stoch_routines.irp.f index 29ca80f7..b5b865ab 100644 --- a/plugins/dress_zmq/dress_stoch_routines.irp.f +++ b/plugins/dress_zmq/dress_stoch_routines.irp.f @@ -247,28 +247,28 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, time = omp_get_wtime() - - if(time - timeLast > 1d0 .or. (.not. loop)) then + if((time - timeLast > 2d0) .or. (.not. loop)) then timeLast = time cur_cp = N_cp - if(.not. actually_computed(dress_jobs(1))) cycle pullLoop - - do i=2,N_det_generators + + do i=1,N_det_generators if(.not. actually_computed(dress_jobs(i))) then - cur_cp = done_cp_at(i-1) + if(i /= 1) then + cur_cp = done_cp_at(i-1) + else + cur_cp = 0 + end if exit end if end do if(cur_cp == 0) cycle pullLoop - double precision :: su, su2, eqt, avg, E0, val integer, external :: zmq_abort su = 0d0 su2 = 0d0 - if(N_states > 1) stop "dress_stoch : N_states == 1" do i=1, int(cps_N(cur_cp)) call get_comb_val(comb(i), dress_detail, cur_cp, val) su += val @@ -280,11 +280,14 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, if(cp_first_tooth(cur_cp) <= comb_teeth) then E0 = E0 + dress_detail(1, first_det_of_teeth(cp_first_tooth(cur_cp))) * (1d0-fractage(cp_first_tooth(cur_cp))) end if + + call wall_time(time) if ((dabs(eqt) < relative_error .and. cps_N(cur_cp) >= 30) .or. total_computed == N_det_generators) then ! Termination - !print '(G10.3, 2X, F16.7, 2X, G16.3, 2X, F16.4, A20)', Nabove(tooth), avg+E, eqt, time-time0, '' -! print *, "GREPME", cur_cp, E+E0+avg, eqt, time-time0, total_computed + print "" + print "(A10,I5,F15.7,E12.4,F10.2)", "grepme", cur_cp, E+E0+avg, eqt, time-time0 + print "" if (zmq_abort(zmq_to_qp_run_socket) == -1) then call sleep(1) if (zmq_abort(zmq_to_qp_run_socket) == -1) then @@ -294,8 +297,9 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, else if (cur_cp > old_cur_cp) then old_cur_cp = cur_cp -! print *, "GREPME", cur_cp, E+E0+avg, eqt, time-time0, total_computed - !print '(G10.3, 2X, F16.7, 2X, G16.3, 2X, F16.4, A20)', Nabove(tooth), avg+E, eqt, time-time0, '' + print "" + print "(A10,I5,F15.7,E12.4,F10.2)", "grepme", cur_cp, E+E0+avg, eqt, time-time0 + print "" endif endif end if @@ -355,7 +359,7 @@ end function &BEGIN_PROVIDER [ integer, N_cps_max ] implicit none comb_teeth = 16 - N_cps_max = 32 + N_cps_max = 64 gen_per_cp = (N_det_generators / N_cps_max) + 1 N_cps_max += 1 END_PROVIDER diff --git a/plugins/mrcc_sto/mrcc_sto.irp.f b/plugins/mrcc_sto/mrcc_sto.irp.f index 0eb6a75e..a9942c02 100644 --- a/plugins/mrcc_sto/mrcc_sto.irp.f +++ b/plugins/mrcc_sto/mrcc_sto.irp.f @@ -61,28 +61,29 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, det_minilist, n_minil if (perturbative_triples) then PROVIDE one_anhil fock_virt_total fock_core_inactive_total one_creat endif + canbediamond = 0 do l_sd=1,n_minilist - call get_excitation(det_minilist(1,1,l_sd),alpha,exc,degree1,phase,N_int) - call decode_exc(exc,degree1,h1,p1,h2,p2,s1,s2) + call get_excitation(det_minilist(1,1,l_sd),alpha,exc,degree1,phase,N_int) + call decode_exc(exc,degree1,h1,p1,h2,p2,s1,s2) - ok = (mo_class(h1)(1:1) == 'A' .or. mo_class(h1)(1:1) == 'I') .and. & - (mo_class(p1)(1:1) == 'A' .or. mo_class(p1)(1:1) == 'V') - if(ok .and. degree1 == 2) then - ok = (mo_class(h2)(1:1) == 'A' .or. mo_class(h2)(1:1) == 'I') .and. & - (mo_class(p2)(1:1) == 'A' .or. mo_class(p2)(1:1) == 'V') - end if - - if(ok) then - canbediamond += 1 - excs_(:,:,:,l_sd,iproc) = exc(:,:,:) - phases_(l_sd, iproc) = phase - else - phases_(l_sd, iproc) = 0d0 - end if - !call i_h_j(alpha,det_minilist(1,1,l_sd),N_int,hij_cache_(l_sd,iproc)) - !call get_s2(alpha,det_minilist(1,1,l_sd),N_int,sij_cache_(l_sd,iproc)) - call i_h_j_s2(alpha,det_minilist(1,1,l_sd),N_int,hij_cache_(l_sd,iproc), sij_cache_(l_sd,iproc)) + ok = (mo_class(h1)(1:1) == 'A' .or. mo_class(h1)(1:1) == 'I') .and. & + (mo_class(p1)(1:1) == 'A' .or. mo_class(p1)(1:1) == 'V') + if(ok .and. degree1 == 2) then + ok = (mo_class(h2)(1:1) == 'A' .or. mo_class(h2)(1:1) == 'I') .and. & + (mo_class(p2)(1:1) == 'A' .or. mo_class(p2)(1:1) == 'V') + end if + + if(ok) then + canbediamond += 1 + excs_(:,:,:,l_sd,iproc) = exc(:,:,:) + phases_(l_sd, iproc) = phase + else + phases_(l_sd, iproc) = 0d0 + end if + !call i_h_j(alpha,det_minilist(1,1,l_sd),N_int,hij_cache_(l_sd,iproc)) + !call get_s2(alpha,det_minilist(1,1,l_sd),N_int,sij_cache_(l_sd,iproc)) + call i_h_j_s2(alpha,det_minilist(1,1,l_sd),N_int,hij_cache_(l_sd,iproc), sij_cache_(l_sd,iproc)) enddo if(canbediamond <= 1) return diff --git a/plugins/mrcepa0/mrcc_stoch_routines.irp.f b/plugins/mrcepa0/mrcc_stoch_routines.irp.f index d8537a8b..45907679 100644 --- a/plugins/mrcepa0/mrcc_stoch_routines.irp.f +++ b/plugins/mrcepa0/mrcc_stoch_routines.irp.f @@ -365,9 +365,12 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m if(cp_first_tooth(cur_cp) <= comb_teeth) then E0 = E0 + mrcc_detail(1, first_det_of_teeth(cp_first_tooth(cur_cp))) * (1d0-fractage(cp_first_tooth(cur_cp))) end if - - print "(I5,F15.7,E12.4,F10.2)", cur_cp, E+E0+avg, eqt, time-timeInit - + + if(cur_cp /= old_cur_cp) then + old_cur_cp = cur_cp + print "(A10, I5,F15.7,E12.4,F10.2)", "grepme", cur_cp, E+E0+avg, eqt, time-timeInit + end if + if ((dabs(eqt) < relative_error .and. cps_N(cur_cp) >= 30) .or. total_computed == N_det_generators) then if (zmq_abort(zmq_to_qp_run_socket) == -1) then call sleep(1) From 1a0f36dfa51f3a7748b80ce9231929b967af2439 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Fri, 2 Mar 2018 15:29:58 +0100 Subject: [PATCH 2/3] init shiftedbk --- plugins/Full_CI_ZMQ/selection.irp.f | 8 ++- plugins/dress_zmq/alpha_factory.irp.f | 8 +-- plugins/dress_zmq/dress_stoch_routines.irp.f | 8 +-- plugins/mrcc_sto/mrcc_sto.irp.f | 8 +-- plugins/shiftedbk/NEEDED_CHILDREN_MODULES | 1 + plugins/shiftedbk/README.rst | 12 ++++ plugins/shiftedbk/shifted_bk.irp.f | 60 ++++++++++++++++++++ 7 files changed, 92 insertions(+), 13 deletions(-) create mode 100644 plugins/shiftedbk/NEEDED_CHILDREN_MODULES create mode 100644 plugins/shiftedbk/README.rst create mode 100644 plugins/shiftedbk/shifted_bk.irp.f diff --git a/plugins/Full_CI_ZMQ/selection.irp.f b/plugins/Full_CI_ZMQ/selection.irp.f index acda9fa6..b3256f6a 100644 --- a/plugins/Full_CI_ZMQ/selection.irp.f +++ b/plugins/Full_CI_ZMQ/selection.irp.f @@ -774,6 +774,7 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) if(tip == 3) then puti = p(1, mi) + if(bannedOrb(puti, mi)) return do i = 1, 3 putj = p(i, ma) if(banned(putj,puti,bant)) cycle @@ -796,11 +797,12 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) h2 = h(1,2) do j = 1,2 putj = p(j, 2) + if(bannedOrb(putj, 2)) cycle p2 = p(turn2(j), 2) do i = 1,2 puti = p(i, 1) - if(banned(puti,putj,bant)) cycle + if(banned(puti,putj,bant) .or. bannedOrb(puti,1)) cycle p1 = p(turn2(i), 1) hij = mo_bielec_integral(p1, p2, h1, h2) * get_phase_bi(phasemask, 1, 2, h1, p1, h2, p2) @@ -815,8 +817,10 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) h2 = h(2, ma) do i=1,3 puti = p(i, ma) + if(bannedOrb(puti,ma)) cycle do j=i+1,4 putj = p(j, ma) + if(bannedOrb(putj,ma)) cycle if(banned(puti,putj,1)) cycle i1 = turn2d(1, i, j) @@ -833,7 +837,9 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) p1 = p(1, mi) do i=1,3 puti = p(turn3(1,i), ma) + if(bannedOrb(puti,ma)) cycle putj = p(turn3(2,i), ma) + if(bannedOrb(putj,ma)) cycle if(banned(puti,putj,1)) cycle p2 = p(i, ma) diff --git a/plugins/dress_zmq/alpha_factory.irp.f b/plugins/dress_zmq/alpha_factory.irp.f index f1a3a8e9..93196cc8 100644 --- a/plugins/dress_zmq/alpha_factory.irp.f +++ b/plugins/dress_zmq/alpha_factory.irp.f @@ -376,7 +376,7 @@ subroutine generate_singles_and_doubles(delta_ij_loc, i_generator, bitmask_index !print *, "IND1", indexes(1,:) !print *, "IND2", indexes_end(1,:) !stop - call alpha_callback_mask(delta_ij_loc, sp, mask, bannedOrb, banned, indexes, indexes_end, abuf, siz, iproc) + call alpha_callback_mask(delta_ij_loc, i_generator, sp, mask, bannedOrb, banned, indexes, indexes_end, abuf, siz, iproc) !call dress_with_alpha_buffer(delta_ij_loc, minilist, interesting(0), abuf, n) end if @@ -388,12 +388,12 @@ subroutine generate_singles_and_doubles(delta_ij_loc, i_generator, bitmask_index end subroutine -subroutine alpha_callback_mask(delta_ij_loc, sp, mask, bannedOrb, banned, indexes, indexes_end, rabuf, siz, iproc) +subroutine alpha_callback_mask(delta_ij_loc, i_gen, sp, mask, bannedOrb, banned, indexes, indexes_end, rabuf, siz, iproc) use bitmasks implicit none double precision,intent(inout) :: delta_ij_loc(N_states,N_det,2) - integer, intent(in) :: sp, indexes(0:mo_tot_num, 0:mo_tot_num), siz, iproc + integer, intent(in) :: sp, indexes(0:mo_tot_num, 0:mo_tot_num), siz, iproc, i_gen integer, intent(in) :: indexes_end(0:mo_tot_num, 0:mo_tot_num), rabuf(*) logical, intent(in) :: bannedOrb(mo_tot_num,2), banned(mo_tot_num, mo_tot_num) integer(bit_kind), intent(in) :: mask(N_int, 2) @@ -491,7 +491,7 @@ subroutine alpha_callback_mask(delta_ij_loc, sp, mask, bannedOrb, banned, indexe call apply_particles(mask, s1, i, s2, j, alpha, ok, N_int) !if(.not. ok) stop "non existing alpha......" !print *, "willcall", st4-1, size(labuf) - call dress_with_alpha_buffer(delta_ij_loc, labuf, det_minilist, st4-1, alpha, iproc) + call dress_with_alpha_buffer(delta_ij_loc, i_gen, labuf, det_minilist, st4-1, alpha, iproc) !call dress_with_alpha_buffer(delta_ij_loc, abuf, siz, alpha, 1) end if end do diff --git a/plugins/dress_zmq/dress_stoch_routines.irp.f b/plugins/dress_zmq/dress_stoch_routines.irp.f index b5b865ab..65f9799e 100644 --- a/plugins/dress_zmq/dress_stoch_routines.irp.f +++ b/plugins/dress_zmq/dress_stoch_routines.irp.f @@ -285,9 +285,9 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, call wall_time(time) if ((dabs(eqt) < relative_error .and. cps_N(cur_cp) >= 30) .or. total_computed == N_det_generators) then ! Termination - print "" + print *,"" print "(A10,I5,F15.7,E12.4,F10.2)", "grepme", cur_cp, E+E0+avg, eqt, time-time0 - print "" + print *,"" if (zmq_abort(zmq_to_qp_run_socket) == -1) then call sleep(1) if (zmq_abort(zmq_to_qp_run_socket) == -1) then @@ -297,9 +297,9 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, else if (cur_cp > old_cur_cp) then old_cur_cp = cur_cp - print "" + print *,"" print "(A10,I5,F15.7,E12.4,F10.2)", "grepme", cur_cp, E+E0+avg, eqt, time-time0 - print "" + print *,"" endif endif end if diff --git a/plugins/mrcc_sto/mrcc_sto.irp.f b/plugins/mrcc_sto/mrcc_sto.irp.f index a9942c02..f94d9409 100644 --- a/plugins/mrcc_sto/mrcc_sto.irp.f +++ b/plugins/mrcc_sto/mrcc_sto.irp.f @@ -21,7 +21,7 @@ END_PROVIDER -subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, det_minilist, n_minilist, alpha, iproc) +subroutine dress_with_alpha_buffer(delta_ij_loc, i_gen, minilist, det_minilist, n_minilist, alpha, iproc) use bitmasks implicit none BEGIN_DOC @@ -32,7 +32,7 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, det_minilist, n_minil !alpha : alpha determinant END_DOC integer(bit_kind), intent(in) :: alpha(N_int,2), det_minilist(N_int, 2, n_minilist) - integer,intent(in) :: minilist(n_minilist), n_minilist, iproc + integer,intent(in) :: minilist(n_minilist), n_minilist, iproc, i_gen double precision, intent(inout) :: delta_ij_loc(N_states,N_det,2) @@ -190,9 +190,9 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, det_minilist, n_minil do i_state=1,N_states hdress = dIa(i_state) * hla * psi_ref_coef(i_I,i_state) sdress = dIa(i_state) * sla * psi_ref_coef(i_I,i_state) - !$OMP ATOMIC + !!!$OMP ATOMIC delta_ij_loc(i_state,k_sd,1) += hdress - !$OMP ATOMIC + !!!$OMP ATOMIC delta_ij_loc(i_state,k_sd,2) += sdress enddo enddo diff --git a/plugins/shiftedbk/NEEDED_CHILDREN_MODULES b/plugins/shiftedbk/NEEDED_CHILDREN_MODULES new file mode 100644 index 00000000..5d17e71f --- /dev/null +++ b/plugins/shiftedbk/NEEDED_CHILDREN_MODULES @@ -0,0 +1 @@ +dress_zmq diff --git a/plugins/shiftedbk/README.rst b/plugins/shiftedbk/README.rst new file mode 100644 index 00000000..d2fa5135 --- /dev/null +++ b/plugins/shiftedbk/README.rst @@ -0,0 +1,12 @@ +========= +shiftedbk +========= + +Needed Modules +============== +.. Do not edit this section It was auto-generated +.. by the `update_README.py` script. +Documentation +============= +.. Do not edit this section It was auto-generated +.. by the `update_README.py` script. diff --git a/plugins/shiftedbk/shifted_bk.irp.f b/plugins/shiftedbk/shifted_bk.irp.f new file mode 100644 index 00000000..12c867d6 --- /dev/null +++ b/plugins/shiftedbk/shifted_bk.irp.f @@ -0,0 +1,60 @@ + +program mrcc_sto + implicit none + BEGIN_DOC +! TODO + END_DOC + call dress_zmq() +end + + +! BEGIN_PROVIDER [ double precision, hij_cache_, (N_det,Nproc) ] +!&BEGIN_PROVIDER [ double precision, sij_cache_, (N_det,Nproc) ] + BEGIN_PROVIDER [ double precision, fock_diag_tmp_, (2,mo_tot_num+1,Nproc) ] +&BEGIN_PROVIDER [ integer, current_generator_, (Nproc) ] + implicit none +! allocate(fock_diag_tmp(2,mo_tot_num+1)) + current_generator_(:) = 0 + END_PROVIDER + + + +subroutine dress_with_alpha_buffer(delta_ij_loc, i_gen, minilist, det_minilist, n_minilist, alpha, iproc) + use bitmasks + implicit none + BEGIN_DOC + !delta_ij_loc(:,:,1) : dressing column for H + !delta_ij_loc(:,:,2) : dressing column for S2 + !minilist : indices of determinants connected to alpha ( in psi_det_sorted ) + !n_minilist : size of minilist + !alpha : alpha determinant + END_DOC + integer(bit_kind), intent(in) :: alpha(N_int,2), det_minilist(N_int, 2, n_minilist) + integer,intent(in) :: minilist(n_minilist), n_minilist, iproc, i_gen + double precision, intent(inout) :: delta_ij_loc(N_states,N_det,2) + double precision :: hii, hij, sij, delta_e + double precision, external :: diag_H_mat_elem_fock + integer :: i,j,k,l,m, l_sd + + + if(current_generator_(iproc) /= i_gen) then + current_generator_(iproc) = i_gen + call build_fock_tmp(fock_diag_tmp_(1,1,iproc),psi_det_generators(1,1,i_gen),N_int) + end if + !return + hii = diag_H_mat_elem_fock(psi_det_generators(1,1,i_gen),alpha,fock_diag_tmp_(1,1,iproc),N_int) + + + do l_sd=1,n_minilist + call i_h_j_s2(alpha,det_minilist(1,1,l_sd),N_int,hij, sij) + do i=1,N_states + delta_ij_loc(i, minilist(l_sd), 1) += hij / hii * psi_coef(minilist(l_sd), i) + end do + end do +end subroutine + + + + + + From bc626377f389c9f1b40a1625584731314010e80f Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Mon, 5 Mar 2018 12:43:31 +0100 Subject: [PATCH 3/3] shiftedbk not working - may be removed later --- plugins/shiftedbk/shifted_bk.irp.f | 52 +++++++++++++++++++++++------- 1 file changed, 41 insertions(+), 11 deletions(-) diff --git a/plugins/shiftedbk/shifted_bk.irp.f b/plugins/shiftedbk/shifted_bk.irp.f index 12c867d6..4b9c7433 100644 --- a/plugins/shiftedbk/shifted_bk.irp.f +++ b/plugins/shiftedbk/shifted_bk.irp.f @@ -8,12 +8,9 @@ program mrcc_sto end -! BEGIN_PROVIDER [ double precision, hij_cache_, (N_det,Nproc) ] -!&BEGIN_PROVIDER [ double precision, sij_cache_, (N_det,Nproc) ] BEGIN_PROVIDER [ double precision, fock_diag_tmp_, (2,mo_tot_num+1,Nproc) ] &BEGIN_PROVIDER [ integer, current_generator_, (Nproc) ] implicit none -! allocate(fock_diag_tmp(2,mo_tot_num+1)) current_generator_(:) = 0 END_PROVIDER @@ -25,6 +22,7 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, i_gen, minilist, det_minilist, BEGIN_DOC !delta_ij_loc(:,:,1) : dressing column for H !delta_ij_loc(:,:,2) : dressing column for S2 + !i_gen : generator index in psi_det_generators !minilist : indices of determinants connected to alpha ( in psi_det_sorted ) !n_minilist : size of minilist !alpha : alpha determinant @@ -35,21 +33,31 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, i_gen, minilist, det_minilist, double precision :: hii, hij, sij, delta_e double precision, external :: diag_H_mat_elem_fock integer :: i,j,k,l,m, l_sd + double precision, save :: tot = 0d0 + double precision :: de(N_states), val, tmp + stop "shiftedbk currently does not work" if(current_generator_(iproc) /= i_gen) then current_generator_(iproc) = i_gen call build_fock_tmp(fock_diag_tmp_(1,1,iproc),psi_det_generators(1,1,i_gen),N_int) end if - !return - hii = diag_H_mat_elem_fock(psi_det_generators(1,1,i_gen),alpha,fock_diag_tmp_(1,1,iproc),N_int) - - do l_sd=1,n_minilist - call i_h_j_s2(alpha,det_minilist(1,1,l_sd),N_int,hij, sij) - do i=1,N_states - delta_ij_loc(i, minilist(l_sd), 1) += hij / hii * psi_coef(minilist(l_sd), i) + hii = diag_H_mat_elem_fock(psi_det_generators(1,1,i_gen),alpha,fock_diag_tmp_(1,1,iproc),N_int) + do i=1,N_states + de(i) = (E0_denominator(i) - hii) + end do + + do i=1,N_states + val = 0D0 + do l_sd=1,n_minilist + call i_h_j_s2(alpha,det_minilist(1,1,l_sd),N_int,hij, sij) + val += hij end do + val = 2d0 * val + tmp = dsqrt(de(i)**2 + val**2) + if(de(i) < 0d0) tmp = -tmp + delta_ij_loc(i, minilist(l_sd), 1) += 0.5d0 * (tmp - de(i)) ! * psi_coef(minilist(l_sd), i) end do end subroutine @@ -57,4 +65,26 @@ end subroutine - +BEGIN_PROVIDER [ logical, initialize_E0_denominator ] + implicit none + BEGIN_DOC + ! If true, initialize pt2_E0_denominator + END_DOC + initialize_E0_denominator = .True. +END_PROVIDER + +BEGIN_PROVIDER [ double precision, E0_denominator, (N_states) ] + implicit none + BEGIN_DOC + ! E0 in the denominator of the PT2 + END_DOC + if (initialize_E0_denominator) then + E0_denominator(1:N_states) = psi_energy(1:N_states) + ! call ezfio_get_full_ci_zmq_energy(pt2_E0_denominator(1)) + ! pt2_E0_denominator(1) -= nuclear_repulsion + ! pt2_E0_denominator(1:N_states) = HF_energy - nuclear_repulsion + ! pt2_E0_denominator(1:N_states) = barycentric_electronic_energy(1:N_states) + else + E0_denominator = -huge(1.d0) + endif +END_PROVIDER