From 0679707fb3bea2c0ee7015a18db28f4dd8511400 Mon Sep 17 00:00:00 2001 From: Marcel Mueller Date: Wed, 31 Jul 2024 09:16:10 +0200 Subject: [PATCH] Raise error for too heavy elements (#188) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Marcel Müller Co-authored-by: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> --- app/driver_guess.f90 | 3 ++- app/driver_run.f90 | 9 ++++---- src/tblite/api/calculator.f90 | 35 +++++++++++++++++++++++++----- src/tblite/ceh/ceh.f90 | 12 ++++++++-- src/tblite/xtb/gfn1.f90 | 13 +++++++++-- src/tblite/xtb/gfn2.f90 | 13 +++++++++-- src/tblite/xtb/ipea1.f90 | 13 +++++++++-- test/unit/test_ceh.f90 | 18 ++++++++++----- test/unit/test_gfn1_xtb.f90 | 21 ++++++++++++------ test/unit/test_gfn2_xtb.f90 | 18 ++++++++++----- test/unit/test_ipea1_xtb.f90 | 18 ++++++++++----- test/unit/test_post_processing.f90 | 6 +++-- test/unit/test_spin.f90 | 12 ++++++---- test/unit/test_xtb_external.f90 | 18 ++++++++++----- test/unit/test_xtb_param.f90 | 12 +++++----- 15 files changed, 160 insertions(+), 61 deletions(-) diff --git a/app/driver_guess.f90 b/app/driver_guess.f90 index d5884f67..5bf026e3 100644 --- a/app/driver_guess.f90 +++ b/app/driver_guess.f90 @@ -115,7 +115,8 @@ subroutine guess_main(config, error) method = "ceh" if (allocated(config%method)) method = config%method if (method == "ceh") then - call new_ceh_calculator(calc_ceh, mol) + call new_ceh_calculator(calc_ceh, mol, error) + if (allocated(error)) return call new_wavefunction(wfn_ceh, mol%nat, calc_ceh%bas%nsh, calc_ceh%bas%nao, 1, config%etemp_guess * kt) end if diff --git a/app/driver_run.f90 b/app/driver_run.f90 index 4710206d..7ac00a29 100644 --- a/app/driver_run.f90 +++ b/app/driver_run.f90 @@ -142,11 +142,11 @@ subroutine run_main(config, error) case default call fatal_error(error, "Unknown method '"//method//"' requested") case("gfn2") - call new_gfn2_calculator(calc, mol) + call new_gfn2_calculator(calc, mol, error) case("gfn1") - call new_gfn1_calculator(calc, mol) + call new_gfn1_calculator(calc, mol, error) case("ipea1") - call new_ipea1_calculator(calc, mol) + call new_ipea1_calculator(calc, mol, error) end select end if if (allocated(error)) return @@ -156,7 +156,8 @@ subroutine run_main(config, error) call new_wavefunction(wfn, mol%nat, calc%bas%nsh, calc%bas%nao, nspin, config%etemp * kt) if (config%guess == "ceh") then - call new_ceh_calculator(calc_ceh, mol) + call new_ceh_calculator(calc_ceh, mol, error) + if (allocated(error)) return call new_wavefunction(wfn_ceh, mol%nat, calc_ceh%bas%nsh, calc_ceh%bas%nao, 1, config%etemp_guess * kt) if (config%grad) then call ctx%message("WARNING: CEH gradient not yet implemented. Stopping.") diff --git a/src/tblite/api/calculator.f90 b/src/tblite/api/calculator.f90 index 9403df52..6d14a855 100644 --- a/src/tblite/api/calculator.f90 +++ b/src/tblite/api/calculator.f90 @@ -88,6 +88,7 @@ function new_gfn2_calculator_api(vctx, vmol) result(vcalc) & type(vp_structure), pointer :: mol type(c_ptr) :: vcalc type(vp_calculator), pointer :: calc + type(error_type), allocatable :: error if (debug) print '("[Info]", 1x, a)', "new_gfn2_calculator" @@ -99,8 +100,14 @@ function new_gfn2_calculator_api(vctx, vmol) result(vcalc) & call c_f_pointer(vmol, mol) allocate(calc) - call new_gfn2_calculator(calc%ptr, mol%ptr) - vcalc = c_loc(calc) + call new_gfn2_calculator(calc%ptr, mol%ptr, error) + if (allocated(error)) then + deallocate(calc) + call ctx%ptr%set_error(error) + return + else + vcalc = c_loc(calc) + end if end function new_gfn2_calculator_api @@ -113,6 +120,7 @@ function new_ipea1_calculator_api(vctx, vmol) result(vcalc) & type(vp_structure), pointer :: mol type(c_ptr) :: vcalc type(vp_calculator), pointer :: calc + type(error_type), allocatable :: error if (debug) print '("[Info]", 1x, a)', "new_ipea1_calculator" @@ -124,8 +132,14 @@ function new_ipea1_calculator_api(vctx, vmol) result(vcalc) & call c_f_pointer(vmol, mol) allocate(calc) - call new_ipea1_calculator(calc%ptr, mol%ptr) - vcalc = c_loc(calc) + call new_ipea1_calculator(calc%ptr, mol%ptr, error) + if (allocated(error)) then + deallocate(calc) + call ctx%ptr%set_error(error) + return + else + vcalc = c_loc(calc) + end if end function new_ipea1_calculator_api @@ -138,6 +152,7 @@ function new_gfn1_calculator_api(vctx, vmol) result(vcalc) & type(vp_structure), pointer :: mol type(c_ptr) :: vcalc type(vp_calculator), pointer :: calc + type(error_type), allocatable :: error if (debug) print '("[Info]", 1x, a)', "new_gfn1_calculator" @@ -149,8 +164,14 @@ function new_gfn1_calculator_api(vctx, vmol) result(vcalc) & call c_f_pointer(vmol, mol) allocate(calc) - call new_gfn1_calculator(calc%ptr, mol%ptr) - vcalc = c_loc(calc) + call new_gfn1_calculator(calc%ptr, mol%ptr, error) + if (allocated(error)) then + deallocate(calc) + call ctx%ptr%set_error(error) + return + else + vcalc = c_loc(calc) + end if end function new_gfn1_calculator_api @@ -184,6 +205,8 @@ function new_xtb_calculator_api(vctx, vmol, vparam) result(vcalc) & call new_xtb_calculator(calc%ptr, mol%ptr, param%ptr, error) if (allocated(error)) then deallocate(calc) + call ctx%ptr%set_error(error) + return else vcalc = c_loc(calc) end if diff --git a/src/tblite/ceh/ceh.f90 b/src/tblite/ceh/ceh.f90 index 37257e62..4fb571e7 100644 --- a/src/tblite/ceh/ceh.f90 +++ b/src/tblite/ceh/ceh.f90 @@ -18,7 +18,7 @@ !> Contains the specification of the Charge Extended Hückel (CEH) method. module tblite_ceh_ceh - use mctc_env, only : error_type, wp + use mctc_env, only : wp, error_type, fatal_error use mctc_io, only: structure_type use tblite_basis_ortho, only : orthogonalize use tblite_basis_slater, only : slater_to_gauss @@ -438,10 +438,18 @@ module tblite_ceh_ceh contains - subroutine new_ceh_calculator(calc,mol) + subroutine new_ceh_calculator(calc, mol, error) !> Instance of the CEH evaluator type(xtb_calculator), intent(out) :: calc type(structure_type), intent(in) :: mol + !> Error handling + type(error_type), allocatable, intent(out) :: error + + ! Check if all atoms of mol%nat are supported (Z <= 86) + if (any(mol%num > max_elem)) then + call fatal_error(error, "No support for elements with Z >" // format_string(max_elem, '(i0)') // ".") + return + end if call add_ceh_basis(calc, mol) call add_ncoord(calc, mol) diff --git a/src/tblite/xtb/gfn1.f90 b/src/tblite/xtb/gfn1.f90 index a36cc24a..dda9406c 100644 --- a/src/tblite/xtb/gfn1.f90 +++ b/src/tblite/xtb/gfn1.f90 @@ -19,7 +19,7 @@ !> Implementation of the GFN1-xTB Hamiltonian to parametrize an xTB calculator. module tblite_xtb_gfn1 - use mctc_env, only : wp + use mctc_env, only : wp, error_type, fatal_error use mctc_io, only : structure_type use mctc_io_symbols, only : to_symbol use tblite_basis_ortho, only : orthogonalize @@ -37,6 +37,7 @@ module tblite_xtb_gfn1 use tblite_xtb_calculator, only : xtb_calculator use tblite_xtb_h0, only : new_hamiltonian use tblite_xtb_spec, only : tb_h0spec + use tblite_output_format, only : format_string implicit none private @@ -515,11 +516,19 @@ module tblite_xtb_gfn1 contains -subroutine new_gfn1_calculator(calc, mol) +subroutine new_gfn1_calculator(calc, mol, error) !> Instance of the xTB evaluator type(xtb_calculator), intent(out) :: calc !> Molecular structure data type(structure_type), intent(in) :: mol + !> Error handling + type(error_type), allocatable, intent(out) :: error + + ! Check if all atoms of mol%nat are supported (Z <= 86) + if (any(mol%num > max_elem)) then + call fatal_error(error, "No support for elements with Z >" // format_string(max_elem, '(i0)') // ".") + return + end if call add_basis(calc, mol) call add_ncoord(calc, mol) diff --git a/src/tblite/xtb/gfn2.f90 b/src/tblite/xtb/gfn2.f90 index 7bb8c98d..3ae493fa 100644 --- a/src/tblite/xtb/gfn2.f90 +++ b/src/tblite/xtb/gfn2.f90 @@ -19,7 +19,7 @@ !> Implementation of the GFN2-xTB Hamiltonian to parametrize an xTB calculator. module tblite_xtb_gfn2 - use mctc_env, only : wp + use mctc_env, only : wp, error_type, fatal_error use mctc_io, only : structure_type use mctc_io_symbols, only : to_symbol use tblite_basis_type, only : basis_type, new_basis, cgto_type @@ -36,6 +36,7 @@ module tblite_xtb_gfn2 use tblite_xtb_calculator, only : xtb_calculator use tblite_xtb_h0, only : new_hamiltonian use tblite_xtb_spec, only : tb_h0spec + use tblite_output_format, only : format_string implicit none private @@ -566,11 +567,19 @@ module tblite_xtb_gfn2 contains -subroutine new_gfn2_calculator(calc, mol) +subroutine new_gfn2_calculator(calc, mol, error) !> Instance of the xTB evaluator type(xtb_calculator), intent(out) :: calc !> Molecular structure data type(structure_type), intent(in) :: mol + !> Error handling + type(error_type), allocatable, intent(out) :: error + + ! Check if all atoms of mol%nat are supported (Z <= 86) + if (any(mol%num > max_elem)) then + call fatal_error(error, "No support for elements with Z >" // format_string(max_elem, '(i0)') // ".") + return + end if call add_basis(calc, mol) call add_ncoord(calc, mol) diff --git a/src/tblite/xtb/ipea1.f90 b/src/tblite/xtb/ipea1.f90 index 516d1e93..e4852c43 100644 --- a/src/tblite/xtb/ipea1.f90 +++ b/src/tblite/xtb/ipea1.f90 @@ -19,7 +19,7 @@ !> Implementation of the IPEA1-xTB Hamiltonian to parametrize an xTB calculator. module tblite_xtb_ipea1 - use mctc_env, only : wp + use mctc_env, only : wp, error_type, fatal_error use mctc_io, only : structure_type use mctc_io_symbols, only : to_symbol use tblite_basis_ortho, only : orthogonalize @@ -37,6 +37,7 @@ module tblite_xtb_ipea1 use tblite_xtb_calculator, only : xtb_calculator use tblite_xtb_h0, only : new_hamiltonian use tblite_xtb_spec, only : tb_h0spec + use tblite_output_format, only : format_string implicit none private @@ -525,11 +526,19 @@ module tblite_xtb_ipea1 contains -subroutine new_ipea1_calculator(calc, mol) +subroutine new_ipea1_calculator(calc, mol, error) !> Instance of the xTB evaluator type(xtb_calculator), intent(out) :: calc !> Molecular structure data type(structure_type), intent(in) :: mol + !> Error handling + type(error_type), allocatable, intent(out) :: error + + ! Check if all atoms of mol%nat are supported (Z <= 86) + if (any(mol%num > max_elem)) then + call fatal_error(error, "No support for elements with Z >" // format_string(max_elem, '(i0)') // ".") + return + end if call add_basis(calc, mol) call add_ncoord(calc, mol) diff --git a/test/unit/test_ceh.f90 b/test/unit/test_ceh.f90 index 5c230f2b..d2eab8ab 100644 --- a/test/unit/test_ceh.f90 +++ b/test/unit/test_ceh.f90 @@ -338,7 +338,8 @@ subroutine test_q_gen(error, mol, ref) integer :: i allocate(cn(mol%nat)) - call new_ceh_calculator(calc, mol) + call new_ceh_calculator(calc, mol, error) + if (allocated(error)) return call new_wavefunction(wfn, mol%nat, calc%bas%nsh, calc%bas%nao, 1, kt) ctx%verbosity = 0 call ceh_singlepoint(ctx, calc, mol, error, wfn, accuracy) @@ -1038,7 +1039,8 @@ subroutine test_q_ef_chrg_mb01(error) call get_structure(mol, "MB16-43", "01") mol%charge = 2.0_wp - call new_ceh_calculator(calc, mol) + call new_ceh_calculator(calc, mol, error) + if (allocated(error)) return call new_wavefunction(wfn, mol%nat, calc%bas%nsh, calc%bas%nao, 1, kt) cont = electric_field(efield) call calc%push_back(cont) @@ -1071,7 +1073,8 @@ subroutine test_d_mb01(error) call get_structure(mol, "MB16-43", "01") - call new_ceh_calculator(calc, mol) + call new_ceh_calculator(calc, mol, error) + if (allocated(error)) return call new_wavefunction(wfn, mol%nat, calc%bas%nsh, calc%bas%nao, 1, kt) ctx%verbosity = 0 call ceh_singlepoint(ctx, calc, mol, error, wfn, accuracy) @@ -1112,7 +1115,8 @@ subroutine test_d_field_mb04(error) efield = 0.0_wp efield(2) = 0.2_wp - call new_ceh_calculator(calc, mol) + call new_ceh_calculator(calc, mol, error) + if (allocated(error)) return call new_wavefunction(wfn, mol%nat, calc%bas%nsh, calc%bas%nao, 1, kt) cont = electric_field(efield) @@ -1163,7 +1167,8 @@ subroutine test_d_hcn(error) call new(mol1, num, xyz) efield = 0.0_wp efield(1) = -0.1_wp - call new_ceh_calculator(calc1, mol1) + call new_ceh_calculator(calc1, mol1, error) + if (allocated(error)) return call new_wavefunction(wfn1, mol1%nat, calc1%bas%nsh, calc1%bas%nao, 1, kt) cont1 = electric_field(efield) call calc1%push_back(cont1) @@ -1175,7 +1180,8 @@ subroutine test_d_hcn(error) xyz(1, :) = xyz(1, :) - 1.0_wp call new(mol2, num, xyz) - call new_ceh_calculator(calc2, mol2) + call new_ceh_calculator(calc2, mol2, error) + if (allocated(error)) return call new_wavefunction(wfn2, mol2%nat, calc2%bas%nsh, calc2%bas%nao, 1, kt) cont2 = electric_field(efield) call calc2%push_back(cont2) diff --git a/test/unit/test_gfn1_xtb.f90 b/test/unit/test_gfn1_xtb.f90 index 196c76e4..5f35ce72 100644 --- a/test/unit/test_gfn1_xtb.f90 +++ b/test/unit/test_gfn1_xtb.f90 @@ -183,7 +183,8 @@ subroutine test_e_pse(error) do izp = 1, 86 if (izp == 25) cycle call new(mol, [izp], xyz, uhf=uhf(izp)) - call new_gfn1_calculator(calc, mol) + call new_gfn1_calculator(calc, mol, error) + if (allocated(error)) return call new_wavefunction(wfn, mol%nat, calc%bas%nsh, calc%bas%nao, 1, kt) energy = 0.0_wp @@ -254,7 +255,8 @@ subroutine test_e_pse_cation(error) do izp = 1, 86 if (izp == 79) cycle ! SCF does not converge for gold call new(mol, [izp], xyz, uhf=uhf(izp), charge=1.0_wp) - call new_gfn1_calculator(calc, mol) + call new_gfn1_calculator(calc, mol, error) + if (allocated(error)) return call new_wavefunction(wfn, mol%nat, calc%bas%nsh, calc%bas%nao, 1, kt) energy = 0.0_wp @@ -326,7 +328,8 @@ subroutine test_e_pse_anion(error) if (izp == 2) cycle ! Helium doesn't have enough orbitals for negative charge if (any(izp == [21, 22, 23, 25, 43, 57, 58, 59])) cycle ! not converging call new(mol, [izp], xyz, uhf=uhf(izp), charge=-1.0_wp) - call new_gfn1_calculator(calc, mol) + call new_gfn1_calculator(calc, mol, error) + if (allocated(error)) return call new_wavefunction(wfn, mol%nat, calc%bas%nsh, calc%bas%nao, 1, kt) energy = 0.0_wp @@ -358,7 +361,8 @@ subroutine test_e_mb01(error) energy = 0.0_wp - call new_gfn1_calculator(calc, mol) + call new_gfn1_calculator(calc, mol, error) + if (allocated(error)) return call new_wavefunction(wfn, mol%nat, calc%bas%nsh, calc%bas%nao, 1, kt) call xtb_singlepoint(ctx, mol, calc, wfn, acc, energy, verbosity=0) @@ -405,7 +409,8 @@ subroutine test_g_mb02(error) gradient(:, :) = 0.0_wp sigma(:, :) = 0.0_wp - call new_gfn1_calculator(calc, mol) + call new_gfn1_calculator(calc, mol, error) + if (allocated(error)) return call new_wavefunction(wfn, mol%nat, calc%bas%nsh, calc%bas%nao, 1, kt) call xtb_singlepoint(ctx, mol, calc, wfn, acc, energy, gradient, sigma, 0) @@ -440,7 +445,8 @@ subroutine test_s_mb03(error) gradient(:, :) = 0.0_wp sigma(:, :) = 0.0_wp - call new_gfn1_calculator(calc, mol) + call new_gfn1_calculator(calc, mol, error) + if (allocated(error)) return call new_wavefunction(wfn, mol%nat, calc%bas%nsh, calc%bas%nao, 1, kt) call xtb_singlepoint(ctx, mol, calc, wfn, acc, energy, gradient, sigma, 0) @@ -475,7 +481,8 @@ subroutine test_error_mb01(error) energy = 0.0_wp - call new_gfn1_calculator(calc, mol) + call new_gfn1_calculator(calc, mol, error) + if (allocated(error)) return call new_wavefunction(wfn, mol%nat, calc%bas%nsh, calc%bas%nao, 1, kt) call xtb_singlepoint(ctx, mol, calc, wfn, acc, energy, verbosity=0) diff --git a/test/unit/test_gfn2_xtb.f90 b/test/unit/test_gfn2_xtb.f90 index 6b7467aa..dff1b262 100644 --- a/test/unit/test_gfn2_xtb.f90 +++ b/test/unit/test_gfn2_xtb.f90 @@ -110,7 +110,8 @@ subroutine test_e_pse(error) do izp = 1, 86 call new(mol, [izp], xyz, uhf=uhf(izp)) - call new_gfn2_calculator(calc, mol) + call new_gfn2_calculator(calc, mol, error) + if (allocated(error)) return call new_wavefunction(wfn, mol%nat, calc%bas%nsh, calc%bas%nao, 1, kt) energy = 0.0_wp @@ -181,7 +182,8 @@ subroutine test_e_pse_cation(error) do izp = 1, 86 if (any(izp == [4, 5, 6])) cycle ! not converging call new(mol, [izp], xyz, uhf=uhf(izp), charge=1.0_wp) - call new_gfn2_calculator(calc, mol) + call new_gfn2_calculator(calc, mol, error) + if (allocated(error)) return call new_wavefunction(wfn, mol%nat, calc%bas%nsh, calc%bas%nao, 1, kt) energy = 0.0_wp @@ -252,7 +254,8 @@ subroutine test_e_pse_anion(error) do izp = 1, 86 if (izp == 24) cycle ! not converging call new(mol, [izp], xyz, uhf=uhf(izp), charge=-1.0_wp) - call new_gfn2_calculator(calc, mol) + call new_gfn2_calculator(calc, mol, error) + if (allocated(error)) return call new_wavefunction(wfn, mol%nat, calc%bas%nsh, calc%bas%nao, 1, kt) energy = 0.0_wp @@ -284,7 +287,8 @@ subroutine test_e_mb01(error) energy = 0.0_wp - call new_gfn2_calculator(calc, mol) + call new_gfn2_calculator(calc, mol, error) + if (allocated(error)) return call new_wavefunction(wfn, mol%nat, calc%bas%nsh, calc%bas%nao, 1, kt) call xtb_singlepoint(ctx, mol, calc, wfn, acc, energy, verbosity=0) @@ -330,7 +334,8 @@ subroutine test_g_mb02(error) gradient(:, :) = 0.0_wp sigma(:, :) = 0.0_wp - call new_gfn2_calculator(calc, mol) + call new_gfn2_calculator(calc, mol, error) + if (allocated(error)) return call new_wavefunction(wfn, mol%nat, calc%bas%nsh, calc%bas%nao, 1, kt) call xtb_singlepoint(ctx, mol, calc, wfn, acc, energy, gradient, sigma, 0) @@ -367,7 +372,8 @@ subroutine test_convergence(error) energy = 0.0_wp - call new_gfn2_calculator(calc, mol) + call new_gfn2_calculator(calc, mol, error) + if (allocated(error)) return call new_wavefunction(wfn, mol%nat, calc%bas%nsh, calc%bas%nao, 1, kt) call eeq_guess(mol, calc, wfn) call xtb_singlepoint(ctx, mol, calc, wfn, acc, energy, verbosity=0) diff --git a/test/unit/test_ipea1_xtb.f90 b/test/unit/test_ipea1_xtb.f90 index cf8b56d5..25829434 100644 --- a/test/unit/test_ipea1_xtb.f90 +++ b/test/unit/test_ipea1_xtb.f90 @@ -181,7 +181,8 @@ subroutine test_e_pse(error) do izp = 1, 86 if (any(izp == [21, 22, 24, 26, 40, 73])) cycle ! SCF does not converge call new(mol, [izp], xyz, uhf=uhf(izp)) - call new_ipea1_calculator(calc, mol) + call new_ipea1_calculator(calc, mol, error) + if (allocated(error)) return call new_wavefunction(wfn, mol%nat, calc%bas%nsh, calc%bas%nao, 1, kt) energy = 0.0_wp @@ -252,7 +253,8 @@ subroutine test_e_pse_cation(error) do izp = 1, 86 if (any(izp == [22, 25, 79])) cycle ! SCF does not converge call new(mol, [izp], xyz, uhf=uhf(izp), charge=1.0_wp) - call new_ipea1_calculator(calc, mol) + call new_ipea1_calculator(calc, mol, error) + if (allocated(error)) return call new_wavefunction(wfn, mol%nat, calc%bas%nsh, calc%bas%nao, 1, kt) energy = 0.0_wp @@ -324,7 +326,8 @@ subroutine test_e_pse_anion(error) if (izp == 2) cycle ! Helium doesn't have enough orbitals for negative charge if (any(izp == [21, 22, 25, 40, 43, 57, 58, 59, 77, 82])) cycle ! not converging call new(mol, [izp], xyz, uhf=uhf(izp), charge=-1.0_wp) - call new_ipea1_calculator(calc, mol) + call new_ipea1_calculator(calc, mol, error) + if (allocated(error)) return call new_wavefunction(wfn, mol%nat, calc%bas%nsh, calc%bas%nao, 1, kt) energy = 0.0_wp @@ -356,7 +359,8 @@ subroutine test_e_mb01(error) energy = 0.0_wp - call new_ipea1_calculator(calc, mol) + call new_ipea1_calculator(calc, mol, error) + if (allocated(error)) return call new_wavefunction(wfn, mol%nat, calc%bas%nsh, calc%bas%nao, 1, kt) call xtb_singlepoint(ctx, mol, calc, wfn, acc, energy, verbosity=0) @@ -402,7 +406,8 @@ subroutine test_g_mb02(error) gradient(:, :) = 0.0_wp sigma(:, :) = 0.0_wp - call new_ipea1_calculator(calc, mol) + call new_ipea1_calculator(calc, mol, error) + if (allocated(error)) return call new_wavefunction(wfn, mol%nat, calc%bas%nsh, calc%bas%nao, 1, kt) call xtb_singlepoint(ctx, mol, calc, wfn, acc, energy, gradient, sigma, 0) @@ -437,7 +442,8 @@ subroutine test_s_mb03(error) gradient(:, :) = 0.0_wp sigma(:, :) = 0.0_wp - call new_ipea1_calculator(calc, mol) + call new_ipea1_calculator(calc, mol, error) + if (allocated(error)) return call new_wavefunction(wfn, mol%nat, calc%bas%nsh, calc%bas%nao, 1, kt) call xtb_singlepoint(ctx, mol, calc, wfn, acc, energy, gradient, sigma, 0) diff --git a/test/unit/test_post_processing.f90 b/test/unit/test_post_processing.f90 index 6d833094..a7bc3fbc 100644 --- a/test/unit/test_post_processing.f90 +++ b/test/unit/test_post_processing.f90 @@ -60,7 +60,8 @@ subroutine test_h2_wbo(error) & shape(xyz)) call new(mol, atoms, xyz, charge=+1.0_wp, uhf=1) - call new_gfn2_calculator(calc, mol) + call new_gfn2_calculator(calc, mol, error) + if (allocated(error)) return call new_wavefunction(wfn, mol%nat, calc%bas%nsh, calc%bas%nao, 1, kt) wbo_label = "bond-orders" call add_post_processing(pproc, wbo_label, error) @@ -156,7 +157,8 @@ subroutine test_timer_print(error) & shape(xyz)) call new(mol, atoms, xyz, charge=+1.0_wp, uhf=1) - call new_gfn2_calculator(calc, mol) + call new_gfn2_calculator(calc, mol, error) + if (allocated(error)) return call new_wavefunction(wfn, mol%nat, calc%bas%nsh, calc%bas%nao, 1, kt) wbo_label = "bond-orders" call add_post_processing(pproc, wbo_label, error) diff --git a/test/unit/test_spin.f90 b/test/unit/test_spin.f90 index c44fd71a..6200b35b 100644 --- a/test/unit/test_spin.f90 +++ b/test/unit/test_spin.f90 @@ -83,7 +83,8 @@ subroutine test_e_p10(error) call rse43_p10(mol) energy = 0.0_wp - call new_gfn2_calculator(calc, mol) + call new_gfn2_calculator(calc, mol, error) + if (allocated(error)) return call new_wavefunction(wfn, mol%nat, calc%bas%nsh, calc%bas%nao, 2, kt) block @@ -127,7 +128,8 @@ subroutine test_e_crcp2(error) allocate(gradient(3, mol%nat), sigma(3, 3)) energy = 0.0_wp - call new_gfn1_calculator(calc, mol) + call new_gfn1_calculator(calc, mol, error) + if (allocated(error)) return call new_wavefunction(wfn, mol%nat, calc%bas%nsh, calc%bas%nao, 2, kt) block @@ -192,7 +194,8 @@ subroutine test_g_p10(error) gradient(:, :) = 0.0_wp sigma(:, :) = 0.0_wp - call new_gfn1_calculator(calc, mol) + call new_gfn1_calculator(calc, mol, error) + if (allocated(error)) return call new_wavefunction(wfn, mol%nat, calc%bas%nsh, calc%bas%nao, 2, kt) block @@ -256,7 +259,8 @@ subroutine test_g_crcp2(error) gradient(:, :) = 0.0_wp sigma(:, :) = 0.0_wp - call new_gfn2_calculator(calc, mol) + call new_gfn2_calculator(calc, mol, error) + if (allocated(error)) return call new_wavefunction(wfn, mol%nat, calc%bas%nsh, calc%bas%nao, 2, kt) block diff --git a/test/unit/test_xtb_external.f90 b/test/unit/test_xtb_external.f90 index 6484ab0e..f170dffe 100644 --- a/test/unit/test_xtb_external.f90 +++ b/test/unit/test_xtb_external.f90 @@ -83,7 +83,8 @@ subroutine test_e_mb01(error) call get_structure(mol, "MB16-43", "01") energy = 0.0_wp - call new_gfn1_calculator(calc, mol) + call new_gfn1_calculator(calc, mol, error) + if (allocated(error)) return call new_wavefunction(wfn, mol%nat, calc%bas%nsh, calc%bas%nao, 1, kt) cont = electric_field([-2.0_wp, 0.0_wp, 0.0_wp]*vatoau) @@ -120,7 +121,8 @@ subroutine test_e_mb02(error) allocate(gradient(3, mol%nat), sigma(3, 3)) energy = 0.0_wp - call new_gfn2_calculator(calc, mol) + call new_gfn2_calculator(calc, mol, error) + if (allocated(error)) return call new_wavefunction(wfn, mol%nat, calc%bas%nsh, calc%bas%nao, 1, kt) cont = electric_field([0.0_wp, sqrt(2.0_wp), -sqrt(2.0_wp)]*vatoau) @@ -157,7 +159,8 @@ subroutine test_d_mb03(error) energy = 0.0_wp efield(:) = 0.0_wp - call new_gfn1_calculator(calc, mol) + call new_gfn1_calculator(calc, mol, error) + if (allocated(error)) return call new_wavefunction(wfn0, mol%nat, calc%bas%nsh, calc%bas%nao, 1, kt) cont = electric_field(efield) @@ -215,7 +218,8 @@ subroutine test_d_mb04(error) energy = 0.0_wp efield(:) = 0.0_wp - call new_gfn2_calculator(calc, mol) + call new_gfn2_calculator(calc, mol, error) + if (allocated(error)) return call new_wavefunction(wfn0, mol%nat, calc%bas%nsh, calc%bas%nao, 1, kt) cont = electric_field(efield) @@ -292,7 +296,8 @@ subroutine test_g_mb05(error) gradient(:, :) = 0.0_wp sigma(:, :) = 0.0_wp - call new_gfn2_calculator(calc, mol) + call new_gfn2_calculator(calc, mol, error) + if (allocated(error)) return call new_wavefunction(wfn, mol%nat, calc%bas%nsh, calc%bas%nao, 1, kt) cont = empty_interaction() @@ -344,7 +349,8 @@ subroutine test_g_mb06(error) gradient(:, :) = 0.0_wp sigma(:, :) = 0.0_wp - call new_gfn2_calculator(calc, mol) + call new_gfn2_calculator(calc, mol, error) + if (allocated(error)) return call new_wavefunction(wfn, mol%nat, calc%bas%nsh, calc%bas%nao, 1, kt) cont = empty_interaction() diff --git a/test/unit/test_xtb_param.f90 b/test/unit/test_xtb_param.f90 index 49648b26..94e0ce5f 100644 --- a/test/unit/test_xtb_param.f90 +++ b/test/unit/test_xtb_param.f90 @@ -391,17 +391,18 @@ subroutine export_gen_param(method, param) end subroutine export_gen_param -subroutine new_gen_calculator(calc, method, mol) +subroutine new_gen_calculator(calc, method, mol, error) type(xtb_calculator), intent(out) :: calc character(len=*), intent(in) :: method type(structure_type), intent(in) :: mol + type(error_type), allocatable, intent(out) :: error select case(method) case("gfn1") - call new_gfn1_calculator(calc, mol) + call new_gfn1_calculator(calc, mol, error) case("gfn2") - call new_gfn2_calculator(calc, mol) + call new_gfn2_calculator(calc, mol, error) case("ipea1") - call new_ipea1_calculator(calc, mol) + call new_ipea1_calculator(calc, mol, error) end select end subroutine new_gen_calculator @@ -427,7 +428,8 @@ subroutine test_gen(mol, method, error) call new_wavefunction(wfn, mol%nat, calc%bas%nsh, calc%bas%nao, 1, kt) call xtb_singlepoint(ctx, mol, calc, wfn, acc, energy1, verbosity=0) - call new_gen_calculator(calc, method, mol) + call new_gen_calculator(calc, method, mol, error) + if (allocated(error)) return call new_wavefunction(wfn, mol%nat, calc%bas%nsh, calc%bas%nao, 1, kt) call xtb_singlepoint(ctx, mol, calc, wfn, acc, energy2, verbosity=0)