Acceleration with a large number of dets

src/det.irp.f

@@ -266,17 +266,22 @@ END_PROVIDER
  integer :: ik,il,jk,jl, idx(4)
  real :: phase
  integer :: exc(4), nact, nact2
- real :: det_kl
+ real :: det_kl, det_k
  integer :: det_exc
 
  two_e_density_num = 0
 
  PROVIDE det
 
+ print *,  'Computing two-electron DM'
  do k=1,det_num
+  det_k = det_coef(k)
+  if ( abs(det_k) < 1.e-5) then
+    cycle
+  endif
   do l=k,det_num
-   det_kl = det_coef(k)*det_coef(l)
+   det_kl = det_k*det_coef(l)
-   if ( (k /= l).and.(abs(det_kl) < 1.e-5) ) then
+   if ( (k /= l).or.(abs(det_kl) < 1.e-5) ) then
      cycle
    endif
 
@@ -298,9 +303,15 @@ END_PROVIDER
 BEGIN_SHELL [ /usr/bin/python ]
 code = """
         notfound = .True.
-        idx = (/ min(%(I)s,%(J)s), max(%(I)s,%(J)s), min(%(K)s,%(L)s), max(%(K)s,%(L)s) /)
+        idx(1) = min(%(I)s,%(J)s)
+        idx(2) = max(%(I)s,%(J)s)
+        idx(3) = min(%(K)s,%(L)s)
+        idx(4) = max(%(K)s,%(L)s)
         do q=1,two_e_density_num
-         if (sum(abs(two_e_density_indice(:,q)-idx))) then
+         if ( (two_e_density_indice(1,q)==idx(1)) .and. &
+              (two_e_density_indice(2,q)==idx(2)) .and. &
+              (two_e_density_indice(3,q)==idx(3)) .and. &
+              (two_e_density_indice(4,q)==idx(4)) ) then
           two_e_density_value(1,q) += det_kl
           two_e_density_value(2,q) += det_kl
           notfound = .False.
@@ -309,15 +320,24 @@ code = """
         enddo
         if (notfound) then
          two_e_density_num += 1
-         two_e_density_indice(:,two_e_density_num)=idx
+         two_e_density_indice(1,two_e_density_num)=idx(1)
+         two_e_density_indice(2,two_e_density_num)=idx(2)
+         two_e_density_indice(3,two_e_density_num)=idx(3)
+         two_e_density_indice(4,two_e_density_num)=idx(4)
          two_e_density_value(1,two_e_density_num) = det_kl
          two_e_density_value(2,two_e_density_num) = det_kl
         endif
 
         notfound = .True.
-        idx = (/ min(%(I)s,%(K)s), max(%(I)s,%(K)s), min(%(J)s,%(L)s), max(%(J)s,%(L)s) /)
+        idx(1) = min(%(I)s,%(K)s)
+        idx(2) = max(%(I)s,%(K)s)
+        idx(3) = min(%(J)s,%(L)s)
+        idx(4) = max(%(J)s,%(L)s)
         do q=1,two_e_density_num
-         if (sum(abs(two_e_density_indice(:,q)-idx))) then
+         if ( (two_e_density_indice(1,q)==idx(1)) .and. &
+              (two_e_density_indice(2,q)==idx(2)) .and. &
+              (two_e_density_indice(3,q)==idx(3)) .and. &
+              (two_e_density_indice(4,q)==idx(4)) ) then
           two_e_density_value(1,q) -= det_kl
           notfound = .False.
           exit
@@ -325,17 +345,26 @@ code = """
         enddo
         if (notfound) then
          two_e_density_num += 1
-         two_e_density_indice(:,two_e_density_num)=idx
+         two_e_density_indice(1,two_e_density_num)=idx(1)
+         two_e_density_indice(2,two_e_density_num)=idx(2)
+         two_e_density_indice(3,two_e_density_num)=idx(3)
+         two_e_density_indice(4,two_e_density_num)=idx(4)
          two_e_density_value(1,two_e_density_num) = -det_kl
          two_e_density_value(2,two_e_density_num) = 0.
         endif
 """
 
 code1 = """
-        idx = (/ min(%(I)s,%(J)s), max(%(I)s,%(J)s), min(%(K)s,%(L)s), max(%(K)s,%(L)s) /)
+        idx(1) = min(%(I)s,%(J)s)
+        idx(2) = max(%(I)s,%(J)s)
+        idx(3) = min(%(K)s,%(L)s)
+        idx(4) = max(%(K)s,%(L)s)
         notfound = .True.
         do q=1,two_e_density_num
-         if (sum(abs(two_e_density_indice(:,q)-idx))) then
+         if ( (two_e_density_indice(1,q)==idx(1)) .and. &
+              (two_e_density_indice(2,q)==idx(2)) .and. &
+              (two_e_density_indice(3,q)==idx(3)) .and. &
+              (two_e_density_indice(4,q)==idx(4)) ) then
           two_e_density_value(1,q) += det_kl
           notfound = .False.
           exit
@@ -343,15 +372,24 @@ code1 = """
         enddo
         if (notfound) then
          two_e_density_num += 1
-         two_e_density_indice(:,two_e_density_num)=idx
+         two_e_density_indice(1,two_e_density_num)=idx(1)
+         two_e_density_indice(2,two_e_density_num)=idx(2)
+         two_e_density_indice(3,two_e_density_num)=idx(3)
+         two_e_density_indice(4,two_e_density_num)=idx(4)
          two_e_density_value(1,two_e_density_num) = det_kl
          two_e_density_value(2,two_e_density_num) = 0.
         endif
 
         notfound = .True.
-        idx = (/ min(%(I)s,%(K)s), max(%(I)s,%(K)s), min(%(J)s,%(L)s), max(%(J)s,%(L)s) /)
+        idx(1) = min(%(I)s,%(K)s)
+        idx(2) = max(%(I)s,%(K)s)
+        idx(3) = min(%(J)s,%(L)s)
+        idx(4) = max(%(J)s,%(L)s)
         do q=1,two_e_density_num
-         if (sum(abs(two_e_density_indice(:,q)-idx))) then
+         if ( (two_e_density_indice(1,q)==idx(1)) .and. &
+              (two_e_density_indice(2,q)==idx(2)) .and. &
+              (two_e_density_indice(3,q)==idx(3)) .and. &
+              (two_e_density_indice(4,q)==idx(4)) ) then
           two_e_density_value(1,q) -= det_kl
           notfound = .False.
           exit
@@ -359,7 +397,10 @@ code1 = """
         enddo
         if (notfound) then
          two_e_density_num += 1
-         two_e_density_indice(:,two_e_density_num)=idx
+         two_e_density_indice(1,two_e_density_num)=idx(1)
+         two_e_density_indice(2,two_e_density_num)=idx(2)
+         two_e_density_indice(3,two_e_density_num)=idx(3)
+         two_e_density_indice(4,two_e_density_num)=idx(4)
          two_e_density_value(1,two_e_density_num) = -det_kl
          two_e_density_value(2,two_e_density_num) = 0.
         endif
@@ -367,9 +408,15 @@ code1 = """
 
 code2 = """
         notfound = .True.
-        idx = (/ min(%(I)s,%(J)s), max(%(I)s,%(J)s), min(%(K)s,%(L)s), max(%(K)s,%(L)s) /)
+        idx(1) = min(%(I)s,%(J)s)
+        idx(2) = max(%(I)s,%(J)s)
+        idx(3) = min(%(K)s,%(L)s)
+        idx(4) = max(%(K)s,%(L)s)
         do q=1,two_e_density_num
-         if (sum(abs(two_e_density_indice(:,q)-idx))) then
+         if ( (two_e_density_indice(1,q)==idx(1)) .and. &
+              (two_e_density_indice(2,q)==idx(2)) .and. &
+              (two_e_density_indice(3,q)==idx(3)) .and. &
+              (two_e_density_indice(4,q)==idx(4)) ) then
           two_e_density_value(2,q) += det_kl
           notfound = .False.
           exit
@@ -377,7 +424,10 @@ code2 = """
         enddo
         if (notfound) then
          two_e_density_num += 1
-         two_e_density_indice(:,two_e_density_num)=idx
+         two_e_density_indice(1,two_e_density_num)=idx(1)
+         two_e_density_indice(2,two_e_density_num)=idx(2)
+         two_e_density_indice(3,two_e_density_num)=idx(3)
+         two_e_density_indice(4,two_e_density_num)=idx(4)
          two_e_density_value(1,two_e_density_num) = 0.
          two_e_density_value(2,two_e_density_num) = det_kl
         endif
@@ -471,6 +521,7 @@ END_SHELL
  call set_density_matrix_two_num(two_e_density_num)
  call set_density_matrix_two_indice(two_e_density_indice)
  call set_density_matrix_two_value(two_e_density_value)
+ print *,  'Done'
 
 END_PROVIDER
 
@@ -490,6 +541,7 @@ BEGIN_PROVIDER [ real, one_e_density_mo, (mo_active_num,mo_active_num,2) ]
    return
  endif
 
+ print *,  'Computing one-electron DM'
  do p=1,2
   do i=1,mo_active_num
    do j=1,mo_active_num
@@ -532,5 +584,6 @@ BEGIN_PROVIDER [ real, one_e_density_mo, (mo_active_num,mo_active_num,2) ]
  enddo
 
  call set_density_matrix_one(one_e_density_mo)
+ print *,  'Done'
 
 END_PROVIDER