From d4730fb08323ed920a43b6b9aedbe12c62424f18 Mon Sep 17 00:00:00 2001 From: Sebastian Ehlert Date: Tue, 21 Jul 2026 13:30:43 +0200 Subject: [PATCH] Fix linter issues --- app/argument.f90 | 4 +- app/cli.f90 | 4 +- app/toml.f90 | 2 + doc/tutorial/first-steps-fortran/src/scan.f90 | 2 +- fpm.toml | 10 +- src/dftd3/api.f90 | 3 +- src/dftd3/citation.f90 | 2 + src/dftd3/cutoff.f90 | 1 + src/dftd3/damping.f90 | 1 + src/dftd3/damping/atm.f90 | 1 + src/dftd3/damping/cso.f90 | 1 + src/dftd3/damping/mzero.f90 | 1 + src/dftd3/damping/optimizedpower.f90 | 1 + src/dftd3/damping/rational.f90 | 1 + src/dftd3/damping/z.f90 | 1 + src/dftd3/damping/zero.f90 | 1 + src/dftd3/gcp.f90 | 89 ++++++++---- src/dftd3/gcp/param.f90 | 4 + src/dftd3/model.f90 | 4 +- src/dftd3/output.f90 | 28 +++- src/dftd3/utils.f90 | 1 + test/unit/CMakeLists.txt | 1 + test/unit/main.f90 | 2 + test/unit/meson.build | 1 + test/unit/test_dftd3.f90 | 96 +++++++------ test/unit/test_gcp.f90 | 2 +- test/unit/test_model.f90 | 6 +- test/unit/test_output.f90 | 134 ++++++++++++++++++ test/unit/test_pairwise.f90 | 30 ++-- test/unit/test_param.f90 | 8 +- test/unit/test_periodic_1d.f90 | 5 +- test/unit/test_periodic_2d.f90 | 8 +- test/unit/test_periodic_3d.f90 | 20 +-- test/unit/test_periodic_atm.f90 | 12 +- test/unit/test_regression.f90 | 7 +- 35 files changed, 359 insertions(+), 135 deletions(-) create mode 100644 test/unit/test_output.f90 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)