mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-08-24 21:21:47 +02: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
|
if [[ $mos -eq 1 ]] ; then
|
||||||
qp set mo_two_e_ints io_mo_two_e_integrals None
|
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_kinetic None
|
||||||
qp set mo_one_e_ints io_mo_integrals_pseudo None
|
qp set mo_one_e_ints io_mo_integrals_pseudo None
|
||||||
qp set mo_one_e_ints io_mo_one_e_integrals None
|
qp set mo_one_e_ints io_mo_one_e_integrals None
|
||||||
|
@ -51,7 +51,7 @@ FCFLAGS : -Ofast
|
|||||||
# -g : Extra debugging information
|
# -g : Extra debugging information
|
||||||
#
|
#
|
||||||
[DEBUG]
|
[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
|
# OpenMP flags
|
||||||
#################
|
#################
|
||||||
|
@ -53,7 +53,7 @@ FCFLAGS : -Ofast -fimplicit-none
|
|||||||
# -g : Extra debugging information
|
# -g : Extra debugging information
|
||||||
#
|
#
|
||||||
[DEBUG]
|
[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
|
# OpenMP flags
|
||||||
|
@ -1907,13 +1907,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 > 300'
|
stop 'pseudopot.f90 : q > 200'
|
||||||
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
|
||||||
|
s_q_k = 0.d0
|
||||||
|
exit
|
||||||
|
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
|
||||||
|
@ -5,11 +5,12 @@ source $QP_ROOT/quantum_package.rc
|
|||||||
|
|
||||||
|
|
||||||
function run() {
|
function run() {
|
||||||
thresh=1.e-7
|
thresh=1.e-6
|
||||||
test_exe scf || skip
|
test_exe scf || skip
|
||||||
qp set_file $1
|
qp set_file $1
|
||||||
qp edit --check
|
qp edit --check
|
||||||
qp reset --mos
|
qp reset --mos
|
||||||
|
qp set scf_utils n_it_scf_max 50
|
||||||
qp run scf
|
qp run scf
|
||||||
# qp set_frozen_core
|
# qp set_frozen_core
|
||||||
energy="$(ezfio get hartree_fock energy)"
|
energy="$(ezfio get hartree_fock energy)"
|
||||||
@ -39,7 +40,7 @@ function run() {
|
|||||||
}
|
}
|
||||||
|
|
||||||
@test "SO" { # 0.539000 5.70403s
|
@test "SO" { # 0.539000 5.70403s
|
||||||
run so.ezfio -25.7175263371941
|
run so.ezfio -25.7175270084056
|
||||||
}
|
}
|
||||||
|
|
||||||
@test "HCO" { # 0.636700 1.55279s
|
@test "HCO" { # 0.636700 1.55279s
|
||||||
@ -107,13 +108,13 @@ function run() {
|
|||||||
}
|
}
|
||||||
|
|
||||||
@test "C2H2" { # 19.599000 37.7923s
|
@test "C2H2" { # 19.599000 37.7923s
|
||||||
run c2h2.ezfio -12.12144019495306
|
run c2h2.ezfio -12.12144044853196
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
@test "SiH3" { # 20.316100 54.0861s
|
@test "SiH3" { # 20.316100 54.0861s
|
||||||
[[ -n $TRAVIS ]] && skip
|
[[ -n $TRAVIS ]] && skip
|
||||||
run sih3.ezfio -5.455398769158780
|
run sih3.ezfio -5.455400439077580
|
||||||
}
|
}
|
||||||
|
|
||||||
@test "OH" { # 32.042200 1.36478m
|
@test "OH" { # 32.042200 1.36478m
|
||||||
@ -130,6 +131,6 @@ function run() {
|
|||||||
|
|
||||||
@test "SO2" { # 71.894900 3.22567m
|
@test "SO2" { # 71.894900 3.22567m
|
||||||
[[ -n $TRAVIS ]] && skip
|
[[ -n $TRAVIS ]] && skip
|
||||||
run so2.ezfio -41.55800190733211
|
run so2.ezfio -41.55800401346361
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -53,6 +53,7 @@ BEGIN_PROVIDER [ double precision, nucl_coord, (nucl_num,3) ]
|
|||||||
'================','============','============','============','============'
|
'================','============','============','============','============'
|
||||||
write(6,'(A)') ''
|
write(6,'(A)') ''
|
||||||
|
|
||||||
|
if (nucl_num > 1) then
|
||||||
double precision :: dist_min, x, y, z
|
double precision :: dist_min, x, y, z
|
||||||
dist_min = huge(1.d0)
|
dist_min = huge(1.d0)
|
||||||
do i=1,nucl_num
|
do i=1,nucl_num
|
||||||
@ -65,6 +66,7 @@ BEGIN_PROVIDER [ double precision, nucl_coord, (nucl_num,3) ]
|
|||||||
enddo
|
enddo
|
||||||
write(6,'(A,F12.4,A)') 'Minimal interatomic distance found: ', &
|
write(6,'(A,F12.4,A)') 'Minimal interatomic distance found: ', &
|
||||||
dsqrt(dist_min)*a0,' Angstrom'
|
dsqrt(dist_min)*a0,' Angstrom'
|
||||||
|
endif
|
||||||
|
|
||||||
endif
|
endif
|
||||||
|
|
||||||
|
@ -196,6 +196,13 @@ END_DOC
|
|||||||
|
|
||||||
double precision,allocatable :: scratch(:,:)
|
double precision,allocatable :: scratch(:,:)
|
||||||
integer :: i,j,k,i_DIIS,j_DIIS
|
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( &
|
allocate( &
|
||||||
B_matrix_DIIS(dim_DIIS+1,dim_DIIS+1), &
|
B_matrix_DIIS(dim_DIIS+1,dim_DIIS+1), &
|
||||||
@ -239,37 +246,44 @@ END_DOC
|
|||||||
B_matrix_DIIS(dim_DIIS+1,dim_DIIS+1) = 0.d0
|
B_matrix_DIIS(dim_DIIS+1,dim_DIIS+1) = 0.d0
|
||||||
C_vector_DIIS(dim_DIIS+1) = -1.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 :: info
|
||||||
integer,allocatable :: ipiv(:)
|
integer,allocatable :: ipiv(:)
|
||||||
|
|
||||||
allocate( &
|
|
||||||
ipiv(dim_DIIS+1) &
|
|
||||||
)
|
|
||||||
|
|
||||||
double precision, allocatable :: AF(:,:)
|
double precision, allocatable :: AF(:,:)
|
||||||
allocate (AF(dim_DIIS+1,dim_DIIS+1))
|
double precision, external :: dlange
|
||||||
double precision :: rcond, ferr, berr
|
|
||||||
integer :: iwork(dim_DIIS+1), lwork
|
|
||||||
|
|
||||||
call dsysvx('N','U',dim_DIIS+1,1, &
|
lwork = max((dim_DIIS+1)**2, (dim_DIIS+1)*5)
|
||||||
B_matrix_DIIS,size(B_matrix_DIIS,1), &
|
allocate(AF(dim_DIIS+1,dim_DIIS+1))
|
||||||
AF, size(AF,1), &
|
allocate(ipiv(2*(dim_DIIS+1)), iwork(2*(dim_DIIS+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)
|
|
||||||
allocate(scratch(lwork,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, &
|
call dsysvx('N','U',dim_DIIS+1,1, &
|
||||||
B_matrix_DIIS,size(B_matrix_DIIS,1), &
|
B_matrix_DIIS,size(B_matrix_DIIS,1), &
|
||||||
AF, size(AF,1), &
|
AF, size(AF,1), &
|
||||||
@ -284,12 +298,12 @@ END_DOC
|
|||||||
info &
|
info &
|
||||||
)
|
)
|
||||||
|
|
||||||
|
deallocate(scratch,AF,iwork)
|
||||||
|
|
||||||
if(info < 0) then
|
if(info < 0) then
|
||||||
stop 'bug in DIIS'
|
stop 'bug in DIIS'
|
||||||
endif
|
endif
|
||||||
|
|
||||||
if (rcond > 1.d-12) then
|
|
||||||
|
|
||||||
! Compute extrapolated Fock matrix
|
! Compute extrapolated Fock matrix
|
||||||
|
|
||||||
|
|
||||||
@ -308,8 +322,4 @@ END_DOC
|
|||||||
enddo
|
enddo
|
||||||
!$OMP END PARALLEL DO
|
!$OMP END PARALLEL DO
|
||||||
|
|
||||||
else
|
|
||||||
dim_DIIS = 0
|
|
||||||
endif
|
|
||||||
|
|
||||||
end
|
end
|
||||||
|
Loading…
Reference in New Issue
Block a user