save

plugins/Hartree_Fock_SlaterDressed/at_nucl.irp.f

@@ -8,6 +8,7 @@ BEGIN_PROVIDER [ double precision , ao_value_at_nucl, (ao_num,nucl_num) ]
 
   do k=1,nucl_num
     do i=1,ao_num
+      ao_value_at_nucl(i,k) = 0.d0
       x = nucl_coord(ao_nucl(i),1) - nucl_coord(k,1)
       y = nucl_coord(ao_nucl(i),2) - nucl_coord(k,2)
       z = nucl_coord(ao_nucl(i),3) - nucl_coord(k,3)
@@ -15,7 +16,6 @@ BEGIN_PROVIDER [ double precision , ao_value_at_nucl, (ao_num,nucl_num) ]
       if (poly == 0.d0) cycle
 
       r2 = (x*x) + (y*y) + (z*z)
-      ao_value_at_nucl(i,k) = 0.d0
       do j=1,ao_prim_num(i)
         expo = ao_expo_ordered_transp(j,i)*r2
         if (expo > 40.d0) cycle

plugins/Hartree_Fock_SlaterDressed/integrals.irp.f

@@ -452,19 +452,19 @@ BEGIN_PROVIDER [ double precision, GauSla$X_matrix, (ao_num, nucl_num) ]
   integer                        :: aGau(3)
 
 !TODO
-  logical :: read
-  integer :: iunit
-  integer :: getunitandopen
-
-  inquire(FILE=trim(ezfio_filename)//'/work/GauSla$X.dat',EXIST=read)
-  if (read) then
-    print *,  'READ $X'
-    iunit = getunitandopen(trim(ezfio_filename)//'/work/GauSla$X.dat','r')
-  else
-    print *,  'WRITE $X'
-    iunit = getunitandopen(trim(ezfio_filename)//'/work/GauSla$X.inp','w')
-    write(iunit,*) '{'
-  endif
+!  logical :: read
+!  integer :: iunit
+!  integer :: getunitandopen
+!
+!  inquire(FILE=trim(ezfio_filename)//'/work/GauSla$X.dat',EXIST=read)
+!  if (read) then
+!    print *,  'READ $X'
+!    iunit = getunitandopen(trim(ezfio_filename)//'/work/GauSla$X.dat','r')
+!  else
+!    print *,  'WRITE $X'
+!    iunit = getunitandopen(trim(ezfio_filename)//'/work/GauSla$X.inp','w')
+!    write(iunit,*) '{'
+!  endif
 !TODO
 
   do k=1,nucl_num
@@ -478,22 +478,22 @@ BEGIN_PROVIDER [ double precision, GauSla$X_matrix, (ao_num, nucl_num) ]
 
       do j=1,ao_prim_num(i)
         expGau = ao_expo_ordered_transp(j,i)
-!        call GauSla$X(expGau,cGau,aGau,expSla,cSla,res)
-        if (read) then
-          call GauSla$X_read(expGau,cGau,aGau,expSla,cSla,res,iunit)
-        else
-          call GauSla$X_write(expGau,cGau,aGau,expSla,cSla,res,iunit)
-        endif
+        call GauSla$X(expGau,cGau,aGau,expSla,cSla,res)
+!        if (read) then
+!          call GauSla$X_read(expGau,cGau,aGau,expSla,cSla,res,iunit)
+!        else
+!          call GauSla$X_write(expGau,cGau,aGau,expSla,cSla,res,iunit)
+!        endif
         GauSla$X_matrix(i,k) += ao_coef_normalized_ordered_transp(j,i) * res
       enddo
 
     enddo
 
   enddo
-  if (.not.read) then
-    write(iunit,*) '0.}'
-  endif
-  close(iunit)
+!  if (.not.read) then
+!    write(iunit,*) '0.}'
+!  endif
+!  close(iunit)
   
 END_PROVIDER
 

src/Determinants/occ_pattern.irp.f

@@ -304,3 +304,4 @@ subroutine make_s2_eigenfunction
 end
 
 
+

src/Determinants/spindeterminants.irp.f

@@ -625,9 +625,16 @@ subroutine create_wf_of_psi_bilinear_matrix(truncate)
   integer                        :: idx
   integer, external              :: get_index_in_psi_det_sorted_bit
   double precision               :: norm(N_states)
+  PROVIDE psi_bilinear_matrix
 
   call generate_all_alpha_beta_det_products
   norm = 0.d0
+  !$OMP PARALLEL DO DEFAULT(NONE)                                    &
+      !$OMP PRIVATE(i,j,k,idx,tmp_det)                               &
+      !$OMP SHARED(N_det_alpha_unique, N_det_beta_unique, N_det,     &
+      !$OMP N_int, N_states, norm, psi_det_beta_unique,              &
+      !$OMP psi_det_alpha_unique, psi_bilinear_matrix,               &
+      !$OMP psi_coef_sorted_bit)
   do j=1,N_det_beta_unique
     do k=1,N_int
       tmp_det(k,2) = psi_det_beta_unique(k,j)
@@ -640,11 +647,14 @@ subroutine create_wf_of_psi_bilinear_matrix(truncate)
       if (idx > 0) then
         do k=1,N_states
           psi_coef_sorted_bit(idx,k) = psi_bilinear_matrix(i,j,k) 
+          !$OMP ATOMIC
           norm(k) += psi_bilinear_matrix(i,j,k)
         enddo
       endif
     enddo
   enddo
+  !$OMP END PARALLEL DO
+
   do k=1,N_states
     norm(k) = 1.d0/dsqrt(norm(k))
     do i=1,N_det
@@ -688,7 +698,7 @@ subroutine generate_all_alpha_beta_det_products
       !$OMP PRIVATE(i,j,k,l,tmp_det,iproc)
   !$ iproc = omp_get_thread_num()
   allocate (tmp_det(N_int,2,N_det_alpha_unique))
-  !$OMP DO
+  !$OMP DO SCHEDULE(static,1)
   do j=1,N_det_beta_unique
     l = 1
     do i=1,N_det_alpha_unique

src/MO_Basis/ao_ortho_canonical.irp.f

@@ -106,9 +106,9 @@ END_PROVIDER
     ao_ortho_canonical_coef(i,i) = 1.d0
   enddo
 
-!call ortho_lowdin(ao_overlap,size(ao_overlap,1),ao_num,ao_ortho_canonical_coef,size(ao_ortho_canonical_coef,1),ao_num)
-!ao_ortho_canonical_num=ao_num
-!return
+call ortho_lowdin(ao_overlap,size(ao_overlap,1),ao_num,ao_ortho_canonical_coef,size(ao_ortho_canonical_coef,1),ao_num)
+ao_ortho_canonical_num=ao_num
+return
 
   if (ao_cartesian) then