LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-26 21:33:30 +01:00
Code Releases Activity

Fix minor bug in multi-state PT2

Browse Source
This commit is contained in:
Anthony Scemama 2021-05-17 15:08:44 +02:00
parent 8da63eeb7d
commit f543d386a9
1 changed files with 4 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/cipsi/selection.irp.f
View File

@ -735,7 +735,7 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
double precision :: eigvalues(N_states+1) double precision :: eigvalues(N_states+1)
double precision :: work(1+6*(N_states+1)+2*(N_states+1)**2) double precision :: work(1+6*(N_states+1)+2*(N_states+1)**2)
integer :: iwork(3+5*(N_states+1)), info, k integer :: info, k , iwork(N_states+1)
if (do_diag) then if (do_diag) then
double precision :: pt2_matrix(N_states+1,N_states+1) double precision :: pt2_matrix(N_states+1,N_states+1)
@ -747,8 +747,8 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
pt2_matrix(N_states+1,istate) = mat(istate,p1,p2) pt2_matrix(N_states+1,istate) = mat(istate,p1,p2)
enddo enddo
call DSYEVD( 'V', 'U', N_states+1, pt2_matrix, N_states+1, eigvalues, & call DSYEV( 'V', 'U', N_states+1, pt2_matrix, N_states+1, eigvalues, &
work, size(work), iwork, size(iwork), info ) work, size(work), info )
if (info /= 0) then if (info /= 0) then
print *, 'error in '//irp_here print *, 'error in '//irp_here
stop -1 stop -1
@ -756,7 +756,7 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
pt2_matrix = dabs(pt2_matrix) pt2_matrix = dabs(pt2_matrix)
iwork(1:N_states+1) = maxloc(pt2_matrix,DIM=1) iwork(1:N_states+1) = maxloc(pt2_matrix,DIM=1)
do k=1,N_states do k=1,N_states
e_pert(iwork(k)) = eigvalues(k) - E0(iwork(k)) e_pert(k) = eigvalues(iwork(k)) - E0(k)
enddo enddo
endif endif