diff --git a/plugins/Hartree_Fock_SlaterDressed/at_nucl.irp.f b/plugins/Hartree_Fock_SlaterDressed/at_nucl.irp.f index afb85b64..8dc8ede2 100644 --- a/plugins/Hartree_Fock_SlaterDressed/at_nucl.irp.f +++ b/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 diff --git a/plugins/Hartree_Fock_SlaterDressed/integrals.irp.f b/plugins/Hartree_Fock_SlaterDressed/integrals.irp.f index 680f3e1f..0deaa09b 100644 --- a/plugins/Hartree_Fock_SlaterDressed/integrals.irp.f +++ b/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 diff --git a/plugins/QmcChem/e_curve_qmc.irp.f b/plugins/QmcChem/qmc_e_curve.irp.f similarity index 100% rename from plugins/QmcChem/e_curve_qmc.irp.f rename to plugins/QmcChem/qmc_e_curve.irp.f diff --git a/src/Determinants/occ_pattern.irp.f b/src/Determinants/occ_pattern.irp.f index 89350543..b0f65d15 100644 --- a/src/Determinants/occ_pattern.irp.f +++ b/src/Determinants/occ_pattern.irp.f @@ -304,3 +304,4 @@ subroutine make_s2_eigenfunction end + diff --git a/src/Determinants/spindeterminants.irp.f b/src/Determinants/spindeterminants.irp.f index 39efb26c..10edf710 100644 --- a/src/Determinants/spindeterminants.irp.f +++ b/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 diff --git a/src/MO_Basis/ao_ortho_canonical.irp.f b/src/MO_Basis/ao_ortho_canonical.irp.f index 2184ce4a..d77374a8 100644 --- a/src/MO_Basis/ao_ortho_canonical.irp.f +++ b/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