PTEROSOR/QuantumPackage
10
0
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-11-03 12:43:48 +01:00
Code Releases Activity

correct transformation of cholesky vectors on the NO basis

Browse Source
This commit is contained in:
eginer 2024-07-11 14:22:27 +02:00
parent d219dc1026
commit 31ec3ace05
2 changed files with 27 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
src/casscf_cipsi/chol_bielec.irp.f
View File

@ -34,20 +34,21 @@ BEGIN_PROVIDER [double precision, cholesky_no_1_idx_transp, (cholesky_mo_num, n_
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [double precision, cholesky_no_2_idx_transp, (cholesky_mo_num, n_act_orb, n_act_orb)] BEGIN_PROVIDER [double precision, cholesky_no_2_idx_transp_old, (cholesky_mo_num, n_act_orb, n_act_orb)]
BEGIN_DOC BEGIN_DOC
! Cholesky vectors with TWO orbital on the active natural orbital basis ! Cholesky vectors with TWO orbital on the active natural orbital basis
END_DOC END_DOC
implicit none implicit none
integer :: i_chol,i_act,j_act,jj_act integer :: i_chol,i_act,j_act,jj_act,jjj_act
double precision, allocatable :: chol_tmp(:,:) double precision, allocatable :: chol_tmp(:,:)
allocate(chol_tmp(cholesky_mo_num,n_act_orb)) allocate(chol_tmp(cholesky_mo_num,n_act_orb))
cholesky_no_2_idx_transp = 0.D0 cholesky_no_2_idx_transp_old = 0.D0
do j_act = 1, n_act_orb do jj_act = 1, n_act_orb
do i_act = 1, n_act_orb jjj_act = list_act(jj_act)
do jj_act = 1, n_act_orb do j_act = 1, n_act_orb
do i_act = 1, n_act_orb
do i_chol = 1, cholesky_mo_num do i_chol = 1, cholesky_mo_num
cholesky_no_2_idx_transp(i_chol, i_act, j_act) += cholesky_no_1_idx_transp(i_chol, i_act,jj_act) * natorbsCI(jj_act,i_act) cholesky_no_2_idx_transp_old(i_chol, i_act, j_act) += cholesky_no_1_idx_transp(i_chol, i_act,jjj_act) * natorbsCI(jj_act,j_act)
enddo enddo
enddo enddo
enddo enddo
@ -56,36 +57,28 @@ BEGIN_PROVIDER [double precision, cholesky_no_2_idx_transp, (cholesky_mo_num, n_
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [double precision, cholesky_no_2_idx_transp_dgemm, (cholesky_mo_num, n_act_orb, n_act_orb)] BEGIN_PROVIDER [double precision, cholesky_no_2_idx_transp, (cholesky_mo_num, n_act_orb, n_act_orb)]
BEGIN_DOC BEGIN_DOC
! Cholesky vectors with TWO orbital on the active natural orbital basis ! Cholesky vectors with TWO orbital on the active natural orbital basis
END_DOC END_DOC
implicit none implicit none
integer :: i_chol,i_act,j_act,jj_act integer :: i_chol,i_act,j_act,jj_act
double precision, allocatable :: chol_tmp(:,:) double precision, allocatable :: chol_tmp(:,:),chol_tmp_bis(:,:)
allocate(chol_tmp(cholesky_mo_num,n_act_orb)) allocate(chol_tmp(cholesky_mo_num,n_act_orb),chol_tmp_bis(cholesky_mo_num,n_act_orb))
cholesky_no_2_idx_transp_dgemm = 0.D0 cholesky_no_2_idx_transp = 0.D0
do j_act = 1, n_act_orb do i_act = 1, n_act_orb
! Get all the integrals corresponding to the "j_act" ! Get all the integrals corresponding to the "j_act"
do i_act = 1, n_act_orb do j_act = 1, n_act_orb
jj_act = list_act(i_act) jj_act = list_act(j_act)
do i_chol = 1, cholesky_mo_num do i_chol = 1, cholesky_mo_num
chol_tmp(i_chol, i_act) = cholesky_no_1_idx_transp(i_chol, j_act, jj_act) chol_tmp(i_chol, j_act) = cholesky_no_1_idx_transp(i_chol, i_act, jj_act)
enddo enddo
enddo enddo
! ! Do the matrix product
! do i_act = 1, n_act_orb
! do jj_act = 1, n_act_orb
! do i_chol = 1, cholesky_mo_num
! cholesky_no_1_idx_transp(i_chol, i_act, j_act) += chol_tmp(i_chol, jj_act) * natorbsCI(jj_act,i_act)
! enddo
! enddo
! enddo
call dgemm('N','N',cholesky_mo_num,n_act_orb,n_act_orb,1.d0, & call dgemm('N','N',cholesky_mo_num,n_act_orb,n_act_orb,1.d0, &
chol_tmp, size(chol_tmp,1), & chol_tmp, size(chol_tmp,1), &
natorbsCI, size(natorbsCI,1), & natorbsCI, size(natorbsCI,1), &
0.d0, & 0.d0, &
cholesky_no_2_idx_transp_dgemm(1,1,j_act), size(cholesky_no_2_idx_transp_dgemm,1)) cholesky_no_2_idx_transp(1,1,i_act), size(cholesky_no_2_idx_transp,1))
enddo enddo
END_PROVIDER END_PROVIDER

14
src/casscf_cipsi/test_chol.irp.f
View File

@ -9,15 +9,21 @@ end
subroutine routine subroutine routine
implicit none implicit none
integer :: i_chol, i_act, i_mo integer :: i_chol, i_act, i_mo
double precision :: accu double precision :: accu,error,exact
accu = 0.d0 accu = 0.d0
do i_mo = 1, n_act_orb do i_mo = 1, n_act_orb
do i_act = 1, n_act_orb do i_act = 1, n_act_orb
do i_chol = 1, cholesky_mo_num do i_chol = 1, cholesky_mo_num
accu += dabs(cholesky_no_2_idx_transp_dgemm(i_chol,i_act,i_mo) - cholesky_no_2_idx_transp(i_chol,i_act,i_mo)) error = dabs(cholesky_no_2_idx_transp(i_chol,i_act,i_mo) - cholesky_no_2_idx_transp_old(i_chol,i_act,i_mo))
print*,cholesky_no_2_idx_transp_dgemm(i_chol,i_act,i_mo) , cholesky_no_2_idx_transp(i_chol,i_act,i_mo) exact = dabs(cholesky_no_2_idx_transp_old(i_chol,i_act,i_mo))
accu += error
if(exact.gt.1.d-10)then
if(error/exact.gt.1.d-7)then
write(*,'(4(E16.10,X))')cholesky_no_2_idx_transp(i_chol,i_act,i_mo) , cholesky_no_2_idx_transp_old(i_chol,i_act,i_mo),error,error/exact
endif
endif
enddo enddo
enddo enddo
enddo enddo
print*,'accu =', accu print*,'accu =', accu/(dble(n_act_orb*n_act_orb*cholesky_mo_num))
end end