mirror of
https://github.com/LCPQ/quantum_package
synced 2024-08-25 14:01:46 +02:00
save
This commit is contained in:
parent
512c9dad07
commit
fea4176820
@ -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
|
||||
|
@ -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
|
||||
|
||||
|
@ -304,3 +304,4 @@ subroutine make_s2_eigenfunction
|
||||
end
|
||||
|
||||
|
||||
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user