cholesky in big_array

src/ao_two_e_ints/cholesky.irp.f

@@ -35,6 +35,41 @@ END_PROVIDER
 
  double precision :: integral, cpu_1, cpu_2, wall_1, wall_2
  logical, external :: ao_two_e_integral_zero
+  double precision, external :: get_ao_two_e_integral
+
+ if (read_ao_two_e_integrals) then
+   PROVIDE ao_two_e_integrals_in_map
+
+   !$OMP PARALLEL DEFAULT(SHARED) PRIVATE(i,j,k,l, integral, wall_2)
+   do m=0,9
+     do l=1+m,ao_num,10
+       !$OMP DO SCHEDULE(dynamic)
+       do j=1,l
+         do k=1,ao_num
+           do i=1,min(k,j)
+             if (ao_two_e_integral_zero(i,j,k,l)) cycle
+             integral = get_ao_two_e_integral(i,j,k,l, ao_integrals_map)
+             ao_integrals(i,k,j,l) = integral
+             ao_integrals(k,i,j,l) = integral
+             ao_integrals(i,k,l,j) = integral
+             ao_integrals(k,i,l,j) = integral
+             ao_integrals(j,l,i,k) = integral
+             ao_integrals(j,l,k,i) = integral
+             ao_integrals(l,j,i,k) = integral
+             ao_integrals(l,j,k,i) = integral
+           enddo
+         enddo
+       enddo
+       !$OMP END DO NOWAIT
+     enddo
+     !$OMP MASTER
+     call wall_time(wall_2)
+     print '(I10,'' %  in'', 4X, F10.2, '' s.'')', (m+1) * 10, wall_2-wall_1
+     !$OMP END MASTER
+   enddo
+   !$OMP END PARALLEL
+
+ else
 
    !$OMP PARALLEL DEFAULT(SHARED) PRIVATE(i,j,k,l, integral, wall_2)
    do m=0,9
@@ -60,7 +95,7 @@ END_PROVIDER
      enddo
      !$OMP MASTER
      call wall_time(wall_2)
-   print '(F10.2,'' %  in'', 4X, I10, '' s.'')', (m+1) * 10, wall_2-wall_1
+     print '(I10,'' %  in'', 4X, F10.2, '' s.'')', (m+1) * 10, wall_2-wall_1
      !$OMP END MASTER
    enddo
    !$OMP END PARALLEL
@@ -71,9 +106,11 @@ END_PROVIDER
    print*, ' cpu  time :',cpu_2 - cpu_1, 's'
    print*, ' wall time :',wall_2 - wall_1, 's  ( x ', (cpu_2-cpu_1)/(wall_2-wall_1+tiny(1.d0)), ' )'
 
+ endif
+
  ! Call Lapack
  cholesky_ao_num = cholesky_ao_num_guess
- call pivoted_cholesky(ao_integrals, cholesky_ao_num, ao_integrals_threshold, ao_num*ao_num, cholesky_ao)
+ call pivoted_cholesky(ao_integrals, cholesky_ao_num, ao_cholesky_threshold, ao_num*ao_num, cholesky_ao)
  print *, 'Rank: ', cholesky_ao_num, '(', 100.d0*dble(cholesky_ao_num)/dble(ao_num*ao_num), ' %)'
 
  ! Remove mmap

src/ccsd/ccsd_space_orb_sub.irp.f

@@ -18,7 +18,7 @@ subroutine run_ccsd_space_orb
   integer(bit_kind)             :: det(N_int,2)
   integer                       :: nO, nV, nOa, nVa
 
-  PROVIDE mo_two_e_integrals_in_map
+!  PROVIDE mo_two_e_integrals_in_map
 
   det = psi_det(:,:,cc_ref)
   print*,'Reference determinant:'

src/ccsd/ccsd_t_space_orb_stoch.irp.f

@@ -274,7 +274,7 @@ subroutine ccsd_par_t_space_stoch(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energ
     enddo
 
     call wall_time(t01)
-    if (t01-t00 > 1.0d0) then
+    if ((t01-t00 > 1.0d0).or.(imin >= Nabc)) then
       t00 = t01
 
       !$OMP TASKWAIT

src/mo_two_e_ints/cholesky.irp.f

@@ -6,11 +6,41 @@ BEGIN_PROVIDER [ double precision, cholesky_mo, (mo_num, mo_num, cholesky_ao_num
 
  integer :: k
 
+ print *, 'AO->MO Transformation of Cholesky vectors'
  !$OMP PARALLEL DO PRIVATE(k)
  do k=1,cholesky_ao_num
   call ao_to_mo(cholesky_ao(1,1,k),ao_num,cholesky_mo(1,1,k),mo_num)
  enddo
  !$OMP END PARALLEL DO
+ print *, ''
+
+END_PROVIDER
+
+BEGIN_PROVIDER [ double precision, cholesky_mo_transp, (cholesky_ao_num, mo_num, mo_num) ]
+ implicit none
+ BEGIN_DOC
+ ! Cholesky vectors in MO basis
+ END_DOC
+
+ integer :: i,j,k
+ double precision, allocatable :: buffer(:,:)
+
+ print *, 'AO->MO Transformation of Cholesky vectors  .'
+ !$OMP PARALLEL PRIVATE(i,j,k,buffer)
+ allocate(buffer(mo_num,mo_num))
+ !$OMP DO SCHEDULE(static)
+ do k=1,cholesky_ao_num
+  call ao_to_mo(cholesky_ao(1,1,k),ao_num,buffer,mo_num)
+  do j=1,mo_num
+    do i=1,mo_num
+      cholesky_mo_transp(k,i,j) = buffer(i,j)
+    enddo
+  enddo
+ enddo
+ !$OMP END DO
+ deallocate(buffer)
+ !$OMP END PARALLEL
+ print *, ''
 
 END_PROVIDER
 

src/mo_two_e_ints/integrals_3_index.irp.f

@@ -4,12 +4,54 @@
  BEGIN_DOC
  ! big_array_coulomb_integrals(j,i,k)  = <ij|kj> = (ik|jj)
  !
- ! big_array_exchange_integrals(i,j,k) = <ij|jk> = (ij|kj)
+ ! big_array_exchange_integrals(j,i,k) = <ij|jk> = (ij|kj)
  END_DOC
- integer :: i,j,k,l
+ integer :: i,j,k,l,a
  double precision :: get_two_e_integral
  double precision :: integral
 
+ if (do_ao_cholesky) then
+
+    double precision, allocatable :: buffer_jj(:,:), buffer(:,:,:)
+    allocate(buffer_jj(cholesky_ao_num,mo_num), buffer(mo_num,mo_num,mo_num))
+    do j=1,mo_num
+      buffer_jj(:,j) = cholesky_mo_transp(:,j,j)
+    enddo
+
+    call dgemm('T','N', mo_num*mo_num,mo_num,cholesky_ao_num, 1.d0, &
+        cholesky_mo_transp, cholesky_ao_num, &
+        buffer_jj, cholesky_ao_num, 0.d0, &
+        buffer, mo_num*mo_num)
+
+    do k = 1, mo_num
+      do i = 1, mo_num
+        do j = 1, mo_num
+          big_array_coulomb_integrals(j,i,k) = buffer(i,k,j)
+        enddo
+      enddo
+    enddo
+    deallocate(buffer_jj)
+
+    allocate(buffer_jj(mo_num,mo_num))
+
+    do j = 1, mo_num
+
+      call dgemm('T','N',mo_num,mo_num,cholesky_ao_num, 1.d0, &
+        cholesky_mo_transp(1,1,j), cholesky_ao_num, &
+        cholesky_mo_transp(1,1,j), cholesky_ao_num, 0.d0, &
+        buffer_jj, mo_num)
+
+      do k=1,mo_num
+        do i=1,mo_num
+          big_array_exchange_integrals(j,i,k) = buffer_jj(i,k)
+       enddo
+     enddo
+    enddo
+
+    deallocate(buffer_jj)
+
+ else
+
    do k = 1, mo_num
      do i = 1, mo_num
        do j = 1, mo_num
@@ -23,5 +65,7 @@
      enddo
    enddo
 
+ endif
+
 END_PROVIDER
 

src/mo_two_e_ints/mo_bi_integrals.irp.f

@@ -1353,14 +1353,29 @@ END_PROVIDER
   integer                        :: i,j
   double precision               :: get_two_e_integral
 
-  PROVIDE mo_two_e_integrals_in_map
+
-  mo_two_e_integrals_jj = 0.d0
+  if (do_ao_cholesky) then
-  mo_two_e_integrals_jj_exchange = 0.d0
+    do j=1,mo_num
+      do i=1,mo_num
+        !TODO: use dgemm
+        mo_two_e_integrals_jj(i,j) = sum(cholesky_mo_transp(:,i,i)*cholesky_mo_transp(:,j,j))
+        mo_two_e_integrals_jj_exchange(i,j) = sum(cholesky_mo_transp(:,i,j)*cholesky_mo_transp(:,j,i))
+      enddo
+    enddo
+
+  else
 
     do j=1,mo_num
       do i=1,mo_num
         mo_two_e_integrals_jj(i,j) = get_two_e_integral(i,j,i,j,mo_integrals_map)
         mo_two_e_integrals_jj_exchange(i,j) = get_two_e_integral(i,j,j,i,mo_integrals_map)
+      enddo
+    enddo
+
+  endif
+
+  do j=1,mo_num
+    do i=1,mo_num
         mo_two_e_integrals_jj_anti(i,j) = mo_two_e_integrals_jj(i,j) - mo_two_e_integrals_jj_exchange(i,j)
     enddo
   enddo

src/utils_cc/energy.irp.f

@@ -5,9 +5,8 @@ subroutine det_energy(det,energy)
   integer(bit_kind), intent(in) :: det
 
   double precision, intent(out) :: energy
+  double precision, external :: diag_H_mat_elem
 
-  call i_H_j(det,det,N_int,energy)
+  energy = diag_H_mat_elem(det,N_int) + nuclear_repulsion
-
-  energy = energy + nuclear_repulsion
 
 end

src/utils_cc/mo_integrals_cc.irp.f

@@ -45,61 +45,64 @@ subroutine gen_v_space(n1,n2,n3,n4,list1,list2,list3,list4,v)
   integer, intent(in)           :: list1(n1),list2(n2),list3(n3),list4(n4)
   double precision, intent(out) :: v(n1,n2,n3,n4)
 
-  integer                       :: i1,i2,i3,i4,idx1,idx2,idx3,idx4
+  integer                       :: i1,i2,i3,i4,idx1,idx2,idx3,idx4,k
-  double precision              :: get_two_e_integral
-  
-  PROVIDE mo_two_e_integrals_in_map
 
+  double precision, allocatable :: buffer(:,:,:)
   !$OMP PARALLEL &
-  !$OMP SHARED(n1,n2,n3,n4,list1,list2,list3,list4,v,mo_integrals_map) &
+  !$OMP SHARED(n1,n2,n3,n4,list1,list2,list3,list4,v,mo_num,cholesky_mo_transp,cholesky_ao_num) &
-  !$OMP PRIVATE(i1,i2,i3,i4,idx1,idx2,idx3,idx4)&
+  !$OMP PRIVATE(i1,i2,i3,i4,idx1,idx2,idx3,idx4,k,buffer)&
   !$OMP DEFAULT(NONE)
-  !$OMP DO collapse(3)
+  allocate(buffer(mo_num,mo_num,mo_num))
+  !$OMP DO
   do i4 = 1, n4
-    do i3 = 1, n3
-      do i2 = 1, n2
-        do i1 = 1, n1
     idx4 = list4(i4)
-          idx3 = list3(i3)
+    call dgemm('T','N', mo_num*mo_num, mo_num, cholesky_ao_num, 1.d0, &
+       cholesky_mo_transp, cholesky_ao_num, &
+       cholesky_mo_transp(1,1,idx4), cholesky_ao_num, 0.d0, buffer, mo_num*mo_num)
+    do i2 = 1, n2
       idx2 = list2(i2)
+      do i3 = 1, n3
+        idx3 = list3(i3)
+        do i1 = 1, n1
           idx1 = list1(i1)
-          v(i1,i2,i3,i4) = get_two_e_integral(idx1,idx2,idx3,idx4,mo_integrals_map)
+          v(i1,i2,i3,i4) = buffer(idx1,idx3,idx2)
         enddo
       enddo
     enddo
   enddo
   !$OMP END DO
+  deallocate(buffer)
   !$OMP END PARALLEL
 
+
 end
 
 ! full
 
 BEGIN_PROVIDER [double precision, cc_space_v, (mo_num,mo_num,mo_num,mo_num)]
-
   implicit none
-
+  integer                       :: i1,i2,i3,i4,k
-  integer          :: i,j,k,l
+  double precision, allocatable :: buffer(:,:,:)
-  double precision :: get_two_e_integral
-  
-  PROVIDE mo_two_e_integrals_in_map
-
   !$OMP PARALLEL &
-  !$OMP SHARED(cc_space_v,mo_num,mo_integrals_map) &
+  !$OMP SHARED(cc_space_v,mo_num,cholesky_mo_transp,cholesky_ao_num) &
-  !$OMP PRIVATE(i,j,k,l) &
+  !$OMP PRIVATE(i1,i2,i3,i4,k,buffer)&
   !$OMP DEFAULT(NONE)
-  
+  allocate(buffer(mo_num,mo_num,mo_num))
-  !$OMP DO collapse(3)
+  !$OMP DO
-  do l = 1, mo_num
+  do i4 = 1, mo_num
-    do k = 1, mo_num
+    call dgemm('T','N', mo_num*mo_num, mo_num, cholesky_ao_num, 1.d0, &
-      do j = 1, mo_num
+         cholesky_mo_transp, cholesky_ao_num, &
-        do i = 1, mo_num
+         cholesky_mo_transp(1,1,i4), cholesky_ao_num, 0.d0, buffer, mo_num*mo_num)
-          cc_space_v(i,j,k,l) = get_two_e_integral(i,j,k,l,mo_integrals_map)
+    do i2 = 1, mo_num
+      do i3 = 1, mo_num
+        do i1 = 1, mo_num
+          cc_space_v(i1,i2,i3,i4) = buffer(i1,i3,i2)
         enddo
       enddo
     enddo
   enddo
   !$OMP END DO
+  deallocate(buffer)
   !$OMP END PARALLEL
 
 END_PROVIDER
@@ -638,6 +641,7 @@ subroutine gen_f_spin(det, n1,n2, n1_S,n2_S, list1,list2, dim1,dim2, f)
   integer                       :: i,j, idx_i,idx_j,i_shift,j_shift
   integer                       :: tmp_i,tmp_j
   integer                       :: si,sj,s
+  PROVIDE big_array_exchange_integrals big_array_coulomb_integrals
 
   allocate(tmp_F(mo_num,mo_num))
 
@@ -702,8 +706,10 @@ subroutine get_fock_matrix_spin(det,s,f)
     s2 = 1
   endif
 
+  PROVIDE big_array_coulomb_integrals big_array_exchange_integrals
+
   !$OMP PARALLEL &
-  !$OMP SHARED(f,mo_num,s1,s2,N_int,det,mo_one_e_integrals) &
+  !$OMP SHARED(f,mo_num,s1,s2,N_int,det,mo_one_e_integrals,big_array_coulomb_integrals,big_array_exchange_integrals) &
   !$OMP PRIVATE(p,q,ok,i,res)&
   !$OMP DEFAULT(NONE)
   !$OMP DO collapse(1)
@@ -713,13 +719,14 @@ subroutine get_fock_matrix_spin(det,s,f)
       do i = 1, mo_num
         call apply_hole(det, s1, i, res, ok, N_int)
         if (ok) then
-          f(p,q) = f(p,q) + mo_two_e_integral(p,i,q,i) - mo_two_e_integral(p,i,i,q)
+!          f(p,q) = f(p,q) + mo_two_e_integral(p,i,q,i) - mo_two_e_integral(p,i,i,q)
+          f(p,q) = f(p,q) + big_array_coulomb_integrals(i,p,q) - big_array_exchange_integrals(i,p,q)
         endif
       enddo
       do i = 1, mo_num
         call apply_hole(det, s2, i, res, ok, N_int)
         if (ok) then
-          f(p,q) = f(p,q) + mo_two_e_integral(p,i,q,i)
+          f(p,q) = f(p,q) + big_array_coulomb_integrals(i,p,q)
         endif
       enddo
     enddo