10
0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-11-19 04:22:32 +01:00

updated tests

This commit is contained in:
Anthony Scemama 2020-05-26 11:00:35 +02:00
parent f536aea568
commit 811cdf86a6
3 changed files with 9 additions and 60 deletions

View File

@ -238,9 +238,6 @@ ntotB=n_b(1)+n_b(2)+n_b(3)
ntot=ntotA+ntotB ntot=ntotA+ntotB
nkl_max=4 nkl_max=4
!=!=!=!=!=!=!=!=!=!
! A l l o c a t e !
!=!=!=!=!=!=!=!=!=!
allocate (array_coefs_A(0:ntot,3)) allocate (array_coefs_A(0:ntot,3))
allocate (array_coefs_B(0:ntot,3)) allocate (array_coefs_B(0:ntot,3))
@ -254,16 +251,8 @@ allocate (array_I_B(-(lmax+ntot):lmax+ntot,0:lmax+ntot,0:ntot,0:ntot,0:ntot))
if(ac.eq.0.d0.and.bc.eq.0.d0)then if(ac.eq.0.d0.and.bc.eq.0.d0)then
!=!=!=!=!=!
! I n i t !
!=!=!=!=!=!
accu=0.d0 accu=0.d0
!=!=!=!=!=!=!=!
! c a l c u l !
!=!=!=!=!=!=!=!
do k=1,kmax do k=1,kmax
do l=0,lmax do l=0,lmax
ktot=ntot+n_kl(k,l) ktot=ntot+n_kl(k,l)
@ -278,18 +267,10 @@ if(ac.eq.0.d0.and.bc.eq.0.d0)then
enddo enddo
enddo enddo
!=!=!=!=!
! E n d !
!=!=!=!=!
Vpseudo=accu*fourpi Vpseudo=accu*fourpi
else if(ac.ne.0.d0.and.bc.ne.0.d0)then else if(ac.ne.0.d0.and.bc.ne.0.d0)then
!=!=!=!=!=!
! I n i t !
!=!=!=!=!=!
f=fourpi*fourpi f=fourpi*fourpi
theta_AC0=dacos( (a(3)-c(3))/ac ) theta_AC0=dacos( (a(3)-c(3))/ac )
@ -330,10 +311,6 @@ else if(ac.ne.0.d0.and.bc.ne.0.d0)then
array_coefs_B(k3p,3) = binom_func(n_b(3),k3p)*(c(3)-b(3))**(n_b(3)-k3p) array_coefs_B(k3p,3) = binom_func(n_b(3),k3p)*(c(3)-b(3))**(n_b(3)-k3p)
enddo enddo
!=!=!=!=!=!=!=!
! c a l c u l !
!=!=!=!=!=!=!=!
accu=0.d0 accu=0.d0
do l=0,lmax do l=0,lmax
do m=-l,l do m=-l,l
@ -408,18 +385,10 @@ else if(ac.ne.0.d0.and.bc.ne.0.d0)then
enddo enddo
enddo enddo
!=!=!=!=!
! E n d !
!=!=!=!=!
Vpseudo=f*accu Vpseudo=f*accu
else if(ac.eq.0.d0.and.bc.ne.0.d0)then else if(ac.eq.0.d0.and.bc.ne.0.d0)then
!=!=!=!=!=!
! I n i t !
!=!=!=!=!=!
f=fourpi**1.5d0 f=fourpi**1.5d0
theta_BC0=dacos( (b(3)-c(3))/bc ) theta_BC0=dacos( (b(3)-c(3))/bc )
phi_BC0=datan2((b(2)-c(2))/bc,(b(1)-c(1))/bc) phi_BC0=datan2((b(2)-c(2))/bc,(b(1)-c(1))/bc)
@ -448,10 +417,6 @@ else if(ac.eq.0.d0.and.bc.ne.0.d0)then
array_coefs_B(k3p,3) = binom_func(n_b(3),k3p)*(c(3)-b(3))**(n_b(3)-k3p) array_coefs_B(k3p,3) = binom_func(n_b(3),k3p)*(c(3)-b(3))**(n_b(3)-k3p)
enddo enddo
!=!=!=!=!=!=!=!
! c a l c u l !
!=!=!=!=!=!=!=!
accu=0.d0 accu=0.d0
do l=0,lmax do l=0,lmax
do m=-l,l do m=-l,l
@ -498,18 +463,10 @@ else if(ac.eq.0.d0.and.bc.ne.0.d0)then
enddo enddo
enddo enddo
!=!=!=!=!
! E n d !
!=!=!=!=!
Vpseudo=f*accu Vpseudo=f*accu
else if(ac.ne.0.d0.and.bc.eq.0.d0)then else if(ac.ne.0.d0.and.bc.eq.0.d0)then
!=!=!=!=!=!
! I n i t !
!=!=!=!=!=!
f=fourpi**1.5d0 f=fourpi**1.5d0
theta_AC0=dacos( (a(3)-c(3))/ac ) theta_AC0=dacos( (a(3)-c(3))/ac )
phi_AC0=datan2((a(2)-c(2))/ac,(a(1)-c(1))/ac) phi_AC0=datan2((a(2)-c(2))/ac,(a(1)-c(1))/ac)
@ -538,10 +495,6 @@ else if(ac.ne.0.d0.and.bc.eq.0.d0)then
array_coefs_A(k3,3) = binom_func(n_a(3),k3)*(c(3)-a(3))**(n_a(3)-k3) array_coefs_A(k3,3) = binom_func(n_a(3),k3)*(c(3)-a(3))**(n_a(3)-k3)
enddo enddo
!=!=!=!=!=!=!=!
! c a l c u l !
!=!=!=!=!=!=!=!
accu=0.d0 accu=0.d0
do l=0,lmax do l=0,lmax
do m=-l,l do m=-l,l
@ -587,10 +540,6 @@ else if(ac.ne.0.d0.and.bc.eq.0.d0)then
enddo enddo
enddo enddo
!=!=!=!=!
! E n d !
!=!=!=!=!
Vpseudo=f*accu Vpseudo=f*accu
endif endif
@ -1885,7 +1834,7 @@ double precision function int_prod_bessel(l,gam,n,m,a,b,arg)
pi=dacos(-1.d0) pi=dacos(-1.d0)
a_over_b_square = (a/b)**2 a_over_b_square = (a/b)**2
! Calcul first term of the sequence ! First term of the sequence
term_a =dble_fact(nlm-1) / (dble_fact(n_1)*dble_fact(m_1)) term_a =dble_fact(nlm-1) / (dble_fact(n_1)*dble_fact(m_1))
expo=0.5d0*dfloat(nlm+1) expo=0.5d0*dfloat(nlm+1)
@ -1894,7 +1843,7 @@ double precision function int_prod_bessel(l,gam,n,m,a,b,arg)
s_0_0=term_rap*a**(n)*b**(m) s_0_0=term_rap*a**(n)*b**(m)
if(mod(nlm,2).eq.0)s_0_0=s_0_0*dsqrt(pi*.5d0) if(mod(nlm,2).eq.0)s_0_0=s_0_0*dsqrt(pi*.5d0)
! Initialise the first recurence terme for the q loop ! Initialize the first recurrence term for the q loop
s_q_0 = s_0_0 s_q_0 = s_0_0
@ -1907,17 +1856,17 @@ double precision function int_prod_bessel(l,gam,n,m,a,b,arg)
sum=s_q_0 sum=s_q_0
if (q>300) then if (q>300) then
stop 'pseudopot.f90 : q > 200' stop 'pseudopot.f90 : q > 300'
endif endif
qk = dble(q) qk = dble(q)
two_qkmp1 = 2.d0*(qk+mk)+1.d0 two_qkmp1 = 2.d0*(qk+mk)+1.d0
do k=0,q-1 do k=0,q-1
s_q_k = two_qkmp1*qk*inverses(k)*s_q_k s_q_k = two_qkmp1*qk*inverses(k)*s_q_k
if (s_q_k < 1.d-32) then ! if (s_q_k < 1.d-32) then
s_q_k = 0.d0 ! s_q_k = 0.d0
exit ! exit
endif ! endif
sum=sum+s_q_k sum=sum+s_q_k
two_qkmp1 = two_qkmp1-2.d0 two_qkmp1 = two_qkmp1-2.d0
qk = qk-1.d0 qk = qk-1.d0

View File

@ -5,7 +5,7 @@ source $QP_ROOT/quantum_package.rc
function run() { function run() {
thresh=1.e-6 thresh=1.e-5
test_exe scf || skip test_exe scf || skip
qp set_file $1 qp set_file $1
qp edit --check qp edit --check

View File

@ -200,7 +200,7 @@ END_DOC
integer, allocatable :: iwork(:) integer, allocatable :: iwork(:)
integer :: lwork integer :: lwork
if (dim_DIIS < 4) then if (dim_DIIS < 1) then
return return
endif endif