correct transformation of cholesky vectors on the NO basis

src/casscf_cipsi/chol_bielec.irp.f

@@ -34,58 +34,51 @@ BEGIN_PROVIDER [double precision, cholesky_no_1_idx_transp, (cholesky_mo_num, n_
 END_PROVIDER 
 
 
+BEGIN_PROVIDER [double precision, cholesky_no_2_idx_transp_old, (cholesky_mo_num, n_act_orb, n_act_orb)]
+ BEGIN_DOC
+ ! Cholesky vectors with TWO orbital on the active natural orbital basis 
+ END_DOC
+ implicit none
+ integer :: i_chol,i_act,j_act,jj_act,jjj_act
+ double precision, allocatable :: chol_tmp(:,:)
+ allocate(chol_tmp(cholesky_mo_num,n_act_orb))
+ cholesky_no_2_idx_transp_old = 0.D0
+ do jj_act = 1, n_act_orb
+  jjj_act = list_act(jj_act)
+  do j_act = 1, n_act_orb
+   do i_act = 1, n_act_orb
+    do i_chol = 1, cholesky_mo_num
+     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
+
+END_PROVIDER 
+
+
 BEGIN_PROVIDER [double precision, cholesky_no_2_idx_transp, (cholesky_mo_num, n_act_orb, n_act_orb)]
  BEGIN_DOC
  ! Cholesky vectors with TWO orbital on the active natural orbital basis 
  END_DOC
  implicit none
  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 = 0.D0
- do j_act = 1, n_act_orb
  do i_act = 1, n_act_orb
-   do jj_act = 1, n_act_orb
-    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) 
-    enddo
-   enddo
-  enddo
- enddo
-
-END_PROVIDER 
-
-
-BEGIN_PROVIDER [double precision, cholesky_no_2_idx_transp_dgemm, (cholesky_mo_num, n_act_orb, n_act_orb)]
- BEGIN_DOC
- ! Cholesky vectors with TWO orbital on the active natural orbital basis 
- END_DOC
- implicit none
- integer :: i_chol,i_act,j_act,jj_act
- double precision, allocatable :: chol_tmp(:,:)
- allocate(chol_tmp(cholesky_mo_num,n_act_orb))
- cholesky_no_2_idx_transp_dgemm = 0.D0
- do j_act = 1, n_act_orb
   ! 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
-    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
-!  ! 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,  &
         chol_tmp, size(chol_tmp,1),                              &
         natorbsCI, size(natorbsCI,1),                                              &
         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
 
 END_PROVIDER 

src/casscf_cipsi/test_chol.irp.f

@@ -9,15 +9,21 @@ end
 subroutine routine
  implicit none
  integer :: i_chol, i_act, i_mo
- double precision :: accu
+ double precision :: accu,error,exact
  accu = 0.d0
  do i_mo = 1, n_act_orb
   do i_act = 1, n_act_orb
    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
- print*,'accu =', accu
+ print*,'accu =', accu/(dble(n_act_orb*n_act_orb*cholesky_mo_num))
 end