10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-09-16 17:35:42 +02:00
quantum_package/plugins/MRPT_Utils/pt2_new.irp.f
Anthony Scemama 94f01c0892 Bugs to fix (#50)
* Add config for knl

* Add mising readme

* Add .gitignore

* Add pseudo to qp_convert

* Working pseudo

* Dressed matrix for pt2 works for one state

* now eigenfunction of S^2

* minor modifs in printing

* Fixed the perturbation with psi_ref instead of psi_det

* Trying do really fo sin free multiple excitations

* Beginning to merge MRCC and MRPT

* final version of MRPT, at least I hope

* Fix 404: Update Zlib Url.

* Delete ifort_knl.cfg

* Update module_handler.py

* Update pot_ao_pseudo_ints.irp.f

* Update map_module.f90

* Restaure map_module.f90

* Update configure

* Update configure

* Update sort.irp.f

* Update sort.irp.f

* Update selection.irp.f

* Update selection.irp.f

* Update dressing.irp.f

* TApplencourt IRPF90 -> LCPQ

* Remove `irpf90.make` in dependency

* Update configure

* Missing PROVIDE

* Missing PROVIDE

* Missing PROVIDE

* Missing PROVIDE

* Update configure

* pouet

* density based mrpt2

* debugging FOBOCI

* Added SCF_density

* New version of FOBOCI

* added density.irp.f

* minor changes in plugins/FOBOCI/SC2_1h1p.irp.f

* added track_orb.irp.f

* minor changes

* minor modifs in FOBOCI

* med

* Minor changes

* minor changes

* strange things in MRPT

* minor modifs

mend

* Fix #185 (Graphviz API / Python 2.6)

* beginning to debug dft

* fixed the factor 2 in lebedev

* DFT integration works for non overlapping densities

* DFT begins to work with lda

* KS LDA is okay

* added core integrals

* mend

* Beginning logn range integrals

* Trying to handle two sets of integrals

* beginning to clean erf integrals

* Handling of two different mo and ao integrals map
2017-04-20 08:36:11 +02:00

72 lines
2.2 KiB
Fortran

subroutine i_H_psi_pert_new_minilist(key,keys,idx_key,N_minilist,coef,Nint,Ndet,Ndet_max,Nstate,i_H_psi_array,coef_pert)
use bitmasks
implicit none
integer, intent(in) :: Nint, Ndet,Ndet_max,Nstate,idx_key(Ndet), N_minilist
integer(bit_kind), intent(in) :: keys(Nint,2,Ndet)
integer(bit_kind), intent(in) :: key(Nint,2)
double precision, intent(in) :: coef(Ndet_max,Nstate)
double precision, intent(out) :: i_H_psi_array(Nstate)
double precision, intent(out) :: coef_pert
integer :: idx(0:Ndet)
integer :: i, ii,j, i_in_key, i_in_coef
double precision :: phase
integer :: exc(0:2,2,2)
double precision :: hij
double precision :: delta_e_final
double precision :: hjj
BEGIN_DOC
! Computes <i|H|Psi> = \sum_J c_J <i|H|J>.
!
! Uses filter_connected_i_H_psi0 to get all the |J> to which |i>
! is connected. The |J> are searched in short pre-computed lists.
END_DOC
ASSERT (Nint > 0)
ASSERT (N_int == Nint)
ASSERT (Nstate > 0)
ASSERT (Ndet > 0)
ASSERT (Ndet_max >= Ndet)
i_H_psi_array = 0.d0
coef_pert = 0.d0
call filter_connected_i_H_psi0(keys,key,Nint,N_minilist,idx)
double precision :: coef_array(Nstate)
if (Nstate == 1) then
do ii=1,idx(0)
i_in_key = idx(ii)
i_in_coef = idx_key(idx(ii))
!DIR$ FORCEINLINE
call i_H_j(keys(1,1,i_in_key),key,Nint,hij)
i_H_psi_array(1) = i_H_psi_array(1) + coef(i_in_coef,1)*hij
do i = 1, Nstate
coef_array(i) = coef(i_in_coef,i)
enddo
call get_delta_e_dyall(keys(1,1,i_in_key),key,coef_array,hij,delta_e_final)
coef_pert += coef(i_in_coef,1)*hij / delta_e_final
enddo
if (coef_pert * i_H_psi_array(1) > 0.d0)then
print*, coef_pert * i_H_psi_array(1)
endif
else
do ii=1,idx(0)
i_in_key = idx(ii)
i_in_coef = idx_key(idx(ii))
!DIR$ FORCEINLINE
call i_H_j(keys(1,1,i_in_key),key,Nint,hij)
i_H_psi_array(1) = i_H_psi_array(1) + coef(i_in_coef,1)*hij
do j = 1, Nstate
i_H_psi_array(j) = i_H_psi_array(j) + coef(i_in_coef,j)*hij
enddo
enddo
endif
end