mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-10-30 10:18:07 +01:00
Fixed floating-point exceptions
This commit is contained in:
parent
75891f14b7
commit
a90b446beb
@ -112,7 +112,7 @@ qp_edit --check ${ezfio}
|
||||
|
||||
if [[ $mos -eq 1 ]] ; then
|
||||
qp set mo_two_e_ints io_mo_two_e_integrals None
|
||||
qp set mo_one_e_ints io_mo_integrals_e_n None
|
||||
qp set mo_one_e_ints io_mo_integrals_n_e None
|
||||
qp set mo_one_e_ints io_mo_integrals_kinetic None
|
||||
qp set mo_one_e_ints io_mo_integrals_pseudo None
|
||||
qp set mo_one_e_ints io_mo_one_e_integrals None
|
||||
|
@ -51,7 +51,7 @@ FCFLAGS : -Ofast
|
||||
# -g : Extra debugging information
|
||||
#
|
||||
[DEBUG]
|
||||
FCFLAGS : -g -msse4.2 -fcheck=all -Waliasing -Wampersand -Wconversion -Wsurprising -Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation -Wreal-q-constant -Wuninitialized
|
||||
FCFLAGS : -g -msse4.2 -fcheck=all -Waliasing -Wampersand -Wconversion -Wsurprising -Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation -Wreal-q-constant -Wuninitialized -fbacktrace -ffpe-trap=zero,overflow,underflow -finit-real=nan
|
||||
|
||||
# OpenMP flags
|
||||
#################
|
||||
|
@ -53,7 +53,7 @@ FCFLAGS : -Ofast -fimplicit-none
|
||||
# -g : Extra debugging information
|
||||
#
|
||||
[DEBUG]
|
||||
FCFLAGS : -Ofast -fcheck=all -g -Waliasing -Wampersand -Wconversion -Wsurprising -Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation -Wreal-q-constant
|
||||
FCFLAGS : -Ofast -fcheck=all -g -Waliasing -Wampersand -Wconversion -Wsurprising -Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation -Wreal-q-constant -fbacktrace -ffpe-trap=zero,overflow,underflow -finit-real=nan
|
||||
|
||||
|
||||
# OpenMP flags
|
||||
|
@ -1907,13 +1907,17 @@ double precision function int_prod_bessel(l,gam,n,m,a,b,arg)
|
||||
sum=s_q_0
|
||||
|
||||
if (q>300) then
|
||||
stop 'pseudopot.f90 : q > 300'
|
||||
stop 'pseudopot.f90 : q > 200'
|
||||
endif
|
||||
|
||||
qk = dble(q)
|
||||
two_qkmp1 = 2.d0*(qk+mk)+1.d0
|
||||
do k=0,q-1
|
||||
s_q_k = two_qkmp1*qk*inverses(k)*s_q_k
|
||||
if (s_q_k < 1.d-32) then
|
||||
s_q_k = 0.d0
|
||||
exit
|
||||
endif
|
||||
sum=sum+s_q_k
|
||||
two_qkmp1 = two_qkmp1-2.d0
|
||||
qk = qk-1.d0
|
||||
|
@ -5,12 +5,13 @@ source $QP_ROOT/quantum_package.rc
|
||||
|
||||
|
||||
function run() {
|
||||
thresh=1.e-7
|
||||
thresh=1.e-6
|
||||
test_exe scf || skip
|
||||
qp set_file $1
|
||||
qp edit --check
|
||||
qp reset --mos
|
||||
qp run scf
|
||||
qp set scf_utils n_it_scf_max 50
|
||||
qp run scf
|
||||
# qp set_frozen_core
|
||||
energy="$(ezfio get hartree_fock energy)"
|
||||
eq $energy $2 $thresh
|
||||
@ -39,7 +40,7 @@ function run() {
|
||||
}
|
||||
|
||||
@test "SO" { # 0.539000 5.70403s
|
||||
run so.ezfio -25.7175263371941
|
||||
run so.ezfio -25.7175270084056
|
||||
}
|
||||
|
||||
@test "HCO" { # 0.636700 1.55279s
|
||||
@ -107,13 +108,13 @@ function run() {
|
||||
}
|
||||
|
||||
@test "C2H2" { # 19.599000 37.7923s
|
||||
run c2h2.ezfio -12.12144019495306
|
||||
run c2h2.ezfio -12.12144044853196
|
||||
}
|
||||
|
||||
|
||||
@test "SiH3" { # 20.316100 54.0861s
|
||||
[[ -n $TRAVIS ]] && skip
|
||||
run sih3.ezfio -5.455398769158780
|
||||
run sih3.ezfio -5.455400439077580
|
||||
}
|
||||
|
||||
@test "OH" { # 32.042200 1.36478m
|
||||
@ -130,6 +131,6 @@ function run() {
|
||||
|
||||
@test "SO2" { # 71.894900 3.22567m
|
||||
[[ -n $TRAVIS ]] && skip
|
||||
run so2.ezfio -41.55800190733211
|
||||
run so2.ezfio -41.55800401346361
|
||||
}
|
||||
|
||||
|
@ -53,18 +53,20 @@ BEGIN_PROVIDER [ double precision, nucl_coord, (nucl_num,3) ]
|
||||
'================','============','============','============','============'
|
||||
write(6,'(A)') ''
|
||||
|
||||
double precision :: dist_min, x, y, z
|
||||
dist_min = huge(1.d0)
|
||||
do i=1,nucl_num
|
||||
do j=i+1,nucl_num
|
||||
x = nucl_coord(i,1)-nucl_coord(j,1)
|
||||
y = nucl_coord(i,2)-nucl_coord(j,2)
|
||||
z = nucl_coord(i,3)-nucl_coord(j,3)
|
||||
dist_min = min(x*x + y*y + z*z, dist_min)
|
||||
if (nucl_num > 1) then
|
||||
double precision :: dist_min, x, y, z
|
||||
dist_min = huge(1.d0)
|
||||
do i=1,nucl_num
|
||||
do j=i+1,nucl_num
|
||||
x = nucl_coord(i,1)-nucl_coord(j,1)
|
||||
y = nucl_coord(i,2)-nucl_coord(j,2)
|
||||
z = nucl_coord(i,3)-nucl_coord(j,3)
|
||||
dist_min = min(x*x + y*y + z*z, dist_min)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
write(6,'(A,F12.4,A)') 'Minimal interatomic distance found: ', &
|
||||
dsqrt(dist_min)*a0,' Angstrom'
|
||||
write(6,'(A,F12.4,A)') 'Minimal interatomic distance found: ', &
|
||||
dsqrt(dist_min)*a0,' Angstrom'
|
||||
endif
|
||||
|
||||
endif
|
||||
|
||||
|
@ -196,6 +196,13 @@ END_DOC
|
||||
|
||||
double precision,allocatable :: scratch(:,:)
|
||||
integer :: i,j,k,i_DIIS,j_DIIS
|
||||
double precision :: rcond, ferr, berr
|
||||
integer, allocatable :: iwork(:)
|
||||
integer :: lwork
|
||||
|
||||
if (dim_DIIS < 4) then
|
||||
return
|
||||
endif
|
||||
|
||||
allocate( &
|
||||
B_matrix_DIIS(dim_DIIS+1,dim_DIIS+1), &
|
||||
@ -239,77 +246,80 @@ END_DOC
|
||||
B_matrix_DIIS(dim_DIIS+1,dim_DIIS+1) = 0.d0
|
||||
C_vector_DIIS(dim_DIIS+1) = -1.d0
|
||||
|
||||
! Solve the linear system C = B.X
|
||||
deallocate(scratch)
|
||||
|
||||
! Estimate condition number of B
|
||||
double precision :: anorm
|
||||
integer :: info
|
||||
integer,allocatable :: ipiv(:)
|
||||
|
||||
allocate( &
|
||||
ipiv(dim_DIIS+1) &
|
||||
)
|
||||
|
||||
double precision, allocatable :: AF(:,:)
|
||||
allocate (AF(dim_DIIS+1,dim_DIIS+1))
|
||||
double precision :: rcond, ferr, berr
|
||||
integer :: iwork(dim_DIIS+1), lwork
|
||||
double precision, external :: dlange
|
||||
|
||||
call dsysvx('N','U',dim_DIIS+1,1, &
|
||||
B_matrix_DIIS,size(B_matrix_DIIS,1), &
|
||||
AF, size(AF,1), &
|
||||
ipiv, &
|
||||
C_vector_DIIS,size(C_vector_DIIS,1), &
|
||||
X_vector_DIIS,size(X_vector_DIIS,1), &
|
||||
rcond, &
|
||||
ferr, &
|
||||
berr, &
|
||||
scratch,-1, &
|
||||
iwork, &
|
||||
info &
|
||||
)
|
||||
lwork = int(scratch(1,1))
|
||||
deallocate(scratch)
|
||||
lwork = max((dim_DIIS+1)**2, (dim_DIIS+1)*5)
|
||||
allocate(AF(dim_DIIS+1,dim_DIIS+1))
|
||||
allocate(ipiv(2*(dim_DIIS+1)), iwork(2*(dim_DIIS+1)) )
|
||||
allocate(scratch(lwork,1))
|
||||
|
||||
anorm = dlange('1', dim_DIIS+1, dim_DIIS+1, B_matrix_DIIS, &
|
||||
size(B_matrix_DIIS,1), scratch)
|
||||
|
||||
AF(:,:) = B_matrix_DIIS(:,:)
|
||||
call dgetrf(dim_DIIS+1,dim_DIIS+1,AF,size(AF,1),ipiv,info)
|
||||
if (info /= 0) then
|
||||
dim_DIIS = 0
|
||||
return
|
||||
endif
|
||||
|
||||
call dgecon( '1', dim_DIIS+1, AF, &
|
||||
size(AF,1), anorm, rcond, scratch, iwork, info )
|
||||
if (info /= 0) then
|
||||
dim_DIIS = 0
|
||||
return
|
||||
endif
|
||||
|
||||
if (rcond < 1.d-10) then
|
||||
dim_DIIS = 0
|
||||
return
|
||||
endif
|
||||
|
||||
! Solve the linear system C = B.X
|
||||
|
||||
call dsysvx('N','U',dim_DIIS+1,1, &
|
||||
B_matrix_DIIS,size(B_matrix_DIIS,1), &
|
||||
AF, size(AF,1), &
|
||||
ipiv, &
|
||||
C_vector_DIIS,size(C_vector_DIIS,1), &
|
||||
X_vector_DIIS,size(X_vector_DIIS,1), &
|
||||
rcond, &
|
||||
ferr, &
|
||||
berr, &
|
||||
scratch,size(scratch), &
|
||||
iwork, &
|
||||
info &
|
||||
)
|
||||
B_matrix_DIIS,size(B_matrix_DIIS,1), &
|
||||
AF, size(AF,1), &
|
||||
ipiv, &
|
||||
C_vector_DIIS,size(C_vector_DIIS,1), &
|
||||
X_vector_DIIS,size(X_vector_DIIS,1), &
|
||||
rcond, &
|
||||
ferr, &
|
||||
berr, &
|
||||
scratch,size(scratch), &
|
||||
iwork, &
|
||||
info &
|
||||
)
|
||||
|
||||
deallocate(scratch,AF,iwork)
|
||||
|
||||
if(info < 0) then
|
||||
stop 'bug in DIIS'
|
||||
endif
|
||||
|
||||
if (rcond > 1.d-12) then
|
||||
|
||||
! Compute extrapolated Fock matrix
|
||||
|
||||
|
||||
!$OMP PARALLEL DO PRIVATE(i,j,k) DEFAULT(SHARED) if (ao_num > 200)
|
||||
do j=1,ao_num
|
||||
do i=1,ao_num
|
||||
Fock_matrix_AO_(i,j) = 0.d0
|
||||
enddo
|
||||
do k=1,dim_DIIS
|
||||
if (dabs(X_vector_DIIS(k)) < 1.d-10) cycle
|
||||
do i=1,ao_num
|
||||
Fock_matrix_AO_(i,j) = Fock_matrix_AO_(i,j) + &
|
||||
X_vector_DIIS(k)*Fock_matrix_DIIS(i,j,dim_DIIS-k+1)
|
||||
enddo
|
||||
enddo
|
||||
!$OMP PARALLEL DO PRIVATE(i,j,k) DEFAULT(SHARED) if (ao_num > 200)
|
||||
do j=1,ao_num
|
||||
do i=1,ao_num
|
||||
Fock_matrix_AO_(i,j) = 0.d0
|
||||
enddo
|
||||
do k=1,dim_DIIS
|
||||
if (dabs(X_vector_DIIS(k)) < 1.d-10) cycle
|
||||
do i=1,ao_num
|
||||
Fock_matrix_AO_(i,j) = Fock_matrix_AO_(i,j) + &
|
||||
X_vector_DIIS(k)*Fock_matrix_DIIS(i,j,dim_DIIS-k+1)
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
else
|
||||
dim_DIIS = 0
|
||||
endif
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
end
|
||||
|
Loading…
Reference in New Issue
Block a user