diff --git a/app/argument.f90 b/app/argument.f90
index 142b5a5b..2ec0ee9d 100644
--- a/app/argument.f90
+++ b/app/argument.f90
@@ -193,7 +193,7 @@ recursive subroutine get_response_file(self, resp, stat)
call push_back(self, arg)
end do
close(unit, iostat=stat)
- if (info /= 0) then
+ if (stat == 0 .and. info /= 0) then
stat = merge(0, info, is_iostat_end(info))
end if
end subroutine get_response_file
@@ -207,7 +207,7 @@ subroutine getline(unit, line, iostat, iomsg)
!> Status of operation
integer, intent(out) :: iostat
!> Error message
- character(len=:), allocatable, optional :: iomsg
+ character(len=:), allocatable, optional, intent(out) :: iomsg
integer, parameter :: bufsize = 512
character(len=bufsize) :: buffer, msg
diff --git a/app/cli.f90 b/app/cli.f90
index 630437c6..0d4f90b0 100644
--- a/app/cli.f90
+++ b/app/cli.f90
@@ -104,7 +104,7 @@ subroutine get_argument_as_real(arg, val, error)
!> Real value
real(wp), intent(out) :: val
!> Error handling
- type(error_type), allocatable :: error
+ type(error_type), allocatable, intent(out) :: error
integer :: stat
@@ -124,7 +124,7 @@ end subroutine get_argument_as_real
subroutine get_argument_as_integer_list(arg, vals, error)
character(len=:), intent(in), allocatable :: arg
integer, allocatable, intent(out) :: vals(:)
- type(error_type), allocatable :: error
+ type(error_type), allocatable, intent(out) :: error
integer :: pos, stat
integer, allocatable :: tmp(:)
diff --git a/app/toml.f90 b/app/toml.f90
index d12eced4..0c86cc1f 100644
--- a/app/toml.f90
+++ b/app/toml.f90
@@ -302,6 +302,8 @@ subroutine get(self, param, method, damping)
call new_cso_damping(tmp, record%param)
call move_alloc(tmp, param)
end block
+ case default
+ continue
end select
end associate
end subroutine get
diff --git a/doc/tutorial/first-steps-fortran/src/scan.f90 b/doc/tutorial/first-steps-fortran/src/scan.f90
index 915b6624..dd406237 100644
--- a/doc/tutorial/first-steps-fortran/src/scan.f90
+++ b/doc/tutorial/first-steps-fortran/src/scan.f90
@@ -37,7 +37,7 @@ end subroutine get_dispersion_for_reaction
subroutine scan_param_for_reaction(error, reaction, method, dft_energy)
use dftd3, only : d3_param
use mctc_env, only : error_type, fatal_error
- type(error_type), allocatable :: error
+ type(error_type), allocatable, intent(out) :: error
type(reaction_type), intent(in) :: reaction
character(*), intent(in) :: method
real(wp), intent(in), optional :: dft_energy
diff --git a/fpm.toml b/fpm.toml
index 2de438ae..17ef8ed9 100644
--- a/fpm.toml
+++ b/fpm.toml
@@ -36,14 +36,6 @@ main = "api-test.c"
ignore = [
"C002", # interface without implicit none
"C003", # implicit none(external)
- "C011", # no default in select case
- "C061", # missing intent attribute
- "C071", # assumed size
- "C072", # assumed size character intent
- "C081", # implicit save
- "C121", # use without explicit only
- "C122", # intrinsic missing for internal modules
- "C131", # default module accessibility
- "C181", # iostat not checked
]
+per-file-ignores."src/dftd3/api.f90" = ["C071", "C072"]
line-length = 132
diff --git a/src/dftd3/api.f90 b/src/dftd3/api.f90
index 138820fe..f2ff66af 100644
--- a/src/dftd3/api.f90
+++ b/src/dftd3/api.f90
@@ -20,6 +20,8 @@
!>{!./include/s-dftd3.h!}
!>```
module dftd3_api
+ use, intrinsic :: iso_c_binding, only : c_associated, c_bool, c_char, c_double, &
+ & c_f_pointer, c_int, c_loc, c_null_char, c_null_ptr, c_ptr
use dftd3_cutoff, only : realspace_cutoff
use dftd3_damping, only : damping_param
use dftd3_damping_cso, only : cso_damping_param, new_cso_damping
@@ -37,7 +39,6 @@ module dftd3_api
& get_cso_damping, get_z_damping
use dftd3_utils, only : wrap_to_central_cell
use dftd3_version, only : get_dftd3_version
- use iso_c_binding
use mctc_env, only : wp, error_type, fatal_error
use mctc_io_structure, only : structure_type, new
implicit none
diff --git a/src/dftd3/citation.f90 b/src/dftd3/citation.f90
index 7fe5fe0a..807efd33 100644
--- a/src/dftd3/citation.f90
+++ b/src/dftd3/citation.f90
@@ -708,6 +708,8 @@ pure function get_citation(doi) result(citation)
pages="2506.14665", &
year="2025" &
)
+ case default
+ continue
end select
end function get_citation
diff --git a/src/dftd3/cutoff.f90 b/src/dftd3/cutoff.f90
index de888979..c5666b91 100644
--- a/src/dftd3/cutoff.f90
+++ b/src/dftd3/cutoff.f90
@@ -17,6 +17,7 @@
module dftd3_cutoff
use mctc_env, only : wp
implicit none
+ private
public :: realspace_cutoff, get_lattice_points, smooth_cutoff
diff --git a/src/dftd3/damping.f90 b/src/dftd3/damping.f90
index 5ff1a646..bf8fa947 100644
--- a/src/dftd3/damping.f90
+++ b/src/dftd3/damping.f90
@@ -18,6 +18,7 @@ module dftd3_damping
use mctc_env, only : wp
use mctc_io, only : structure_type
implicit none
+ private
public :: damping_param, dispersion_interface
diff --git a/src/dftd3/damping/atm.f90 b/src/dftd3/damping/atm.f90
index 419561a6..75bb5b2d 100644
--- a/src/dftd3/damping/atm.f90
+++ b/src/dftd3/damping/atm.f90
@@ -19,6 +19,7 @@ module dftd3_damping_atm
use mctc_env, only : wp
use mctc_io, only : structure_type
implicit none
+ private
public :: get_atm_dispersion, get_atm_pairwise_dispersion
diff --git a/src/dftd3/damping/cso.f90 b/src/dftd3/damping/cso.f90
index 42535772..6547386b 100644
--- a/src/dftd3/damping/cso.f90
+++ b/src/dftd3/damping/cso.f90
@@ -22,6 +22,7 @@ module dftd3_damping_cso
use mctc_env, only : wp
use mctc_io, only : structure_type
implicit none
+ private
public :: cso_damping_param, new_cso_damping
diff --git a/src/dftd3/damping/mzero.f90 b/src/dftd3/damping/mzero.f90
index a7aabf62..04f8bf9d 100644
--- a/src/dftd3/damping/mzero.f90
+++ b/src/dftd3/damping/mzero.f90
@@ -22,6 +22,7 @@ module dftd3_damping_mzero
use mctc_env, only : wp
use mctc_io, only : structure_type
implicit none
+ private
public :: mzero_damping_param, new_mzero_damping
diff --git a/src/dftd3/damping/optimizedpower.f90 b/src/dftd3/damping/optimizedpower.f90
index 9f365ac0..1071bdf9 100644
--- a/src/dftd3/damping/optimizedpower.f90
+++ b/src/dftd3/damping/optimizedpower.f90
@@ -22,6 +22,7 @@ module dftd3_damping_optimizedpower
use mctc_env, only : wp
use mctc_io, only : structure_type
implicit none
+ private
public :: optimizedpower_damping_param, new_optimizedpower_damping
diff --git a/src/dftd3/damping/rational.f90 b/src/dftd3/damping/rational.f90
index a8edb7c5..25c676d7 100644
--- a/src/dftd3/damping/rational.f90
+++ b/src/dftd3/damping/rational.f90
@@ -22,6 +22,7 @@ module dftd3_damping_rational
use mctc_env, only : wp
use mctc_io, only : structure_type
implicit none
+ private
public :: rational_damping_param, new_rational_damping
diff --git a/src/dftd3/damping/z.f90 b/src/dftd3/damping/z.f90
index 862ab308..3df7def2 100644
--- a/src/dftd3/damping/z.f90
+++ b/src/dftd3/damping/z.f90
@@ -22,6 +22,7 @@ module dftd3_damping_z
use mctc_env, only : wp
use mctc_io, only : structure_type
implicit none
+ private
public :: z_damping_param, new_z_damping
diff --git a/src/dftd3/damping/zero.f90 b/src/dftd3/damping/zero.f90
index f978a0c3..4046b8b6 100644
--- a/src/dftd3/damping/zero.f90
+++ b/src/dftd3/damping/zero.f90
@@ -22,6 +22,7 @@ module dftd3_damping_zero
use mctc_env, only : wp
use mctc_io, only : structure_type
implicit none
+ private
public :: zero_damping_param, new_zero_damping
diff --git a/src/dftd3/gcp.f90 b/src/dftd3/gcp.f90
index 061d9929..addbc663 100644
--- a/src/dftd3/gcp.f90
+++ b/src/dftd3/gcp.f90
@@ -485,9 +485,15 @@ end subroutine srb_deriv
!* Inspired by mopac7.0
!******************************************************************************
subroutine ssovl(r, iat, jat, iz, xza, xzb, ovl)
+ real(wp), intent(in) :: r
+ integer, intent(in) :: iat, jat
+ integer, intent(in) :: iz(:)
+ real(wp), intent(in) :: xza, xzb
+ real(wp), intent(out) :: ovl
+
integer :: ii, shell(72)
logical :: debug
- real(wp) :: za, zb, R, ovl, ax, bx, norm, R05
+ real(wp) :: za, zb, ax, bx, norm, R05
integer :: na, nb
real(wp) :: xx
data shell/ &
@@ -501,8 +507,6 @@ subroutine ssovl(r, iat, jat, iz, xza, xzb, ovl)
! k-rn , no f-elements
54*3/
! ...
- real(wp) :: xza, xzb
- integer :: iat, jat, iz(*)
za = xza
zb = xzb
@@ -580,6 +584,8 @@ subroutine ssovl(r, iat, jat, iz, xza, xzb, ovl)
norm = sqrt((ZA*ZB*R*R)**7)/480.0d0
ovl = norm*(A6(ax)*Bint(bx, 0)-3.0d0*(A4(ax)*Bint(bx, 2) &
& -A2(ax)*Bint(bx, 4))-A0(ax)*Bint(bx, 6))/3.0_wp
+ case default
+ error stop "invalid shell combination in ssovl"
end select
else ! different elements
select case (ii)
@@ -634,6 +640,8 @@ subroutine ssovl(r, iat, jat, iz, xza, xzb, ovl)
case(9) ! <3s|3>
norm = sqrt((ZA*ZB*R*R)**7)/1440.0d0
ovl = norm*(A6(ax)*B0(bx)-3.0d0*(A4(ax)*B2(bx)-A2(ax)*B4(bx))-A0(ax)*B6(bx))
+ case default
+ error stop "invalid shell combination in ssovl"
end select
end if
end subroutine ssovl
@@ -851,7 +859,8 @@ end function bint
! faculty function
integer(wp) function fact(N)
implicit none
-integer :: j, n
+integer, intent(in) :: n
+integer :: j
fact = 1
do j = 2, n
fact = fact*j
@@ -870,9 +879,15 @@ subroutine gsovl(r, iat, jat, iz, xza, xzb, g)
! za = slater exponent atom A
! zb = slater exponent atom B
! R = distance between atom A and B
+ real(wp), intent(in) :: r
+ integer, intent(in) :: iat, jat
+ integer, intent(in) :: iz(:)
+ real(wp), intent(in) :: xza, xzb
+ real(wp), intent(out) :: g
+
integer :: ii, shell(72)
logical :: debug
- real(wp) :: ax, bx, R05, za, zb, R
+ real(wp) :: ax, bx, R05, za, zb
integer :: na, nb
data shell/ &
! h, he
@@ -885,11 +900,9 @@ subroutine gsovl(r, iat, jat, iz, xza, xzb, g)
! k-rn , no f-elements
54*3/
! ...
- real(wp) :: g, Fa, Fb
+ real(wp) :: Fa, Fb
!--------------------- set exponents ---------------------------------------
- real(wp) :: xza, xzb
real(wp) :: xx
- integer :: iat, jat, iz(*)
logical :: lsame
za = xza
@@ -952,6 +965,8 @@ subroutine gsovl(r, iat, jat, iz, xza, xzb, g)
end if
case(9)
call g3s3s(za, zb, Fa, Fb, R, g, lsame)
+ case default
+ error stop "invalid shell combination in gsovl"
end select
else ! different elements
lsame = .false.
@@ -989,6 +1004,8 @@ subroutine gsovl(r, iat, jat, iz, xza, xzb, g)
end if
case(9) ! <3s|3>
call g3s3s(za, zb, Fa, Fb, R, g, lsame)
+ case default
+ error stop "invalid shell combination in gsovl"
end select
end if
@@ -1005,9 +1022,10 @@ subroutine g1s1s(za, zb, Fa, Fb, R, g, sameElement)
! derivative of explicit integral expression
! using maple
implicit real(wp) (t)
- real(wp) :: za, zb, Fa, Fb
- real(wp) :: g, R
- logical :: sameElement
+ real(wp), intent(in) :: za, zb, Fa, Fb
+ real(wp), intent(in) :: R
+ real(wp), intent(out) :: g
+ logical, intent(in) :: sameElement
if(sameElement) then
t1 = za ** 2
@@ -1059,10 +1077,13 @@ subroutine g2s1s(za, zb, Fa, Fb, R, g, switch, lsame)
! derivative of explicit integral expression
! using maple
implicit real(wp) (t)
- real(wp) :: za, zb, Fa, Fb
- real(wp) :: g, R, norm
- logical :: switch
- logical :: lsame
+ real(wp), intent(in) :: za, zb, Fa
+ real(wp), intent(inout) :: Fb
+ real(wp), intent(in) :: R
+ real(wp), intent(out) :: g
+ real(wp) :: norm
+ logical, intent(in) :: switch
+ logical, intent(in) :: lsame
norm = (1d0/24d0)*sqrt(za**3*zb**5*3d0)
if(switch) then
@@ -1123,9 +1144,11 @@ subroutine g2s2s(za, zb, Fa, Fb, R, g, SameElement)
! derivative of explicit integral expression
! using maple
implicit real(wp) (t)
- real(wp) :: za, zb, Fa, Fb
- real(wp) :: g, R, norm
- logical :: SameElement
+ real(wp), intent(in) :: za, zb, Fa, Fb
+ real(wp), intent(in) :: R
+ real(wp), intent(out) :: g
+ real(wp) :: norm
+ logical, intent(in) :: SameElement
norm = 1d0/(16d0*3d0)*SQRT((ZA*ZB)**5)
@@ -1191,10 +1214,13 @@ subroutine g1s3s(za, zb, Fa, Fb, R, g, switch, lsame)
! derivative of explicit integral expression
! using maple
implicit real(wp) (t)
- real(wp) :: za, zb, Fa, Fb
- real(wp) :: g, R, norm
- logical :: switch
- logical :: lsame
+ real(wp), intent(in) :: za, zb, Fa
+ real(wp), intent(inout) :: Fb
+ real(wp), intent(in) :: R
+ real(wp), intent(out) :: g
+ real(wp) :: norm
+ logical, intent(in) :: switch
+ logical, intent(in) :: lsame
if(switch) Fb = -Fb
@@ -1263,10 +1289,13 @@ subroutine g2s3s(za, zb, Fa, Fb, R, g, switch, lsame)
! derivative of explicit integral expression
! using maple
implicit real(wp) (t)
- real(wp) :: za, zb, Fa, Fb
- real(wp) :: g, R, norm
- logical :: switch
- logical :: lsame
+ real(wp), intent(in) :: za, zb, Fa
+ real(wp), intent(inout) :: Fb
+ real(wp), intent(in) :: R
+ real(wp), intent(out) :: g
+ real(wp) :: norm
+ logical, intent(in) :: switch
+ logical, intent(in) :: lsame
norm = sqrt((za**5)*(zb**7)/7.5_wp)/96.0d0
if(switch) Fb = -Fb
@@ -1351,9 +1380,11 @@ subroutine g3s3s(za, zb, Fa, Fb, R, g, SameElement)
! derivative of explicit integral expression
! using maple
implicit real(wp) (t)
- real(wp) :: za, zb, Fa, Fb
- real(wp) :: g, R, norm
- logical :: SameElement
+ real(wp), intent(in) :: za, zb, Fa, Fb
+ real(wp), intent(in) :: R
+ real(wp), intent(out) :: g
+ real(wp) :: norm
+ logical, intent(in) :: SameElement
norm = sqrt((ZA*ZB)**7)/1440.0d0
diff --git a/src/dftd3/gcp/param.f90 b/src/dftd3/gcp/param.f90
index cb4c477f..117bf36a 100644
--- a/src/dftd3/gcp/param.f90
+++ b/src/dftd3/gcp/param.f90
@@ -570,6 +570,8 @@ subroutine get_gcp_param(param, mol, method, basis, eta)
eta_ = 1.4022_wp
param%alpha = 0.8055_wp
param%beta = 1.3000_wp
+ case default
+ continue
end select
case(p_sv_p_bas)
@@ -906,6 +908,8 @@ subroutine get_gcp_param(param, mol, method, basis, eta)
param%damp = .true.
end if
+ case default
+ continue
end select
if (allocated(nbas)) then
param%xv = nbas - 0.5_wp * nel
diff --git a/src/dftd3/model.f90 b/src/dftd3/model.f90
index 93e39358..fff05f6c 100644
--- a/src/dftd3/model.f90
+++ b/src/dftd3/model.f90
@@ -15,9 +15,9 @@
! along with s-dftd3. If not, see .
module dftd3_model
+ use, intrinsic :: ieee_arithmetic, only : ieee_is_nan
use dftd3_data, only : get_r4r2_val, get_vdw_rad
- use dftd3_reference
- use ieee_arithmetic, only : ieee_is_nan
+ use dftd3_reference, only : number_of_references, reference_cn, get_c6, init_reference_c6
use mctc_data, only : get_covalent_rad
use mctc_env, only : wp
use mctc_io, only : structure_type
diff --git a/src/dftd3/output.f90 b/src/dftd3/output.f90
index 67a2571b..6edd5723 100644
--- a/src/dftd3/output.f90
+++ b/src/dftd3/output.f90
@@ -492,11 +492,19 @@ subroutine turbomole_gradlatt(mol, fname, energy, sigma, stat)
end do skip_lines
call getline(igrad,line)
read(line(10:17),*,iostat=err) icycle
- read(line(33:51),*,iostat=err) escf
+ if (err == 0) read(line(33:51),*,iostat=err) escf
+ if (err /= 0) then
+ stat = 1
+ return
+ end if
do i = 1, 3
call getline(igrad,line)
read(line,*,iostat=err) dlat(1,i),dlat(2,i),dlat(3,i)
+ if (err /= 0) then
+ stat = 1
+ return
+ end if
end do
if (any(abs(dlat-mol%lattice) > 1.0e-8_wp)) then
stat = 1
@@ -505,6 +513,10 @@ subroutine turbomole_gradlatt(mol, fname, energy, sigma, stat)
do i = 1, 3
call getline(igrad,line)
read(line,*,iostat=err) glat(1,i),glat(2,i),glat(3,i)
+ if (err /= 0) then
+ stat = 1
+ return
+ end if
end do
do i = 1, 3
backspace(igrad)
@@ -572,12 +584,20 @@ subroutine turbomole_gradient(mol, fname, energy, gradient, stat)
end do skip_lines
call getline(igrad,line)
read(line(10:17),*,iostat=err) icycle
- read(line(33:51),*,iostat=err) escf
+ if (err == 0) read(line(33:51),*,iostat=err) escf
+ if (err /= 0) then
+ stat = 1
+ return
+ end if
allocate(xyz(3,mol%nat))
do i = 1, mol%nat
call getline(igrad,line)
read(line,*,iostat=err) xyz(1,i),xyz(2,i),xyz(3,i)
+ if (err /= 0) then
+ stat = 1
+ return
+ end if
end do
if (any(abs(xyz-mol%xyz) > 1.0e-8_wp)) then
stat = 1
@@ -586,6 +606,10 @@ subroutine turbomole_gradient(mol, fname, energy, gradient, stat)
do i = 1, mol%nat
call getline(igrad,line)
read(line,*,iostat=err) gscf(1,i),gscf(2,i),gscf(3,i)
+ if (err /= 0) then
+ stat = 1
+ return
+ end if
end do
do i = 1, mol%nat
backspace(igrad)
diff --git a/src/dftd3/utils.f90 b/src/dftd3/utils.f90
index c9687078..5e633b3a 100644
--- a/src/dftd3/utils.f90
+++ b/src/dftd3/utils.f90
@@ -18,6 +18,7 @@ module dftd3_utils
use mctc_env, only : wp
use mctc_io_math, only : matinv_3x3
implicit none
+ private
public :: wrap_to_central_cell
diff --git a/test/unit/CMakeLists.txt b/test/unit/CMakeLists.txt
index 303d686a..e6264b64 100644
--- a/test/unit/CMakeLists.txt
+++ b/test/unit/CMakeLists.txt
@@ -26,6 +26,7 @@ set(
"periodic_3d"
"periodic_atm"
"gcp"
+ "output"
"regression"
)
set(
diff --git a/test/unit/main.f90 b/test/unit/main.f90
index 88cf6d92..20f80adc 100644
--- a/test/unit/main.f90
+++ b/test/unit/main.f90
@@ -22,6 +22,7 @@ program tester
use test_dftd3, only : collect_dftd3
use test_gcp, only : collect_gcp
use test_model, only : collect_model
+ use test_output, only : collect_output
use test_pairwise, only : collect_pairwise
use test_param, only : collect_param
use test_periodic_1d, only : collect_periodic_1d
@@ -47,6 +48,7 @@ program tester
& new_testsuite("periodic_3d", collect_periodic_3d), &
& new_testsuite("periodic_atm", collect_periodic_atm), &
& new_testsuite("gcp", collect_gcp), &
+ & new_testsuite("output", collect_output), &
& new_testsuite("regression", collect_regression) &
& ]
diff --git a/test/unit/meson.build b/test/unit/meson.build
index 837480aa..2e86661e 100644
--- a/test/unit/meson.build
+++ b/test/unit/meson.build
@@ -36,6 +36,7 @@ tests = [
'periodic_3d',
'periodic_atm',
'gcp',
+ 'output',
'regression',
]
diff --git a/test/unit/test_dftd3.f90 b/test/unit/test_dftd3.f90
index 48d96998..bbc33ea1 100644
--- a/test/unit/test_dftd3.f90
+++ b/test/unit/test_dftd3.f90
@@ -15,7 +15,11 @@
! along with s-dftd3. If not, see .
module test_dftd3
- use dftd3
+ use dftd3, only : get_dispersion, realspace_cutoff, damping_param, d3_param, &
+ & cso_damping_param, new_cso_damping, mzero_damping_param, new_mzero_damping, &
+ & optimizedpower_damping_param, new_optimizedpower_damping, &
+ & rational_damping_param, new_rational_damping, zero_damping_param, &
+ & new_zero_damping, z_damping_param, new_z_damping, d3_model, new_d3_model
use mctc_env, only : wp
use mctc_env_testing, only : new_unittest, unittest_type, error_type, check, &
& test_failed
@@ -171,10 +175,10 @@ subroutine test_pbed3bjatm_smooth_cutoff_grad(error)
type(structure_type) :: mol
type(rational_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 1.0_wp, alp = 14.0_wp, &
& a1 = 0.4289_wp, s8 = 0.7875_wp, a2 = 4.4407_wp)
- type(realspace_cutoff) :: cutoff = realspace_cutoff(&
+ type(realspace_cutoff), parameter :: cutoff = realspace_cutoff(&
& cn=40.0_wp, disp2=8.0_wp, disp3=8.0_wp, width2=4.0_wp, width3=4.0_wp)
call get_structure(mol, "MB16-43", "01")
@@ -240,7 +244,7 @@ subroutine test_pbed3bj_mb01(error)
type(structure_type) :: mol
type(rational_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 0.0_wp, alp = 14.0_wp, &
& a1 = 0.4289_wp, s8 = 0.7875_wp, a2 = 4.4407_wp)
@@ -258,7 +262,7 @@ subroutine test_b97d3bj_mb02(error)
type(structure_type) :: mol
type(rational_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 0.0_wp, alp = 14.0_wp, &
& a1 = 0.5545_wp, s8 = 2.2609_wp, a2 = 3.2297_wp)
@@ -276,7 +280,7 @@ subroutine test_tpssd3bj_mb03(error)
type(structure_type) :: mol
type(rational_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 0.0_wp, alp = 14.0_wp, &
& a1 = 0.4535_wp, s8 = 1.9435_wp, a2 = 4.4752_wp)
@@ -294,7 +298,7 @@ subroutine test_pwpb95d3bj_mb04(error)
type(structure_type) :: mol
type(rational_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 0.82_wp, s9 = 0.0_wp, alp = 14.0_wp, &
& a1 = 0.0000_wp, s8 = 0.2904_wp, a2 = 7.3141_wp)
@@ -312,7 +316,7 @@ subroutine test_b2plypd3bj_mb05(error)
type(structure_type) :: mol
type(rational_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 0.64_wp, s9 = 0.0_wp, alp = 14.0_wp, &
& a1 = 0.3065_wp, s8 = 0.9147_wp, a2 = 5.0570_wp)
@@ -330,7 +334,7 @@ subroutine test_pw6b95d3bj_mb06(error)
type(structure_type) :: mol
type(rational_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 0.0_wp, alp = 14.0_wp, &
& a1 = 0.2076_wp, s8 = 0.7257_wp, a2 = 6.3750_wp)
@@ -348,7 +352,7 @@ subroutine test_olypd3bj_mb07(error)
type(structure_type) :: mol
type(rational_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 0.0_wp, alp = 14.0_wp, &
& a1 = 0.5299_wp, s8 = 2.6205_wp, a2 = 2.8065_wp)
@@ -366,7 +370,7 @@ subroutine test_pbe0d3bj_mb08(error)
type(structure_type) :: mol
type(rational_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 0.0_wp, alp = 14.0_wp, &
& a1 = 0.4145_wp, s8 = 1.2177_wp, a2 = 4.8593_wp)
@@ -384,7 +388,7 @@ subroutine test_rpbed3zero_mb09(error)
type(structure_type) :: mol
type(zero_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 0.0_wp, alp = 14.0_wp, rs8 = 1.0_wp, &
& rs6 = 0.872_wp, s8 = 0.514_wp)
@@ -402,7 +406,7 @@ subroutine test_b2gpplypd3zero_mb10(error)
type(structure_type) :: mol
type(zero_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 0.56_wp, s9 = 0.0_wp, alp = 14.0_wp, rs8 = 1.0_wp, &
& rs6 = 1.586_wp, s8 = 0.760_wp)
@@ -420,7 +424,7 @@ subroutine test_ssbd3zero_mb11(error)
type(structure_type) :: mol
type(zero_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 0.0_wp, alp = 14.0_wp, rs8 = 1.0_wp, &
& rs6 = 1.215_wp, s8 = 0.663_wp)
@@ -438,7 +442,7 @@ subroutine test_b1b95d3zero_mb12(error)
type(structure_type) :: mol
type(zero_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 0.0_wp, alp = 14.0_wp, rs8 = 1.0_wp, &
& rs6 = 1.613_wp, s8 = 1.868_wp)
@@ -456,7 +460,7 @@ subroutine test_m06ld3zero_mb13(error)
type(structure_type) :: mol
type(zero_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 0.0_wp, alp = 14.0_wp, rs8 = 1.0_wp, &
& rs6 = 1.581_wp, s8 = 0.000_wp)
@@ -474,7 +478,7 @@ subroutine test_tpsshd3zero_mb14(error)
type(structure_type) :: mol
type(zero_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 0.0_wp, alp = 14.0_wp, rs8 = 1.0_wp, &
& rs6 = 1.223_wp, s8 = 1.219_wp)
@@ -492,7 +496,7 @@ subroutine test_hfd3zero_mb15(error)
type(structure_type) :: mol
type(zero_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 0.0_wp, alp = 14.0_wp, rs8 = 1.0_wp, &
& rs6 = 1.158_wp, s8 = 1.746_wp)
@@ -510,7 +514,7 @@ subroutine test_camb3lypd3zero_mb16(error)
type(structure_type) :: mol
type(zero_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 0.0_wp, alp = 14.0_wp, rs8 = 1.0_wp, &
& rs6 = 1.378_wp, s8 = 1.217_wp)
@@ -528,7 +532,7 @@ subroutine test_dsdblypd3bjatm_mb17(error)
type(structure_type) :: mol
type(rational_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 0.5_wp, s9 = 1.0_wp, alp = 14.0_wp, &
& a1 = 0.0_wp, s8 = 0.2130_wp, a2 = 6.0519_wp)
@@ -546,7 +550,7 @@ subroutine test_mpwlypd3bjatm_mb18(error)
type(structure_type) :: mol
type(rational_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 1.0_wp, alp = 14.0_wp, &
& a1 = 0.4831_wp, s8 = 2.0077_wp, a2 = 3.5043_wp)
@@ -564,7 +568,7 @@ subroutine test_tpss0d3bjatm_mb19(error)
type(structure_type) :: mol
type(rational_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 1.0_wp, alp = 14.0_wp, &
& a1 = 0.3768_wp, s8 = 1.2576_wp, a2 = 4.5865_wp)
@@ -582,7 +586,7 @@ subroutine test_bpbed3bjatm_mb20(error)
type(structure_type) :: mol
type(rational_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 1.0_wp, alp = 14.0_wp, &
& a1 = 0.4567_wp, s8 = 4.0728_wp, a2 = 4.3908_wp)
@@ -600,7 +604,7 @@ subroutine test_pwb6kd3bjatm_mb21(error)
type(structure_type) :: mol
type(rational_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 1.0_wp, alp = 14.0_wp, &
& a1 = 0.1865_wp, s8 = 0.9383_wp, a2 = 7.7627_wp)
@@ -618,7 +622,7 @@ subroutine test_lcwpbed3bjatm_mb22(error)
type(structure_type) :: mol
type(rational_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 1.0_wp, alp = 14.0_wp, &
& a1 = 0.3919_wp, s8 = 1.8541_wp, a2 = 5.0897_wp)
@@ -636,7 +640,7 @@ subroutine test_pw1pwd3bjatm_mb23(error)
type(structure_type) :: mol
type(rational_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 1.0_wp, alp = 14.0_wp, &
& a1 = 0.3807_wp, s8 = 2.3363_wp, a2 = 5.8844_wp)
@@ -654,7 +658,7 @@ subroutine test_mpw1b95d3bjatm_mb24(error)
type(structure_type) :: mol
type(rational_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 1.0_wp, alp = 14.0_wp, &
& a1 = 0.1955_wp, s8 = 1.0508_wp, a2 = 6.4177_wp)
@@ -672,7 +676,7 @@ subroutine test_blypd3zeroatm_mb25(error)
type(structure_type) :: mol
type(zero_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 1.0_wp, alp = 14.0_wp, rs8 = 1.0_wp, &
& rs6 = 1.094_wp, s8 = 1.682_wp)
@@ -690,7 +694,7 @@ subroutine test_revpbed3zeroatm_mb26(error)
type(structure_type) :: mol
type(zero_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 1.0_wp, alp = 14.0_wp, rs8 = 1.0_wp, &
& rs6 = 0.923_wp, s8 = 1.010_wp)
@@ -708,7 +712,7 @@ subroutine test_hse06d3zeroatm_mb27(error)
type(structure_type) :: mol
type(zero_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 1.0_wp, alp = 14.0_wp, rs8 = 1.0_wp, &
& rs6 = 1.129_wp, s8 = 0.109_wp)
@@ -726,7 +730,7 @@ subroutine test_bmkd3zeroatm_mb28(error)
type(structure_type) :: mol
type(zero_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 1.0_wp, alp = 14.0_wp, rs8 = 1.0_wp, &
& rs6 = 1.931_wp, s8 = 2.168_wp)
@@ -744,7 +748,7 @@ subroutine test_m06d3zeroatm_mb29(error)
type(structure_type) :: mol
type(zero_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 1.0_wp, alp = 14.0_wp, rs8 = 1.0_wp, &
& rs6 = 1.325_wp, s8 = 0.000_wp)
@@ -762,7 +766,7 @@ subroutine test_b3lypd3zeroatm_mb30(error)
type(structure_type) :: mol
type(zero_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 1.0_wp, alp = 14.0_wp, rs8 = 1.0_wp, &
& rs6 = 1.261_wp, s8 = 1.105_wp)
@@ -780,7 +784,7 @@ subroutine test_bpd3zeroatm_mb31(error)
type(structure_type) :: mol
type(zero_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 1.0_wp, alp = 14.0_wp, rs8 = 1.0_wp, &
& rs6 = 1.139_wp, s8 = 1.683_wp)
@@ -798,7 +802,7 @@ subroutine test_m05d3zeroatm_mb32(error)
type(structure_type) :: mol
type(zero_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 1.0_wp, alp = 14.0_wp, rs8 = 1.0_wp, &
& rs6 = 1.355_wp, s8 = 1.279_wp)
@@ -816,7 +820,7 @@ subroutine test_pbed3zerom_mb33(error)
type(structure_type) :: mol
type(mzero_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 1.0_wp, alp = 14.0_wp, rs8 = 1.0_wp, &
& rs6 = 2.340218_wp, s8 = 0.0_wp, bet = 0.129434_wp)
@@ -834,7 +838,7 @@ subroutine test_blypd3zerom_mb34(error)
type(structure_type) :: mol
type(mzero_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 1.0_wp, alp = 14.0_wp, rs8 = 1.0_wp, &
& rs6 = 1.279637_wp, s8 = 1.841686_wp, bet = 0.014370_wp)
@@ -852,7 +856,7 @@ subroutine test_b97dd3zerom_mb35(error)
type(structure_type) :: mol
type(mzero_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 1.0_wp, alp = 14.0_wp, rs8 = 1.0_wp, &
& rs6 = 1.338153_wp, s8 = 1.532981_wp, bet = 0.013988_wp)
@@ -870,7 +874,7 @@ subroutine test_lcwpbed3zerom_mb36(error)
type(structure_type) :: mol
type(mzero_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 1.0_wp, alp = 14.0_wp, rs8 = 1.0_wp, &
& rs6 = 1.366361_wp, s8 = 1.280619_wp, bet = 0.003160_wp)
@@ -888,7 +892,7 @@ subroutine test_b97hd3op_mb37(error)
type(structure_type) :: mol
type(optimizedpower_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 0.97388_wp, s9 = 1.0_wp, alp = 14.0_wp, bet = 6.0_wp, &
& a1 = 0.150_wp, s8 = 0.0_wp, a2 = 4.25_wp)
@@ -908,7 +912,7 @@ subroutine test_tpsshd3op_mb38(error)
type(structure_type) :: mol
type(optimizedpower_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 1.0_wp, alp = 14.0_wp, bet = 8.0_wp, &
& a1 = 0.575_wp, s8 = 0.43185_wp, a2 = 3.00_wp)
@@ -928,7 +932,7 @@ subroutine test_b3lypd3cso_mb01(error)
type(structure_type) :: mol
type(cso_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 0.0_wp, alp = 14.0_wp, &
& a1 = 0.86_wp, a2 = 2.5_wp, rs6 = 0.0_wp, rs8 = 6.25_wp)
@@ -948,7 +952,7 @@ subroutine test_pbed3cso_mb02(error)
type(structure_type) :: mol
type(cso_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 1.0_wp, alp = 14.0_wp, &
& a1 = 0.24_wp, a2 = 2.5_wp, rs6 = 0.0_wp, rs8 = 6.25_wp)
@@ -967,7 +971,7 @@ subroutine test_pbed3z_mb39(error)
type(structure_type) :: mol
type(z_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 0.0_wp, alp = 14.0_wp, &
& a1 = 200770.0_wp, a2 = 0.0_wp, rs6 = 0.0_wp, rs8 = 6.25_wp)
@@ -987,7 +991,7 @@ subroutine test_pbed3z_sensitive_grad(error)
type(structure_type) :: mol
type(z_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s8 = 1.0_wp, s9 = 0.0_wp, alp = 14.0_wp, &
& a1 = 1.0_wp, a2 = 0.0_wp)
@@ -1005,7 +1009,7 @@ subroutine test_pbed3bj_actinides(error)
type(structure_type) :: mol
type(rational_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 0.0_wp, alp = 14.0_wp, &
& a1 = 0.4289_wp, s8 = 0.7875_wp, a2 = 4.4407_wp)
diff --git a/test/unit/test_gcp.f90 b/test/unit/test_gcp.f90
index caa8e255..e2fba2ff 100644
--- a/test/unit/test_gcp.f90
+++ b/test/unit/test_gcp.f90
@@ -16,7 +16,7 @@
module test_gcp
use dftd3_cutoff, only : realspace_cutoff
- use dftd3_gcp
+ use dftd3_gcp, only : gcp_param, get_gcp_param, get_geometric_counterpoise
use dftd3_output, only : ascii_gcp_param
use mctc_env, only : wp
use mctc_env_testing, only : new_unittest, unittest_type, error_type, check, &
diff --git a/test/unit/test_model.f90 b/test/unit/test_model.f90
index a60c8d0a..2a1d6483 100644
--- a/test/unit/test_model.f90
+++ b/test/unit/test_model.f90
@@ -18,7 +18,7 @@ module test_model
use dftd3, only : rational_damping_param, get_dispersion, realspace_cutoff
use dftd3_cutoff, only : get_lattice_points
use dftd3_data, only : get_vdw_rad, get_r4r2_val
- use dftd3_model
+ use dftd3_model, only : d3_model, new_d3_model
use mctc_data, only : get_covalent_rad
use mctc_env, only : wp
use mctc_env_testing, only : new_unittest, unittest_type, error_type, check, &
@@ -65,7 +65,7 @@ subroutine test_gw_gen(error, mol, ref)
type(error_type), allocatable, intent(out) :: error
!> Molecular structure data
- type(structure_type) :: mol
+ type(structure_type), intent(in) :: mol
!> Reference Gaussian weights
real(wp), intent(in) :: ref(:, :)
@@ -102,7 +102,7 @@ subroutine test_dgw_gen(error, mol)
type(error_type), allocatable, intent(out) :: error
!> Molecular structure data
- type(structure_type) :: mol
+ type(structure_type), intent(in) :: mol
integer :: iat, mref
type(d3_model) :: d3
diff --git a/test/unit/test_output.f90 b/test/unit/test_output.f90
new file mode 100644
index 00000000..ea64ce76
--- /dev/null
+++ b/test/unit/test_output.f90
@@ -0,0 +1,134 @@
+! This file is part of s-dftd3.
+! SPDX-Identifier: LGPL-3.0-or-later
+!
+! s-dftd3 is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! s-dftd3 is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with s-dftd3. If not, see .
+
+module test_output
+ use dftd3_output, only : turbomole_gradient, turbomole_gradlatt
+ use mctc_env, only : wp
+ use mctc_env_testing, only : new_unittest, unittest_type, error_type, check, &
+ & test_failed
+ use mctc_io, only : structure_type, new
+ implicit none
+ private
+
+ public :: collect_output
+
+contains
+
+
+!> Collect all exported unit tests
+subroutine collect_output(testsuite)
+
+ !> Collection of tests
+ type(unittest_type), allocatable, intent(out) :: testsuite(:)
+
+ testsuite = [ &
+ & new_unittest("turbomole-gradient-corrupt", test_gradient_corrupt), &
+ & new_unittest("turbomole-gradlatt-corrupt", test_gradlatt_corrupt) &
+ & ]
+
+end subroutine collect_output
+
+
+!> A corrupted (non-numeric) gradient entry in an existing $grad file must be
+!> detected and reported via stat/=0 instead of being silently ignored.
+subroutine test_gradient_corrupt(error)
+
+ !> Error handling
+ type(error_type), allocatable, intent(out) :: error
+
+ integer, parameter :: nat = 2
+ integer, parameter :: num(nat) = [1, 1]
+ real(wp), parameter :: xyz(3, nat) = reshape([&
+ & 0.0_wp, 0.0_wp, 0.0_wp, &
+ & 0.0_wp, 0.0_wp, 1.4_wp], &
+ & shape(xyz))
+ character(len=*), parameter :: fname = "test_output_gradient_corrupt.tmp"
+ type(structure_type) :: mol
+ real(wp) :: gradient(3, nat)
+ integer :: stat, io
+
+ call new(mol, num, xyz)
+ gradient = 0.0_wp
+
+ open(newunit=io, file=fname, status="replace", action="write")
+ write(io, '("$grad")')
+ write(io, '(2x,"cycle =",1x,i6,4x,"SCF energy =",f18.11,3x,"|dE/dxyz| =",f10.6)') &
+ & 1, 0.0_wp, 0.0_wp
+ write(io, "(3(F20.14,2x),4x,a2)") mol%xyz(1,1), mol%xyz(2,1), mol%xyz(3,1), "H "
+ write(io, "(3(F20.14,2x),4x,a2)") mol%xyz(1,2), mol%xyz(2,2), mol%xyz(3,2), "H "
+ write(io, '(" xxx yyy zzz")')
+ write(io, "(3D22.13)") 0.0_wp, 0.0_wp, 0.0_wp
+ write(io, '("$end")')
+ close(io)
+
+ call turbomole_gradient(mol, fname, 0.0_wp, gradient, stat)
+
+ open(newunit=io, file=fname, status="old")
+ close(io, status="delete")
+
+ call check(error, stat, 1)
+ if (allocated(error)) return
+
+end subroutine test_gradient_corrupt
+
+
+!> A corrupted (non-numeric) gradient entry in an existing $gradlatt file must
+!> be detected and reported via stat/=0 instead of being silently ignored.
+subroutine test_gradlatt_corrupt(error)
+
+ !> Error handling
+ type(error_type), allocatable, intent(out) :: error
+
+ integer, parameter :: nat = 1
+ integer, parameter :: num(nat) = [6]
+ real(wp), parameter :: xyz(3, nat) = reshape([0.0_wp, 0.0_wp, 0.0_wp], shape(xyz))
+ real(wp), parameter :: lattice(3, 3) = reshape([&
+ & 10.0_wp, 0.0_wp, 0.0_wp, &
+ & 0.0_wp, 10.0_wp, 0.0_wp, &
+ & 0.0_wp, 0.0_wp, 10.0_wp], &
+ & shape(lattice))
+ character(len=*), parameter :: fname = "test_output_gradlatt_corrupt.tmp"
+ type(structure_type) :: mol
+ real(wp) :: sigma(3, 3)
+ integer :: stat, io
+
+ call new(mol, num, xyz, periodic=[.true.], lattice=lattice)
+ sigma = 0.0_wp
+
+ open(newunit=io, file=fname, status="replace", action="write")
+ write(io, '("$gradlatt")')
+ write(io, '(2x,"cycle =",1x,i6,4x,"SCF energy =",f18.11,3x,"|dE/dlatt| =",f10.6)') &
+ & 1, 0.0_wp, 0.0_wp
+ write(io, "(3(F20.14,2x))") mol%lattice(1,1), mol%lattice(2,1), mol%lattice(3,1)
+ write(io, "(3(F20.14,2x))") mol%lattice(1,2), mol%lattice(2,2), mol%lattice(3,2)
+ write(io, "(3(F20.14,2x))") mol%lattice(1,3), mol%lattice(2,3), mol%lattice(3,3)
+ write(io, '(" xxx yyy zzz")')
+ write(io, "(3D22.13)") 0.0_wp, 0.0_wp, 0.0_wp
+ write(io, "(3D22.13)") 0.0_wp, 0.0_wp, 0.0_wp
+ write(io, '("$end")')
+ close(io)
+
+ call turbomole_gradlatt(mol, fname, 0.0_wp, sigma, stat)
+
+ open(newunit=io, file=fname, status="old")
+ close(io, status="delete")
+
+ call check(error, stat, 1)
+ if (allocated(error)) return
+
+end subroutine test_gradlatt_corrupt
+
+end module test_output
diff --git a/test/unit/test_pairwise.f90 b/test/unit/test_pairwise.f90
index bce81101..26297091 100644
--- a/test/unit/test_pairwise.f90
+++ b/test/unit/test_pairwise.f90
@@ -15,7 +15,9 @@
! along with s-dftd3. If not, see .
module test_pairwise
- use dftd3
+ use dftd3, only : get_dispersion, get_pairwise_dispersion, realspace_cutoff, &
+ & damping_param, mzero_damping_param, optimizedpower_damping_param, &
+ & rational_damping_param, zero_damping_param, d3_model, new_d3_model
use mctc_env, only : wp
use mctc_env_testing, only : new_unittest, unittest_type, error_type, check, &
& test_failed
@@ -100,7 +102,7 @@ subroutine test_pbed3_bj_mb01(error)
type(error_type), allocatable, intent(out) :: error
type(structure_type) :: mol
- type(rational_damping_param) :: param = rational_damping_param(&
+ type(rational_damping_param), parameter :: param = rational_damping_param(&
& s6 = 1.0_wp, s9 = 0.0_wp, alp = 14.0_wp, &
& a1 = 0.4289_wp, s8 = 0.7875_wp, a2 = 4.4407_wp)
@@ -116,7 +118,7 @@ subroutine test_b97d3_bj_atm_mb02(error)
type(error_type), allocatable, intent(out) :: error
type(structure_type) :: mol
- type(rational_damping_param) :: param = rational_damping_param(&
+ type(rational_damping_param), parameter :: param = rational_damping_param(&
& s6 = 1.0_wp, s9 = 1.0_wp, alp = 14.0_wp, &
& a1 = 0.5545_wp, s8 = 2.2609_wp, a2 = 3.2297_wp)
@@ -132,10 +134,10 @@ subroutine test_pbed3_bj_atm_smooth(error)
type(error_type), allocatable, intent(out) :: error
type(structure_type) :: mol
- type(rational_damping_param) :: param = rational_damping_param(&
+ type(rational_damping_param), parameter :: param = rational_damping_param(&
& s6 = 1.0_wp, s9 = 1.0_wp, alp = 14.0_wp, &
& a1 = 0.4289_wp, s8 = 0.7875_wp, a2 = 4.4407_wp)
- type(realspace_cutoff) :: smooth_cutoff = &
+ type(realspace_cutoff), parameter :: smooth_cutoff = &
& realspace_cutoff(cn=30_wp, disp2=8.0_wp, disp3=8.0_wp, width2=4.0_wp, width3=4.0_wp)
call get_structure(mol, "MB16-43", "01")
@@ -150,7 +152,7 @@ subroutine test_tpssd3_bj_atm_ammonia(error)
type(error_type), allocatable, intent(out) :: error
type(structure_type) :: mol
- type(rational_damping_param) :: param = rational_damping_param(&
+ type(rational_damping_param), parameter :: param = rational_damping_param(&
& s6 = 1.0_wp, s9 = 1.0_wp, alp = 14.0_wp, &
& a1 = 0.4535_wp, s8 = 1.9435_wp, a2 = 4.4752_wp)
@@ -166,7 +168,7 @@ subroutine test_hfd3_zero_mb03(error)
type(error_type), allocatable, intent(out) :: error
type(structure_type) :: mol
- type(zero_damping_param) :: param = zero_damping_param(&
+ type(zero_damping_param), parameter :: param = zero_damping_param(&
& s6 = 1.0_wp, s9 = 0.0_wp, rs8 = 1.0_wp, alp = 14.0_wp, &
& rs6 = 1.158_wp, s8 = 1.746_wp)
@@ -182,7 +184,7 @@ subroutine test_hse06d3_zero_atm_mb04(error)
type(error_type), allocatable, intent(out) :: error
type(structure_type) :: mol
- type(zero_damping_param) :: param = zero_damping_param(&
+ type(zero_damping_param), parameter :: param = zero_damping_param(&
& s6 = 1.0_wp, s9 = 1.0_wp, rs8 = 1.0_wp, alp = 14.0_wp, &
& rs6 = 1.129_wp, s8 = 0.109_wp)
@@ -198,7 +200,7 @@ subroutine test_blypd3_zero_atm_urea(error)
type(error_type), allocatable, intent(out) :: error
type(structure_type) :: mol
- type(zero_damping_param) :: param = zero_damping_param(&
+ type(zero_damping_param), parameter :: param = zero_damping_param(&
& s6 = 1.0_wp, s9 = 1.0_wp, rs8 = 1.0_wp, alp = 14.0_wp, &
& rs6 = 1.094_wp, s8 = 1.682_wp)
@@ -214,7 +216,7 @@ subroutine test_b3lypd3_mzero_mb05(error)
type(error_type), allocatable, intent(out) :: error
type(structure_type) :: mol
- type(mzero_damping_param) :: param = mzero_damping_param(&
+ type(mzero_damping_param), parameter :: param = mzero_damping_param(&
& s6 = 1.0_wp, s9 = 0.0_wp, rs8 = 1.0_wp, alp = 14.0_wp, &
& rs6 = 1.338153_wp, s8 = 1.532981_wp, bet = 0.013988_wp)
@@ -230,7 +232,7 @@ subroutine test_pbe0d3_mzero_atm_mb06(error)
type(error_type), allocatable, intent(out) :: error
type(structure_type) :: mol
- type(mzero_damping_param) :: param = mzero_damping_param(&
+ type(mzero_damping_param), parameter :: param = mzero_damping_param(&
& s6 = 1.0_wp, s9 = 1.0_wp, rs8 = 1.0_wp, alp = 14.0_wp, &
& rs6 = 2.077949_wp, s8 = 0.000081_wp, bet = 0.116755_wp)
@@ -246,7 +248,7 @@ subroutine test_bpd3_mzero_atm_co2(error)
type(error_type), allocatable, intent(out) :: error
type(structure_type) :: mol
- type(mzero_damping_param) :: param = mzero_damping_param(&
+ type(mzero_damping_param), parameter :: param = mzero_damping_param(&
& s6 = 1.0_wp, s9 = 1.0_wp, rs8 = 1.0_wp, alp = 14.0_wp, &
& rs6 = 1.233460_wp, s8 = 1.945174_wp, bet = 0.000000_wp)
@@ -262,7 +264,7 @@ subroutine test_revtpssd3_op_mb07(error)
type(error_type), allocatable, intent(out) :: error
type(structure_type) :: mol
- type(optimizedpower_damping_param) :: param = optimizedpower_damping_param(&
+ type(optimizedpower_damping_param), parameter :: param = optimizedpower_damping_param(&
& s6 = 1.0_wp, s9 = 0.0_wp, alp = 14.0_wp, &
& s8 = 0.27632_wp, a1 = 0.700_wp, a2 = 2.500_wp, bet = 8.0_wp)
@@ -278,7 +280,7 @@ subroutine test_revpbed3_op_atm_mb08(error)
type(error_type), allocatable, intent(out) :: error
type(structure_type) :: mol
- type(optimizedpower_damping_param) :: param = optimizedpower_damping_param(&
+ type(optimizedpower_damping_param), parameter :: param = optimizedpower_damping_param(&
& s6 = 1.0_wp, s9 = 1.0_wp, alp = 14.0_wp, &
& s8 = 1.44765_wp, a1 = 0.600_wp, a2 = 2.50_wp, bet = 0.0_wp)
diff --git a/test/unit/test_param.f90 b/test/unit/test_param.f90
index 96fa7192..4cd57a7c 100644
--- a/test/unit/test_param.f90
+++ b/test/unit/test_param.f90
@@ -15,7 +15,13 @@
! along with s-dftd3. If not, see .
module test_param
- use dftd3
+ use dftd3, only : get_dispersion, realspace_cutoff, damping_param, d3_param, &
+ & get_rational_damping, get_zero_damping, get_mrational_damping, &
+ & get_mzero_damping, get_optimizedpower_damping, get_cso_damping, get_z_damping, &
+ & cso_damping_param, new_cso_damping, mzero_damping_param, new_mzero_damping, &
+ & optimizedpower_damping_param, new_optimizedpower_damping, &
+ & rational_damping_param, new_rational_damping, zero_damping_param, &
+ & new_zero_damping, z_damping_param, new_z_damping, d3_model, new_d3_model
use mctc_env, only : wp
use mctc_env_testing, only : new_unittest, unittest_type, error_type, check, &
& test_failed
diff --git a/test/unit/test_periodic_1d.f90 b/test/unit/test_periodic_1d.f90
index 679ffd42..21cd39fa 100644
--- a/test/unit/test_periodic_1d.f90
+++ b/test/unit/test_periodic_1d.f90
@@ -15,7 +15,8 @@
! along with s-dftd3. If not, see .
module test_periodic_1d
- use dftd3
+ use dftd3, only : get_dispersion, realspace_cutoff, damping_param, d3_param, &
+ & rational_damping_param, new_rational_damping, d3_model, new_d3_model
use mctc_env, only : wp
use mctc_env_testing, only : new_unittest, unittest_type, error_type, check, &
& test_failed
@@ -126,7 +127,7 @@ subroutine test_revpbed3bj_1d(error)
& shape(lattice))
type(structure_type) :: mol
type(rational_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 0.0_wp, alp = 14.0_wp, &
& a1 = 0.5238_wp, s8 = 2.3550_wp, a2 = 3.5016_wp)
diff --git a/test/unit/test_periodic_2d.f90 b/test/unit/test_periodic_2d.f90
index 39726a38..5c55babd 100644
--- a/test/unit/test_periodic_2d.f90
+++ b/test/unit/test_periodic_2d.f90
@@ -15,7 +15,9 @@
! along with s-dftd3. If not, see .
module test_periodic_2d
- use dftd3
+ use dftd3, only : get_dispersion, realspace_cutoff, damping_param, d3_param, &
+ & rational_damping_param, new_rational_damping, zero_damping_param, &
+ & new_zero_damping, d3_model, new_d3_model
use mctc_env, only : wp
use mctc_env_testing, only : new_unittest, unittest_type, error_type, check, &
& test_failed
@@ -103,7 +105,7 @@ subroutine test_bp86d3zero_2d(error)
& shape(lattice))
type(structure_type) :: mol
type(zero_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 0.0_wp, alp = 14.0_wp, &
& rs6 = 1.139_wp, s8 = 1.683_wp)
@@ -192,7 +194,7 @@ subroutine test_gh185(error)
type(structure_type) :: mol
type(rational_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s8 = 0.7875_wp, a1 = 0.4289_wp, a2 = 4.4407_wp, s9 = 0.0_wp)
call new(mol, sym, xyz, periodic=[.true.], lattice=lattice_vac)
diff --git a/test/unit/test_periodic_3d.f90 b/test/unit/test_periodic_3d.f90
index 00714fb5..df2e396b 100644
--- a/test/unit/test_periodic_3d.f90
+++ b/test/unit/test_periodic_3d.f90
@@ -15,7 +15,9 @@
! along with s-dftd3. If not, see .
module test_periodic_3d
- use dftd3
+ use dftd3, only : get_dispersion, realspace_cutoff, damping_param, d3_param, &
+ & rational_damping_param, new_rational_damping, zero_damping_param, &
+ & new_zero_damping, d3_model, new_d3_model
use mctc_env, only : wp
use mctc_env_testing, only : new_unittest, unittest_type, error_type, check, &
& test_failed
@@ -346,7 +348,7 @@ subroutine test_pbed3bj_acetic(error)
type(structure_type) :: mol
type(rational_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 0.0_wp, alp = 14.0_wp, &
& a1 = 0.4289_wp, s8 = 0.7875_wp, a2 = 4.4407_wp)
@@ -364,7 +366,7 @@ subroutine test_pbesold3bj_adaman(error)
type(structure_type) :: mol
type(rational_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 0.0_wp, alp = 14.0_wp, &
& a1 = 0.4466_wp, s8 = 2.9491_wp, a2 = 6.1742_wp)
@@ -382,7 +384,7 @@ subroutine test_tpssd3bj_ammonia(error)
type(structure_type) :: mol
type(rational_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 0.0_wp, alp = 14.0_wp, &
& a1 = 0.4535_wp, s8 = 1.9435_wp, a2 = 4.4752_wp)
@@ -400,7 +402,7 @@ subroutine test_hse06d3bj_anthracene(error)
type(structure_type) :: mol
type(rational_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 0.0_wp, alp = 14.0_wp, &
& a1 = 0.383_wp, s8 = 2.310_wp, a2 = 5.685_wp)
@@ -418,7 +420,7 @@ subroutine test_blypd3zero_benzene(error)
type(structure_type) :: mol
type(zero_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 0.0_wp, alp = 14.0_wp, rs8 = 1.0_wp, &
& rs6 = 1.094_wp, s8 = 1.682_wp)
@@ -436,7 +438,7 @@ subroutine test_m06ld3zero_cyanamide(error)
type(structure_type) :: mol
type(zero_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 0.0_wp, alp = 14.0_wp, rs8 = 1.0_wp, &
& rs6 = 1.581_wp, s8 = 0.000_wp)
@@ -454,7 +456,7 @@ subroutine test_rpw86pbed3zero_co2(error)
type(structure_type) :: mol
type(zero_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 0.0_wp, alp = 14.0_wp, rs8 = 1.0_wp, &
& rs6 = 1.224_wp, s8 = 0.901_wp)
@@ -472,7 +474,7 @@ subroutine test_revssbd3zero_cytosine(error)
type(structure_type) :: mol
type(zero_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 0.0_wp, alp = 14.0_wp, rs8 = 1.0_wp, &
& rs6 = 1.221_wp, s8 = 0.560_wp)
diff --git a/test/unit/test_periodic_atm.f90 b/test/unit/test_periodic_atm.f90
index 2b0088a6..b5aa2ce3 100644
--- a/test/unit/test_periodic_atm.f90
+++ b/test/unit/test_periodic_atm.f90
@@ -15,7 +15,9 @@
! along with s-dftd3. If not, see .
module test_periodic_atm
- use dftd3
+ use dftd3, only : get_dispersion, realspace_cutoff, damping_param, d3_param, &
+ & rational_damping_param, new_rational_damping, zero_damping_param, &
+ & new_zero_damping, d3_model, new_d3_model
use mctc_env, only : wp
use mctc_env_testing, only : new_unittest, unittest_type, error_type, check, &
& test_failed
@@ -342,7 +344,7 @@ subroutine test_hsesold3bjatm_oxacb(error)
type(structure_type) :: mol
type(rational_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 1.0_wp, alp = 14.0_wp, &
& a1 = 0.4650_wp, s8 = 2.9215_wp, a2 = 6.2003_wp)
@@ -360,7 +362,7 @@ subroutine test_pwggad3bjatm_pyrazine(error)
type(structure_type) :: mol
type(rational_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 1.0_wp, alp = 14.0_wp, &
& a1 = 0.2211_wp, s8 = 2.6910_wp, a2 = 6.7278_wp)
@@ -378,7 +380,7 @@ subroutine test_b3pw91d3zeroatm_urea(error)
type(structure_type) :: mol
type(zero_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 1.0_wp, alp = 14.0_wp, rs8 = 1.0_wp, &
& rs6 = 1.176_wp, s8 = 1.775_wp)
@@ -396,7 +398,7 @@ subroutine test_rpbed3zeroatm_hexamine(error)
type(structure_type) :: mol
type(zero_damping_param) :: param
- type(d3_param) :: inp = d3_param(&
+ type(d3_param), parameter :: inp = d3_param(&
& s6 = 1.0_wp, s9 = 1.0_wp, alp = 14.0_wp, rs8 = 1.0_wp, &
& rs6 = 0.872_wp, s8 = 0.514_wp)
diff --git a/test/unit/test_regression.f90 b/test/unit/test_regression.f90
index 68a70a90..7834c784 100644
--- a/test/unit/test_regression.f90
+++ b/test/unit/test_regression.f90
@@ -15,7 +15,8 @@
! along with s-dftd3. If not, see .
module test_regression
- use dftd3
+ use dftd3, only : get_dispersion, realspace_cutoff, rational_damping_param, &
+ & d3_model, new_d3_model
use mctc_env, only : wp
use mctc_env_testing, only : new_unittest, unittest_type, error_type, check, &
& test_failed
@@ -51,7 +52,7 @@ subroutine test_dftbplus_871(error)
type(error_type), allocatable, intent(out) :: error
type(structure_type) :: mol
- type(rational_damping_param) :: param = rational_damping_param( &
+ type(rational_damping_param), parameter :: param = rational_damping_param( &
& s6=1.00_wp, s8=2.34_wp, a1=6.30_wp, a2=5.00_wp, s9=0.00_wp, alp=14.0_wp)
type(d3_model) :: d3
real(wp) :: energy, sigma(3, 3)
@@ -76,7 +77,7 @@ end subroutine test_dftbplus_871
!> Check whether we are dealing with an exceptional value, NaN or Inf
elemental function is_exceptional(val)
- use ieee_arithmetic, only : ieee_is_nan
+ use, intrinsic :: ieee_arithmetic, only : ieee_is_nan
real(wp), intent(in) :: val
logical :: is_exceptional
is_exceptional = ieee_is_nan(val) .or. abs(val) > huge(val)