diff --git a/src/almo_scf.F b/src/almo_scf.F index 35ecf05773..b005bb02e6 100644 --- a/src/almo_scf.F +++ b/src/almo_scf.F @@ -460,22 +460,22 @@ CONTAINS IF (almo_scf_env%opt_block_diag_pcg%eps_error_early > 0.0_dp) THEN almo_scf_env%opt_block_diag_pcg%eps_error = almo_scf_env%opt_block_diag_pcg%eps_error_early almo_scf_env%opt_block_diag_pcg%early_stopping_on = .TRUE. - IF (unit_nr > 0) WRITE (*, *) "ALMO_OPTIMIZER_PCG: EPS_ERROR_EARLY is on" + IF (unit_nr > 0) WRITE (unit_nr, "(/,T2,A)") "ALMO_OPTIMIZER_PCG: EPS_ERROR_EARLY is on" END IF IF (almo_scf_env%opt_block_diag_diis%eps_error_early > 0.0_dp) THEN almo_scf_env%opt_block_diag_diis%eps_error = almo_scf_env%opt_block_diag_diis%eps_error_early almo_scf_env%opt_block_diag_diis%early_stopping_on = .TRUE. - IF (unit_nr > 0) WRITE (*, *) "ALMO_OPTIMIZER_DIIS: EPS_ERROR_EARLY is on" + IF (unit_nr > 0) WRITE (unit_nr, "(/,T2,A)") "ALMO_OPTIMIZER_DIIS: EPS_ERROR_EARLY is on" END IF IF (almo_scf_env%opt_block_diag_pcg%max_iter_early > 0) THEN almo_scf_env%opt_block_diag_pcg%max_iter = almo_scf_env%opt_block_diag_pcg%max_iter_early almo_scf_env%opt_block_diag_pcg%early_stopping_on = .TRUE. - IF (unit_nr > 0) WRITE (*, *) "ALMO_OPTIMIZER_PCG: MAX_ITER_EARLY is on" + IF (unit_nr > 0) WRITE (unit_nr, "(/,T2,A)") "ALMO_OPTIMIZER_PCG: MAX_ITER_EARLY is on" END IF IF (almo_scf_env%opt_block_diag_diis%max_iter_early > 0) THEN almo_scf_env%opt_block_diag_diis%max_iter = almo_scf_env%opt_block_diag_diis%max_iter_early almo_scf_env%opt_block_diag_diis%early_stopping_on = .TRUE. - IF (unit_nr > 0) WRITE (*, *) "ALMO_OPTIMIZER_DIIS: MAX_ITER_EARLY is on" + IF (unit_nr > 0) WRITE (unit_nr, "(/,T2,A)") "ALMO_OPTIMIZER_DIIS: MAX_ITER_EARLY is on" END IF ELSE almo_scf_env%opt_block_diag_diis%early_stopping_on = .FALSE. @@ -485,12 +485,12 @@ CONTAINS IF (almo_scf_env%opt_xalmo_pcg%eps_error_early > 0.0_dp) THEN almo_scf_env%opt_xalmo_pcg%eps_error = almo_scf_env%opt_xalmo_pcg%eps_error_early almo_scf_env%opt_xalmo_pcg%early_stopping_on = .TRUE. - IF (unit_nr > 0) WRITE (*, *) "XALMO_OPTIMIZER_PCG: EPS_ERROR_EARLY is on" + IF (unit_nr > 0) WRITE (unit_nr, "(/,T2,A)") "XALMO_OPTIMIZER_PCG: EPS_ERROR_EARLY is on" END IF IF (almo_scf_env%opt_xalmo_pcg%max_iter_early > 0.0_dp) THEN almo_scf_env%opt_xalmo_pcg%max_iter = almo_scf_env%opt_xalmo_pcg%max_iter_early almo_scf_env%opt_xalmo_pcg%early_stopping_on = .TRUE. - IF (unit_nr > 0) WRITE (*, *) "XALMO_OPTIMIZER_PCG: MAX_ITER_EARLY is on" + IF (unit_nr > 0) WRITE (unit_nr, "(/,T2,A)") "XALMO_OPTIMIZER_PCG: MAX_ITER_EARLY is on" END IF ELSE almo_scf_env%opt_xalmo_pcg%early_stopping_on = .FALSE. diff --git a/src/almo_scf_optimizer.F b/src/almo_scf_optimizer.F index ba189d10f8..b516dcac0c 100644 --- a/src/almo_scf_optimizer.F +++ b/src/almo_scf_optimizer.F @@ -4209,7 +4209,7 @@ CONTAINS ABS(gfun0), & " is smaller than the threshold", num_threshold END IF - CPABORT("") + CPABORT("Unable to continue with low numerical accuracy") END IF IF (ABS(gfun0) < num_threshold) THEN IF (unit_nr > 0) THEN @@ -4217,7 +4217,7 @@ CONTAINS ABS(gfun0), & " is smaller than the threshold", num_threshold END IF - CPABORT("") + CPABORT("Unable to continue with low numerical accuracy") END IF use_quadratic_approximation = .TRUE. diff --git a/src/almo_scf_qs.F b/src/almo_scf_qs.F index 8eec646979..99b41e1c95 100644 --- a/src/almo_scf_qs.F +++ b/src/almo_scf_qs.F @@ -451,7 +451,7 @@ CONTAINS CALL dbcsr_release(matrix_qs_nosym) CASE DEFAULT - CPABORT("") + CPABORT("Unknown mat_distr_aos for matrix_qs_to_almo") END SELECT CALL timestop(handle) @@ -489,7 +489,7 @@ CONTAINS CALL dbcsr_copy(matrix_qs, matrix_almo_redist, keep_sparsity=.TRUE.) CALL dbcsr_release(matrix_almo_redist) CASE DEFAULT - CPABORT("") + CPABORT("Unknown mat_distr_aos for matrix_almo_to_qs") END SELECT CALL timestop(handle) @@ -1339,7 +1339,7 @@ CONTAINS new_block(:, :) = 1.0_dp ELSE ! remove the intermediate values from the quencher temporarily - CPABORT("") + CPABORT("distance > r0 not yet validated") ! Unexplained in https://github.com/cp2k/cp2k/pull/5345 new_block(:, :) = 1.0_dp/(1.0_dp + EXP((r1 - r0)/(r0 - distance) + (r1 - r0)/(r1 - distance))) END IF diff --git a/src/aobasis/ai_contraction.F b/src/aobasis/ai_contraction.F index cd895d117b..57bacd8e99 100644 --- a/src/aobasis/ai_contraction.F +++ b/src/aobasis/ai_contraction.F @@ -449,7 +449,7 @@ CONTAINS sab(1:na, 1:nb) = sab(1:na, 1:nb) + qab(ia:ja, ib:jb) END IF ELSE - CPABORT("") + CPABORT("Direction should be in or out when copying a block of matrix") END IF END SUBROUTINE block_add_ab diff --git a/src/aobasis/ai_onecenter.F b/src/aobasis/ai_onecenter.F index eeea70059e..4fc02fb6e0 100644 --- a/src/aobasis/ai_onecenter.F +++ b/src/aobasis/ai_onecenter.F @@ -257,7 +257,7 @@ CONTAINS DO iq = 1, m SELECT CASE (l) CASE DEFAULT - CPABORT("") + CPABORT("Only 0, 1, 2, 3, 4, 5, 6 are supported as the value of l in sg_erf") CASE (0) ! nothing left to do CASE (1) diff --git a/src/aobasis/ai_os_rr.F b/src/aobasis/ai_os_rr.F index 6c6ebec311..f5682c7b4c 100644 --- a/src/aobasis/ai_os_rr.F +++ b/src/aobasis/ai_os_rr.F @@ -181,7 +181,7 @@ CONTAINS END DO END IF ELSE - CPABORT("") + CPABORT("None of ax, ay, az is positive") END IF END DO END DO @@ -254,7 +254,7 @@ CONTAINS END DO END IF ELSE - CPABORT("") + CPABORT("None of bx, by, bz is positive") END IF END DO END DO diff --git a/src/aobasis/basis_set_container_types.F b/src/aobasis/basis_set_container_types.F index 9b566692fa..98c7105e1e 100644 --- a/src/aobasis/basis_set_container_types.F +++ b/src/aobasis/basis_set_container_types.F @@ -208,7 +208,9 @@ CONTAINS END IF END DO ELSE - CPABORT("") + CALL cp_abort(__LOCATION__, & + "Neither inum nor basis_type exists "// & + "for remove_basis_from_container") END IF ! IF (ibas /= 0) THEN @@ -264,7 +266,9 @@ CONTAINS END IF END DO ELSE - CPABORT("") + CALL cp_abort(__LOCATION__, & + "Neither inumbas nor basis_type exists "// & + "for get_basis_from_container") END IF END SUBROUTINE get_basis_from_container diff --git a/src/atom.F b/src/atom.F index 5c203ee978..884f3194f6 100644 --- a/src/atom.F +++ b/src/atom.F @@ -74,7 +74,7 @@ CONTAINS CASE (atom_pseudo_run) CALL atom_pseudo_opt(atom_section) CASE default - CPABORT("") + CPABORT("Unknown RUN_TYPE of ATOM") END SELECT iw = cp_print_key_unit_nr(logger, atom_section, "PRINT%PROGRAM_BANNER", extension=".log") diff --git a/src/atom_electronic_structure.F b/src/atom_electronic_structure.F index 15a66655a9..c180ff67a2 100644 --- a/src/atom_electronic_structure.F +++ b/src/atom_electronic_structure.F @@ -158,23 +158,23 @@ CONTAINS SELECT CASE (method) CASE DEFAULT - CPABORT("") + CPABORT("Unknown method for calculate_atom_restricted") CASE (do_rks_atom) need_x = do_hfx need_xc = .TRUE. CASE (do_uks_atom) - CPABORT("") + CPABORT("UKS is incompatible with calculate_atom_restricted") CASE (do_rhf_atom) need_x = .TRUE. need_xc = .FALSE. hf_frac = 1._dp CASE (do_uhf_atom) - CPABORT("") + CPABORT("UHF is incompatible with calculate_atom_restricted") CASE (do_rohf_atom) need_x = .TRUE. need_xc = .FALSE. hf_frac = 1._dp - CPABORT("") + CPABORT("ROHF is incompatible with calculate_atom_restricted") END SELECT ! ZMP starting to read external density for the zmp calculation @@ -209,11 +209,11 @@ CONTAINS ! Pseudopotentials SELECT CASE (atom%potential%ppot_type) CASE DEFAULT - CPABORT("") + CPABORT("Unknown pseudopotential type for calculate_atom_restricted") CASE (NO_PSEUDO) SELECT CASE (reltyp) CASE DEFAULT - CPABORT("") + CPABORT("Unknown relativistic type for calculate_atom_restricted") CASE (do_nonrel_atom) hcore%op = atom%integrals%kin - atom%zcore*atom%integrals%core CASE (do_zoramp_atom, do_sczoramp_atom) @@ -280,7 +280,7 @@ CONTAINS ! Pseudopotential energy SELECT CASE (atom%potential%ppot_type) CASE DEFAULT - CPABORT("") + CPABORT("Unknown pseudopotential type for calculate_atom_restricted") CASE (no_pseudo) atom%energy%eploc = 0._dp atom%energy%epnl = 0._dp @@ -304,7 +304,7 @@ CONTAINS jmat%op = 0._dp SELECT CASE (atom%coulomb_integral_type) CASE DEFAULT - CPABORT("") + CPABORT("Unknown Coulomb integral type for calculate_atom_restricted") CASE (do_analytic) CALL ceri_contract(jmat%op, atom%integrals%ceri, atom%orbitals%pmat, atom%integrals%n) CASE (do_semi_analytic) @@ -323,7 +323,7 @@ CONTAINS kmat%op = 0._dp SELECT CASE (atom%exchange_integral_type) CASE DEFAULT - CPABORT("") + CPABORT("Unknown exchange integral type for calculate_atom_restricted") CASE (do_analytic) CALL eeri_contract(kmat%op, atom%integrals%eeri, atom%orbitals%pmat, atom%integrals%n) CASE (do_semi_analytic) @@ -476,14 +476,14 @@ CONTAINS SELECT CASE (method) CASE DEFAULT - CPABORT("") + CPABORT("Unknown method for calculate_atom_unrestricted") CASE (do_rks_atom) - CPABORT("") + CPABORT("RKS is incompatible with calculate_atom_unrestricted") CASE (do_uks_atom) need_x = do_hfx need_xc = .TRUE. CASE (do_rhf_atom) - CPABORT("") + CPABORT("RHF is incompatible with calculate_atom_unrestricted") CASE (do_uhf_atom) need_x = .TRUE. need_xc = .FALSE. @@ -492,7 +492,7 @@ CONTAINS need_x = .TRUE. need_xc = .FALSE. hf_frac = 1._dp - CPABORT("") + CPABORT("ROHF is incompatible with calculate_atom_unrestricted") END SELECT ! set alpha and beta occupations @@ -529,11 +529,11 @@ CONTAINS lsdpot = .FALSE. SELECT CASE (atom%potential%ppot_type) CASE DEFAULT - CPABORT("") + CPABORT("Unknown pseudopotential type for calculate_atom_unrestricted") CASE (no_pseudo) SELECT CASE (reltyp) CASE DEFAULT - CPABORT("") + CPABORT("Unknown relativistic type for calculate_atom_unrestricted") CASE (do_nonrel_atom) hcore%op = atom%integrals%kin - atom%zcore*atom%integrals%core CASE (do_zoramp_atom, do_sczoramp_atom) @@ -622,7 +622,7 @@ CONTAINS ! Pseudopotential energy SELECT CASE (atom%potential%ppot_type) CASE DEFAULT - CPABORT("") + CPABORT("Unknown pseudopotential type for calculate_atom_unrestricted") CASE (no_pseudo) atom%energy%eploc = 0._dp atom%energy%epnl = 0._dp @@ -646,7 +646,7 @@ CONTAINS jmat%op = 0._dp SELECT CASE (atom%coulomb_integral_type) CASE DEFAULT - CPABORT("") + CPABORT("Unknown Coulomb integral type for calculate_atom_unrestricted") CASE (do_analytic) CALL ceri_contract(jmat%op, atom%integrals%ceri, atom%orbitals%pmat, atom%integrals%n) CASE (do_semi_analytic) @@ -666,7 +666,7 @@ CONTAINS kmatb%op = 0._dp SELECT CASE (atom%exchange_integral_type) CASE DEFAULT - CPABORT("") + CPABORT("Unknown exchange integral type for calculate_atom_unrestricted") CASE (do_analytic) CALL eeri_contract(kmata%op, atom%integrals%eeri, atom%orbitals%pmata, atom%integrals%n) CALL eeri_contract(kmatb%op, atom%integrals%eeri, atom%orbitals%pmatb, atom%integrals%n) diff --git a/src/atom_energy.F b/src/atom_energy.F index 4e2590510e..7d2a7b853d 100644 --- a/src/atom_energy.F +++ b/src/atom_energy.F @@ -595,7 +595,7 @@ CONTAINS rbasis(:, i + 3, l) = 0.125_dp*(wfn(:, i, l, 3) - 3._dp*wfn(:, i, l, 1) & + 3._dp*wfn(:, i, l, -1) - wfn(:, i, l, -3))/delta**3 CASE DEFAULT - CPABORT("") + CPABORT("Only 1, 2, 3 are supported as the number of wavefunction derivatives") END SELECT END DO diff --git a/src/atom_fit.F b/src/atom_fit.F index 7ed8537163..b80ba7e82d 100644 --- a/src/atom_fit.F +++ b/src/atom_fit.F @@ -206,7 +206,7 @@ CONTAINS penalty = .FALSE. SELECT CASE (basis%basis_type) CASE DEFAULT - CPABORT("") + CPABORT("Unknown basis type for atom_fit_basis") CASE (GTO_BASIS) IF (basis%geometrical) THEN ostate%nvar = 2 @@ -312,7 +312,7 @@ CONTAINS IF (ostate%state == 2) THEN SELECT CASE (basis%basis_type) CASE DEFAULT - CPABORT("") + CPABORT("Unknown basis type for atom_fit_basis") CASE (GTO_BASIS) IF (basis%geometrical) THEN basis%am = 0._dp @@ -403,7 +403,7 @@ CONTAINS ! x->basis SELECT CASE (basis%basis_type) CASE DEFAULT - CPABORT("") + CPABORT("Unknown basis type for atom_fit_basis") CASE (GTO_BASIS) IF (basis%geometrical) THEN basis%am = 0._dp @@ -479,7 +479,7 @@ CONTAINS SELECT CASE (basis%basis_type) CASE DEFAULT - CPABORT("") + CPABORT("Unknown basis type for atom_fit_basis") CASE (GTO_BASIS) zval = atom_info(1, 1)%atom%z crad = ptable(zval)%covalent_radius*bohr @@ -1235,9 +1235,9 @@ CONTAINS CALL release_opmat(dma) CALL release_opmat(dmb) CASE (do_rohf_atom) - CPABORT("") + CPABORT("ROHF not yet implemented for opt_nlcc_param") CASE DEFAULT - CPABORT("") + CPABORT("Unknown method for opt_nlcc_param") END SELECT im = im + 1 diff --git a/src/atom_grb.F b/src/atom_grb.F index 3dca2d8219..2575d79300 100644 --- a/src/atom_grb.F +++ b/src/atom_grb.F @@ -125,7 +125,7 @@ CONTAINS CASE (do_uks_atom, do_uhf_atom, do_rohf_atom) CPABORT("Unrestricted methods not allowed for GRB generation") CASE DEFAULT - CPABORT("") + CPABORT("Unknown method for GRB generation") END SELECT ! input for basis optimization @@ -292,7 +292,7 @@ CONTAINS rbasis(:, i + 3, l) = 0.125_dp*(wfn(:, i, l, 3) - 3._dp*wfn(:, i, l, 1) & + 3._dp*wfn(:, i, l, -1) - wfn(:, i, l, -3))/delta**3 CASE DEFAULT - CPABORT("") + CPABORT("Only 1, 2, 3 are supported as the number of response derivatives") END SELECT END DO diff --git a/src/atom_kind_orbitals.F b/src/atom_kind_orbitals.F index 9604592ea5..25c3265e68 100644 --- a/src/atom_kind_orbitals.F +++ b/src/atom_kind_orbitals.F @@ -813,11 +813,11 @@ CONTAINS ! set the method flag SELECT CASE (rel_control%rel_method) CASE DEFAULT - CPABORT("") + CPABORT("Unknown relativistic method for calculate_atomic_relkin") CASE (rel_dkh) SELECT CASE (rel_control%rel_DKH_order) CASE DEFAULT - CPABORT("") + CPABORT("Unknown DKH order for calculate_atomic_relkin") CASE (0) relativistic = do_dkh0_atom CASE (1) @@ -830,9 +830,9 @@ CONTAINS CASE (rel_zora) SELECT CASE (rel_control%rel_zora_type) CASE DEFAULT - CPABORT("") + CPABORT("Unknown ZORA type for calculate_atomic_relkin") CASE (rel_zora_full) - CPABORT("") + CPABORT("ZORA full not yet implemented in calculate_atomic_relkin") CASE (rel_zora_mp) relativistic = do_zoramp_atom CASE (rel_sczora_mp) @@ -1053,7 +1053,7 @@ CONTAINS j = first_sgf(shell_index(l, k2), set_index(l, k2)) SELECT CASE (atom%relativistic) CASE DEFAULT - CPABORT("") + CPABORT("Unknown relativistic type for calculate_atomic_relkin") CASE (do_zoramp_atom, do_sczoramp_atom) DO m = 0, ll rtmat(i + m, j + m) = integrals%tzora(k1, k2, l) diff --git a/src/atom_operators.F b/src/atom_operators.F index 668e348f67..3a0e95ab1d 100644 --- a/src/atom_operators.F +++ b/src/atom_operators.F @@ -138,7 +138,7 @@ CONTAINS END IF END DO ELSE - CPABORT("") + CPABORT("Unknown potential confinement type for atom_int_setup") END IF CALL numpot_matrix(integrals%conf, cpot, basis, 0) DEALLOCATE (cpot) @@ -147,7 +147,7 @@ CONTAINS SELECT CASE (basis%basis_type) CASE DEFAULT - CPABORT("") + CPABORT("Unknown basis type for atom_int_setup") CASE (GTO_BASIS) DO l = 0, lmat n = integrals%n(l) @@ -283,7 +283,7 @@ CONTAINS CPASSERT(.NOT. integrals%eri_coulomb) CPASSERT(.NOT. integrals%eri_exchange) CASE (NUM_BASIS) - CPABORT("") + CPABORT("Numerical basis not yet implemented for atom_int_setup") END SELECT ! setup transformation matrix to get an orthogonal basis, remove linear dependencies @@ -366,7 +366,7 @@ CONTAINS SELECT CASE (basis%basis_type) CASE DEFAULT - CPABORT("") + CPABORT("Unknown basis type for atom_ppint_setup") CASE (GTO_BASIS) SELECT CASE (potential%ppot_type) @@ -431,7 +431,7 @@ CONTAINS CASE (sgp_pseudo) CALL sgpint_setup(integrals, basis, potential) CASE DEFAULT - CPABORT("") + CPABORT("Unknown pseudopotential type for atom_ppint_setup") END SELECT CASE (CGTO_BASIS) @@ -508,7 +508,7 @@ CONTAINS CASE (sgp_pseudo) CALL sgpint_setup(integrals, basis, potential) CASE DEFAULT - CPABORT("") + CPABORT("Unknown pseudopotential type for atom_ppint_setup") END SELECT CASE (STO_BASIS) @@ -593,11 +593,11 @@ CONTAINS CASE (sgp_pseudo) CALL sgpint_setup(integrals, basis, potential) CASE DEFAULT - CPABORT("") + CPABORT("Unknown pseudopotential type for atom_ppint_setup") END SELECT CASE (NUM_BASIS) - CPABORT("") + CPABORT("Numerical basis not yet implemented for atom_ppint_setup") END SELECT ! add ecp_pseudo using numerical representation of basis @@ -833,7 +833,7 @@ CONTAINS SELECT CASE (reltyp) CASE DEFAULT - CPABORT("") + CPABORT("Unknown relativistic type for atom_relint_setup") CASE (do_nonrel_atom, do_zoramp_atom, do_sczoramp_atom) dkhorder = -1 CASE (do_dkh0_atom) @@ -848,7 +848,7 @@ CONTAINS SELECT CASE (reltyp) CASE DEFAULT - CPABORT("") + CPABORT("Unknown relativistic type for atom_relint_setup") CASE (do_nonrel_atom) ! nothing to do NULLIFY (integrals%tzora, integrals%hdkh) @@ -951,7 +951,7 @@ CONTAINS SELECT CASE (basis%basis_type) CASE DEFAULT - CPABORT("") + CPABORT("Unknown basis type for atom_relint_setup") CASE (GTO_BASIS, CGTO_BASIS) DO l = 0, lmat @@ -971,9 +971,9 @@ CONTAINS END DO CASE (STO_BASIS) - CPABORT("") + CPABORT("Slater-type basis not yet implemented for atom_relint_setup") CASE (NUM_BASIS) - CPABORT("") + CPABORT("Numerical basis not yet implemented for atom_relint_setup") END SELECT CALL dkh_integrals(integrals, basis, dkhorder, sp, tp, vp, pvp) @@ -1022,7 +1022,7 @@ CONTAINS CALL dkh_atom_transformation(sp(1:m, 1:m, l), vp(1:m, 1:m, l), tp(1:m, 1:m, l), pvp(1:m, 1:m, l), m, order) SELECT CASE (basis%basis_type) CASE DEFAULT - CPABORT("") + CPABORT("Unknown basis type for dkh_integrals") CASE (GTO_BASIS) CPASSERT(n == m) integrals%hdkh(1:n, 1:n, l) = tp(1:n, 1:n, l) + vp(1:n, 1:n, l) @@ -1030,9 +1030,9 @@ CONTAINS CALL contract2(integrals%hdkh(1:n, 1:n, l), tp(1:m, 1:m, l), basis%cm(1:m, 1:n, l)) CALL contract2add(integrals%hdkh(1:n, 1:n, l), vp(1:m, 1:m, l), basis%cm(1:m, 1:n, l)) CASE (STO_BASIS) - CPABORT("") + CPABORT("Slater-type basis not yet implemented for dkh_integrals") CASE (NUM_BASIS) - CPABORT("") + CPABORT("Numerical basis not yet implemented for dkh_integrals") END SELECT ELSE integrals%hdkh(1:n, 1:n, l) = 0._dp @@ -1062,7 +1062,7 @@ CONTAINS IF (ebas) THEN SELECT CASE (basis_a%basis_type) CASE DEFAULT - CPABORT("") + CPABORT("Unknown basis type for atom_basis_projection_overlap") CASE (GTO_BASIS) DO l = 0, lmat na = basis_a%nbas(l) diff --git a/src/atom_optimization.F b/src/atom_optimization.F index 2b64542070..d2ffa6a3fc 100644 --- a/src/atom_optimization.F +++ b/src/atom_optimization.F @@ -224,7 +224,7 @@ CONTAINS ELSEIF (history%hlen == 1) THEN fmat = history%hmat(nnow)%fmat ELSE - CPABORT("") + CPABORT("Length of matrix history hlen < 1") END IF END SUBROUTINE atom_opt_fmat diff --git a/src/atom_output.F b/src/atom_output.F index c2060add06..59d577c206 100644 --- a/src/atom_output.F +++ b/src/atom_output.F @@ -369,9 +369,9 @@ CONTAINS END DO WRITE (iw, '(" ",79("*"))') CASE (NUM_BASIS) - CPABORT("") + CPABORT("Numerical basis not yet implemented for atom_print_basis") CASE DEFAULT - CPABORT("") + CPABORT("Unknown basis type for atom_print_basis") END SELECT END SUBROUTINE atom_print_basis @@ -426,7 +426,9 @@ CONTAINS END IF END DO CASE (CGTO_BASIS) - CPABORT("") + CALL cp_abort(__LOCATION__, & + "Contracted Gaussian-type basis not yet implemented "// & + "for atom_print_basis_file") CASE (STO_BASIS) WRITE (iw, '(T3,A)') "BASIS_TYPE SLATER" DO l = 0, lmat @@ -461,9 +463,9 @@ CONTAINS END IF END DO CASE (NUM_BASIS) - CPABORT("") + CPABORT("Numerical basis not yet implemented for atom_print_basis_file") CASE DEFAULT - CPABORT("") + CPABORT("Unknown basis type for atom_print_basis_file") END SELECT IF (PRESENT(wfn)) THEN @@ -523,7 +525,7 @@ CONTAINS xc_fun_section => section_vals_get_subs_vals(xc_section, "XC_FUNCTIONAL") SELECT CASE (meth) CASE DEFAULT - CPABORT("") + CPABORT("Unknown method for atom_print_method") CASE (do_rks_atom) CALL section_vals_val_get(xc_fun_section, "_SECTION_PARAMETERS_", i_val=myfun) CASE (do_uks_atom) @@ -538,7 +540,7 @@ CONTAINS SELECT CASE (meth) CASE DEFAULT - CPABORT("") + CPABORT("Unknown method for atom_print_method") CASE (do_rks_atom) IF (iw > 0) WRITE (iw, fmt="(/,' METHOD | Restricted Kohn-Sham Calculation')") CASE (do_uks_atom) @@ -576,7 +578,7 @@ CONTAINS SELECT CASE (reltyp) CASE DEFAULT - CPABORT("") + CPABORT("Unknown relativistic type for atom_print_method") CASE (do_nonrel_atom) IF (iw > 0) WRITE (iw, fmt="(' METHOD | Nonrelativistic Calculation')") CASE (do_zoramp_atom) @@ -729,7 +731,7 @@ CONTAINS END DO END DO CASE DEFAULT - CPABORT("") + CPABORT("Unknown pseudopotential type for atom_print_potential") END SELECT IF (potential%confinement) THEN IF (potential%conf_type == poly_conf) THEN @@ -741,7 +743,7 @@ CONTAINS WRITE (iw, '(T57,A,F12.6,A)') "w =", potential%rcon, " Bohr" WRITE (iw, '(T57,A,F12.6,A)') "ron =", potential%scon, " Bohr" ELSE - CPABORT("") + CPABORT("Unknown potential confinement type") END IF ELSE WRITE (iw, '(/,T10,A)') " No Confinement Potential is applied " @@ -861,7 +863,7 @@ CONTAINS SELECT CASE (atom%method_type) CASE DEFAULT - CPABORT("") + CPABORT("Unknown method type for atom_print_orbitals") CASE (do_rks_atom) CALL atom_print_orbitals_helper(atom, atom%orbitals%wfn, "", iw) CASE (do_uks_atom) @@ -873,7 +875,7 @@ CONTAINS CALL atom_print_orbitals_helper(atom, atom%orbitals%wfna, "Alpha", iw) CALL atom_print_orbitals_helper(atom, atom%orbitals%wfnb, "Beta", iw) CASE (do_rohf_atom) - CPABORT("") + CPABORT("ROHF not yet implemented for atom_print_orbitals") END SELECT graph = .FALSE. @@ -883,7 +885,7 @@ CONTAINS fnbody = TRIM(ptable(z)%symbol)//"_PPorbital" SELECT CASE (atom%method_type) CASE DEFAULT - CPABORT("") + CPABORT("Unknown method type for atom_print_orbitals") CASE (do_rks_atom) CALL atom_orbitals_grace(atom, atom%orbitals%wfn, fnbody) CASE (do_uks_atom) @@ -895,7 +897,7 @@ CONTAINS CALL atom_orbitals_grace(atom, atom%orbitals%wfna, TRIM(fnbody)//"alpha") CALL atom_orbitals_grace(atom, atom%orbitals%wfnb, TRIM(fnbody)//"beta") CASE (do_rohf_atom) - CPABORT("") + CPABORT("ROHF not yet implemented for atom_print_orbitals") END SELECT END IF diff --git a/src/atom_sgp.F b/src/atom_sgp.F index e1553aabeb..178e7e93bd 100644 --- a/src/atom_sgp.F +++ b/src/atom_sgp.F @@ -125,7 +125,7 @@ CONTAINS ELSEIF (is_upf) THEN CALL upf_sgp_constr(upf_pot, sgp_pot, basis) ELSE - CPABORT("") + CPABORT("Either ecp_pot or upf_pot is needed for sgp_construction") END IF NULLIFY (core, hnl) @@ -140,7 +140,7 @@ CONTAINS ELSEIF (is_upf) THEN CALL upfints(core%op, hnl%op, basis, upf_pot, cutpotu, sgp_pot%ac_local) ELSE - CPABORT("") + CPABORT("Either ecp_pot or upf_pot is needed for sgp_construction") END IF ! CALL sgpints(score%op, shnl%op, basis, sgp_pot, cutpots) @@ -170,7 +170,7 @@ CONTAINS errcc = SQRT(errcc/REAL(n, KIND=dp)) DEALLOCATE (cgauss) ELSE - CPABORT("") + CPABORT("sgp_pot%has_nlcc requires is_upf") END IF error(3) = errcc END IF @@ -239,7 +239,7 @@ CONTAINS IF (iw > 0) WRITE (iw, '(" No Pseudopotential available for transformation. ")') do_transform = .FALSE. CASE DEFAULT - CPABORT("") + CPABORT("Unknown ppot_type") END SELECT ! generate the transformed potentials @@ -249,7 +249,7 @@ CONTAINS ELSEIF (is_upf) THEN CALL upf_sgp_constr(upf_pot, sgp_pot, atom_ref%basis) ELSE - CPABORT("") + CPABORT("Either ecp_pseudo or upf_pseudo is needed for atom_sgp_construction") END IF END IF @@ -282,7 +282,7 @@ CONTAINS ELSEIF (is_upf) THEN CALL upfints(core%op, hnl%op, atom_ref%basis, upf_pot, cutpotu, sgp_pot%ac_local) ELSE - CPABORT("") + CPABORT("Either ecp_pseudo or upf_pseudo is needed for atom_sgp_construction") END IF ! CALL sgpints(score%op, shnl%op, atom_ref%basis, sgp_pot, cutpots) @@ -319,7 +319,7 @@ CONTAINS errcc = SQRT(errcc/REAL(n, KIND=dp)) DEALLOCATE (cgauss) ELSE - CPABORT("") + CPABORT("sgp_pot%has_nlcc requires is_upf") END IF IF (iw > 0) THEN WRITE (iw, '(" Non-linear core correction: core density")') diff --git a/src/atom_utils.F b/src/atom_utils.F index c3e79b2847..8465ff388a 100644 --- a/src/atom_utils.F +++ b/src/atom_utils.F @@ -539,7 +539,7 @@ CONTAINS IF (iw > 0) WRITE (iw, fmt="(' ZMP | ERROR! External grid dimension ',I4,' differs from internal grid ',I4)") & nr, atom%basis%grid%nr IF (iw > 0) WRITE (iw, fmt="(' ZMP | ERROR! Stopping ZMP calculation')") - CPABORT("") + CPABORT("Unable to continue reading external density file") END IF DO ir = 1, nr @@ -549,7 +549,7 @@ CONTAINS IF (iw > 0) WRITE (iw, fmt='(" ZMP |",T20,"R_out[bohr]",T36,"R_in[bohr]",T61,"R_diff[bohr]")') IF (iw > 0) WRITE (iw, fmt='(" ZMP |",T14,E24.15,T39,E24.15,T64,E24.15)') & rr, atom%basis%grid%rad(ir), ABS(rr - atom%basis%grid%rad(ir)) - CPABORT("") + CPABORT("Unable to continue reading external density file") END IF END DO CALL close_file(unit_number=extunit) @@ -626,7 +626,7 @@ CONTAINS IF (iw > 0) WRITE (iw, fmt="(' ZMP | ERROR! External grid dimension ',I4,' differs from internal grid ',I4)") & nr, atom%basis%grid%nr IF (iw > 0) WRITE (iw, fmt="(' ZMP | ERROR! Stopping ZMP calculation')") - CPABORT("") + CPABORT("Unable to continue reading external v_xc file") END IF DO ir = 1, nr READ (extunit, *) rr, vxc(ir) @@ -635,7 +635,7 @@ CONTAINS IF (iw > 0) WRITE (iw, fmt='(" ZMP |",T20,"R_out[bohr]",T36,"R_in[bohr]",T61,"R_diff[bohr]")') IF (iw > 0) WRITE (iw, fmt='(" ZMP |",T14,E24.15,T39,E24.15,T64,E24.15)') & rr, atom%basis%grid%rad(ir), ABS(rr - atom%basis%grid%rad(ir)) - CPABORT("") + CPABORT("Unable to continue reading external v_xc file") END IF END DO @@ -737,7 +737,9 @@ CONTAINS corden(:) = corden(:) - REAL(2*j - 2, dp)*fe(:)*rc**(2*j - 2)*cval/a2 END IF ELSE - CPABORT("") + CALL cp_abort(__LOCATION__, & + "Only , , are supported as "// & + "in atom_core_density, found <"//TRIM(my_typ)//">") END IF END DO END DO @@ -767,7 +769,9 @@ CONTAINS CALL spline3ders(potential%upf_pot%r(1:n), potential%upf_pot%rho_nlcc(1:n), rval(1:m), & d2ynew=rhoc(1:m)) ELSE - CPABORT("") + CALL cp_abort(__LOCATION__, & + "Only , , are supported as "// & + "in atom_core_density, found <"//TRIM(my_typ)//">") END IF IF (reverse) THEN DO i = 1, m @@ -1131,7 +1135,7 @@ CONTAINS IF (MAXVAL(ABS(pmat(:, :, l))) < 1.e-14_dp) CYCLE SELECT CASE (basis%basis_type) CASE DEFAULT - CPABORT("") + CPABORT("Unknown basis type for coulomb_potential_analytic") CASE (GTO_BASIS) DO i = 1, basis%nbas(l) DO j = i, basis%nbas(l) @@ -1528,7 +1532,7 @@ CONTAINS SELECT CASE (basis%basis_type) CASE DEFAULT - CPABORT("") + CPABORT("Unknown basis type for potential_analytic") CASE (GTO_BASIS) DO i = 1, basis%nbas(la) DO j = 1, basis%nbas(lb) @@ -1613,7 +1617,8 @@ CONTAINS expa(:) = EXP(-z(:)**2)/sab**(ll + 2)/2._dp**((ll + nu)/2 + 2) SELECT CASE (ll) CASE DEFAULT - CPABORT("") + CALL cp_abort(__LOCATION__, & + "Only 0, 1, 2, 3, 4, 5, 6 are supported as the value of ll") CASE (0) CPASSERT(nu == 0) CASE (1) @@ -1622,7 +1627,8 @@ CONTAINS CASE (2) SELECT CASE (nu) CASE DEFAULT - CPABORT("") + CALL cp_abort(__LOCATION__, & + "Only 0, 2 are supported as the value of nu when ll = 2") CASE (0) erfa(:) = erfa(:) - 2._dp*expa(:) CASE (2) @@ -1631,7 +1637,8 @@ CONTAINS CASE (3) SELECT CASE (nu) CASE DEFAULT - CPABORT("") + CALL cp_abort(__LOCATION__, & + "Only 1, 3 are supported as the value of nu when ll = 3") CASE (1) erfa(:) = erfa(:) - expa(:)*(12._dp*z(:) + 30._dp/z(:)) CASE (3) @@ -1640,7 +1647,8 @@ CONTAINS CASE (4) SELECT CASE (nu) CASE DEFAULT - CPABORT("") + CALL cp_abort(__LOCATION__, & + "Only 0, 2, 4 are supported as the value of nu when ll = 4") CASE (0) erfa(:) = erfa(:) - expa(:)*(4._dp*z(:)**2 + 14._dp) CASE (2) @@ -1651,7 +1659,8 @@ CONTAINS CASE (5) SELECT CASE (nu) CASE DEFAULT - CPABORT("") + CALL cp_abort(__LOCATION__, & + "Only 1, 3, 5 are supported as the value of nu when ll = 5") CASE (1) erfa(:) = erfa(:) - expa(:)*(24._dp*z(:)**3 + 108._dp*z(:) + 210._dp/z(:)) CASE (3) @@ -1663,7 +1672,8 @@ CONTAINS CASE (6) SELECT CASE (nu) CASE DEFAULT - CPABORT("") + CALL cp_abort(__LOCATION__, & + "Only 0, 2, 4, 6 are supported as the value of nu when ll = 6") CASE (0) erfa(:) = erfa(:) - expa(:)*(8._dp*z(:)**4 + 44._dp*z(:)**2 + 114._dp) CASE (2) @@ -1880,7 +1890,7 @@ CONTAINS END DO END DO CASE DEFAULT - CPABORT("") + CPABORT("Only 0, 1, 2 are supported as the value of derivatives") END SELECT END SUBROUTINE numpot_matrix @@ -2231,9 +2241,9 @@ CONTAINS CASE (do_uks_atom, do_uhf_atom) spinpol = .TRUE. CASE (do_rohf_atom) - CPABORT("") + CPABORT("ROHF not yet implemented for get_rho0") CASE DEFAULT - CPABORT("") + CPABORT("Unknown method for get_rho0") END SELECT nr = atom%basis%grid%nr @@ -2434,7 +2444,7 @@ CONTAINS m = basis%nprim(l) SELECT CASE (basis%basis_type) CASE DEFAULT - CPABORT("") + CPABORT("Unknown basis type for atom_completeness") CASE (GTO_BASIS) CALL sg_overlap(omat(1:n, 1:n, l), l, basis%am(1:n, l), basis%am(1:n, l)) CASE (CGTO_BASIS) @@ -2446,7 +2456,7 @@ CONTAINS CALL sto_overlap(omat(1:n, 1:n, l), basis%ns(1:n, l), basis%as(1:n, l), & basis%ns(1:n, l), basis%as(1:n, l)) CASE (NUM_BASIS) - CPABORT("") + CPABORT("Numerical basis not yet implemented for atom_completeness") END SELECT CALL invmat_symm(omat(1:n, 1:n, l)) END DO diff --git a/src/colvar_methods.F b/src/colvar_methods.F index 281f17cb62..0489fefb36 100644 --- a/src/colvar_methods.F +++ b/src/colvar_methods.F @@ -1721,7 +1721,7 @@ CONTAINS !!! FIXME this is rubbish at the moment as we have no force to be computed on this CALL HBP_colvar(colvar, cell, particles=particles) CASE DEFAULT - CPABORT("") + CPABORT("Unknown colvar type for colvar_eval_mol_f") END SELECT ! Check for fixed atom constraints IF (PRESENT(fixd_list)) CALL check_fixed_atom_cns_colv(fixd_list, colvar) @@ -1809,7 +1809,7 @@ CONTAINS CASE (mindist_colvar_id) CALL mindist_colvar(colvar, cell, subsys=subsys) CASE DEFAULT - CPABORT("") + CPABORT("Unknown colvar type for colvar_eval_glob_f") END SELECT ! Check for fixed atom constraints CALL check_fixed_atom_cns_colv(subsys%gci%fixd_list, colvar) @@ -1881,7 +1881,7 @@ CONTAINS CASE (HBP_colvar_id) CALL HBP_colvar(colvar, cell, particles=particles) CASE DEFAULT - CPABORT("") + CPABORT("Unknown colvar type for colvar_recursive_eval") END SELECT END SUBROUTINE colvar_recursive_eval @@ -2042,8 +2042,7 @@ CONTAINS xi(2) = 0.0_dp xi(3) = 1.0_dp CASE DEFAULT - !Not implemented for anything which is not a single component. - CPABORT("") + CPABORT("xyz_diag_colvar not implemented for anything which is not a single component") END SELECT fi(:) = xi END IF diff --git a/src/common/cp_result_methods.F b/src/common/cp_result_methods.F index 644dcef0e8..c62fe15576 100644 --- a/src/common/cp_result_methods.F +++ b/src/common/cp_result_methods.F @@ -330,8 +330,7 @@ CONTAINS CASE (result_type_logical) n_entries = n_entries + SIZE(results%result_value(i)%value%logical_type) CASE DEFAULT - ! Type not implemented in cp_result_type - CPABORT("") + CPABORT("Type not implemented in cp_result_type") END SELECT EXIT END IF diff --git a/src/common/cp_result_types.F b/src/common/cp_result_types.F index 01c8b80649..950932dae3 100644 --- a/src/common/cp_result_types.F +++ b/src/common/cp_result_types.F @@ -228,8 +228,7 @@ CONTAINS CASE (result_type_logical) ALLOCATE (value%logical_type(size_value)) CASE DEFAULT - ! Type not implemented in cp_result_type - CPABORT("") + CPABORT("Type not implemented in cp_result_type") END SELECT CALL timestop(handle) END SUBROUTINE cp_result_value_init @@ -268,8 +267,7 @@ CONTAINS CPASSERT(.NOT. ASSOCIATED(value%integer_type)) CPASSERT(.NOT. ASSOCIATED(value%real_type)) CASE DEFAULT - ! Type not implemented in cp_result_type - CPABORT("") + CPABORT("Type not implemented in cp_result_type") END SELECT DEALLOCATE (value) END IF @@ -336,8 +334,7 @@ CONTAINS ALLOCATE (value_out%logical_type(isize)) value_out%logical_type = value_in%logical_type CASE DEFAULT - ! Type not implemented in cp_result_type - CPABORT("") + CPABORT("Type not implemented in cp_result_type") END SELECT CALL timestop(handle) END SUBROUTINE cp_result_value_copy diff --git a/src/common/powell.F b/src/common/powell.F index 4afb1c312a..20c7def891 100644 --- a/src/common/powell.F +++ b/src/common/powell.F @@ -96,7 +96,7 @@ CONTAINS DEALLOCATE (optstate%xopt) optstate%state = -1 CASE DEFAULT - CPABORT("") + CPABORT("Unknown optimization state") END SELECT CALL timestop(handle) diff --git a/src/constraint.F b/src/constraint.F index 16c5fbd53f..e6d1308ea4 100644 --- a/src/constraint.F +++ b/src/constraint.F @@ -711,7 +711,7 @@ CONTAINS ELSEIF (id_type == "R") THEN label = "Rattle Lagrangian Multipliers:" ELSE - CPABORT("") + CPABORT("Only S for Shake or R for Rattle are supported for Lagrangian Multipliers") END IF WRITE (log_unit, FMT='(A,T40,4F15.9)') TRIM(label), lagr(1:MIN(4, SIZE(lagr))) DO j = 5, SIZE(lagr), 4 diff --git a/src/cp_ddapc_forces.F b/src/cp_ddapc_forces.F index 33075d1beb..979571da7f 100644 --- a/src/cp_ddapc_forces.F +++ b/src/cp_ddapc_forces.F @@ -374,7 +374,7 @@ CONTAINS END DO CASE DEFAULT - CPABORT("") + CPABORT("Unknown ddapc constraint/restraint form") END SELECT END SUBROUTINE evaluate_restraint_functional diff --git a/src/cp_ddapc_methods.F b/src/cp_ddapc_methods.F index 02f143f474..5265a249ed 100644 --- a/src/cp_ddapc_methods.F +++ b/src/cp_ddapc_methods.F @@ -889,7 +889,7 @@ CONTAINS WRITE (output_unit, '(A,I6,A)') "Atom number :: ", i, " is out of the solvation sphere" WRITE (output_unit, '(2(A,F12.6))') "Distance from the center::", r1, " Radius of the sphere::", rs END IF - CPABORT("") + CPABORT("Unable to evaluate electrostatic potential in solution") END IF LocP(:, i) = 0.0_dp IF (r1 /= 0.0_dp) THEN diff --git a/src/cp_ddapc_util.F b/src/cp_ddapc_util.F index a48852f472..7fe0888cdc 100644 --- a/src/cp_ddapc_util.F +++ b/src/cp_ddapc_util.F @@ -732,7 +732,7 @@ CONTAINS IF (v0 > 0.1_dp) THEN WRITE (*, '(A,2I5,2F15.9)') "ERROR IN DERIVATIVE OF B VECTOR, IPARTICLE, ICOORD:", iparticle, i, & dbv(kk, i), ddbv(kk) - CPABORT("") + CPABORT("Error on B large than 0.1") END IF END IF END DO @@ -812,7 +812,7 @@ CONTAINS IF (v0 > 0.1_dp) THEN WRITE (*, '(A,4I5,2F15.9)') "ERROR IN DERIVATIVE OF A MATRIX, IPARTICLE, ICOORD:", iparticle, i, kk, ll, & dAm(kk, ll, i), ddAm(kk, ll) - CPABORT("") + CPABORT("Error on A larger than 0.1") END IF END IF END DO diff --git a/src/cp_external_control.F b/src/cp_external_control.F index 6bca6a7ba6..4b32395cde 100644 --- a/src/cp_external_control.F +++ b/src/cp_external_control.F @@ -208,7 +208,7 @@ CONTAINS my_start_time = globenv%cp2k_start_time ELSE ! If none of the two arguments is present abort.. This routine should always check about time. - CPABORT("") + CPABORT("Neither target_time nor globenv exists for external_control") END IF IF ((.NOT. should_stop) .AND. (my_target_time > 0.0_dp)) THEN diff --git a/src/dbt/dbt_test.F b/src/dbt/dbt_test.F index ec484cc5f8..2740474ed0 100644 --- a/src/dbt/dbt_test.F +++ b/src/dbt/dbt_test.F @@ -335,7 +335,7 @@ CONTAINS IF (.NOT. eql) THEN IF (io_unit > 0) WRITE (io_unit, '(A,1X,A)') TRIM(tensor_name), 'Test failed!' - CPABORT('') + CPABORT("tensor1 and tensor2 are not equal in dbt_test_formats") ELSE IF (io_unit > 0) WRITE (io_unit, '(A,1X,A)') TRIM(tensor_name), 'Test passed!' END IF @@ -768,7 +768,7 @@ CONTAINS IF (.NOT. eql .OR. .NOT. notzero) THEN IF (io_unit > 0) WRITE (io_unit, *) 'Test failed!', eql_diff - CPABORT('') + CPABORT("array_3_test_mm is not non-zero or not equal to array_3_mm") ELSE IF (io_unit > 0) WRITE (io_unit, *) 'Test passed!', eql_diff END IF diff --git a/src/dbt/tas/dbt_tas_mm.F b/src/dbt/tas/dbt_tas_mm.F index 28ccc283ad..12d8654603 100644 --- a/src/dbt/tas/dbt_tas_mm.F +++ b/src/dbt/tas/dbt_tas_mm.F @@ -1503,7 +1503,9 @@ CONTAINS min_nze = MAX(nze_a, 1_int_8) max_nze = MAX(MAXVAL([nze_b, nze_c]), 1_int_8) CASE DEFAULT - CPABORT("") + CALL cp_abort(__LOCATION__, & + "Only 1, 2, 3 are supported as max_mm_dim "// & + "for split_factor_estimate") END SELECT nsplit = INT(MIN(INT(numnodes, KIND=int_8), NINT(REAL(max_nze, dp)/(REAL(min_nze, dp)*s_opt_factor), KIND=int_8))) diff --git a/src/distribution_methods.F b/src/distribution_methods.F index 838da8b46c..c2a143497c 100644 --- a/src/distribution_methods.F +++ b/src/distribution_methods.F @@ -691,7 +691,7 @@ CONTAINS ELSE ! expects nothing else - CPABORT("") + CPABORT("Invalid optimization for DFT%QS%DISTRIBUTION") END IF ! prepare the lists of local particles diff --git a/src/dm_ls_scf_create.F b/src/dm_ls_scf_create.F index 3cc770f4f3..f094e7e7d6 100644 --- a/src/dm_ls_scf_create.F +++ b/src/dm_ls_scf_create.F @@ -302,7 +302,7 @@ CONTAINS ls_scf_env%needs_s_inv = .FALSE. ls_scf_env%use_s_sqrt = .FALSE. CASE DEFAULT - CPABORT("") + CPABORT("Unknown S_INVERSION type for LS_SCF") END SELECT SELECT CASE (ls_scf_env%s_preconditioner_type) @@ -447,7 +447,7 @@ CONTAINS CALL cite_reference(Lin2013) WRITE (unit_nr, '(T2,A,T51,A20)') "Purification method", ADJUSTR("PEXSI") CASE DEFAULT - CPABORT("") + CPABORT("Unknown purification method for LS_SCF") END SELECT SELECT CASE (ls_scf_env%ls_mstruct%cluster_type) diff --git a/src/dm_ls_scf_methods.F b/src/dm_ls_scf_methods.F index 8347cc2090..e74da48ab7 100644 --- a/src/dm_ls_scf_methods.F +++ b/src/dm_ls_scf_methods.F @@ -341,7 +341,7 @@ CONTAINS CALL dbcsr_multiply("N", "N", 1.0_dp, matrix_bs_sqrt, matrix_tmp, & 0.0_dp, matrix) CASE DEFAULT - CPABORT("") + CPABORT("Direction should be forward or backward when applying preconditioner") END SELECT CALL dbcsr_release(matrix_tmp) diff --git a/src/ec_environment.F b/src/ec_environment.F index 3a00901d2f..2c959cb728 100644 --- a/src/ec_environment.F +++ b/src/ec_environment.F @@ -591,13 +591,13 @@ CONTAINS ls_env%needs_s_inv = .FALSE. ls_env%use_s_sqrt = .FALSE. CASE DEFAULT - CPABORT("") + CPABORT("Unknown ls_env%s_inversion_type") END SELECT CASE (ec_matrix_trs4, ec_matrix_tc2) ls_env%needs_s_inv = .FALSE. ls_env%use_s_sqrt = .TRUE. CASE DEFAULT - CPABORT("") + CPABORT("Unknown ec_env%ks_solver") END SELECT SELECT CASE (ls_env%s_preconditioner_type) diff --git a/src/energy_corrections.F b/src/energy_corrections.F index 2221fcad18..e0ea3c5191 100644 --- a/src/energy_corrections.F +++ b/src/energy_corrections.F @@ -2859,7 +2859,7 @@ CONTAINS CALL ec_ls_init(qs_env, ksmat, smat) CALL ec_ls_solver(qs_env, pmat, wmat, ec_ls_method=ec_env%ks_solver) CASE DEFAULT - CPASSERT(.FALSE.) + CPABORT("Option invalid or unavailable for ec_env%ks_solver") END SELECT IF (ec_env%mao) THEN @@ -3064,7 +3064,7 @@ CONTAINS CASE DEFAULT - CPASSERT(.FALSE.) + CPABORT("Option invalid or unavailable for ec_env%energy_functional") END SELECT diff --git a/src/eri_mme/eri_mme_integrate.F b/src/eri_mme/eri_mme_integrate.F index 1ca61251a4..edd6612df3 100644 --- a/src/eri_mme/eri_mme_integrate.F +++ b/src/eri_mme/eri_mme_integrate.F @@ -547,7 +547,9 @@ CONTAINS CASE (3) IF (PRESENT(RR_count)) RR_count = RR_count + 1 CASE DEFAULT - CPABORT("") + CALL cp_abort(__LOCATION__, & + "Only 1, 2, 3 are supported as method "// & + "for eri_mme_3c_integrate_nonortho") END SELECT IF (param%debug) THEN diff --git a/src/ewald_environment_types.F b/src/ewald_environment_types.F index 7baf299ddd..16dd35054f 100644 --- a/src/ewald_environment_types.F +++ b/src/ewald_environment_types.F @@ -300,7 +300,7 @@ CONTAINS CASE (3) ewald_env%gmax = gmax_read CASE DEFAULT - CPABORT("") + CPABORT("Invalid dimensions of GMAX input in Ewald section") END SELECT IF (ewald_env%ewald_type == do_ewald_spme) THEN CALL section_vals_val_get(ewald_section, "O_SPLINE", i_val=ewald_env%o_spline) @@ -372,7 +372,7 @@ CONTAINS WRITE (iw, '( T2,"EWALD| ",A,T71,I10 )') & 'Spline interpolation order ', ewald_env%o_spline CASE DEFAULT - CPABORT("") + CPABORT("Unknown Ewald type") END SELECT ELSE WRITE (iw, '( T2,"EWALD| ",T73, A )') 'not used' @@ -498,7 +498,7 @@ CONTAINS CASE (3) ewald_env%gmax = gmax_read CASE DEFAULT - CPABORT("") + CPABORT("Invalid dimensions of GMAX input in Ewald section") END SELECT ELSE SELECT CASE (param) diff --git a/src/ewald_pw_methods.F b/src/ewald_pw_methods.F index cb5cb68fbd..9cbcbf2e22 100644 --- a/src/ewald_pw_methods.F +++ b/src/ewald_pw_methods.F @@ -126,7 +126,7 @@ CONTAINS poisson_env=poisson_env) CASE (do_ewald_none) CASE default - CPABORT("") + CPABORT("Unknown ewald_type for ewald_pw_grid_update") END SELECT IF (ASSOCIATED(poisson_env)) THEN ALLOCATE (pw_pools(1)) diff --git a/src/ewald_pw_types.F b/src/ewald_pw_types.F index 89585a9e14..747003aa61 100644 --- a/src/ewald_pw_types.F +++ b/src/ewald_pw_types.F @@ -289,7 +289,7 @@ CONTAINS CASE (do_ewald_none) ! No EWALD sums.. CASE default - CPABORT("") + CPABORT("Unknown ewald_type for ewald_pw_init") END SELECT ! Poisson Environment IF (ASSOCIATED(ewald_pw%poisson_env)) THEN diff --git a/src/fm/cp_cfm_basic_linalg.F b/src/fm/cp_cfm_basic_linalg.F index 77ba3681c1..d3880afabb 100644 --- a/src/fm/cp_cfm_basic_linalg.F +++ b/src/fm/cp_cfm_basic_linalg.F @@ -326,11 +326,9 @@ CONTAINS END DO END IF ELSE -#if defined(__parallel) - CPABORT("to do (pdscal,pdcopy,pdaxpy)") -#else - CPABORT("") -#endif + CALL cp_abort(__LOCATION__, & + "cp_cfm_scale_and_add is not yet implemented for cases "// & + "where input two matrix structures are not equivalent") END IF END IF CALL timestop(handle) @@ -433,11 +431,9 @@ CONTAINS END DO END IF ELSE -#if defined(__parallel) - CPABORT("to do (pdscal,pdcopy,pdaxpy)") -#else - CPABORT("") -#endif + CALL cp_abort(__LOCATION__, & + "cp_cfm_scale_and_add_fm is not yet implemented for cases "// & + "where two input matrix structures are not equivalent") END IF END IF CALL timestop(handle) diff --git a/src/fm/cp_cfm_types.F b/src/fm/cp_cfm_types.F index 9bb3c969d8..17c77dc1eb 100644 --- a/src/fm/cp_cfm_types.F +++ b/src/fm/cp_cfm_types.F @@ -682,7 +682,7 @@ CONTAINS source%local_data(1, 1), 1, 1, source%matrix_struct%descriptor, 1, & destination%local_data(1, 1), 1, 1, destination%matrix_struct%descriptor, 1) #else - CPABORT("") + CPABORT("cp_cfm_to_cfm_matrix: pzcopy needs __parallel build flag") #endif END IF END SUBROUTINE cp_cfm_to_cfm_matrix diff --git a/src/fm/cp_fm_basic_linalg.F b/src/fm/cp_fm_basic_linalg.F index 586d2e4a12..f074ce7574 100644 --- a/src/fm/cp_fm_basic_linalg.F +++ b/src/fm/cp_fm_basic_linalg.F @@ -218,11 +218,9 @@ CONTAINS CALL daxpy(size_a, my_beta, b, 1, a, 1) ELSE -#ifdef __parallel - CPABORT("to do (pdscal,pdcopy,pdaxpy)") -#else - CPABORT("") -#endif + CALL cp_abort(__LOCATION__, & + "cp_fm_scale_and_add is not yet implemented for cases "// & + "where two input matrix structures are not equivalent") END IF END IF diff --git a/src/force_env_methods.F b/src/force_env_methods.F index b9bc561f35..93744ddb03 100644 --- a/src/force_env_methods.F +++ b/src/force_env_methods.F @@ -320,7 +320,7 @@ CONTAINS CASE (use_ipi) CALL request_forces(force_env%ipi_env) CASE default - CPABORT("") + CPABORT("Unknown force environment; cannot evaluate energy or force") END SELECT END IF ! In case it is requested, we evaluate the stress tensor numerically @@ -1393,7 +1393,7 @@ CONTAINS CALL mixed_map_forces(particles_mix, virial_mix, results_mix, global_forces, virials, results, & (1.0_dp - lambda), istate(2), nforce_eval, map_index, mapping_section, .FALSE.) CASE DEFAULT - CPABORT("") + CPABORT("Unknown mixing type for mixed_energy_forces") END SELECT !Simply deallocate and loose the pointer references.. DO iforce_eval = 1, nforce_eval diff --git a/src/force_fields_all.F b/src/force_fields_all.F index 07bc775be0..061e971116 100644 --- a/src/force_fields_all.F +++ b/src/force_fields_all.F @@ -3734,7 +3734,13 @@ CONTAINS ((atm1 == my_atm2) .AND. (atm2 == my_atm1))) found = .TRUE. CASE DEFAULT ! Should never reach this point - CPABORT("") + CALL cp_abort(__LOCATION__, & + ", , , , "// & + ", , , "// & + ", are "// & + "supported as the for store_FF_missing_par, "// & + "found unknown option "// & + "<"//TRIM(type_name)//">") END SELECT IF (found) EXIT END DO diff --git a/src/input/input_keyword_types.F b/src/input/input_keyword_types.F index 64fe5c5a0c..1665d10024 100644 --- a/src/input/input_keyword_types.F +++ b/src/input/input_keyword_types.F @@ -397,7 +397,7 @@ CONTAINS CASE (no_t) keyword%n_var = 0 CASE default - CPABORT("") + CPABORT("Unknown type_of_var for keyword_create") END SELECT END IF IF (PRESENT(n_var)) keyword%n_var = n_var @@ -582,7 +582,7 @@ CONTAINS CASE (no_t) WRITE (unit_nr, "(' Non-standard type.')") CASE default - CPABORT("") + CPABORT("Unknown type_of_var for keyword_describe") END SELECT END IF IF (keyword%type_of_var == enum_t) THEN @@ -743,7 +743,7 @@ CONTAINS WRITE (UNIT=unit_number, FMT="(A)") & REPEAT(" ", l1)//"" CASE DEFAULT - CPABORT("") + CPABORT("Unknown type_of_var for write_keyword_xml") END SELECT short_string = "" diff --git a/src/input/input_section_types.F b/src/input/input_section_types.F index f398cfa3bd..917c8edeb1 100644 --- a/src/input/input_section_types.F +++ b/src/input/input_section_types.F @@ -1787,8 +1787,6 @@ CONTAINS CPASSERT(ASSOCIATED(section_vals_in)) CPASSERT(ASSOCIATED(section_vals_out)) - ! IF(.NOT. ASSOCIATED(section_vals_in%section, section_vals_out%section))& - ! CPABORT("") istart = 1 iend = SIZE(section_vals_in%values, 2) @@ -1816,9 +1814,9 @@ CONTAINS END DO IF (.NOT. PRESENT(i_rep_low) .AND. (.NOT. PRESENT(i_rep_high))) THEN IF (.NOT. (SIZE(section_vals_in%values, 2) == SIZE(section_vals_out%values, 2))) & - CPABORT("") + CPABORT("Incompatible sizes of values between input and output") IF (.NOT. (SIZE(section_vals_in%subs_vals, 2) == SIZE(section_vals_out%subs_vals, 2))) & - CPABORT("") + CPABORT("Incompatible sizes of subsections between input and output") END IF iend = SIZE(section_vals_in%subs_vals, 2) IF (PRESENT(i_rep_high)) iend = i_rep_high diff --git a/src/input/input_val_types.F b/src/input/input_val_types.F index 1f3203d400..9ac7220f12 100644 --- a/src/input/input_val_types.F +++ b/src/input/input_val_types.F @@ -239,7 +239,7 @@ CONTAINS IF (ASSOCIATED(enum)) THEN IF (val%type_of_var /= no_t .AND. val%type_of_var /= integer_t .AND. & val%type_of_var /= enum_t) THEN - CPABORT("") + CPABORT("Type of variable is incompatible with enum") END IF IF (ASSOCIATED(val%i_val)) THEN val%type_of_var = enum_t @@ -358,10 +358,10 @@ CONTAINS IF (SIZE(val%l_val) > 0) THEN l_val = val%l_val(1) ELSE - CPABORT("") + CPABORT("Invalid size of logical value(s)") END IF ELSE - CPABORT("") + CPABORT("Logical value is unavailable") END IF END IF @@ -371,10 +371,10 @@ CONTAINS IF (SIZE(val%i_val) > 0) THEN i_val = val%i_val(1) ELSE - CPABORT("") + CPABORT("Invalid size of integer value(s)") END IF ELSE - CPABORT("") + CPABORT("Integer value is unavailable") END IF END IF @@ -384,10 +384,10 @@ CONTAINS IF (SIZE(val%r_val) > 0) THEN r_val = val%r_val(1) ELSE - CPABORT("") + CPABORT("Invalid size of real value(s)") END IF ELSE - CPABORT("") + CPABORT("Real value is unavailable") END IF END IF @@ -419,16 +419,16 @@ CONTAINS c_val = val%c_val(1) END IF ELSE - CPABORT("") + CPABORT("Invalid size of character value(s)") END IF ELSE IF (ASSOCIATED(val%i_val) .AND. ASSOCIATED(val%enum)) THEN IF (SIZE(val%i_val) > 0) THEN c_val = enum_i2c(val%enum, val%i_val(1)) ELSE - CPABORT("") + CPABORT("Invalid size of character value(s)") END IF ELSE - CPABORT("") + CPABORT("Character value is unavailable") END IF END IF @@ -668,7 +668,7 @@ CONTAINS WRITE (UNIT=string(2*i - 1:), FMT="(1X,L1)") val%l_val(i) END DO ELSE - CPABORT("") + CPABORT("Logical value is unavailable") END IF CASE (integer_t) IF (ASSOCIATED(val%i_val)) THEN @@ -676,7 +676,7 @@ CONTAINS WRITE (UNIT=string(12*i - 11:), FMT="(I12)") val%i_val(i) END DO ELSE - CPABORT("") + CPABORT("Integer value is unavailable") END IF CASE (real_t) IF (ASSOCIATED(val%r_val)) THEN @@ -692,7 +692,7 @@ CONTAINS END DO END IF ELSE - CPABORT("") + CPABORT("Real value is unavailable") END IF CASE (char_t) IF (ASSOCIATED(val%c_val)) THEN @@ -702,13 +702,13 @@ CONTAINS ipos = ipos + LEN_TRIM(ADJUSTL(val%c_val(i))) + 1 END DO ELSE - CPABORT("") + CPABORT("Character value is unavailable") END IF CASE (lchar_t) IF (ASSOCIATED(val%c_val)) THEN CALL val_get(val, c_val=string) ELSE - CPABORT("") + CPABORT("Character value is unavailable") END IF CASE (enum_t) IF (ASSOCIATED(val%i_val)) THEN @@ -717,7 +717,7 @@ CONTAINS WRITE (UNIT=string, FMT="(A)") TRIM(ADJUSTL(enum_string)) END DO ELSE - CPABORT("") + CPABORT("Enumeration value is unavailable") END IF CASE default CPABORT("unexpected type_of_var for val ") diff --git a/src/kpoint_methods.F b/src/kpoint_methods.F index dde3c497bf..7612f0001e 100644 --- a/src/kpoint_methods.F +++ b/src/kpoint_methods.F @@ -551,7 +551,7 @@ CONTAINS DEALLOCATE (agauge) END IF CASE DEFAULT - CPASSERT(.FALSE.) + CPABORT("Option invalid or unavailable for kpoint%kp_scheme") END SELECT ! check for consistency of options @@ -693,7 +693,7 @@ CONTAINS ELSE IF (kpoint%parallel_group_size > 0) THEN ngr = MIN(kpoint%parallel_group_size, npe) ELSE - CPASSERT(.FALSE.) + CPABORT("kpoint%parallel_group_size cannot be smaller than -1") END IF nkp_grp = npe/ngr ! processor dimensions diff --git a/src/kpoint_types.F b/src/kpoint_types.F index 3db6864342..61c4d7656a 100644 --- a/src/kpoint_types.F +++ b/src/kpoint_types.F @@ -818,7 +818,11 @@ CONTAINS kpoint%xkp_input(1:3, 1:n_rep) = kpoint%xkp(1:3, 1:n_rep) kpoint%wkp_input(1:n_rep) = kpoint%wkp(1:n_rep) CASE DEFAULT - CPABORT("") + CALL cp_abort(__LOCATION__, & + ", , , , "// & + " are supported as the for "// & + "read_kpoint_section, found unknown option "// & + "<"//TRIM(kpoint%kp_scheme)//">") END SELECT CALL section_vals_val_get(kpoint_section, "GAMMA_CENTERED", l_val=kpoint%gamma_centered) @@ -874,7 +878,7 @@ CONTAINS CASE (use_complex_wfn) kpoint%use_real_wfn = .FALSE. CASE DEFAULT - CPABORT("") + CPABORT("The WAVEFUNCTIONS option should be either REAL or COMPLEX") END SELECT ELSE @@ -968,7 +972,11 @@ CONTAINS CASE ("GENERAL") WRITE (punit, '(A,T71,A10)') ' BRILLOUIN| K-point scheme ', ' General' CASE DEFAULT - CPABORT("") + CALL cp_abort(__LOCATION__, & + ", , , , "// & + " are supported as the for "// & + "write_kpoint_info, found unknown option "// & + "<"//TRIM(kpoint%kp_scheme)//">") END SELECT IF (kpoint%kp_scheme /= "NONE") THEN IF (kpoint%symmetry) THEN diff --git a/src/metadyn_tools/graph_methods.F b/src/metadyn_tools/graph_methods.F index 16334da1eb..739fd093e7 100644 --- a/src/metadyn_tools/graph_methods.F +++ b/src/metadyn_tools/graph_methods.F @@ -605,9 +605,7 @@ CONTAINS CALL init_periodic_table() IF (ndw > 3) THEN - WRITE (*, *) - WRITE (*, *) 'ERROR: GAUSSIAN format can only handle FES on 3 CV !' - CPABORT("") + CPABORT("ERROR: GAUSSIAN format can only handle FES on 3 CV !") END IF OPEN (10, file=file, status='old') @@ -631,10 +629,9 @@ CONTAINS END DO IF (residual > 1.0d-6) THEN - WRITE (*, *) - WRITE (*, *) 'ERROR: this program can only handle orthogonal cells' - WRITE (*, *) ' with vectors pointing in the X, Y and Z directions' - CPABORT("") + CALL cp_abort(__LOCATION__, & + "fes_cube_write supports only orthogonal cells with "// & + "vectors pointing in the X, Y and Z directions") END IF WRITE (*, *) diff --git a/src/minimax/minimax_exp_k15.F b/src/minimax/minimax_exp_k15.F index 46a5a1d163..ca7bb50b3c 100644 --- a/src/minimax/minimax_exp_k15.F +++ b/src/minimax/minimax_exp_k15.F @@ -192,13 +192,13 @@ CONTAINS R_min = 2.0000000000000000E+01_dp R_max = 1.1750000000000000E+06_dp CASE DEFAULT - CPABORT("") + CPABORT("Only integers 1-15 are supported as the value of k") END SELECT fit_coef = 0.0 aw = 0.0 IF (Rc < R_min) THEN - CPABORT("") + CPABORT("Rc < R_min in get_minimax_coeff_k15") ELSE SELECT CASE (k) CASE (1) @@ -581,7 +581,7 @@ CONTAINS END IF END IF CASE DEFAULT - CPABORT("") + CPABORT("Only integers 1-15 are supported as the value of k") END SELECT END IF diff --git a/src/mixed_cdft_methods.F b/src/mixed_cdft_methods.F index dc4592c84f..74f7a80279 100644 --- a/src/mixed_cdft_methods.F +++ b/src/mixed_cdft_methods.F @@ -213,7 +213,9 @@ CONTAINS CASE (use_qmmmx) CPABORT("No force mixing allowed for mixed CDFT QM/MM") CASE DEFAULT - CPASSERT(.FALSE.) + CALL cp_abort(__LOCATION__, & + "Only use_qs_force and use_qmmm are "// & + "supported for mixed_cdft_init") END SELECT CPASSERT(ASSOCIATED(force_env_qs)) END DO @@ -493,7 +495,9 @@ CONTAINS CASE (use_qmmm) force_env_qs => force_env%sub_force_env(iforce_eval)%force_env CASE DEFAULT - CPASSERT(.FALSE.) + CALL cp_abort(__LOCATION__, & + "Only use_qs_force and use_qmmm are "// & + "supported for mixed_cdft_build_weight_parallel") END SELECT END DO IF (.NOT. force_env%mixed_env%do_mixed_qmmm_cdft) THEN @@ -903,7 +907,9 @@ CONTAINS force_env_qs_source => force_env%sub_force_env(jforce_eval)%force_env force_env_qs_target => force_env%sub_force_env(iforce_eval)%force_env CASE DEFAULT - CPASSERT(.FALSE.) + CALL cp_abort(__LOCATION__, & + "Only use_qs_force and use_qmmm are "// & + "supported for mixed_cdft_transfer_weight") END SELECT IF (.NOT. force_env%mixed_env%do_mixed_qmmm_cdft) THEN CALL force_env_get(force_env=force_env_qs_source, & @@ -1063,7 +1069,9 @@ CONTAINS CASE (use_qs_force, use_qmmm) force_env_qs => force_env%sub_force_env(iforce_eval)%force_env CASE DEFAULT - CPASSERT(.FALSE.) + CALL cp_abort(__LOCATION__, & + "Only use_qs_force and use_qmmm are "// & + "supported for mixed_cdft_set_flags") END SELECT IF (.NOT. force_env%mixed_env%do_mixed_qmmm_cdft) THEN CALL force_env_get(force_env=force_env_qs, qs_env=qs_env) diff --git a/src/molden_utils.F b/src/molden_utils.F index 5de7b1a5ea..1c233e8a6c 100644 --- a/src/molden_utils.F +++ b/src/molden_utils.F @@ -152,9 +152,7 @@ CONTAINS ! we are using the dbcsr mo_coeff ! we copy it to the fm anyway DO ispin = 1, SIZE(mos) - IF (.NOT. ASSOCIATED(mos(ispin)%mo_coeff_b)) THEN - CPASSERT(.FALSE.) - END IF + CPASSERT(ASSOCIATED(mos(ispin)%mo_coeff_b)) CALL copy_dbcsr_to_fm(mos(ispin)%mo_coeff_b, & mos(ispin)%mo_coeff) !fm->dbcsr END DO diff --git a/src/motion/helium_io.F b/src/motion/helium_io.F index a90e7077db..0513c61ffb 100644 --- a/src/motion/helium_io.F +++ b/src/motion/helium_io.F @@ -1380,7 +1380,7 @@ CONTAINS CALL cp_print_key_finished_output(unit_nr, logger, print_key) END DO ELSE - CPABORT("") + CPABORT("Unknown output format for helium_print_coordinates") END IF END DO diff --git a/src/motion/neb_utils.F b/src/motion/neb_utils.F index 8a0c83ea53..264b4260d7 100644 --- a/src/motion/neb_utils.F +++ b/src/motion/neb_utils.F @@ -585,7 +585,7 @@ CONTAINS ! Write he gradients in the colvar coordinates into the replica_env array ! and copy back also the metric tensor.. ! work in progress.. - CPABORT("") + CPABORT("implementation incomplete in perform_replica_md") rep_env%f(:, j + 1) = 0.0_dp Mmatrix = 0.0_dp ELSE diff --git a/src/motion/pint_io.F b/src/motion/pint_io.F index cd4e627db0..8ddd96b703 100644 --- a/src/motion/pint_io.F +++ b/src/motion/pint_io.F @@ -176,7 +176,7 @@ CONTAINS form = "FORMATTED" ext = ".xyz" CASE default - CPABORT("") + CPABORT("Unknown output format for pint_write_centroids") END SELECT NULLIFY (f_env, cell, subsys) @@ -325,7 +325,7 @@ CONTAINS form = "FORMATTED" ext = ".xyz" CASE default - CPABORT("") + CPABORT("Unknown output format for pint_write_trajectory") END SELECT NULLIFY (f_env, cell, subsys) diff --git a/src/motion/thermostat/thermostat_mapping.F b/src/motion/thermostat/thermostat_mapping.F index eb5da91b87..0dc3656195 100644 --- a/src/motion/thermostat/thermostat_mapping.F +++ b/src/motion/thermostat/thermostat_mapping.F @@ -296,7 +296,7 @@ CONTAINS END DO END DO ELSE - CPABORT("") + CPABORT("Unknown map_info%dis_type") END IF IF (nglob_cns /= 0) THEN CPABORT("Molecular thermostats with global constraints are impossible!") @@ -736,7 +736,7 @@ CONTAINS END DO END DO ELSE - CPABORT("") + CPABORT("Unknown map_info%dis_type") END IF IF (nglob_cns /= 0) THEN CPABORT("Molecular thermostats with global constraints are impossible!") diff --git a/src/motion/thermostat/thermostat_utils.F b/src/motion/thermostat/thermostat_utils.F index a7c80a2de4..f3e5828f48 100644 --- a/src/motion/thermostat/thermostat_utils.F +++ b/src/motion/thermostat/thermostat_utils.F @@ -491,7 +491,9 @@ CONTAINS itherm = itherm + 1 thermolist(ipart) = itherm ELSE - CPABORT("") + CALL cp_abort(__LOCATION__, & + "The atom "//cp_to_string(ipart)//" has been "// & + "assigned to different adiabatic regions!") END IF END DO END DO @@ -510,7 +512,9 @@ CONTAINS itherm = itherm + 1 thermolist(ipart) = itherm ELSE - CPABORT("") + CALL cp_abort(__LOCATION__, & + "The atom "//cp_to_string(ipart)//" has been "// & + "assigned to different adiabatic regions!") END IF END DO END DO diff --git a/src/motion_utils.F b/src/motion_utils.F index fd5488f985..d83916a8e3 100644 --- a/src/motion_utils.F +++ b/src/motion_utils.F @@ -348,7 +348,12 @@ CONTAINS id_wpc = "FORCE_MIXING_LABELS" id_extxyz = "force_mixing_label" ! non-standard CASE DEFAULT - CPABORT("") + CALL cp_abort(__LOCATION__, & + ", , , "// & + " are supported as "// & + "the for write_trajectory, "// & + "found unknown option "// & + "<"//TRIM(my_pk_name)//">") END SELECT charge_occup = .FALSE. @@ -463,7 +468,7 @@ CONTAINS "Step ", it, ", E = ", etot END IF CASE DEFAULT - CPABORT("") + CPABORT("Unknown output format") END SELECT IF (TRIM(my_pk_name) == "FORCE_MIXING_LABELS") THEN ALLOCATE (fml_array(3*SIZE(particle_set))) diff --git a/src/mp2.F b/src/mp2.F index 779267f31b..abcaca936d 100644 --- a/src/mp2.F +++ b/src/mp2.F @@ -746,7 +746,7 @@ CONTAINS mos_mp2, para_env, unit_nr, calc_forces, calc_ex, do_ri_sos_laplace_mp2=.TRUE.) CASE DEFAULT - CPABORT("") + CPABORT("Unknown MP2 method") END SELECT t2 = m_walltime() diff --git a/src/mp2_setup.F b/src/mp2_setup.F index 23d33a18d6..64c3f51c04 100644 --- a/src/mp2_setup.F +++ b/src/mp2_setup.F @@ -538,7 +538,7 @@ CONTAINS CASE (mp2_ri_optimize_basis) WRITE (unit_nr, '(T2,A)') "MP2| Optimize RI auxiliary basis" CASE DEFAULT - CPABORT("") + CPABORT("Unknown MP2 method") END SELECT WRITE (unit_nr, '(T2,A)') "" CALL m_flush(unit_nr) diff --git a/src/mpiwrap/mp_perf_test.F b/src/mpiwrap/mp_perf_test.F index 9707ca5370..3e9a701fbc 100644 --- a/src/mpiwrap/mp_perf_test.F +++ b/src/mpiwrap/mp_perf_test.F @@ -122,7 +122,7 @@ CONTAINS DO i = 1, npow ncount = 10**i t2 = 0.0E0_dp - IF (ncount > nbufmax) CPABORT("") + CPASSERT(ncount <= nbufmax) DO j = 1, 3**(npow - i) CALL comm%sync() t1 = MPI_WTIME() @@ -145,7 +145,7 @@ CONTAINS DO i = 1, npow ncount = 10**i t2 = 0.0E0_dp - IF (ncount > nbufmax) CPABORT("") + CPASSERT(ncount <= nbufmax) DO j = 1, 3**(npow - i) CALL comm%sync() t1 = MPI_WTIME() @@ -167,7 +167,7 @@ CONTAINS END IF ncount = 10**npow IF (ionode .AND. output_unit > 0) WRITE (output_unit, *) "For messages of ", ncount*8, " bytes" - IF (ncount > nbufmax) CPABORT("") + CPASSERT(ncount <= nbufmax) DO itask = 0, nprocs - 1 DO jtask = itask + 1, nprocs - 1 CALL comm%sync() @@ -202,7 +202,7 @@ CONTAINS DO i = 1, npow ncount = 10**i t2 = 0.0E0_dp - IF (ncount > nbufmax) CPABORT("") + CPASSERT(ncount <= nbufmax) DO j = 1, 3**(npow - i) CALL comm%sync() t1 = MPI_WTIME() @@ -231,7 +231,7 @@ CONTAINS DO i = 1, npow ncount = 10**i t2 = 0.0E0_dp - IF (ncount > nbufmax) CPABORT("") + CPASSERT(ncount <= nbufmax) DO j = 1, 3**(npow - i) CALL comm%sync() t1 = MPI_WTIME() @@ -261,7 +261,7 @@ CONTAINS DO i = 1, npow ncount = 10**i t2 = 0.0E0_dp - IF (ncount > nbufmax) CPABORT("") + CPASSERT(ncount <= nbufmax) DO j = 1, 3**(npow - i) CALL comm%sync() t1 = MPI_WTIME() @@ -281,7 +281,7 @@ CONTAINS DO i = 1, npow ncount = 10**i t2 = 0.0E0_dp - IF (ncount > nbufmax) CPABORT("") + CPASSERT(ncount <= nbufmax) DO j = 1, 3**(npow - i) buffer2(:) = buffer1 CALL comm%sync() @@ -305,7 +305,7 @@ CONTAINS DO i = 1, npow ncount = 10**i t2 = 0.0E0_dp - IF (ncount > nbufmax) CPABORT("") + CPASSERT(ncount <= nbufmax) scount = ncount/nprocs rcount = ncount/nprocs DO j = 1, nprocs @@ -366,7 +366,7 @@ CONTAINS CALL comm%max(maxdiff) IF (ionode .AND. output_unit > 0) WRITE (output_unit, *) "MPI_SENDRECV_REPLACE ", t4, maxdiff ! *** involved shift **** - IF (MODULO(nprocs, 2) /= 0) CPABORT("") + CPASSERT(MODULO(nprocs, 2) == 0) DO j = 1, Nprocs DO i = 1, Nloc grid3(i, j) = MODULO(i*j*taskid, itests) diff --git a/src/optimize_input.F b/src/optimize_input.F index b17a85c575..318487e913 100644 --- a/src/optimize_input.F +++ b/src/optimize_input.F @@ -136,7 +136,7 @@ CONTAINS CASE (opt_force_matching) CALL force_matching(oi_env, input_declaration, root_section, para_env) CASE DEFAULT - CPABORT("") + CPABORT("Unknown optimize input method") END SELECT CALL timestop(handle) @@ -668,7 +668,7 @@ CONTAINS CALL section_vals_val_get(fm_section, "SHIFT_QM", r_val=oi_env%fm_env%shift_qm) CALL section_vals_val_get(fm_section, "SHIFT_AVERAGE", l_val=oi_env%fm_env%shift_average) CASE DEFAULT - CPABORT("") + CPABORT("Unknown optimize input method") END SELECT CALL timestop(handle) diff --git a/src/pair_potential.F b/src/pair_potential.F index 5c34407d71..6e2d4af4f5 100644 --- a/src/pair_potential.F +++ b/src/pair_potential.F @@ -202,7 +202,7 @@ CONTAINS ! Do nothing.. CASE DEFAULT ! Never reach this point - CPABORT("") + CPABORT("Unknown potential type for spline_nonbond_control") END SELECT ! Special case for EAM SELECT CASE (pot%type(k)) @@ -638,7 +638,7 @@ CONTAINS CASE (tab_type) nvar = 4 + nvar CASE DEFAULT - CPABORT("") + CPABORT("Unknown potential target for get_nonbond_storage") END SELECT ! Setup a table of the indexes.. ALLOCATE (my_index(ndim)) @@ -804,7 +804,7 @@ CONTAINS CASE (nn_type) ! no checks CASE DEFAULT - CPABORT("") + CPABORT("Unknown potential target for get_nonbond_storage") END SELECT IF (ANY(potential_single_allocation == pot_target)) THEN pot_par(nk, :) = REAL(pot_target, KIND=dp) diff --git a/src/pair_potential_types.F b/src/pair_potential_types.F index d7cc8e8d90..ec797ee3f5 100644 --- a/src/pair_potential_types.F +++ b/src/pair_potential_types.F @@ -976,22 +976,26 @@ CONTAINS CPASSERT(.NOT. ASSOCIATED(potparm)) ALLOCATE (potparm) + + IF (PRESENT(ndim) .AND. (PRESENT(ub) .OR. PRESENT(lb))) THEN + CALL cp_abort(__LOCATION__, & + "pair_potential_p_create expects either 1 input parameter "// & + "or 2 input parameters and at each call; found "// & + "together with or ") + END IF + IF (PRESENT(ndim)) THEN loc_lb = 1 loc_ub = ndim ALLOCATE (potparm%pot(loc_lb:loc_ub)) - IF (PRESENT(lb) .OR. PRESENT(ub)) THEN - CPABORT("") - END IF ELSE IF (PRESENT(lb) .AND. PRESENT(ub)) THEN loc_lb = lb loc_ub = ub ALLOCATE (potparm%pot(loc_lb:loc_ub)) - IF (PRESENT(ndim)) THEN - CPABORT("") - END IF ELSE - CPABORT("") + CALL cp_abort(__LOCATION__, & + "pair_potential_p_create expects either 1 input parameter "// & + "or 2 input parameters and at each call; found none") END IF DO i = loc_lb, loc_ub NULLIFY (potparm%pot(i)%pot) diff --git a/src/preconditioner.F b/src/preconditioner.F index 2f56becea0..69d1ad3509 100644 --- a/src/preconditioner.F +++ b/src/preconditioner.F @@ -264,7 +264,7 @@ CONTAINS CASE (ot_precond_none, ot_precond_full_kinetic, ot_precond_s_inverse, ot_precond_full_single_inverse) ! these are 'independent' ! do nothing CASE DEFAULT - CPABORT("") + CPABORT("Unknown preconditioner type") END SELECT END IF diff --git a/src/pw/ps_wavelet_base.F b/src/pw/ps_wavelet_base.F index 33a9f239c0..2a9fc0f9b0 100644 --- a/src/pw/ps_wavelet_base.F +++ b/src/pw/ps_wavelet_base.F @@ -130,11 +130,10 @@ CONTAINS ! transform along z axis lot = ncache/(4*n3) IF (lot < 1) THEN - WRITE (*, *) & - 'convolxc_off:ncache has to be enlarged to be able to hold at'// & - 'least one 1-d FFT of this size even though this will'// & - 'reduce the performance for shorter transform lengths' - CPABORT("") + CALL cp_abort(__LOCATION__, & + 'convolxc_off:ncache has to be enlarged to be able to hold at '// & + 'least one 1-d FFT of this size even though this will '// & + 'reduce the performance for shorter transform lengths') END IF DO j2 = 1, md2/nproc !this condition ensures that we manage only the interesting part for the FFT @@ -184,11 +183,10 @@ CONTAINS ! transform along x axis lot = ncache/(4*n1) IF (lot < 1) THEN - WRITE (*, *) & - 'convolxc_off:ncache has to be enlarged to be able to hold at'// & - 'least one 1-d FFT of this size even though this will'// & - 'reduce the performance for shorter transform lengths' - CPABORT("") + CALL cp_abort(__LOCATION__, & + 'convolxc_off:ncache has to be enlarged to be able to hold at '// & + 'least one 1-d FFT of this size even though this will '// & + 'reduce the performance for shorter transform lengths') END IF DO j = 1, n2, lot @@ -224,11 +222,10 @@ CONTAINS !transform along y axis lot = ncache/(4*n2) IF (lot < 1) THEN - WRITE (*, *) & - 'convolxc_off:ncache has to be enlarged to be able to hold at'// & - 'least one 1-d FFT of this size even though this will'// & - 'reduce the performance for shorter transform lengths' - CPABORT("") + CALL cp_abort(__LOCATION__, & + 'convolxc_off:ncache has to be enlarged to be able to hold at '// & + 'least one 1-d FFT of this size even though this will '// & + 'reduce the performance for shorter transform lengths') END IF DO j = 1, n1, lot @@ -945,11 +942,10 @@ CONTAINS ! transform along z axis lot = ncache/(2*n3) IF (lot < 1) THEN - WRITE (*, *) & - 'convolxc_off:ncache has to be enlarged to be able to hold at'// & - 'least one 1-d FFT of this size even though this will'// & - 'reduce the performance for shorter transform lengths', n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, iproc - CPABORT("") + CALL cp_abort(__LOCATION__, & + 'convolxc_off:ncache has to be enlarged to be able to hold at '// & + 'least one 1-d FFT of this size even though this will '// & + 'reduce the performance for shorter transform lengths') END IF DO j2 = 1, md2/nproc @@ -999,11 +995,10 @@ CONTAINS ! transform along x axis lot = ncache/(4*n1) IF (lot < 1) THEN - WRITE (*, *) & - 'convolxc_off:ncache has to be enlarged to be able to hold at'// & - 'least one 1-d FFT of this size even though this will'// & - 'reduce the performance for shorter transform lengths' - CPABORT("") + CALL cp_abort(__LOCATION__, & + 'convolxc_off:ncache has to be enlarged to be able to hold at '// & + 'least one 1-d FFT of this size even though this will '// & + 'reduce the performance for shorter transform lengths') END IF DO j = 1, n2, lot @@ -1039,11 +1034,10 @@ CONTAINS !transform along y axis lot = ncache/(4*n2) IF (lot < 1) THEN - WRITE (*, *) & - 'convolxc_off:ncache has to be enlarged to be able to hold at'// & - 'least one 1-d FFT of this size even though this will'// & - 'reduce the performance for shorter transform lengths' - CPABORT("") + CALL cp_abort(__LOCATION__, & + 'convolxc_off:ncache has to be enlarged to be able to hold at '// & + 'least one 1-d FFT of this size even though this will '// & + 'reduce the performance for shorter transform lengths') END IF DO j = 1, n1, lot @@ -1681,11 +1675,10 @@ CONTAINS ! transform along z axis lot = ncache/(2*n3) IF (lot < 1) THEN - WRITE (*, *) & - 'convolxc_on:ncache has to be enlarged to be able to hold at'// & - 'least one 1-d FFT of this size even though this will'// & - 'reduce the performance for shorter transform lengths' - CPABORT("") + CALL cp_abort(__LOCATION__, & + 'convolxc_on:ncache has to be enlarged to be able to hold at '// & + 'least one 1-d FFT of this size even though this will '// & + 'reduce the performance for shorter transform lengths') END IF DO j2 = 1, md2/nproc @@ -1738,11 +1731,10 @@ CONTAINS ! transform along x axis lot = ncache/(4*n1) IF (lot < 1) THEN - WRITE (*, *) & - 'convolxc_on:ncache has to be enlarged to be able to hold at'// & - 'least one 1-d FFT of this size even though this will'// & - 'reduce the performance for shorter transform lengths' - CPABORT("") + CALL cp_abort(__LOCATION__, & + 'convolxc_on:ncache has to be enlarged to be able to hold at '// & + 'least one 1-d FFT of this size even though this will '// & + 'reduce the performance for shorter transform lengths') END IF DO j = 1, n2/2, lot @@ -1778,11 +1770,10 @@ CONTAINS !transform along y axis lot = ncache/(4*n2) IF (lot < 1) THEN - WRITE (*, *) & - 'convolxc_on:ncache has to be enlarged to be able to hold at'// & - 'least one 1-d FFT of this size even though this will'// & - 'reduce the performance for shorter transform lengths' - CPABORT("") + CALL cp_abort(__LOCATION__, & + 'convolxc_on:ncache has to be enlarged to be able to hold at '// & + 'least one 1-d FFT of this size even though this will '// & + 'reduce the performance for shorter transform lengths') END IF DO j = 1, n1, lot diff --git a/src/pw/ps_wavelet_fft3d.F b/src/pw/ps_wavelet_fft3d.F index 79766e9a95..2381556718 100644 --- a/src/pw/ps_wavelet_fft3d.F +++ b/src/pw/ps_wavelet_fft3d.F @@ -46,6 +46,7 @@ CONTAINS , 5000, 5120, 5184, 5400, 5625, 5760, 6000, 6144, 6400, 6480, 6750, 6912, 7200, 7500, 7680& , 8000, ctrig_length] + CHARACTER(LEN=80) :: err INTEGER :: i !Multiple of 2,3,5 @@ -56,8 +57,8 @@ CONTAINS RETURN END IF END DO loop_data - WRITE (unit=*, fmt=*) "fourier_dim: ", n, " is bigger than ", idata(ndata1024) - CPABORT("") + WRITE (unit=err, fmt=*) "fourier_dim: ", n, " is bigger than ", idata(ndata1024) + CPABORT(TRIM(err)) END SUBROUTINE fourier_dim ! Copyright (C) Stefan Goedecker, CEA Grenoble, 2002 @@ -114,6 +115,7 @@ CONTAINS REAL(KIND=dp) :: trig INTEGER :: after, before, now, isign, ic + CHARACTER(LEN=888) :: err INTEGER :: i, itt, j, nh REAL(KIND=dp) :: angle, trigc, trigs, twopi @@ -200,10 +202,10 @@ CONTAINS DO i = 1, 150 IF (i == 150) THEN - PRINT *, 'VALUE OF', n, 'NOT ALLOWED FOR FFT, ALLOWED VALUES ARE:' + WRITE (err, *) 'VALUE OF', n, 'NOT ALLOWED FOR FFT, ALLOWED VALUES ARE:' 37 FORMAT(15(i5)) - WRITE (*, 37) (idata(1, j), j=1, 149) - CPABORT("") + WRITE (err, 37) (idata(1, j), j=1, 149) + CALL cp_abort(__LOCATION__, TRIM(err)) END IF IF (n == idata(1, i)) THEN ic = 0 diff --git a/src/pw/ps_wavelet_scaling_function.F b/src/pw/ps_wavelet_scaling_function.F index d5f85f5d47..1eed8a8d73 100644 --- a/src/pw/ps_wavelet_scaling_function.F +++ b/src/pw/ps_wavelet_scaling_function.F @@ -53,8 +53,7 @@ CONTAINS nrange = ni ALLOCATE (y(0:nd), stat=i_all) IF (i_all /= 0) THEN - WRITE (*, *) ' scaling_function: problem of memory allocation' - CPABORT("") + CPABORT("Scaling_function: problem of memory allocation") END IF ! plot scaling function @@ -108,8 +107,7 @@ CONTAINS CALL lazy_arrays(itype, m, ch, cg, cgt, cht) ALLOCATE (y(0:nd), stat=i_all) IF (i_all /= 0) THEN - WRITE (*, *) ' wavelet_function: problem of memory allocation' - CPABORT("") + CPABORT("Wavelet_function: problem of memory allocation") END IF ! plot wavelet diff --git a/src/pw/ps_wavelet_util.F b/src/pw/ps_wavelet_util.F index 8217846357..b7bdbc4d43 100644 --- a/src/pw/ps_wavelet_util.F +++ b/src/pw/ps_wavelet_util.F @@ -240,6 +240,7 @@ CONTAINS nd1, nd2, nd3 INTEGER, INTENT(in) :: nproc + CHARACTER(len=80) :: err INTEGER :: l1, l2, l3 !dimensions of the density in the real space @@ -255,24 +256,21 @@ CONTAINS CALL fourier_dim(l1, n1) IF (n1 == m1) THEN ELSE - PRINT *, 'the FFT in the x direction is not allowed' - PRINT *, 'n01 dimension', n01 - CPABORT("") + WRITE (err, *) 'the FFT in the x direction is not allowed; n01 dimension ', n01 + CPABORT(TRIM(err)) END IF l1 = l1 + 1 CALL fourier_dim(l2, n2) IF (n2 == m2) THEN ELSE - PRINT *, 'the FFT in the z direction is not allowed' - PRINT *, 'n03 dimension', n03 - CPABORT("") + WRITE (err, *) 'the FFT in the z direction is not allowed; n03 dimension ', n03 + CPABORT(TRIM(err)) END IF CALL fourier_dim(l3, n3) IF (n3 == m3) THEN ELSE - PRINT *, 'the FFT in the y direction is not allowed' - PRINT *, 'n02 dimension', n02 - CPABORT("") + WRITE (err, *) 'the FFT in the y direction is not allowed; n02 dimension ', n02 + CPABORT(TRIM(err)) END IF !dimensions that contain the unpadded real space, @@ -338,6 +336,7 @@ CONTAINS CHARACTER(len=*), PARAMETER :: routineN = 'S_FFT_dimensions' + CHARACTER(len=80) :: err INTEGER :: handle, l1, l2, l3 !dimensions of the density in the real space @@ -354,17 +353,15 @@ CONTAINS CALL fourier_dim(l1, n1) IF (n1 == m1) THEN ELSE - PRINT *, 'the FFT in the x direction is not allowed' - PRINT *, 'n01 dimension', n01 - CPABORT("") + WRITE (err, *) 'the FFT in the x direction is not allowed; n01 dimension', n01 + CPABORT(TRIM(err)) END IF l1 = l1 + 1 CALL fourier_dim(l2, n2) IF (n2 == m2) THEN ELSE - PRINT *, 'the FFT in the z direction is not allowed' - PRINT *, 'n03 dimension', n03 - CPABORT("") + WRITE (err, *) 'the FFT in the z direction is not allowed; n03 dimension', n03 + CPABORT(TRIM(err)) END IF DO CALL fourier_dim(l3, n3) diff --git a/src/pw/pw_grids.F b/src/pw/pw_grids.F index a6161d4447..69a43bb380 100644 --- a/src/pw/pw_grids.F +++ b/src/pw/pw_grids.F @@ -919,7 +919,7 @@ CONTAINS blocking = .TRUE. END IF CASE DEFAULT - CPABORT("") + CPABORT("Unknown PW grid blocking") END SELECT !..create group for real space distribution diff --git a/src/pw/pw_poisson_methods.F b/src/pw/pw_poisson_methods.F index 02f41935f0..89f8f65c32 100644 --- a/src/pw/pw_poisson_methods.F +++ b/src/pw/pw_poisson_methods.F @@ -166,7 +166,7 @@ CONTAINS CASE (pw_poisson_wavelet) rebuild = (poisson_env%parameters%wavelet_scf_type /= wavelet%itype_scf) .OR. rebuild CASE default - CPABORT("") + CPABORT("Unknown Poisson solver") END SELECT END IF IF (rebuild) THEN diff --git a/src/pw/pw_poisson_types.F b/src/pw/pw_poisson_types.F index fa5517e92c..b73b8423cb 100644 --- a/src/pw/pw_poisson_types.F +++ b/src/pw/pw_poisson_types.F @@ -232,7 +232,7 @@ CONTAINS CASE (3) green%method = PERIODIC3D CASE DEFAULT - CPABORT("") + CPABORT("Periodicity that is not 0, 1, 2, 3 is invalid") END SELECT CASE (pw_poisson_mt) green%MT_rel_cutoff = poisson_params%mt_rel_cutoff @@ -258,7 +258,7 @@ CONTAINS CASE (3) CPABORT("Illegal combination of periodicity and Poisson solver (MT)") CASE DEFAULT - CPABORT("") + CPABORT("Periodicity that is not 0, 1, 2, 3 is invalid") END SELECT CASE (pw_poisson_implicit) green%method = PS_IMPLICIT @@ -305,7 +305,7 @@ CONTAINS END SELECT CASE DEFAULT - CPABORT("") + CPABORT("Unknown method for green function") END SELECT ! initialize influence function @@ -400,7 +400,7 @@ CONTAINS END IF CASE DEFAULT - CPABORT("") + CPABORT("Unknown method for green function") END SELECT END ASSOCIATE diff --git a/src/pw/pw_spline_utils.F b/src/pw/pw_spline_utils.F index 5b9055ca7c..4e708be0a3 100644 --- a/src/pw/pw_spline_utils.F +++ b/src/pw/pw_spline_utils.F @@ -1004,9 +1004,7 @@ CONTAINS safe_calc = .FALSE. IF (PRESENT(safe_computation)) safe_calc = safe_computation ii = coarse_coeffs_pw%pw_grid%para%group%compare(fine_values_pw%pw_grid%para%group) - IF (ii > mp_comm_congruent) THEN - CPABORT("") - END IF + CPASSERT(ii <= mp_comm_congruent) my_coarse_bo = coarse_coeffs_pw%pw_grid%bounds_local coarse_gbo = coarse_coeffs_pw%pw_grid%bounds fine_bo = fine_values_pw%pw_grid%bounds_local @@ -1345,7 +1343,7 @@ CONTAINS CASE (-3) wk = w_border1(3) CASE default - CPABORT("") + CPABORT("Only 1, -1, -3 are supported as the value of ik") CYCLE END SELECT ELSE @@ -1357,7 +1355,7 @@ CONTAINS CASE (-1) wk = w_border1(1) CASE default - CPABORT("") + CPABORT("Only 3, 1, -1 are supported as the value of ik") CYCLE END SELECT END IF @@ -1869,7 +1867,7 @@ CONTAINS CASE (-3) wk = w_border1(3) CASE default - CPABORT("") + CPABORT("Only 1, -1, -3 are supported as the value of ik") CYCLE END SELECT ELSE @@ -1881,7 +1879,7 @@ CONTAINS CASE (-1) wk = w_border1(1) CASE default - CPABORT("") + CPABORT("Only 3, 1, -1 are supported as the value of ik") CYCLE END SELECT END IF @@ -1911,7 +1909,7 @@ CONTAINS CASE (-3) wj = w_border1(3)*wk CASE default - CPABORT("") + CPABORT("Only 1, -1, -3 are supported as the value of ij") CYCLE END SELECT ELSE @@ -1923,7 +1921,7 @@ CONTAINS CASE (3) wj = w_border1(3)*wk CASE default - CPABORT("") + CPABORT("Only -1, 1, 3 are supported as the value of ij") CYCLE END SELECT END IF @@ -2486,7 +2484,7 @@ CONTAINS END SUBROUTINE pw_spline_precond_create ! ************************************************************************************************** -!> \brief switches the types of precoditioner to use +!> \brief switches the types of preconditioner to use !> \param preconditioner the preconditioner to be changed !> \param precond_kind the new kind of preconditioner to use !> \param pbc ... @@ -2540,7 +2538,7 @@ CONTAINS preconditioner%normalize = .FALSE. do_3d_coeff = .TRUE. CASE default - CPABORT("") + CPABORT("Unknown preconditioner kind for pw_spline_precond_set_kind") END SELECT IF (do_3d_coeff) THEN s = 1._dp @@ -2622,7 +2620,7 @@ CONTAINS transpose=preconditioner%transpose) END IF CASE default - CPABORT("") + CPABORT("Unknown preconditioner kind for pw_spline_do_precond") END SELECT END SUBROUTINE pw_spline_do_precond diff --git a/src/pw_env_methods.F b/src/pw_env_methods.F index 9b2606d10d..6a4252651e 100644 --- a/src/pw_env_methods.F +++ b/src/pw_env_methods.F @@ -367,7 +367,7 @@ CONTAINS xc_deriv_spline3_smooth, xc_deriv_nn10_smooth, xc_deriv_nn50_smooth) smooth_required = smooth_required .OR. .TRUE. CASE DEFAULT - CPABORT("") + CPABORT("Unknown xc_deriv_method_id") END SELECT SELECT CASE (xc_smooth_method_id) CASE (xc_rho_no_smooth) @@ -375,7 +375,7 @@ CONTAINS CASE (xc_rho_spline2_smooth, xc_rho_spline3_smooth, xc_rho_nn10, xc_rho_nn50) smooth_required = smooth_required .OR. .TRUE. CASE DEFAULT - CPABORT("") + CPABORT("Unknown xc_smooth_method_id") END SELECT ! EPR, NMR, EFG can require splines. If the linres/EFG section is present we assume ! it could be on and splines might be used (not quite sure if this is due to their use of splines or something else) diff --git a/src/pw_poisson_read_input.F b/src/pw_poisson_read_input.F index c4644c2bdf..9e2e553f53 100644 --- a/src/pw_poisson_read_input.F +++ b/src/pw_poisson_read_input.F @@ -78,7 +78,7 @@ CONTAINS CALL decode_periodic_wavelet(periodic, params) CASE (pw_poisson_none) CASE default - CPABORT("") + CPABORT("Unknown Poisson solver") END SELECT ! Set Ewald default to NONE @@ -99,7 +99,7 @@ CONTAINS END SUBROUTINE pw_poisson_read_parameters ! ************************************************************************************************** -!> \brief Helper routien for pw_poisson_read_parameters +!> \brief Helper routine for pw_poisson_read_parameters !> \param periodic ... !> \param params ... !> \author Ole Schuett @@ -126,7 +126,7 @@ CONTAINS CASE (use_perd_none) params%periodic = [0, 0, 0] CASE DEFAULT - CPABORT("") + CPABORT("Invalid periodicity") END SELECT ! check for consistent use of periodicity (cell <-> Poisson solver) !CPPostcondition(ALL(perd == cell%perd),cp_fatal_level,routineP,failure) @@ -134,7 +134,7 @@ CONTAINS END SUBROUTINE decode_periodic_green ! ************************************************************************************************** -!> \brief Helper routien for pw_poisson_read_parameters +!> \brief Helper routine for pw_poisson_read_parameters !> \param periodic ... !> \param params ... !> \author Ole Schuett @@ -172,7 +172,7 @@ CONTAINS CASE (use_perd_x, use_perd_y, use_perd_z) CPABORT("Poisson solver for this periodicity not yet implemented") CASE DEFAULT - CPABORT("") + CPABORT("Invalid periodicity") END SELECT END SUBROUTINE decode_periodic_wavelet diff --git a/src/qmmm_create.F b/src/qmmm_create.F index ae43a5ef42..f15dd5d2f0 100644 --- a/src/qmmm_create.F +++ b/src/qmmm_create.F @@ -330,7 +330,7 @@ CONTAINS qmmm_link_Imomm = .FALSE. IF (qmmm_link) THEN CALL setup_qmmm_links(qmmm_section, qmmm_links, mm_el_pot_radius, & - mm_el_pot_radius_corr, mm_atom_index, iw) + mm_el_pot_radius_corr, mm_atom_index) qmmm_env_qm%qmmm_links => qmmm_links CALL print_qmmm_links(qmmm_section, qmmm_links) diff --git a/src/qmmm_gaussian_init.F b/src/qmmm_gaussian_init.F index 8ce0f57c2e..c588591b9e 100644 --- a/src/qmmm_gaussian_init.F +++ b/src/qmmm_gaussian_init.F @@ -136,7 +136,7 @@ CONTAINS DEALLOCATE (radius) DEALLOCATE (c_radius) ELSE - CPABORT("") + CPABORT("Ndim smaller than 1 for Gaussian QM/MM coupling potential") END IF ! ALLOCATE (qmmm_gaussian_fns(Ndim - 1)) diff --git a/src/qmmm_gpw_energy.F b/src/qmmm_gpw_energy.F index fafa104ffe..af8d7d34af 100644 --- a/src/qmmm_gpw_energy.F +++ b/src/qmmm_gpw_energy.F @@ -146,8 +146,7 @@ CONTAINS CASE (do_qmmm_gauss, do_qmmm_swave) CPABORT("GAUSS or SWAVE QM/MM electrostatic coupling not yet implemented for SE.") CASE DEFAULT - IF (iw > 0) WRITE (iw, '(T2,"QMMM|",1X,A)') "Unknown Coupling..." - CPABORT("") + CPABORT("Unknown QM/MM coupling") END SELECT ELSEIF (dft_control%qs_control%dftb .OR. dft_control%qs_control%xtb) THEN ! DFTB @@ -163,8 +162,7 @@ CONTAINS CASE (do_qmmm_gauss, do_qmmm_swave) CPABORT("GAUSS or SWAVE QM/MM electrostatic coupling not implemented for DFTB.") CASE DEFAULT - IF (iw > 0) WRITE (iw, '(T2,"QMMM|",1X,A)') "Unknown Coupling..." - CPABORT("") + CPABORT("Unknown QM/MM coupling") END SELECT ELSE ! QS @@ -195,8 +193,7 @@ CONTAINS IF (iw > 0) WRITE (iw, '(T2,"QMMM|",1X,A)') & "No QM/MM Electrostatic coupling. Just Mechanical Coupling!" CASE DEFAULT - IF (iw > 0) WRITE (iw, '(T2,"QMMM|",1X,A)') "Unknown Coupling..." - CPABORT("") + CPABORT("Unknown QM/MM coupling") END SELECT ! Dump info on the electrostatic potential if requested IF (BTEST(cp_print_key_should_output(logger%iter_info, print_section, & @@ -325,7 +322,7 @@ CONTAINS END DO CALL timestop(handle2) CASE DEFAULT - CPABORT("") + CPABORT("Unknown kind interpolation") END SELECT lb = v_qmmm%pw_grid%bounds_local(1, :) ub = v_qmmm%pw_grid%bounds_local(2, :) diff --git a/src/qmmm_gpw_forces.F b/src/qmmm_gpw_forces.F index 72b82f9c0d..f2ecb1a293 100644 --- a/src/qmmm_gpw_forces.F +++ b/src/qmmm_gpw_forces.F @@ -174,8 +174,7 @@ CONTAINS IF (iw > 0) WRITE (iw, '(T2,"QMMM|",1X,A)') & "- No QM/MM Electrostatic coupling. Just Mechanical Coupling!" CASE DEFAULT - IF (iw > 0) WRITE (iw, '(T2,"QMMM|",1X,A)') "Unknown Coupling..." - CPABORT("") + CPABORT("Unknown QM/MM coupling") END SELECT ELSEIF (dft_control%qs_control%dftb .OR. dft_control%qs_control%xtb) THEN ! DFTB @@ -192,8 +191,7 @@ CONTAINS CASE (do_qmmm_gauss, do_qmmm_swave) CPABORT("GAUSS or SWAVE QM/MM electrostatic coupling not yet implemented for DFTB.") CASE DEFAULT - IF (iw > 0) WRITE (iw, '(T2,"QMMM|",1X,A)') "Unknown Coupling..." - CPABORT("") + CPABORT("Unknown QM/MM coupling") END SELECT IF (need_f) THEN Forces(:, :) = Forces(:, :)/REAL(para_env%num_pe, KIND=dp) @@ -275,8 +273,7 @@ CONTAINS IF (iw > 0) WRITE (iw, '(T2,"QMMM|",1X,A)') & "- No QM/MM Electrostatic coupling. Just Mechanical Coupling!" CASE DEFAULT - IF (iw > 0) WRITE (iw, '(T2,"QMMM|",1X,A)') "- Unknown Coupling..." - CPABORT("") + CPABORT("Unknown QM/MM coupling") END SELECT END IF END IF @@ -525,7 +522,7 @@ CONTAINS param_section=interp_section) END DO CASE DEFAULT - CPABORT("") + CPABORT("Unknown interpolation method") END SELECT shells = .FALSE. @@ -1396,8 +1393,7 @@ CONTAINS CASE (do_qmmm_none) CYCLE Diff CASE DEFAULT - IF (iw > 0) WRITE (iw, '(T3,A)') "Unknown Coupling..." - CPABORT("") + CPABORT("Unknown QM/MM coupling") END SELECT energy(K) = pw_integral_ab(rho, v_qmmm_rspace) END DO Diff @@ -1436,8 +1432,7 @@ CONTAINS CASE (do_qmmm_none) IF (iw > 0) WRITE (iw, '(T3,A)') "No QM/MM Derivatives to debug. Just Mechanical Coupling!" CASE DEFAULT - IF (iw > 0) WRITE (iw, '(T3,A)') "Unknown Coupling..." - CPABORT("") + CPABORT("Unknown QM/MM coupling") END SELECT CALL cp_print_key_finished_output(iw, logger, print_section, "PROGRAM_RUN_INFO") diff --git a/src/qmmm_init.F b/src/qmmm_init.F index c9accbb2e2..a2499ee7c9 100644 --- a/src/qmmm_init.F +++ b/src/qmmm_init.F @@ -1028,7 +1028,7 @@ CONTAINS CASE (do_qmmm_link_gho) ! do nothing for the moment CASE DEFAULT - CPABORT("") + CPABORT("Unknown QM/MM link type") END SELECT END DO END IF @@ -1099,18 +1099,16 @@ CONTAINS !> \param mm_el_pot_radius ... !> \param mm_el_pot_radius_corr ... !> \param mm_atom_index ... -!> \param iw ... !> \par History !> 12.2004 created [tlaino] !> \author Teodoro Laino ! ************************************************************************************************** SUBROUTINE setup_qmmm_links(qmmm_section, qmmm_links, mm_el_pot_radius, mm_el_pot_radius_corr, & - mm_atom_index, iw) + mm_atom_index) TYPE(section_vals_type), POINTER :: qmmm_section TYPE(qmmm_links_type), POINTER :: qmmm_links REAL(KIND=dp), DIMENSION(:), POINTER :: mm_el_pot_radius, mm_el_pot_radius_corr INTEGER, DIMENSION(:), POINTER :: mm_atom_index - INTEGER, INTENT(IN) :: iw INTEGER :: ikind, link_type, mm_index, n_gho, & n_imomm, n_pseudo, n_rep_val, n_tot, & @@ -1175,9 +1173,9 @@ CONTAINS ! DO ikind = 1, SIZE(wrk_tmp) IF (COUNT(wrk_tmp == wrk_tmp(ikind)) > 1) THEN - WRITE (iw, '(/A)') "In the IMOMM scheme no more than one QM atom can be bounded to the same MM atom." - WRITE (iw, '(A)') "Multiple link MM atom not allowed. Check your link sections." - CPABORT("") + CALL cp_abort(__LOCATION__, & + "In the IMOMM scheme no more than one QM atom can be bounded to the same "// & + "MM atom. Multiple link MM atom not allowed. Check your link sections.") END IF END DO DEALLOCATE (wrk_tmp) @@ -1205,7 +1203,7 @@ CONTAINS IF (n_gho /= 0) THEN ! not yet implemented ! still to define : type, implementation into QS - CPABORT("") + CPABORT("QM/MM link with ghost atoms not yet implemented") END IF END SUBROUTINE setup_qmmm_links diff --git a/src/qmmm_per_elpot.F b/src/qmmm_per_elpot.F index f90d7269b1..c13f0ff4fe 100644 --- a/src/qmmm_per_elpot.F +++ b/src/qmmm_per_elpot.F @@ -132,8 +132,9 @@ CONTAINS ALLOCATE (per_potentials(K)%Pot) SELECT CASE (qmmm_coupl_type) CASE (do_qmmm_coulomb, do_qmmm_pcharge) - ! Not yet implemented for this case - CPABORT("") + CALL cp_abort(__LOCATION__, & + "QM/MM coupling type Coulomb or Point_Charge not "// & + "yet implemented for qmmm_per_potential_init") CASE (do_qmmm_gauss, do_qmmm_swave) ALLOCATE (Lg(Ndim)) ALLOCATE (gx(Ndim)) @@ -148,8 +149,9 @@ CONTAINS SELECT CASE (qmmm_coupl_type) CASE (do_qmmm_coulomb, do_qmmm_pcharge) - ! Not yet implemented for this case - CPABORT("") + CALL cp_abort(__LOCATION__, & + "QM/MM coupling type Coulomb or Point_Charge not "// & + "yet implemented for qmmm_per_potential_init") CASE (do_qmmm_gauss, do_qmmm_swave) pgf => pgfs(K)%pgf idim = 0 @@ -203,7 +205,7 @@ CONTAINS box(2) = (qm_cell_small%hmat(2, 2) - mm_cell%hmat(2, 2))/2.0_dp box(3) = (qm_cell_small%hmat(3, 3) - mm_cell%hmat(3, 3))/2.0_dp IF (ANY(box > 0.0_dp)) THEN - CPABORT("") + CPABORT("QM cell and MM cell differ in size") END IF n_rep_real(1) = CEILING((box(1) + mymaxradius)/mm_cell%hmat(1, 1)) n_rep_real(2) = CEILING((box(2) + mymaxradius)/mm_cell%hmat(2, 2)) @@ -373,7 +375,7 @@ CONTAINS CPABORT("QM-QM long range correction not possible with GAUSS/SWAVE coupling") CASE DEFAULT ! We should never get to this point - CPABORT("") + CPABORT("Unknown QM/MM coupling type") END SELECT iw = cp_print_key_unit_nr(logger, print_section, "PERIODIC_INFO", extension=".log") diff --git a/src/qmmm_tb_methods.F b/src/qmmm_tb_methods.F index bc69ec019c..8058c41956 100644 --- a/src/qmmm_tb_methods.F +++ b/src/qmmm_tb_methods.F @@ -1308,7 +1308,7 @@ CONTAINS sr = erfc(qm_alpha*dr)/dr qpot = qpot + qeff*sr ELSE - CPABORT("") + CPABORT("Unknown pot_type for dr > rtiny") END IF END IF END DO LoopMM @@ -1397,7 +1397,7 @@ CONTAINS dsr = 0.5_dp*(erfc(qm_alpha*drp)/drp - erfc(qm_alpha*drm)/drm)/ddrmm fsr = qeff*qcharge*dsr ELSE - CPABORT("") + CPABORT("Unknown pot_type for dr > rtiny") END IF force_ab = -fsr*rij/dr ELSE diff --git a/src/qmmm_topology_util.F b/src/qmmm_topology_util.F index 4a8d848c85..3ea4eaf263 100644 --- a/src/qmmm_topology_util.F +++ b/src/qmmm_topology_util.F @@ -164,13 +164,11 @@ CONTAINS IF (detected_link) THEN IF (iw > 0) WRITE (iw, fmt='(A)', ADVANCE="NO") " QM/MM link detected..." IF (.NOT. qmmm_env%qmmm_link) THEN - IF (iw > 0) WRITE (iw, fmt='(A)') " Missing LINK section in input file!" - WRITE (output_unit, '(T2,"QMMM_CONNECTIVITY|",A)') & - " ERROR in the QM/MM connectivity. A QM/MM LINK was detected but", & - " no LINK section was provided in the Input file!", & - " This very probably can be identified as an error in the specified QM", & - " indexes or in a missing LINK section. Check your structure!" - CPABORT("") + CALL cp_abort(__LOCATION__, & + "ERROR in the QM/MM connectivity: a QM/MM LINK was detected but "// & + "no LINK section was provided in the Input file! "// & + "This very probably can be identified as an error in the specified QM "// & + "indexes or in a missing LINK section. Check your structure!") END IF END IF qm_molecule_index(qm_mol_num) = imolecule diff --git a/src/qs_chargemol.F b/src/qs_chargemol.F index 75df9fa3ce..32f7c50516 100644 --- a/src/qs_chargemol.F +++ b/src/qs_chargemol.F @@ -640,9 +640,7 @@ CONTAINS IF (mos(1)%use_mo_coeff_b) THEN DO ispin = 1, SIZE(mos) - IF (.NOT. ASSOCIATED(mos(ispin)%mo_coeff_b)) THEN - CPASSERT(.FALSE.) - END IF + CPASSERT(ASSOCIATED(mos(ispin)%mo_coeff_b)) CALL copy_dbcsr_to_fm(mos(ispin)%mo_coeff_b, & mos(ispin)%mo_coeff) END DO diff --git a/src/qs_collocate_density.F b/src/qs_collocate_density.F index 52ae851f7a..57925e0e86 100644 --- a/src/qs_collocate_density.F +++ b/src/qs_collocate_density.F @@ -269,7 +269,9 @@ CONTAINS n = coset(2, 2, 2) pab(n, 1) = 6._dp*cval_nlcc(4, iexp_nlcc)/alpha**6 CASE DEFAULT - CPABORT("") + CALL cp_abort(__LOCATION__, & + "Only 1, 2, 3, 4 are supported as the "// & + "value of j in calculate_rho_nlcc") END SELECT END DO IF (dft_control%nspins == 2) pab = pab*0.5_dp @@ -441,7 +443,9 @@ CONTAINS n = coset(2, 2, 2) pab(n, 1) = 6._dp*cexp_ppl(4) CASE DEFAULT - CPABORT("") + CALL cp_abort(__LOCATION__, & + "Only 1, 2, 3, 4 are supported as the "// & + "value of j in calculate_ppl_grid") END SELECT END DO diff --git a/src/qs_dftb_dispersion.F b/src/qs_dftb_dispersion.F index 73912265af..33199ebf94 100644 --- a/src/qs_dftb_dispersion.F +++ b/src/qs_dftb_dispersion.F @@ -87,7 +87,7 @@ CONTAINS CALL calculate_dispersion_pairpot(qs_env, dispersion_env, & energy%dispersion, calculate_forces) CASE DEFAULT - CPABORT("") + CPABORT("Unknown dispersion type for DFTB") END SELECT END IF diff --git a/src/qs_dftb_matrices.F b/src/qs_dftb_matrices.F index e0b09c9297..01ef48f19f 100644 --- a/src/qs_dftb_matrices.F +++ b/src/qs_dftb_matrices.F @@ -663,9 +663,7 @@ CONTAINS DO ispin = 1, SIZE(mo_derivs) CALL get_mo_set(mo_set=mo_array(ispin), & mo_coeff_b=mo_coeff, occupation_numbers=occupation_numbers) - IF (.NOT. mo_array(ispin)%use_mo_coeff_b) THEN - CPABORT("") - END IF + CPASSERT(mo_array(ispin)%use_mo_coeff_b) CALL dbcsr_multiply('n', 'n', 1.0_dp, ks_matrix(ispin, 1)%matrix, mo_coeff, & 0.0_dp, mo_derivs(ispin)%matrix) END DO diff --git a/src/qs_dftb_parameters.F b/src/qs_dftb_parameters.F index 3ef0460821..35c95324c7 100644 --- a/src/qs_dftb_parameters.F +++ b/src/qs_dftb_parameters.F @@ -306,7 +306,7 @@ CONTAINS DO l = 0, 3 SELECT CASE (l) CASE DEFAULT - CPABORT("") + CPABORT("Only 0, 1, 2 are supported as the value of l") CASE (0) lp = 10 CASE (1) @@ -700,7 +700,9 @@ CONTAINS RETURN 1 CONTINUE - CPABORT("") + ! Many instances of READ (..., END=1, err=1) gets conflated here + ! TODO: overhaul the file parser to handle errors separately + CPABORT("Something went wrong while reading DFTB parameter file") END SUBROUTINE qs_dftb_param_init diff --git a/src/qs_dispersion_utils.F b/src/qs_dispersion_utils.F index 37de5f717c..22de392510 100644 --- a/src/qs_dispersion_utils.F +++ b/src/qs_dispersion_utils.F @@ -504,7 +504,7 @@ CONTAINS SELECT CASE (dispersion_env%nl_type) CASE DEFAULT ! unknown functional - CPABORT("") + CPABORT("Unknown vdW nonlocal functional") CASE (vdw_nl_DRSLL) WRITE (output_unit, & fmt="(' vdW POTENTIAL| ','DRSLL Functional: M. Dion et al, PRL 92: 246401 (2004)')") diff --git a/src/qs_dos.F b/src/qs_dos.F index 1ce4d882ba..651c9e1813 100644 --- a/src/qs_dos.F +++ b/src/qs_dos.F @@ -330,7 +330,7 @@ CONTAINS CHARACTER(LEN=16) :: energy_label, fmtstr_data CHARACTER(LEN=32) :: zero_label - CHARACTER(LEN=default_string_length) :: my_act, my_pos + CHARACTER(LEN=default_string_length) :: err, my_act, my_pos INTEGER :: broaden_type, energy_unit, energy_zero, fractional_occupation_int, handle, i, ik, & iounit, ispin, iterstep, iv, iw, ndigits, nhist, nmo(2), nmo_kp, nspins, & resolved_energy_zero @@ -368,9 +368,9 @@ CONTAINS ! make sure is a valid grid DO i = 1, 3 IF (nkp_grid(i) < 1) THEN - WRITE (UNIT=iounit, FMT='(T4,A,I3,A,I1)') & + WRITE (UNIT=err, FMT='(T4,A,I3,A,I1)') & "Invalid kpoint grid for DOS ", nkp_grid(i), " in dimension ", i - CPABORT("") + CPABORT(TRIM(err)) END IF END DO ! calculate orbitals and energies diff --git a/src/qs_fb_filter_matrix_methods.F b/src/qs_fb_filter_matrix_methods.F index 1970018782..1be7bcdc2a 100644 --- a/src/qs_fb_filter_matrix_methods.F +++ b/src/qs_fb_filter_matrix_methods.F @@ -1264,6 +1264,7 @@ CONTAINS CHARACTER(LEN=*), PARAMETER :: routineN = 'fb_fltrmat_build_atomic_fltrmat' + CHARACTER(LEN=default_string_length) :: err INTEGER :: handle, handle_dgemm, handle_dsygv, ii, & info, jj, mat_dim, work_array_size LOGICAL :: check_ok @@ -1317,8 +1318,8 @@ CONTAINS work, work_array_size, info) ! check if diagonalisation is successful IF (info /= 0) THEN - WRITE (*, *) "DSYGV ERROR MESSAGE: ", info - CPABORT("DSYGV failed") + WRITE (err, *) "DSYGV failed with non-zero exit status ", info + CPABORT(TRIM(err)) END IF CALL timestop(handle_dsygv) diff --git a/src/qs_force_types.F b/src/qs_force_types.F index 8821f20637..0dbdadff79 100644 --- a/src/qs_force_types.F +++ b/src/qs_force_types.F @@ -468,7 +468,10 @@ CONTAINS END DO END DO CASE DEFAULT - CPABORT("") + CALL cp_abort(__LOCATION__, & + " is supported as the "// & + "for add_qs_force, found unknown option "// & + "<"//TRIM(forcetype)//">") END SELECT END SUBROUTINE add_qs_force @@ -506,7 +509,10 @@ CONTAINS END DO END DO CASE DEFAULT - CPABORT("") + CALL cp_abort(__LOCATION__, & + " is supported as the "// & + "for put_qs_force, found unknown option "// & + "<"//TRIM(forcetype)//">") END SELECT END SUBROUTINE put_qs_force @@ -544,7 +550,10 @@ CONTAINS END DO END DO CASE DEFAULT - CPABORT("") + CALL cp_abort(__LOCATION__, & + " is supported as the "// & + "for get_qs_force, found unknown option "// & + "<"//TRIM(forcetype)//">") END SELECT END SUBROUTINE get_qs_force diff --git a/src/qs_initial_guess.F b/src/qs_initial_guess.F index 65b089ad50..5c5acca6c7 100644 --- a/src/qs_initial_guess.F +++ b/src/qs_initial_guess.F @@ -360,7 +360,6 @@ CONTAINS IF (dft_control%correct_el_density_dip) THEN tot_corr_zeff = qs_env%total_zeff_corr - !WRITE(*,*) "tot_corr_zeff = ", tot_corr_zeff IF ((ABS(tot_corr_zeff) > 0.0_dp) .AND. (density_guess /= restart_guess)) THEN CALL cp_warn(__LOCATION__, & "Use SCF_GUESS RESTART in conjunction with "// & @@ -780,8 +779,12 @@ CONTAINS IF (density_guess == sparse_guess) THEN - IF (ofgpw) CPABORT("SPARSE_GUESS not implemented for OFGPW") - IF (.NOT. scf_control%use_ot) CPABORT("OT needed!") + IF (ofgpw) THEN + CPABORT("calculate_first_density_matrix: sparse_guess not implemented for OFGPW") + END IF + IF (.NOT. scf_control%use_ot) THEN + CPABORT("calculate_first_density_matrix: sparse_guess implemented for OT only") + END IF IF (do_kpoints) THEN CPABORT("calculate_first_density_matrix: sparse_guess not implemented for k-points") END IF @@ -910,9 +913,8 @@ CONTAINS ! nmo_tmp = nmo_tmp - n_cols natoms_tmp = natoms_tmp - 1 - IF (nmo_tmp < 0 .OR. natoms_tmp < 0) THEN - CPABORT("Wrong1!") - END IF + CPASSERT(nmo_tmp >= 0) + CPASSERT(natoms_tmp >= 0) DO j = 1, n_cols CALL dlarnv(1, iseed, n_rows, buff(1, j)) END DO @@ -922,9 +924,7 @@ CONTAINS END DO END DO - IF (istart_col <= nmo) THEN - CPABORT("Wrong2!") - END IF + CPASSERT(istart_col > nmo) DEALLOCATE (buff, nelec_kind, sort_kind) @@ -933,7 +933,9 @@ CONTAINS DO i = 1, nmo CALL cp_fm_get_submatrix(mo_coeff, buff, 1, i, nao, 1) IF (SUM(buff**2) < 1E-10_dp) THEN - WRITE (*, *) 'wrong', i, SUM(buff**2) + IF (ounit > 0) THEN + WRITE (ounit, *) 'wrong', i, SUM(buff**2) + END IF END IF length = SQRT(DOT_PRODUCT(buff(:, 1), buff(:, 1))) buff(:, :) = buff(:, :)/length @@ -942,16 +944,18 @@ CONTAINS length = SQRT(DOT_PRODUCT(buff2(:, 1), buff2(:, 1))) buff2(:, :) = buff2(:, :)/length IF (ABS(DOT_PRODUCT(buff(:, 1), buff2(:, 1)) - 1.0_dp) < 1E-10_dp) THEN - WRITE (*, *) 'wrong2', i, j, DOT_PRODUCT(buff(:, 1), buff2(:, 1)) - DO ikind = 1, nao - IF (ABS(mo_coeff%local_data(ikind, i)) > 1e-10_dp) THEN - WRITE (*, *) 'c1', ikind, mo_coeff%local_data(ikind, i) - END IF - IF (ABS(mo_coeff%local_data(ikind, j)) > 1e-10_dp) THEN - WRITE (*, *) 'c2', ikind, mo_coeff%local_data(ikind, j) - END IF - END DO - CPABORT("") + IF (ounit > 0) THEN + WRITE (ounit, *) 'wrong2', i, j, DOT_PRODUCT(buff(:, 1), buff2(:, 1)) + DO ikind = 1, nao + IF (ABS(mo_coeff%local_data(ikind, i)) > 1e-10_dp) THEN + WRITE (ounit, *) 'c1', ikind, mo_coeff%local_data(ikind, i) + END IF + IF (ABS(mo_coeff%local_data(ikind, j)) > 1e-10_dp) THEN + WRITE (ounit, *) 'c2', ikind, mo_coeff%local_data(ikind, j) + END IF + END DO + END IF + CPABORT("Something went wrong with sparse_guess!") END IF END DO END DO @@ -1326,7 +1330,7 @@ CONTAINS pdiag(isgfa + 14) = econf(3)/7._dp pdiag(isgfa + 15) = econf(3)/7._dp CASE DEFAULT - CPABORT("") + CPABORT("Only 0, 1, 2, 3 are supported as the value of la") END SELECT END DO END DO @@ -1400,7 +1404,10 @@ CONTAINS END IF END IF CASE DEFAULT - CPABORT("") + CALL cp_abort(__LOCATION__, & + "Only 1 for s-basis, 4 for sp-basis and 9 for spd-basis "// & + "are supported as the value of nsgf in the MOPAC type "// & + "guess for semi-empirical methods") END SELECT END DO ELSE diff --git a/src/qs_integrate_potential_single.F b/src/qs_integrate_potential_single.F index 8e074db968..e02ab0e4ff 100644 --- a/src/qs_integrate_potential_single.F +++ b/src/qs_integrate_potential_single.F @@ -210,7 +210,9 @@ CONTAINS n = coset(2, 2, 2) pab(n, 1) = 6._dp*cexp_ppl(4) CASE DEFAULT - CPABORT("") + CALL cp_abort(__LOCATION__, & + "Only 1, 2, 3, 4 are supported as the "// & + "value of j in integrate_ppl_rspace") END SELECT END DO @@ -406,7 +408,9 @@ CONTAINS n = coset(2, 2, 2) pab(n, 1) = 6._dp*cval_nlcc(4, iexp_nlcc)/alpha**6 CASE DEFAULT - CPABORT("") + CALL cp_abort(__LOCATION__, & + "Only 1, 2, 3, 4 are supported as the "// & + "value of j in integrate_rho_nlcc") END SELECT END DO IF (dft_control%nspins == 2) pab = pab*0.5_dp diff --git a/src/qs_kind_types.F b/src/qs_kind_types.F index d554c4fd3a..8928bc4553 100644 --- a/src/qs_kind_types.F +++ b/src/qs_kind_types.F @@ -3257,7 +3257,7 @@ CONTAINS CALL write_orb_basis_set(tmp_basis, output_unit, "Nuclear Soft Basis Set") END IF ELSE - CPABORT("") + CPABORT("write_qs_kind requires qs_kind to be associated") END IF END IF @@ -3296,7 +3296,7 @@ CONTAINS CALL write_qs_kind(qs_kind, ikind, output_unit) END DO ELSE - CPABORT("") + CPABORT("write_qs_kind_set requires qs_kind_set to be associated") END IF END IF @@ -3386,7 +3386,7 @@ CONTAINS END DO ELSE - CPABORT("") + CPABORT("write_gto_basis_sets require qs_kind_set to be associated") END IF END IF diff --git a/src/qs_kinetic.F b/src/qs_kinetic.F index 283b04abbf..b743911176 100644 --- a/src/qs_kinetic.F +++ b/src/qs_kinetic.F @@ -238,7 +238,7 @@ CONTAINS nimg = dft_control%nimages END IF ELSE - CPABORT("") + CPABORT("Either matrix_t or matrixkp_t is needed for build_kinetic_matrix_low") END IF nkind = SIZE(atomic_kind_set) diff --git a/src/qs_ks_utils.F b/src/qs_ks_utils.F index 5a09b8b9ce..98755af9bf 100644 --- a/src/qs_ks_utils.F +++ b/src/qs_ks_utils.F @@ -617,7 +617,7 @@ CONTAINS END DO CASE DEFAULT - CPABORT("") + CPABORT("Unknown dft_control%sic_list_id") END SELECT ! data needed for each of the orbs diff --git a/src/qs_linres_current.F b/src/qs_linres_current.F index 0b3b4f9148..400cc30712 100644 --- a/src/qs_linres_current.F +++ b/src/qs_linres_current.F @@ -1363,7 +1363,7 @@ CONTAINS offset = MODULO(cubecenter(i) + lb_cube(i) + rsgrid%desc%lb(i) - rsgrid%lb_local(i), ng(i)) + 1 - lb_cube(i) ! check for out of bounds IF (ub_cube(i) + offset > UBOUND(grid, i) .OR. lb_cube(i) + offset < LBOUND(grid, i)) THEN - CPASSERT(.FALSE.) + CPABORT("Cube bound out of grid bounds") END IF DO ig = lb_cube(i), ub_cube(i) map(ig, i) = ig + offset @@ -1925,7 +1925,7 @@ CONTAINS WRITE (*, *) 'error too many atoms' WRITE (*, *) 'dist=', ABS(r(:)) WRITE (*, *) 'large_dist=', (scale + 0.5_dp)*dbox - CPABORT("") + CPABORT("Some atoms are too far from box center") END IF END DO END IF @@ -1958,7 +1958,7 @@ CONTAINS WRITE (*, *) 'box_center', box_center WRITE (*, *) 'ratom', ratom(:, iatom) WRITE (*, *) 'gauge_atom_radius', gauge_atom_radius - CPABORT("") + CPABORT("Some atoms are too close within gauge_atom_radius") END IF END IF END DO diff --git a/src/qs_mo_io.F b/src/qs_mo_io.F index e4fc2ecf46..4504787e02 100644 --- a/src/qs_mo_io.F +++ b/src/qs_mo_io.F @@ -142,9 +142,7 @@ CONTAINS ! we are using the dbcsr mo_coeff ! we copy it to the fm for anycase DO ispin = 1, SIZE(mo_array) - IF (.NOT. ASSOCIATED(mo_array(ispin)%mo_coeff_b)) THEN - CPASSERT(.FALSE.) - END IF + CPASSERT(ASSOCIATED(mo_array(ispin)%mo_coeff_b)) CALL copy_dbcsr_to_fm(mo_array(ispin)%mo_coeff_b, & mo_array(ispin)%mo_coeff) !fm->dbcsr END DO diff --git a/src/qs_moments.F b/src/qs_moments.F index 2c45f347ea..6a8ac14ccf 100644 --- a/src/qs_moments.F +++ b/src/qs_moments.F @@ -1479,7 +1479,7 @@ CONTAINS row=irow, col=icol, BLOCK=sblock, found=found) IF (ASSOCIATED(cblock) .AND. .NOT. ASSOCIATED(sblock) .OR. & .NOT. ASSOCIATED(cblock) .AND. ASSOCIATED(sblock)) THEN - CPABORT("") + CPABORT("cblock and sblock should both be present for contract_cossin") END IF IF (ASSOCIATED(cblock) .AND. ASSOCIATED(sblock)) THEN diff --git a/src/qs_neighbor_list_types.F b/src/qs_neighbor_list_types.F index e8f38064ab..c77afac074 100644 --- a/src/qs_neighbor_list_types.F +++ b/src/qs_neighbor_list_types.F @@ -322,7 +322,7 @@ CONTAINS nnode = 0 END IF ELSE - CPABORT("") + CPABORT("iterator%list_search is not available") END IF iterator%ikind = ikind diff --git a/src/qs_neighbor_lists.F b/src/qs_neighbor_lists.F index 5b094b1e9b..4c8e38cf4f 100644 --- a/src/qs_neighbor_lists.F +++ b/src/qs_neighbor_lists.F @@ -1132,7 +1132,10 @@ CONTAINS CASE ("PP") otype = 4 ! simple atomic pair potential list CASE default - CPABORT("") + CALL cp_abort(__LOCATION__, & + ", , , are supported as the "// & + "for build_neighbor_lists, found unknown option "// & + "<"//TRIM(operator_type)//">") END SELECT ELSE ! default is a simple AB neighbor list @@ -1211,7 +1214,7 @@ CONTAINS nlistb(ikind) = SIZE(atom(ikind)%list) listb(ikind)%list => index_list CASE default - CPABORT("") + CPABORT("Only 1, 2, 3, 4 are supported as otype for the operator") END SELECT END DO @@ -1445,7 +1448,7 @@ CONTAINS DEALLOCATE (lista(ikind)%list) END DO CASE default - CPABORT("") + CPABORT("Only 1, 2, 3, 4 are supported as otype for the operator") END SELECT DEALLOCATE (kind_a, pres_a, pres_b, lista, listb, nlista, nlistb) DEALLOCATE (index_list) diff --git a/src/qs_operators_ao.F b/src/qs_operators_ao.F index 90075e7be8..4e658993fb 100644 --- a/src/qs_operators_ao.F +++ b/src/qs_operators_ao.F @@ -1392,9 +1392,7 @@ CONTAINS CPASSERT(ASSOCIATED(op)) CPASSERT(ASSOCIATED(op_der)) !IF(.NOT.op_sm_der(1,1)%matrix%symmetry=="none") THEN - IF (.NOT. dbcsr_get_matrix_type(op_der(1, 1)%matrix) == dbcsr_type_no_symmetry) THEN - CPABORT("") - END IF + CPASSERT(dbcsr_get_matrix_type(op_der(1, 1)%matrix) == dbcsr_type_no_symmetry) NULLIFY (qs_kind, qs_kind_set) NULLIFY (cell, particle_set) diff --git a/src/qs_outer_scf.F b/src/qs_outer_scf.F index 7127158c90..1b4a93e52d 100644 --- a/src/qs_outer_scf.F +++ b/src/qs_outer_scf.F @@ -165,7 +165,7 @@ CONTAINS scf_env%outer_scf%gradient(:, ihistory) = return_basis_center_gradient_norm(qs_env) CASE DEFAULT - CPABORT("") + CPABORT("Unknown outer SCF type") END SELECT @@ -365,7 +365,7 @@ CONTAINS scf_control%outer_scf%cdft_opt_control%newton_step* & MATMUL(inv_jacobian, scf_env%outer_scf%gradient(:, ihistory)) CASE DEFAULT - CPABORT("") + CPABORT("Unknown outer SCF optimizer") END SELECT EXIT END DO @@ -422,7 +422,7 @@ CONTAINS CASE (outer_scf_basis_center_opt) CALL qs_update_basis_center_pos(qs_env) CASE DEFAULT - CPABORT("") + CPABORT("Unknown outer SCF type") END SELECT CALL timestop(handle) @@ -489,7 +489,7 @@ CONTAINS CASE (outer_scf_basis_center_opt) outer_scf_history(1, ivec) = 0.0_dp CASE DEFAULT - CPABORT("") + CPABORT("Unknown outer SCF type") END SELECT CALL set_qs_env(qs_env, outer_scf_ihistory=outer_scf_ihistory) ! multilinear extrapolation @@ -516,7 +516,7 @@ CONTAINS CASE (outer_scf_basis_center_opt) ! nothing to do CASE DEFAULT - CPABORT("") + CPABORT("Unknown outer SCF type") END SELECT DEALLOCATE (extrapolation) @@ -635,7 +635,7 @@ CONTAINS scf_env%outer_scf%inv_jacobian = cdft_control%constraint%inv_jacobian END IF CASE DEFAULT - CPABORT("") + CPABORT("Switching direction should be either ot2cdft or cdft2ot") END SELECT END SUBROUTINE outer_loop_switch diff --git a/src/qs_overlap.F b/src/qs_overlap.F index 3bc52c5249..857850a5bf 100644 --- a/src/qs_overlap.F +++ b/src/qs_overlap.F @@ -253,7 +253,7 @@ CONTAINS nimg = dft_control%nimages END IF ELSE - CPABORT("") + CPABORT("Either matrix_s or matrixkp_s is needed for build_overlap_matrix_low") END IF nkind = SIZE(qs_kind_set) @@ -472,7 +472,7 @@ CONTAINS lb_max(jset), lb_min(jset), npgfb(jset), rpgfb(:, jset), zetb(:, jset), & rab, sab=oint(:, :, 1), dab=oint(:, :, 2:4), ddab=oint(:, :, 5:10)) CASE DEFAULT - CPABORT("") + CPABORT("Only 0, 1, 2 are supported as nder in build_overlap_matrix_low") END SELECT IF (do_forces .AND. ASSOCIATED(p_block) .AND. ((iatom /= jatom) .OR. use_virial)) THEN ! Decontract P matrix block @@ -874,7 +874,7 @@ CONTAINS CALL get_kpoint_info(kpoint=kpoints, cell_to_index=cell_to_index) use_cell_mapping = (SIZE(cell_to_index) > 1) ELSE - CPABORT("") + CPABORT("Either matrix_p or matrixkp_p is needed for build_overlap_force") END IF nkind = SIZE(qs_kind_set) diff --git a/src/qs_scf_output.F b/src/qs_scf_output.F index 4cbcb2e85c..203abdc458 100644 --- a/src/qs_scf_output.F +++ b/src/qs_scf_output.F @@ -1144,7 +1144,7 @@ CONTAINS CASE (outer_scf_optimizer_secant) WRITE (output_unit, '(A)') " Minimizer : Secant" CASE DEFAULT - CPABORT("") + CPABORT("Unknown CDFT outer_scf optimizer") END SELECT WRITE (output_unit, '(/,A,L7)') & " Reusing OT preconditioner: ", cdft_control%reuse_precond diff --git a/src/qs_wf_history_types.F b/src/qs_wf_history_types.F index 7cde716bfe..b28d39e4f9 100644 --- a/src/qs_wf_history_types.F +++ b/src/qs_wf_history_types.F @@ -264,7 +264,7 @@ CONTAINS CPASSERT(ASSOCIATED(wf_history)) CPASSERT(ASSOCIATED(wf_history%past_states)) IF (wf_index > wf_history%memory_depth .OR. wf_index > wf_history%snapshot_count) THEN - CPABORT("") + CPABORT("Requested wavefunction index not available in history") END IF res => wf_history%past_states( & MODULO(wf_history%snapshot_count + 1 - wf_index, & diff --git a/src/rpa_util.F b/src/rpa_util.F index 7770647fdf..78b4844274 100644 --- a/src/rpa_util.F +++ b/src/rpa_util.F @@ -855,7 +855,7 @@ CONTAINS CALL cp_fm_syrk(uplo='U', trans='N', k=dimen_ia, alpha=alpha, matrix_a=fm_mat_S, & ia=1, ja=1, beta=0.0_dp, matrix_c=fm_mat_Q_gemm) CASE DEFAULT - CPABORT("") + CPABORT("Unknown mm_style for contract_S_to_Q") END SELECT CALL dgemm_counter_stop(dgemm_counter, dimen_RI, dimen_RI, dimen_ia) diff --git a/src/s_square_methods.F b/src/s_square_methods.F index ddf45ccd45..9a2f1a9d28 100644 --- a/src/s_square_methods.F +++ b/src/s_square_methods.F @@ -214,9 +214,9 @@ CONTAINS energy = s2_restraint_control%strength*(s_square - s2_restraint_control%target) s2_restraint_control%s2_order_p = s_square CASE (do_s2_restraint) ! not yet implemented - CPABORT("") + CPABORT("do_s2_restraint for not yet implemented") CASE DEFAULT - CPABORT("") + CPABORT("Unknown constraint/restraint form") END SELECT CALL timestop(handle) diff --git a/src/sap_kind_types.F b/src/sap_kind_types.F index 52f407068a..9f268ac644 100644 --- a/src/sap_kind_types.F +++ b/src/sap_kind_types.F @@ -152,7 +152,7 @@ CONTAINS ELSE IF (i == 0) THEN NULLIFY (alist) ELSE - CPABORT("") + CPABORT("Invalid result of locate(sap_int%asort, atom)") END IF END SUBROUTINE get_alist diff --git a/src/scf_control_types.F b/src/scf_control_types.F index d0adbf13a5..527bb5e81f 100644 --- a/src/scf_control_types.F +++ b/src/scf_control_types.F @@ -757,7 +757,7 @@ CONTAINS CASE (outer_scf_cdft_constraint) CPABORT("CDFT constraints must be defined in QS&CDFT") CASE DEFAULT - CPABORT("") + CPABORT("Unknown outer SCF type") END SELECT WRITE (output_unit, '(T25,A,T72,ES9.2)') "eps_scf", scf_control%outer_scf%eps_scf WRITE (output_unit, '(T25,A,T72,I9)') "max_scf", scf_control%outer_scf%max_scf @@ -779,7 +779,7 @@ CONTAINS CASE (outer_scf_optimizer_secant) WRITE (output_unit, '(T25,A)') "Optimization with the secant method" CASE DEFAULT - CPABORT("") + CPABORT("Unknown outer SCF optimizer") END SELECT WRITE (output_unit, '(T25,A,T72,ES9.2)') "step_size", scf_control%outer_scf%step_size ELSE diff --git a/src/se_core_core.F b/src/se_core_core.F index b7b6747001..d509bd8474 100644 --- a/src/se_core_core.F +++ b/src/se_core_core.F @@ -224,7 +224,7 @@ CONTAINS force(jkind)%all_potential(3, atom_b) = force(jkind)%all_potential(3, atom_b) + force_ab(3) END IF CASE DEFAULT - CPABORT("") + CPABORT("Unknown method for semi-empirical calculation") END SELECT ELSE IF (se_int_control%do_ewald_gks) THEN diff --git a/src/se_core_matrix.F b/src/se_core_matrix.F index bba1f6921e..2c53f7ca31 100644 --- a/src/se_core_matrix.F +++ b/src/se_core_matrix.F @@ -258,7 +258,7 @@ CONTAINS SELECT CASE (dft_control%qs_control%method_id) CASE DEFAULT - CPABORT("") + CPABORT("Unknown method for semi-empirical calculation") CASE (do_method_am1, do_method_rm1, do_method_mndo, do_method_pdg, & do_method_pm3, do_method_pm6, do_method_pm6fm, do_method_mndod, do_method_pnnl) DO i = 1, SIZE(h_blocka, 1) diff --git a/src/se_fock_matrix.F b/src/se_fock_matrix.F index 69feb941f9..a3374641e5 100644 --- a/src/se_fock_matrix.F +++ b/src/se_fock_matrix.F @@ -245,9 +245,7 @@ CONTAINS DO ispin = 1, SIZE(mo_derivs) CALL get_mo_set(mo_set=mo_array(ispin), & mo_coeff_b=mo_coeff, occupation_numbers=occupation_numbers) - IF (.NOT. mo_array(ispin)%use_mo_coeff_b) THEN - CPABORT("") - END IF + CPASSERT(mo_array(ispin)%use_mo_coeff_b) CALL dbcsr_get_info(mo_coeff, nfullcols_total=ncol_global) CALL dbcsr_multiply('n', 'n', 1.0_dp, ks_matrix(ispin)%matrix, mo_coeff, & 0.0_dp, mo_derivs(ispin)%matrix) diff --git a/src/se_fock_matrix_coulomb.F b/src/se_fock_matrix_coulomb.F index 51805c93cd..cea85e2bfc 100644 --- a/src/se_fock_matrix_coulomb.F +++ b/src/se_fock_matrix_coulomb.F @@ -398,7 +398,7 @@ CONTAINS force(jkind)%rho_elec(3, atom_b) = force(jkind)%rho_elec(3, atom_b) + force_ab(3) END IF CASE DEFAULT - CPABORT("") + CPABORT("Unknown semi-empirical method for build_fock_matrix_coulomb") END SELECT ELSE IF (se_int_control%do_ewald_gks) THEN @@ -570,7 +570,7 @@ CONTAINS do_method_rm1, do_method_mndod, do_method_pnnl) itype = get_se_type(dft_control%qs_control%method_id) CASE DEFAULT - CPABORT("") + CPABORT("Unknown semi-empirical method for build_fock_matrix_coulomb_lr") END SELECT ! Zero arrays and possibly build neighbor lists @@ -590,7 +590,7 @@ CONTAINS CASE (do_multipole_quadrupole) task = .TRUE. CASE DEFAULT - CPABORT("") + CPABORT("Only none, charge, dipole and quadrupole are supported") END SELECT ! Build-up neighbor lists for real-space part of Ewald multipoles @@ -1139,7 +1139,7 @@ CONTAINS force(jkind)%rho_elec(3, atom_b) = force(jkind)%rho_elec(3, atom_b) + force_ab(3) END IF CASE DEFAULT - CPABORT("") + CPABORT("Unknown semi-empirical method for build_fock_matrix_coul_lrc") END SELECT END IF END DO @@ -1474,7 +1474,7 @@ CONTAINS force(jkind)%rho_elec(3, atom_b) = force(jkind)%rho_elec(3, atom_b) + force_ab(3) END IF CASE DEFAULT - CPABORT("") + CPABORT("Unknown semi-empirical method for build_fock_matrix_coul_lr_r3") END SELECT END IF END DO diff --git a/src/semi_empirical_int3_utils.F b/src/semi_empirical_int3_utils.F index d2066bcda0..0dd4f77bab 100644 --- a/src/semi_empirical_int3_utils.F +++ b/src/semi_empirical_int3_utils.F @@ -157,7 +157,7 @@ CONTAINS RETURN END IF ! We should NEVER reach this point - CPABORT("") + CPABORT("Either l1 or l2 is nonzero for charg_int_3") END FUNCTION charg_int_3 ! ************************************************************************************************** @@ -192,7 +192,7 @@ CONTAINS RETURN END IF ! We should NEVER reach this point - CPABORT("") + CPABORT("Either l1 or l2 is nonzero for coeff_int_3") END FUNCTION coeff_int_3 ! ************************************************************************************************** @@ -226,7 +226,7 @@ CONTAINS RETURN END IF ! We should NEVER reach this point - CPABORT("") + CPABORT("Either l1 or l2 is nonzero for dcharg_int_3") END FUNCTION dcharg_int_3 END MODULE semi_empirical_int3_utils diff --git a/src/semi_empirical_int_utils.F b/src/semi_empirical_int_utils.F index c1160a94f9..2b1d31ec9f 100644 --- a/src/semi_empirical_int_utils.F +++ b/src/semi_empirical_int_utils.F @@ -560,7 +560,7 @@ CONTAINS RETURN END IF ! We should NEVER reach this point - CPABORT("") + CPABORT("Something went wrong with charg_int_nri") END FUNCTION charg_int_nri ! ************************************************************************************************** @@ -762,7 +762,7 @@ CONTAINS RETURN END IF ! We should NEVER reach this point - CPABORT("") + CPABORT("Something went wrong with dcharg_int_nri") END FUNCTION dcharg_int_nri ! ************************************************************************************************** @@ -967,7 +967,7 @@ CONTAINS RETURN END IF ! We should NEVER reach this point - CPABORT("") + CPABORT("Something went wrong with dcharg_int_nri_fs") END FUNCTION dcharg_int_nri_fs ! ************************************************************************************************** @@ -1394,7 +1394,7 @@ CONTAINS RETURN END IF ! We should NEVER reach this point - CPABORT("") + CPABORT("Something went wrong with charg_int_ri") END FUNCTION charg_int_ri ! ************************************************************************************************** @@ -1528,7 +1528,7 @@ CONTAINS RETURN END IF ! We should NEVER reach this point - CPABORT("") + CPABORT("Something went wrong with dcharg_int_ri") END FUNCTION dcharg_int_ri ! ************************************************************************************************** @@ -1666,7 +1666,7 @@ CONTAINS RETURN END IF ! We should NEVER reach this point - CPABORT("") + CPABORT("Something went wrong with dcharg_int_ri_fs") END FUNCTION dcharg_int_ri_fs ! ************************************************************************************************** @@ -2463,7 +2463,7 @@ CONTAINS END DO END DO ELSE - CPABORT("") + CPABORT("Something went wrong with store_2el_2c_diag") END IF END SUBROUTINE store_2el_2c_diag diff --git a/src/start/cp2k_runs.F b/src/start/cp2k_runs.F index a821b97a1f..7287947c5d 100644 --- a/src/start/cp2k_runs.F +++ b/src/start/cp2k_runs.F @@ -295,7 +295,7 @@ CONTAINS CASE (do_tree_mc_ana) CALL do_analyze_files(input_declaration, root_section, para_env) CASE default - CPABORT("") + CPABORT("Unknown program") END SELECT CALL section_vals_release(input_file) @@ -333,7 +333,7 @@ CONTAINS CASE (energy_force_run) CALL force_env_calc_energy_force(force_env, calc_force=.TRUE.) CASE default - CPABORT("") + CPABORT("Unknown run type") END SELECT CALL cp_rm_iter_level(sublogger%iter_info, level_name="JUST_ENERGY", n_rlevel_att=iter_level) CASE (mol_dyn_run) @@ -390,7 +390,7 @@ CONTAINS CASE (mimic_run) CALL do_mimic_loop(force_env) CASE default - CPABORT("") + CPABORT("Unknown run type") END SELECT ! Sample peak memory diff --git a/src/subcell_types.F b/src/subcell_types.F index fc35d5d361..3053c4c0a4 100644 --- a/src/subcell_types.F +++ b/src/subcell_types.F @@ -136,7 +136,7 @@ CONTAINS DEALLOCATE (subcell) ELSE - CPABORT("") + CPABORT("The subcell is not associated and cannot be deallocated") END IF END SUBROUTINE deallocate_subcell diff --git a/src/subsys/colvar_types.F b/src/subsys/colvar_types.F index 5bafc5324f..b7c28982d7 100644 --- a/src/subsys/colvar_types.F +++ b/src/subsys/colvar_types.F @@ -488,7 +488,7 @@ CONTAINS CASE (no_colvar_id) ! Do nothing CASE DEFAULT - CPABORT("") + CPABORT("Unknown colvar type") END SELECT END SUBROUTINE colvar_create @@ -1336,7 +1336,7 @@ CONTAINS CASE (no_colvar_id) ! Do nothing CASE default - CPABORT("") + CPABORT("Unknown colvar type") END SELECT DEALLOCATE (colvar) diff --git a/src/subsys/molecule_kind_types.F b/src/subsys/molecule_kind_types.F index a33561a3ea..232123e92e 100644 --- a/src/subsys/molecule_kind_types.F +++ b/src/subsys/molecule_kind_types.F @@ -287,7 +287,7 @@ CONTAINS CASE (combine_colvar_id) ncolv%ncombinecvs = ncolv%ncombinecvs + 1 CASE DEFAULT - CPABORT("") + CPABORT("Unknown colvar type") END SELECT END DO END IF diff --git a/src/subsys/multipole_types.F b/src/subsys/multipole_types.F index b04beafe39..1089bff3e5 100644 --- a/src/subsys/multipole_types.F +++ b/src/subsys/multipole_types.F @@ -85,7 +85,7 @@ CONTAINS CASE (do_multipole_quadrupole) multipoles%task(1:3) = .TRUE. CASE DEFAULT - CPABORT("") + CPABORT("Multipole supports only charge, dipole and quadrupole") END SELECT nparticles = SIZE(particle_set) IF (multipoles%task(1)) THEN diff --git a/src/task_list_methods.F b/src/task_list_methods.F index 447d7f6018..f7983f47a6 100644 --- a/src/task_list_methods.F +++ b/src/task_list_methods.F @@ -1429,7 +1429,7 @@ CONTAINS END IF END IF CASE DEFAULT - CPABORT("") + CPABORT("Unknown task list distribution type") END SELECT END DO diff --git a/src/tblite_ks_matrix.F b/src/tblite_ks_matrix.F index 924e88db2e..108df1f8b7 100644 --- a/src/tblite_ks_matrix.F +++ b/src/tblite_ks_matrix.F @@ -151,9 +151,7 @@ CONTAINS CALL get_qs_env(qs_env, mo_derivs=mo_derivs, mos=mo_array) DO ispin = 1, SIZE(mo_derivs) CALL get_mo_set(mo_set=mo_array(ispin), mo_coeff_b=mo_coeff) - IF (.NOT. mo_array(ispin)%use_mo_coeff_b) THEN - CPABORT("") - END IF + CPASSERT(mo_array(ispin)%use_mo_coeff_b) CALL dbcsr_multiply('n', 'n', 1.0_dp, ks_matrix(ispin, 1)%matrix, mo_coeff, & 0.0_dp, mo_derivs(ispin)%matrix) END DO diff --git a/src/tmc/tmc_master.F b/src/tmc/tmc_master.F index 58593a3dde..20811cce10 100644 --- a/src/tmc/tmc_master.F +++ b/src/tmc/tmc_master.F @@ -457,7 +457,7 @@ CONTAINS ! -- START_CONF_RESULT --------------- CASE (TMC_STAT_START_CONF_RESULT) ! start configuration should already be handeled - CPABORT("") + CPABORT("TMC_STAT_START_CONF_RESULT is invalid") ! -- ENERGY RESULT ----------------- CASE (TMC_STAT_APPROX_ENERGY_RESULT) nr_of_job(3) = nr_of_job(3) + 1 diff --git a/src/tmc/tmc_messages.F b/src/tmc/tmc_messages.F index 449e275498..82b36f4bdb 100644 --- a/src/tmc/tmc_messages.F +++ b/src/tmc/tmc_messages.F @@ -208,7 +208,7 @@ CONTAINS CALL para_env%send(m_send%task_real, dest, message_tag) END IF IF (m_send%info(4) > 0) THEN - CPABORT("") + CPABORT("Unable to send message when m_send%info(4) > 0") !TODO send characters CALL para_env%send(m_send%task_char, dest, message_tag) END IF IF (DEBUG >= 1) & @@ -238,7 +238,7 @@ CONTAINS END IF IF (m_send%info(4) > 0) THEN IF (.NOT. act_send_recv) ALLOCATE (m_send%task_char(m_send%info(3))) - CPABORT("") + CPABORT("Unable to broadcast message when m_send%info(4) > 0") !TODO bcast char CALL para_env%bcast(m_send%task_char, MASTER_COMM_ID) END IF END IF @@ -307,7 +307,7 @@ CONTAINS !-- receive message character part IF (m_send%info(4) > 0) THEN ALLOCATE (m_send%task_char(m_send%info(4))) - CPABORT("") + CPABORT("Unable to receive message when m_send%info(4) > 0") !TODO recv characters CALL para_env%recv(m_send%task_char, dest, message_tag) END IF END IF diff --git a/src/tmc/tmc_tree_acceptance.F b/src/tmc/tmc_tree_acceptance.F index 9002b577d6..939f31563c 100644 --- a/src/tmc/tmc_tree_acceptance.F +++ b/src/tmc/tmc_tree_acceptance.F @@ -104,7 +104,7 @@ CONTAINS CALL timeset(routineN, handle) IF (tmc_params%task_type == task_type_gaussian_adaptation) THEN - CPABORT("") + CPABORT("task_type_gaussian_adaptation not yet implemented") !TODO CALL acc_check_gauss_adapt(f=tree_element%potential, ct=tree_element%ekin_before_md, acc=accept) !DO NOT DO RETURN END IF diff --git a/src/tmc/tmc_tree_build.F b/src/tmc/tmc_tree_build.F index da2ae613d9..cea018160d 100644 --- a/src/tmc/tmc_tree_build.F +++ b/src/tmc/tmc_tree_build.F @@ -1084,7 +1084,7 @@ CONTAINS ! check if real top to bottom or bottom to top deallocation (no middle element deallocation) IF (ASSOCIATED(ptr%parent) .AND. & (ASSOCIATED(ptr%acc) .OR. ASSOCIATED(ptr%nacc))) THEN - CPABORT("") + CPABORT("Invalid association state of parent element") END IF IF (ready) THEN @@ -1383,9 +1383,7 @@ CONTAINS !-- new tree head has no parent IF (.NOT. ASSOCIATED(actual_ptr, end_of_clean_tree)) THEN ! in trajectory just one direction should exist - IF (ASSOCIATED(actual_ptr%acc) .AND. ASSOCIATED(actual_ptr%nacc)) THEN - CPABORT("") - END IF + CPASSERT(.NOT. (ASSOCIATED(actual_ptr%acc) .AND. ASSOCIATED(actual_ptr%nacc))) ! the parent should be deleted already, but global tree is allocated to the second last accepted, & ! hence there could be still a reference to an element... IF (.NOT. ASSOCIATED(actual_ptr%parent)) THEN diff --git a/src/topology.F b/src/topology.F index 25f5b75af9..b82782ec0a 100644 --- a/src/topology.F +++ b/src/topology.F @@ -648,7 +648,7 @@ CONTAINS CALL read_coordinate_cp2k(topology, para_env, subsys_section) CASE DEFAULT ! We should never reach this point.. - CPABORT("") + CPABORT("Option invalid or unavailable for reading coordinates") END SELECT ! Parse &COORD section and in case overwrite diff --git a/src/topology_amber.F b/src/topology_amber.F index 7a26a1d59a..8f9bbc4361 100644 --- a/src/topology_amber.F +++ b/src/topology_amber.F @@ -1624,8 +1624,7 @@ CONTAINS k(iphi) = pk(icp(iwork(1))) m(iphi) = NINT(pn(icp(iwork(1)))) IF (m(iphi) - pn(icp(iwork(1))) > EPSILON(1.0_dp)) THEN - ! non integer torsions not supported - CPABORT("") + CPABORT("Non-integer torsions not supported") END IF phi0(iphi) = phase(icp(iwork(1))) @@ -1658,8 +1657,7 @@ CONTAINS k(iphi) = pk(icp(iwork(i))) m(iphi) = NINT(pn(icp(iwork(i)))) IF (m(iphi) - pn(icp(iwork(i))) > EPSILON(1.0_dp)) THEN - ! non integer torsions not supported - CPABORT("") + CPABORT("Non-integer torsions not supported") END IF phi0(iphi) = phase(icp(iwork(i))) END IF diff --git a/src/topology_constraint_util.F b/src/topology_constraint_util.F index 2fae1dd1d9..b7d07a8b12 100644 --- a/src/topology_constraint_util.F +++ b/src/topology_constraint_util.F @@ -761,7 +761,7 @@ CONTAINS fixd_list(kk)%restraint%k0 = cons_info%fixed_mol_k0(k1loc) ELSE ! Should never reach this point - CPABORT("") + CPABORT("Unknown fix atom specification") END IF IF (fixd_list(kk)%restraint%active) THEN nfixd_restraint = nfixd_restraint + 1 @@ -1164,14 +1164,13 @@ CONTAINS ! Check for consistency in the constraint definition IF (ANY(lcolv(kk)%colvar%i_atom > last_atom) .OR. & ANY(lcolv(kk)%colvar%i_atom < first_atom)) THEN - WRITE (*, '(T5,"|",T8,A)') "Error in constraints setup!" - WRITE (*, '(T5,"|",T8,A)') "A constraint has been defined for a molecule type", & - " but the atoms specified in the constraint and the atoms defined for", & - " the molecule DO NOT match!", & - "This could be very probable due to a wrong connectivity, or an error", & - " in the constraint specification in the input file.", & - " Please check it carefully!" - CPABORT("") + CALL cp_abort(__LOCATION__, & + "Error in constraints setup! A constraint has been "// & + "defined for a molecule type, but the atoms specified "// & + "in the constraint and the atoms defined for the molecule "// & + "DO NOT match! This could be very probable due to a wrong "// & + "connectivity, or an error in the constraint specification "// & + "in the input file. Please check it carefully!") END IF END DO END SUBROUTINE setup_lcolv @@ -1214,14 +1213,13 @@ CONTAINS (g3x3_list(kk)%a + first_atom - 1 > last_atom) .OR. & (g3x3_list(kk)%b + first_atom - 1 > last_atom) .OR. & (g3x3_list(kk)%c + first_atom - 1 > last_atom)) THEN - WRITE (*, '(T5,"|",T8,A)') "Error in constraints setup!" - WRITE (*, '(T5,"|",T8,A)') "A constraint has been defined for a molecule type", & - " but the atoms specified in the constraint and the atoms defined for", & - " the molecule DO NOT match!", & - "This could be very probable due to a wrong connectivity, or an error", & - " in the constraint specification in the input file.", & - " Please check it carefully!" - CPABORT("") + CALL cp_abort(__LOCATION__, & + "Error in constraints setup! A constraint has been "// & + "defined for a molecule type, but the atoms specified "// & + "in the constraint and the atoms defined for the molecule "// & + "DO NOT match! This could be very probable due to a wrong "// & + "connectivity, or an error in the constraint specification "// & + "in the input file. Please check it carefully!") END IF END DO @@ -1276,14 +1274,13 @@ CONTAINS (g4x6_list(kk)%b + first_atom - 1 > last_atom) .OR. & (g4x6_list(kk)%c + first_atom - 1 > last_atom) .OR. & (g4x6_list(kk)%d + first_atom - 1 > last_atom)) THEN - WRITE (*, '(T5,"|",T8,A)') "Error in constraints setup!" - WRITE (*, '(T5,"|",T8,A)') "A constrained has been defined for a molecule type", & - " but the atoms specified in the constraint and the atoms defined for", & - " the molecule DO NOT match!", & - "This could be very probable due to a wrong connectivity, or an error", & - " in the constraint specification in the input file.", & - " Please check it carefully!" - CPABORT("") + CALL cp_abort(__LOCATION__, & + "Error in constraints setup! A constrained has been "// & + "defined for a molecule type, but the atoms specified "// & + "in the constraint and the atoms defined for the molecule "// & + "DO NOT match! This could be very probable due to a wrong "// & + "connectivity, or an error in the constraint specification "// & + "in the input file. Please check it carefully!") END IF END DO diff --git a/src/topology_coordinate_util.F b/src/topology_coordinate_util.F index fa04e75a46..e2a1b91768 100644 --- a/src/topology_coordinate_util.F +++ b/src/topology_coordinate_util.F @@ -98,7 +98,7 @@ CONTAINS CHARACTER(len=*), PARAMETER :: routineN = 'topology_coordinate_pack' - CHARACTER(LEN=default_string_length) :: atmname + CHARACTER(LEN=default_string_length) :: atmname, err INTEGER :: atom_i, atom_j, counter, dim0, dim1, & dim2, dim3, first, handle, handle2, i, & iatom, ikind, iw, j, k, last, & @@ -263,11 +263,12 @@ CONTAINS IF (ANY(kind_of == 0)) THEN DO i = 1, topology%natoms IF (kind_of(i) == 0) THEN - WRITE (*, *) i, kind_of(i) - WRITE (*, *) "Two molecules have been defined as identical molecules but atoms mismatch charges!" + WRITE (err, "(1X,I5)") i END IF END DO - CPABORT("") + CALL cp_abort(__LOCATION__, & + "Two molecules have been defined as identical molecules but atoms "// & + "mismatch charges! Check these atoms:"//TRIM(err)) END IF CALL timestop(handle2) @@ -798,7 +799,10 @@ CONTAINS CALL reallocate(ex_bond_list_w(j)%array1, 1, l) END DO CASE DEFAULT - CPABORT("") + CALL cp_abort(__LOCATION__, & + " is supported as the for "// & + "setup_exclusion_list, found unknown option "// & + "<"//TRIM(keyword)//">") END SELECT END SUBROUTINE setup_exclusion_list diff --git a/src/topology_generate_util.F b/src/topology_generate_util.F index a82cf6aedc..718c42ac9b 100644 --- a/src/topology_generate_util.F +++ b/src/topology_generate_util.F @@ -104,7 +104,7 @@ CONTAINS TYPE(array1_list_type), ALLOCATABLE, DIMENSION(:) :: atom_bond_list ! convert a simple list of bonds to a list of bonds per atom - ! (each bond is present in the forward and backward direction + ! (each bond is present in the forward and backward direction) ALLOCATE (atom_bond_list(natom)) DO i = 1, natom @@ -157,8 +157,7 @@ CONTAINS (TRIM(id2str(id_molname(i))) /= TRIM(molname))) THEN WRITE (*, *) "Atom (", i, ") has already a molecular name assigned ! ("//TRIM(id2str(id_molname(i)))//")." WRITE (*, *) "New molecular name would be: ("//TRIM(molname)//")." - WRITE (*, *) "Detecting something wrong in the molecular setup!" - CPABORT("") + CPABORT("Detecting something wrong in the molecular setup!") END IF END IF id_molname(i) = str2id(molname) @@ -286,7 +285,7 @@ CONTAINS IF (iw > 0) WRITE (iw, '(/,T2,A)') "Start of molecule generation" ! convert a simple list of bonds to a list of bonds per atom - ! (each bond is present in the forward and backward direction + ! (each bond is present in the forward and backward direction) ALLOCATE (atom_bond_list(natom)) DO I = 1, natom ALLOCATE (atom_bond_list(I)%array1(0)) @@ -667,7 +666,7 @@ CONTAINS " Present THRESHOLD (", my_maxrad*bondparm_factor, " )."// & " Present BONDLENGTH_MAX (", r_max(1, 1), " )" END IF - CPABORT("") + CPABORT("Unable to generate connectivity") END IF DO i = 1, natom particle_set(i)%atomic_kind => atomic_kind_set(1) @@ -857,7 +856,7 @@ CONTAINS " Present THRESHOLD (", my_maxrad*bondparm_factor, " )."// & " Present BONDLENGTH_MAX (", r_max(1, 1), " )" END IF - CPABORT("") + CPABORT("Unable to generate connectivity") END IF END DO IF (connectivity_ok .AND. (output_unit > 0)) THEN @@ -1115,7 +1114,7 @@ CONTAINS Ilist4 = Iarray4(1:nvar) CASE DEFAULT ! Should never reach this point - CPABORT("") + CPABORT("Only 2, 3, 4 are supported as the value of nsize") END SELECT CALL list_canonical_order(Ilist1, Ilist2, Ilist3, Ilist4, nsize, is_impr) ! @@ -1219,7 +1218,7 @@ CONTAINS DEALLOCATE (Ilist4) CASE DEFAULT ! Should never reach this point - CPABORT("") + CPABORT("Only 2, 3, 4 are supported as the value of nsize") END SELECT END IF END SUBROUTINE connectivity_external_control @@ -1704,12 +1703,12 @@ CONTAINS Oarray4(nvar) = Ilist(4) CASE DEFAULT !should never reach this point - CPABORT("") + CPABORT("Only 2, 3, 4 are supported as the value of it_levl") END SELECT Ilist(it_levl) = -1 ELSE !should never reach this point - CPABORT("") + CPABORT("it_levl exceeds max_levl in match_iterative_path") END IF END DO END IF diff --git a/src/topology_gromos.F b/src/topology_gromos.F index f04f6ce38c..d3ddfa9858 100644 --- a/src/topology_gromos.F +++ b/src/topology_gromos.F @@ -598,9 +598,7 @@ CONTAINS conn_info%c_bond_type(i) = conn_info%bond_type(ibond) END IF ELSE - IF (atom_info%id_molname(iatom) /= atom_info%id_molname(jatom)) THEN - CPABORT("") - END IF + CPASSERT(atom_info%id_molname(iatom) == atom_info%id_molname(jatom)) END IF END DO diff --git a/src/topology_input.F b/src/topology_input.F index de8c839b71..4aa95dfb4b 100644 --- a/src/topology_input.F +++ b/src/topology_input.F @@ -193,11 +193,15 @@ CONTAINS c_val=cons_info%const_g33_molname(ig)) END IF IF ((cons_info%const_g33_mol(ig) /= 0) .AND. (cons_info%const_g33_molname(ig) /= "UNDEF")) THEN - CPABORT("") + CALL cp_abort(__LOCATION__, & + "Invalid G3X3 constraint section "//cp_to_string(ig)//": "// & + "check MOLECULE and MOLNAME setup!") END IF IF ((cons_info%const_g33_mol(ig) == 0) .AND. (cons_info%const_g33_molname(ig) == "UNDEF") .AND. & (.NOT. cons_info%g33_intermolecular(ig))) THEN - CPABORT("") + CALL cp_abort(__LOCATION__, & + "Invalid G3X3 constraint section "//cp_to_string(ig)//": "// & + "check MOLECULE and MOLNAME setup!") END IF CALL section_vals_val_get(g3x3_section, "ATOMS", i_rep_section=ig, & i_vals=ilist) @@ -271,11 +275,15 @@ CONTAINS c_val=cons_info%const_g46_molname(ig)) END IF IF ((cons_info%const_g46_mol(ig) /= 0) .AND. (cons_info%const_g46_molname(ig) /= "UNDEF")) THEN - CPABORT("") + CALL cp_abort(__LOCATION__, & + "Invalid G4X6 constraint section "//cp_to_string(ig)//": "// & + "check MOLECULE and MOLNAME setup!") END IF IF ((cons_info%const_g46_mol(ig) == 0) .AND. (cons_info%const_g46_molname(ig) == "UNDEF") .AND. & (.NOT. cons_info%g46_intermolecular(ig))) THEN - CPABORT("") + CALL cp_abort(__LOCATION__, & + "Invalid G4X6 constraint section "//cp_to_string(ig)//": "// & + "check MOLECULE and MOLNAME setup!") END IF CALL section_vals_val_get(g4x6_section, "ATOMS", i_rep_section=ig, & i_vals=ilist) @@ -348,11 +356,15 @@ CONTAINS c_val=cons_info%const_vsite_molname(ig)) END IF IF ((cons_info%const_vsite_mol(ig) /= 0) .AND. (cons_info%const_vsite_molname(ig) /= "UNDEF")) THEN - CPABORT("") + CALL cp_abort(__LOCATION__, & + "Invalid VIRTUAL_SITE constraint section "//cp_to_string(ig)//": "// & + "check MOLECULE and MOLNAME setup!") END IF IF ((cons_info%const_vsite_mol(ig) == 0) .AND. (cons_info%const_vsite_molname(ig) == "UNDEF") .AND. & (.NOT. cons_info%vsite_intermolecular(ig))) THEN - CPABORT("") + CALL cp_abort(__LOCATION__, & + "Invalid VIRTUAL_SITE constraint section "//cp_to_string(ig)//": "// & + "check MOLECULE and MOLNAME setup!") END IF CALL section_vals_val_get(vsite_section, "ATOMS", i_rep_section=ig, & i_vals=ilist) diff --git a/src/topology_psf.F b/src/topology_psf.F index bcb5122922..91aaec84e7 100644 --- a/src/topology_psf.F +++ b/src/topology_psf.F @@ -113,12 +113,9 @@ CONTAINS c_int = 'I8' label = 'PSF' CALL parser_search_string(parser, label, .TRUE., found, begin_line=.TRUE.) - IF (.NOT. found) THEN - IF (output_unit > 0) THEN - WRITE (output_unit, '(A)') "ERROR| Missing PSF specification line" - END IF - CPABORT("") - END IF + IF (.NOT. found) & + CALL cp_abort(__LOCATION__, & + "Missing PSF specification line in <"//TRIM(filename)//">") DO WHILE (parser_test_next_token(parser) /= "EOL") CALL parser_get_object(parser, field) SELECT CASE (field(1:3)) @@ -460,9 +457,7 @@ CONTAINS conn_info%c_bond_b(i) = jatom END IF ELSE - IF (atom_info%id_molname(iatom) /= atom_info%id_molname(jatom)) THEN - CPABORT("") - END IF + CPASSERT(atom_info%id_molname(iatom) == atom_info%id_molname(jatom)) END IF END DO ! diff --git a/src/xas_tdp_atom.F b/src/xas_tdp_atom.F index f17a2c7019..87df1c0f2a 100644 --- a/src/xas_tdp_atom.F +++ b/src/xas_tdp_atom.F @@ -2132,14 +2132,14 @@ CONTAINS dga1 => xas_atom_env%dga1(ikind)%array dga2 => xas_atom_env%dga2(ikind)%array - !Before integration, wanna pre-divide all relevant derivastives by the nrom of the gradient + !Before integration, wanna pre-divide all relevant derivatives by the norm of the gradient CALL divide_by_norm_drho(deriv_set, rho_set, lsd=.TRUE.) !Wanna integrate , start looping over phi_j and do the first integration, then !collect vxc and vxg and loop over phi_i for the second integration !Note: we do not use the CG coefficients because they are only useful when there is a product ! of Gaussians, which is not really the case here - !Note: the spherical orbitals for phi_i are distributed among the prcos of the current batch + !Note: the spherical orbitals for phi_i are distributed among the procs of the current batch ALLOCATE (so(na, nr)) ALLOCATE (dso(na, nr, 3)) diff --git a/src/xas_tdp_methods.F b/src/xas_tdp_methods.F index cdae845090..4b35c3fb8c 100644 --- a/src/xas_tdp_methods.F +++ b/src/xas_tdp_methods.F @@ -570,7 +570,7 @@ CONTAINS !> \brief Overall control and environment types initialization !> \param xas_tdp_env the environment type to initialize !> \param xas_tdp_control the control type to initialize -!> \param qs_env the inherited qs environement type +!> \param qs_env the inherited qs environment type !> \param rixs_env ... ! ************************************************************************************************** SUBROUTINE xas_tdp_init(xas_tdp_env, xas_tdp_control, qs_env, rixs_env) @@ -2649,7 +2649,7 @@ CONTAINS DO ispin = 1, 2 CALL duplicate_mo_set(restart_mos(ispin), mos(1)) - ! Set the new occupation number in the case of spin-independent based calculaltion since the restart is spin-depedent + ! Set the new occupation number in the case of spin-independent based calculation since the restart is spin-depedent IF (SIZE(mos) == 1) & restart_mos(ispin)%occupation_numbers = mos(1)%occupation_numbers/2 END DO diff --git a/src/xas_tdp_utils.F b/src/xas_tdp_utils.F index abab16f8a3..05038c4ded 100644 --- a/src/xas_tdp_utils.F +++ b/src/xas_tdp_utils.F @@ -125,7 +125,7 @@ CONTAINS !> where other subroutines computes the matrices A, B, E, D and G, which are: !> - A: the ground-state contribution: F_pq*delta_IJ - epsilon_IJ*S_pq !> - B: the Coulomb kernel ~(pI|Jq) -!> - C: the xc kernel c_aa (double derivatibe wrt to n_alpha) and C_ab (wrt n_alpha and n_beta) +!> - C: the xc kernel c_aa (double derivative wrt to n_alpha) and C_ab (wrt n_alpha and n_beta) !> - D: the on-digonal exact exchange kernel ~(pq|IJ) !> - E: the off-diagonal exact exchange kernel ~(pJ|Iq) !> - G: the metric S_pq*delta_IJ diff --git a/src/xtb_ks_matrix.F b/src/xtb_ks_matrix.F index 05be242d8a..527f5f20b0 100644 --- a/src/xtb_ks_matrix.F +++ b/src/xtb_ks_matrix.F @@ -212,9 +212,7 @@ CONTAINS CALL get_qs_env(qs_env, mo_derivs=mo_derivs, mos=mo_array) DO ispin = 1, SIZE(mo_derivs) CALL get_mo_set(mo_set=mo_array(ispin), mo_coeff_b=mo_coeff) - IF (.NOT. mo_array(ispin)%use_mo_coeff_b) THEN - CPABORT("") - END IF + CPASSERT(mo_array(ispin)%use_mo_coeff_b) CALL dbcsr_multiply('n', 'n', 1.0_dp, ks_matrix(ispin, 1)%matrix, mo_coeff, & 0.0_dp, mo_derivs(ispin)%matrix) END DO @@ -470,9 +468,7 @@ CONTAINS CALL get_qs_env(qs_env, mo_derivs=mo_derivs, mos=mo_array) DO ispin = 1, SIZE(mo_derivs) CALL get_mo_set(mo_set=mo_array(ispin), mo_coeff_b=mo_coeff) - IF (.NOT. mo_array(ispin)%use_mo_coeff_b) THEN - CPABORT("") - END IF + CPASSERT(mo_array(ispin)%use_mo_coeff_b) CALL dbcsr_multiply('n', 'n', 1.0_dp, ks_matrix(ispin, 1)%matrix, mo_coeff, & 0.0_dp, mo_derivs(ispin)%matrix) END DO diff --git a/tools/conventions/conventions.supp b/tools/conventions/conventions.supp index 4e7cabb6ab..62d32132e4 100644 --- a/tools/conventions/conventions.supp +++ b/tools/conventions/conventions.supp @@ -1,4 +1,3 @@ -almo_scf.F: Found WRITE statement with hardcoded unit in "almo_scf_init" https://cp2k.org/conv#c012 al_system_dynamics.F: Found WRITE statement with hardcoded unit in "dump_vel" https://cp2k.org/conv#c012 base_hooks.F: Found CALL m_abort in procedure "cp_abort" https://cp2k.org/conv#c102 base_hooks.F: Found STOP statement in procedure "cp_abort" https://cp2k.org/conv#c205 @@ -169,17 +168,8 @@ powell.F: Found GOTO statement in procedure "newuob" https://cp2k.org/conv#c201 preconditioner_makes.F: Found WRITE statement with hardcoded unit in "make_full_all" https://cp2k.org/conv#c012 preconditioner_makes.F: Found WRITE statement with hardcoded unit in "make_full_all_ortho" https://cp2k.org/conv#c012 ps_implicit_methods.F: OMP PARALLEL without DEFAULT(NONE) found in "ps_implicit_prepare_blocks" https://cp2k.org/conv#c006 -ps_wavelet_base.F: Found WRITE statement with hardcoded unit in "f_poissonsolver" https://cp2k.org/conv#c012 -ps_wavelet_base.F: Found WRITE statement with hardcoded unit in "p_poissonsolver" https://cp2k.org/conv#c012 -ps_wavelet_base.F: Found WRITE statement with hardcoded unit in "s_poissonsolver" https://cp2k.org/conv#c012 -ps_wavelet_fft3d.F: Found WRITE statement with hardcoded unit in "ctrig" https://cp2k.org/conv#c012 -ps_wavelet_fft3d.F: Found WRITE statement with hardcoded unit in "fourier_dim" https://cp2k.org/conv#c012 ps_wavelet_kernel.F: Found WRITE statement with hardcoded unit in "indices" https://cp2k.org/conv#c012 ps_wavelet_scaling_function.F: Found WRITE statement with hardcoded unit in "ftest" https://cp2k.org/conv#c012 -ps_wavelet_scaling_function.F: Found WRITE statement with hardcoded unit in "scaling_function" https://cp2k.org/conv#c012 -ps_wavelet_scaling_function.F: Found WRITE statement with hardcoded unit in "wavelet_function" https://cp2k.org/conv#c012 -ps_wavelet_util.F: Found WRITE statement with hardcoded unit in "p_fft_dimensions" https://cp2k.org/conv#c012 -ps_wavelet_util.F: Found WRITE statement with hardcoded unit in "s_fft_dimensions" https://cp2k.org/conv#c012 pwdft_environment_types.F: Module "sirius" USEd without ONLY clause or not PRIVATE https://cp2k.org/conv#c002 pw_grids.F: Found WRITE statement with hardcoded unit in "pw_grid_sort" https://cp2k.org/conv#c012 qcschema.F: Module "hdf5_wrapper" USEd without ONLY clause or not PRIVATE https://cp2k.org/conv#c002 @@ -194,8 +184,6 @@ qs_dispersion_s_dftd3.F: Module "mctc_data" USEd without ONLY clause or not PRIV qs_dispersion_s_dftd3.F: Module "mctc_env" USEd without ONLY clause or not PRIVATE https://cp2k.org/conv#c002 qs_external_density.F: Found WRITE statement with hardcoded unit in "external_read_density" https://cp2k.org/conv#c012 qs_fb_env_methods.F: Found CALL cp_fm_gemm in procedure "fb_env_do_diag" https://cp2k.org/conv#c101 -qs_fb_filter_matrix_methods.F: Found WRITE statement with hardcoded unit in "fb_fltrmat_build_atomic_fltrmat" https://cp2k.org/conv#c012 -qs_initial_guess.F: Found WRITE statement with hardcoded unit in "calculate_first_density_matrix" https://cp2k.org/conv#c012 qs_linres_atom_current.F: Found WRITE statement with hardcoded unit in "calculate_jrho_atom_rad" https://cp2k.org/conv#c012 qs_linres_current.F: Found WRITE statement with hardcoded unit in "box_atoms" https://cp2k.org/conv#c012 qs_linres_current.F: Found WRITE statement with hardcoded unit in "box_atoms_new" https://cp2k.org/conv#c012 @@ -263,10 +251,6 @@ tmc_dot_tree.F: Found WRITE statement with hardcoded unit in "create_dot_color" tmc_dot_tree.F: Found WRITE statement with hardcoded unit in "create_global_tree_dot_color" https://cp2k.org/conv#c012 tmc_messages.F: Found WRITE statement with hardcoded unit in "read_energy_result_message" https://cp2k.org/conv#c012 tmc_messages.F: Found WRITE statement with hardcoded unit in "tmc_message" https://cp2k.org/conv#c012 -topology_constraint_util.F: Found WRITE statement with hardcoded unit in "setup_lcolv" https://cp2k.org/conv#c012 -topology_constraint_util.F: Found WRITE statement with hardcoded unit in "setup_lg3x3" https://cp2k.org/conv#c012 -topology_constraint_util.F: Found WRITE statement with hardcoded unit in "setup_lg4x6" https://cp2k.org/conv#c012 -topology_coordinate_util.F: Found WRITE statement with hardcoded unit in "topology_coordinate_pack" https://cp2k.org/conv#c012 topology_generate_util.F: Found WRITE statement with hardcoded unit in "generate_molname_low" https://cp2k.org/conv#c012 topology_generate_util.F: Found WRITE statement with hardcoded unit in "topology_generate_molecule" https://cp2k.org/conv#c012 topology_gromos.F: Found READ with unchecked STAT in "read_topology_gromos" https://cp2k.org/conv#c001 diff --git a/tools/precommit/check_file_properties.py b/tools/precommit/check_file_properties.py index eb982de437..9de9048880 100755 --- a/tools/precommit/check_file_properties.py +++ b/tools/precommit/check_file_properties.py @@ -205,12 +205,7 @@ def check_file(path: pathlib.Path) -> List[str]: if "\r\n" in content: warnings += [f"{path}: contains DOS linebreaks"] - if ( - fn_ext not in (".pot", ".patch") - and basefn != "Makefile" - and basefn != "generate_arch_files.sh" - and "\t" in content - ): + if fn_ext not in (".pot", ".patch") and basefn != "Makefile" and "\t" in content: warnings += [f"{path}: contains tab character"] if fn_ext == ".cu" and "#if defined(_OMP_H)\n#error" not in content: @@ -224,6 +219,18 @@ def check_file(path: pathlib.Path) -> List[str]: if STR_END_SPACE_RE.search(a) and STR_BEGIN_SPACE_RE.search(b): warnings += [f"{path}:{i+1} Double space in multi-line string"] + # Check CPASSERT(.FALSE.) and empty CPABORT() messages + suppress_cpabort = ["semi_empirical_int_debug.F"] + if fn_ext == ".F" and basefn not in suppress_cpabort: + if "CPASSERT(.FALSE.)" in content: + warnings += [ + f"{path}: Found CPASSERT(.FALSE.) - please use CPABORT() with messages" + ] + if "CPABORT('')" in content or 'CPABORT("")' in content: + warnings += [ + f"{path}: Found CPABORT() with empty message - please fill in the reason" + ] + # check banner year = datetime.now(timezone.utc).year bsd_licensed = any(str(path).startswith(p) for p in BSD_PATHS)