10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-12-22 20:35:19 +01:00
This commit is contained in:
Anthony Scemama 2017-07-03 15:31:03 +02:00
parent 512c9dad07
commit fea4176820
6 changed files with 39 additions and 28 deletions

View File

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

View File

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

View File

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

View File

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

View File

@ -106,9 +106,9 @@ END_PROVIDER
ao_ortho_canonical_coef(i,i) = 1.d0 ao_ortho_canonical_coef(i,i) = 1.d0
enddo enddo
!call ortho_lowdin(ao_overlap,size(ao_overlap,1),ao_num,ao_ortho_canonical_coef,size(ao_ortho_canonical_coef,1),ao_num) 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 ao_ortho_canonical_num=ao_num
!return return
if (ao_cartesian) then if (ao_cartesian) then