10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-11-03 20:54:00 +01:00

Fixed MP2 and MP2 wf

This commit is contained in:
Anthony Scemama 2016-01-02 21:45:28 +01:00
parent 6cd35b90bf
commit e4b86d9e2b
4 changed files with 62 additions and 57 deletions

View File

@ -73,10 +73,6 @@
enddo enddo
endif endif
! Introduce level shift here
do i = elec_alpha_num+1, mo_tot_num
Fock_matrix_mo(i,i) += level_shift
enddo
do i = 1, mo_tot_num do i = 1, mo_tot_num
Fock_matrix_diag_mo(i) = Fock_matrix_mo(i,i) Fock_matrix_diag_mo(i) = Fock_matrix_mo(i,i)

View File

@ -11,55 +11,55 @@
double precision, allocatable :: work(:), F(:,:), S(:,:) double precision, allocatable :: work(:), F(:,:), S(:,:)
if (mo_tot_num == ao_num) then ! if (mo_tot_num == ao_num) then
! Solve H.C = E.S.C in AO basis set ! ! Solve H.C = E.S.C in AO basis set
!
allocate(F(ao_num_align,ao_num), S(ao_num_align,ao_num) ) ! allocate(F(ao_num_align,ao_num), S(ao_num_align,ao_num) )
do j=1,ao_num ! do j=1,ao_num
do i=1,ao_num ! do i=1,ao_num
S(i,j) = ao_overlap(i,j) ! S(i,j) = ao_overlap(i,j)
F(i,j) = Fock_matrix_ao(i,j) ! F(i,j) = Fock_matrix_ao(i,j)
enddo ! enddo
enddo ! enddo
!
n = ao_num ! n = ao_num
lwork = 1+6*n + 2*n*n ! lwork = 1+6*n + 2*n*n
liwork = 3 + 5*n ! liwork = 3 + 5*n
!
allocate(work(lwork), iwork(liwork) ) ! allocate(work(lwork), iwork(liwork) )
!
lwork = -1 ! lwork = -1
liwork = -1 ! liwork = -1
!
call dsygvd(1,'v','u',ao_num,F,size(F,1),S,size(S,1),& ! call dsygvd(1,'v','u',ao_num,F,size(F,1),S,size(S,1),&
diagonal_Fock_matrix_mo, work, lwork, iwork, liwork, info) ! diagonal_Fock_matrix_mo, work, lwork, iwork, liwork, info)
!
if (info /= 0) then ! if (info /= 0) then
print *, irp_here//' failed : ', info ! print *, irp_here//' failed : ', info
stop 1 ! stop 1
endif ! endif
lwork = int(work(1)) ! lwork = int(work(1))
liwork = iwork(1) ! liwork = iwork(1)
deallocate(work,iwork) ! deallocate(work,iwork)
allocate(work(lwork), iwork(liwork) ) ! allocate(work(lwork), iwork(liwork) )
!
call dsygvd(1,'v','u',ao_num,F,size(F,1),S,size(S,1),& ! call dsygvd(1,'v','u',ao_num,F,size(F,1),S,size(S,1),&
diagonal_Fock_matrix_mo, work, lwork, iwork, liwork, info) ! diagonal_Fock_matrix_mo, work, lwork, iwork, liwork, info)
!
if (info /= 0) then ! if (info /= 0) then
print *, irp_here//' failed : ', info ! print *, irp_here//' failed : ', info
stop 1 ! stop 1
endif ! endif
do j=1,mo_tot_num ! do j=1,mo_tot_num
do i=1,ao_num ! do i=1,ao_num
eigenvectors_Fock_matrix_mo(i,j) = F(i,j) ! eigenvectors_Fock_matrix_mo(i,j) = F(i,j)
enddo ! enddo
enddo ! enddo
!
deallocate(work, iwork, F, S) ! deallocate(work, iwork, F, S)
!
else ! else
!
! Solve H.C = E.C in MO basis set ! Solve H.C = E.C in MO basis set
allocate( F(mo_tot_num_align,mo_tot_num) ) allocate( F(mo_tot_num_align,mo_tot_num) )
@ -69,6 +69,12 @@
enddo enddo
enddo enddo
! Insert level shift here
do i = elec_alpha_num+1, mo_tot_num
Fock_matrix_mo(i,i) += level_shift
enddo
n = mo_tot_num n = mo_tot_num
lwork = 1+6*n + 2*n*n lwork = 1+6*n + 2*n*n
liwork = 3 + 5*n liwork = 3 + 5*n
@ -105,7 +111,12 @@
0.d0, eigenvectors_Fock_matrix_mo, size(eigenvectors_Fock_matrix_mo,1)) 0.d0, eigenvectors_Fock_matrix_mo, size(eigenvectors_Fock_matrix_mo,1))
deallocate(work, iwork, F) deallocate(work, iwork, F)
endif ! Remove level shift
do i = elec_alpha_num+1, mo_tot_num
Fock_matrix_mo(i,i) -= level_shift
enddo
! endif
END_PROVIDER END_PROVIDER

View File

@ -12,8 +12,7 @@ program mp2_wf
allocate (pt2(N_st), norm_pert(N_st), H_pert_diag(N_st)) allocate (pt2(N_st), norm_pert(N_st), H_pert_diag(N_st))
pt2 = 1.d0 pt2 = 1.d0
selection_criterion = 1.e-12 selection_criterion_factor = 0.d0
selection_criterion_min = 1.e-12
TOUCH selection_criterion_min selection_criterion selection_criterion_factor TOUCH selection_criterion_min selection_criterion selection_criterion_factor
call H_apply_mp2_selection(pt2, norm_pert, H_pert_diag, N_st) call H_apply_mp2_selection(pt2, norm_pert, H_pert_diag, N_st)
psi_det = psi_det_sorted psi_det = psi_det_sorted

View File

@ -135,7 +135,6 @@ subroutine pt2_moller_plesset ($arguments)
endif endif
if (delta_e /= 0.d0) then if (delta_e /= 0.d0) then
! call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det,psi_selectors_size,n_st,i_H_psi_array)
call i_H_psi_minilist(det_pert,minilist,idx_minilist,N_minilist,psi_selectors_coef,Nint,N_minilist,psi_selectors_size,N_st,i_H_psi_array) call i_H_psi_minilist(det_pert,minilist,idx_minilist,N_minilist,psi_selectors_coef,Nint,N_minilist,psi_selectors_size,N_st,i_H_psi_array)
h = diag_H_mat_elem_fock(det_ref,det_pert,fock_diag_tmp,Nint) h = diag_H_mat_elem_fock(det_ref,det_pert,fock_diag_tmp,Nint)
else else