LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-06-25 22:52:15 +02:00
Code Issues Releases Wiki Activity

State following OK

Browse Source
This commit is contained in:
Anthony Scemama 2016-11-18 22:22:46 +01:00
parent 1446bf9ace
commit 9a06b970de
2 changed files with 20 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
plugins/MRCC_Utils/davidson.irp.f
View File

@ -862,7 +862,9 @@ subroutine davidson_diag_hjj_sjj_mrcc(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sz
do k=1,N_st
coord = maxloc(overlap)
order( coord(2) ) = coord(1)
overlap(:,coord(2)) = -1.d0
do i=1,shift2
overlap(coord(1),i) = -1.d0
enddo
enddo
overlap = y
do k=1,N_st

23
src/Davidson/diagonalization_hs2.irp.f
View File

@ -328,21 +328,30 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sze,N_s
integer :: coord(2), order(N_st_diag)
overlap = -1.d0
do k=1,shift2
do i=1,shift2
do i=1,shift2
do k=1,shift2
overlap(k,i) = dabs(y(k,i))
enddo
enddo
do k=1,N_st
coord = maxloc(overlap)
order( coord(2) ) = coord(1)
overlap(:,coord(2)) = -1.d0
do i=1,shift2
overlap(coord(1),i) = -1.d0
enddo
enddo
print *, order(1:N_st)
do i=1,shift2
do k=1,shift2
overlap(k,i) = y(k,i)
enddo
enddo
overlap = y
do k=1,N_st
l = order(k)
if (k /= l) then
y(1:shift2,k) = overlap(1:shift2,l)
do i=1,shift2
y(i,k) = overlap(i,l)
enddo
endif
enddo
do k=1,N_st
@ -750,7 +759,9 @@ subroutine davidson_diag_hjj_sjj_mmap(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sz
do k=1,N_st
coord = maxloc(overlap)
order( coord(2) ) = coord(1)
overlap(:,coord(2)) = -1.d0
do i=1,shift2
overlap(coord(1),i) = -1.d0
enddo
enddo
overlap = y
do k=1,N_st