Commit 21f760aa authored by Yingzhou Li's avatar Yingzhou Li

Updated davidson proj

parent 82843349
......@@ -337,27 +337,57 @@ contains
return
end if
! - norm(PsiExt)
! - Work1 = Psi'*Psi
if (ijob == SID_PROJ + 1) then
call rci_op_col_norm(iS, task, m, next, MID_PsiExt, m)
call rci_op_copy(iS, task, 'N', MID_PsiExt, MID_SPsiExt)
ijob = ijob + 1
return
end if
! - normize(PsiExt)
if (ijob == SID_PROJ + 2) then
do it = 1, next
if (resvec(it) > 0) then
resvec(it) = 1.0_r8/resvec(it)
else
resvec(it) = 0.0_r8
end if
end do
call rci_op_colscale(iS, task, m, next, MID_PsiExt, m)
call rci_op_gemm(iS, task, 'C', 'N', next, next, &
m, 1.0_r8, &
MID_PsiExt, m, MID_SPsiExt, m, 0.0_r8, &
MID_Work1, max_n)
ijob = ijob + 1
return
end if
! - Cholesky factorization of G
if (ijob == SID_PROJ + 3) then
call rci_op_potrf(iS, task, 'U', next, MID_Work1, max_n)
ijob = ijob + 1
return
end if
! - PsiExt = PsiExt/Work1
if (ijob == SID_PROJ + 4) then
call rci_op_trsm(iS, task, 'R', 'U', 'N', m, next, 1.0_r8, &
MID_Work1, max_n, MID_PsiExt, m)
ijob = SID_RECONST
return
end if
! ! - norm(PsiExt)
! if (ijob == SID_PROJ + 1) then
! call rci_op_col_norm(iS, task, m, next, MID_PsiExt, m)
! ijob = ijob + 1
! return
! end if
!
! ! - normize(PsiExt)
! if (ijob == SID_PROJ + 2) then
! do it = 1, next
! if (resvec(it) > 0) then
! resvec(it) = 1.0_r8/resvec(it)
! else
! resvec(it) = 0.0_r8
! end if
! end do
! call rci_op_colscale(iS, task, m, next, MID_PsiExt, m)
! ijob = SID_RECONST
! return
! end if
! -- HPsiExt = H * PsiExt
if (ijob == SID_RECONST) then
call rci_op_h_multi(iS, task, 'N', m, next, MID_PsiExt, &
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment