Optimizations, maybe wrong

src/csf/configuration_CI_sigma_helpers.irp.f

@@ -1,6 +1,6 @@
 use bitmasks
 
- BEGIN_PROVIDER [ integer(bit_kind), alphasIcfg_list , (N_int,2,N_configuration,mo_num*mo_num)]
+ BEGIN_PROVIDER [ integer(bit_kind), alphasIcfg_list , (N_int,2,N_configuration,elec_num)]
 &BEGIN_PROVIDER [ integer, NalphaIcfg_list, (N_configuration) ]
   implicit none
   !use bitmasks
@@ -45,6 +45,8 @@ use bitmasks
   logical                        :: pqExistsQ
   logical                        :: ppExistsQ
 
+  double precision               :: t0, t1
+  call wall_time(t0)
 
   allocate(tableUniqueAlphas(mo_num,mo_num))
   NalphaIcfg_list = 0
@@ -80,16 +82,17 @@ use bitmasks
     vmotype = -1
     nvmos = 0
     do i = 1,mo_num
-       !print *,i,IBSET(0,i-1),POPCNT(IAND(Isomo,(IBSET(0_8,i-1)))), POPCNT(IAND(Idomo,(IBSET(0_8,i-1))))
+      if(IAND(Idomo,(IBSET(0_8,i-1))) .EQ. 0) then
-       if(POPCNT(IAND(Isomo,(IBSET(0_8,i-1)))) .EQ. 0 .AND. POPCNT(IAND(Idomo,(IBSET(0_8,i-1)))) .EQ. 0) then
+        if(IAND(Isomo,(IBSET(0_8,i-1))) .EQ. 0) then
           nvmos += 1
           listvmos(nvmos) = i
           vmotype(nvmos) = 1
-       else if(POPCNT(IAND(Isomo,(IBSET(0_8,i-1)))) .EQ. 1 .AND. POPCNT(IAND(Idomo,(IBSET(0_8,i-1)))) .EQ. 0 ) then
+        else if(POPCNT(IAND(Isomo,(IBSET(0_8,i-1)))) .EQ. 1) then
           nvmos += 1
           listvmos(nvmos) = i
           vmotype(nvmos) = 2
         end if
+      end if
     end do
 
     tableUniqueAlphas = .FALSE.
@@ -144,7 +147,7 @@ use bitmasks
         endif
 
         ! Again, we don't have to search from 1
-          ! we just use seniorty to find the
+        ! we just use seniority to find the
         ! first index with NSOMO - 2 to NSOMO + 2
         ! this is what is done in kstart, kend
 
@@ -234,14 +237,16 @@ use bitmasks
     ppExistsQ = .False.
     Isomo = iand(reunion_of_act_virt_bitmask(1,1),Icfg(1,1))
     Idomo = iand(reunion_of_act_virt_bitmask(1,1),Icfg(1,2))
-  do k = 1, idxI-1
+    kstart = max(1,cfg_seniority_index(max(0,Nsomo_I-2)))
+    do k = kstart, idxI-1
       diffSOMO = IEOR(Isomo,iand(reunion_of_act_virt_bitmask(1,1),psi_configuration(1,1,k)))
+      ndiffSOMO = POPCNT(diffSOMO)
+      if (ndiffSOMO /= 2) cycle
       diffDOMO = IEOR(Idomo,iand(reunion_of_act_virt_bitmask(1,1),psi_configuration(1,2,k)))
       xordiffSOMODOMO = IEOR(diffSOMO,diffDOMO)
-     ndiffSOMO = POPCNT(diffSOMO)
       ndiffDOMO = POPCNT(diffDOMO)
       nxordiffSOMODOMO = POPCNT(xordiffSOMODOMO)
-     if((ndiffSOMO+ndiffDOMO+nxordiffSOMODOMO .EQ. 4) .AND. ndiffSOMO .EQ. 2) then
+      if((ndiffSOMO+ndiffDOMO+nxordiffSOMODOMO .EQ. 4)) then
         ppExistsQ = .TRUE.
         EXIT
       endif
@@ -257,6 +262,8 @@ use bitmasks
 
     NalphaIcfg = 0
   enddo ! end loop idxI
+  call wall_time(t1)
+  print *, 'Preparation : ', t1 - t0
 
 END_PROVIDER
 
@@ -416,7 +423,7 @@ END_PROVIDER
         endif
 
         ! Again, we don't have to search from 1
-        ! we just use seniorty to find the
+        ! we just use seniortiy to find the
         ! first index with NSOMO - 2 to NSOMO + 2
         ! this is what is done in kstart, kend
 

src/csf/sigma_vector.irp.f

@@ -144,6 +144,7 @@ end subroutine get_phase_qp_to_cfg
 
   integer :: nt
 
+
   norm_det1 = 0.d0
   MS = elec_alpha_num - elec_beta_num
   print *,"Maxbfdim=",NBFMax
@@ -444,7 +445,6 @@ end subroutine get_phase_qp_to_cfg
   print *,"Rowsmax=",rowsmax," Colsmax=",colsmax
   END_PROVIDER
 
-  !BEGIN_PROVIDER [ real*8, AIJpqContainer, (NSOMOMin:NSOMOMax,4,NSOMOMax+1,NSOMOMax+1,NBFMax,NBFMax)]
   BEGIN_PROVIDER [ real*8, AIJpqContainer, (NBFMax,NBFmax,NSOMOMax+1,NSOMOMax+1,4,NSOMOMin:NSOMOMax)]
   use cfunctions
   implicit none
@@ -476,54 +476,50 @@ end subroutine get_phase_qp_to_cfg
   cols = -1
   integer*8 MS
   MS = 0
-  touch AIJpqMatrixDimsList
   real*8,dimension(:,:),allocatable :: meMatrix
   integer maxdim
-  !maxdim = max(rowsmax,colsmax)
+
-  ! allocate matrix
-  !print *,"rowsmax =",rowsmax," colsmax=",colsmax
-  !print *,"NSOMOMax = ",NSOMOMax
   ! Type
   ! 1. SOMO -> SOMO
-  !print *,"Doing SOMO -> SOMO"
+  AIJpqContainer = 0.d0
-  !AIJpqContainer(NSOMOMin,1,1,1,1,1) = 1.0d0
   AIJpqContainer(1,1,1,1,1,NSOMOMin) = 1.0d0
+  integer :: rows_old, cols_old
+  rows_old = -1
+  cols_old = -1
+  allocate(meMatrix(1,1))
   do i = NSOMOMin+2, NSOMOMax, 2
      Isomo = ISHFT(1_8,i)-1
-     do j = i-2,i-2, 2
+     j=i-2
      if(j .GT. NSOMOMax .OR. j .LT. 0) cycle
-        !print *,"i,j=",i,j
+     nsomoi = i
      do k = 1,i
+        orbp = k
         do l = 1,i
 
            ! Define Jsomo
            if(k .NE. l) then
               Jsomo = IBCLR(Isomo, k-1)
               Jsomo = IBCLR(Jsomo, l-1)
-                 nsomoi = i
               nsomoj = j
            else
               Isomo = ISHFT(1_8,i)-1
               Jsomo = ISHFT(1_8,i)-1
-                 nsomoi = i
               nsomoj = i
            endif
 
-              !print *,"k,l=",k,l
-              !call debug_spindet(Jsomo,1)
-              !call debug_spindet(Isomo,1)
-
-              !AIJpqContainer(nsomoi,1,k,l,:,:) = 0.0d0
-              AIJpqContainer(:,:,k,l,1,nsomoi) = 0.0d0
            call getApqIJMatrixDims(Isomo,           &
                 Jsomo, &
                 MS,                       &
                 rows,                     &
                 cols)
 
-              orbp = k
            orbq = l
+           if ((rows /= rows_old).or.(cols /= cols_old)) then
+             deallocate(meMatrix)
              allocate(meMatrix(rows,cols))
+             rows_old = rows
+             cols_old = cols
+           endif
            meMatrix = 0.0d0
            ! fill matrix
            call getApqIJMatrixDriver(Isomo,           &
@@ -535,20 +531,17 @@ end subroutine get_phase_qp_to_cfg
                 meMatrix,                 &
                 rows,                     &
                 cols)
-             !print *, i,j,k,l,">",Isomo,Jsomo,">",rows, cols,">",rowsmax,colsmax
-             !call printMatrix(meMatrix,rows,cols)
            ! i -> j
           do ri = 1,rows
               do ci = 1,cols
-                    !AIJpqContainer(nsomoi,1,k,l,ri,ci) = meMatrix(ri, ci)
                  AIJpqContainer(ri,ci,k,l,1,nsomoi) = meMatrix(ri, ci)
               end do
            end do
+        end do
+     end do
+  end do
   deallocate(meMatrix)
-           end do
+
-        end do
-     end do
-  end do
   ! Type
   ! 2. DOMO -> VMO
   !print *,"Doing DOMO -> VMO"