comp-chem/cp2k
1
0
Fork 0
mirror of https://github.com/cp2k/cp2k.git synced 2026-07-27 21:55:16 -04:00
Code Issues Projects Releases Packages Wiki Activity Actions

Precommit: check for CPASSERT(.FALSE.), and empty CPABORT() (#5491)

Browse source
This commit is contained in:
HE Zilong 2026-07-03 18:09:01 +08:00 • committed by GitHub
parent bfcb1ea1d6
commit d275998fba
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
142 changed files with 616 additions and 597 deletions
Download patch file Download diff file Expand all files Collapse all files

12
src/almo_scf.F
View file

@ -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.

4
src/almo_scf_optimizer.F
View file

@ -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.

6
src/almo_scf_qs.F
View file

@ -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

2
src/aobasis/ai_contraction.F
View file

@ -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

2
src/aobasis/ai_onecenter.F
View file

@ -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)

4
src/aobasis/ai_os_rr.F
View file

@ -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

8
src/aobasis/basis_set_container_types.F
View file

@ -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

2
src/atom.F
View file

@ -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")

36
src/atom_electronic_structure.F
View file

@ -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)

2
src/atom_energy.F
View file

@ -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

12
src/atom_fit.F
View file

@ -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

4
src/atom_grb.F
View file

@ -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

10
src/atom_kind_orbitals.F
View file

@ -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)

34
src/atom_operators.F
View file

@ -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)

2
src/atom_optimization.F
View file

@ -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

30
src/atom_output.F
View file

@ -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

14
src/atom_sgp.F
View file

@ -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")')

48
src/atom_utils.F
View file

@ -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 <RHO>, <DER>, <LAP> are supported as <my_typ> "// &
"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 <RHO>, <DER>, <LAP> are supported as <my_typ> "// &
"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

9
src/colvar_methods.F
View file

@ -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

3
src/common/cp_result_methods.F
View file

@ -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

9
src/common/cp_result_types.F
View file

@ -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

2
src/common/powell.F
View file

@ -96,7 +96,7 @@ CONTAINS
DEALLOCATE (optstate%xopt)
optstate%state = -1
CASE DEFAULT
CPABORT("")
CPABORT("Unknown optimization state")
END SELECT
CALL timestop(handle)

2
src/constraint.F
View file

@ -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

2
src/cp_ddapc_forces.F
View file

@ -374,7 +374,7 @@ CONTAINS
END DO
CASE DEFAULT
CPABORT("")
CPABORT("Unknown ddapc constraint/restraint form")
END SELECT
END SUBROUTINE evaluate_restraint_functional

2
src/cp_ddapc_methods.F
View file

@ -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

4
src/cp_ddapc_util.F
View file

@ -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

2
src/cp_external_control.F
View file

@ -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

4
src/dbt/dbt_test.F
View file

@ -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

4
src/dbt/tas/dbt_tas_mm.F
View file

@ -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)))

2
src/distribution_methods.F
View file

@ -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

4
src/dm_ls_scf_create.F
View file

@ -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)

2
src/dm_ls_scf_methods.F
View file

@ -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)

4
src/ec_environment.F
View file

@ -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)

4
src/energy_corrections.F
View file

@ -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

4
src/eri_mme/eri_mme_integrate.F
View file

@ -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

6
src/ewald_environment_types.F
View file

@ -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)

2
src/ewald_pw_methods.F
View file

@ -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))

2
src/ewald_pw_types.F
View file

@ -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

16
src/fm/cp_cfm_basic_linalg.F
View file

@ -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)

2
src/fm/cp_cfm_types.F
View file

@ -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

8
src/fm/cp_fm_basic_linalg.F
View file

@ -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

4
src/force_env_methods.F
View file

@ -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

8
src/force_fields_all.F
View file

@ -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__, &
"<Bond>, <Angle>, <Urey-Bradley>, <Torsion>, "// &
"<Improper>, <Out of plane bend>, <Charge>, "// &
"<Spline_Bond_Env>, <Spline_Non_Bond_Env> are "// &
"supported as the <type_name> for store_FF_missing_par, "// &
"found unknown option "// &
"<"//TRIM(type_name)//">")
END SELECT
IF (found) EXIT
END DO

6
src/input/input_keyword_types.F
View file

@ -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)//"<DATA_TYPE kind=""non-standard type"">"
CASE DEFAULT
CPABORT("")
CPABORT("Unknown type_of_var for write_keyword_xml")
END SELECT
short_string = ""

6
src/input/input_section_types.F
View file

@ -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

32
src/input/input_val_types.F
View file

@ -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 ")

4
src/kpoint_methods.F
View file

@ -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

14
src/kpoint_types.F
View file

@ -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__, &
"<NONE>, <GAMMA>, <MONKHORST-PACK>, <MACDONALD>, "// &
"<GENERAL> are supported as the <kpoint%kp_scheme> 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__, &
"<NONE>, <GAMMA>, <MONKHORST-PACK>, <MACDONALD>, "// &
"<GENERAL> are supported as the <kpoint%kp_scheme> for "// &
"write_kpoint_info, found unknown option "// &
"<"//TRIM(kpoint%kp_scheme)//">")
END SELECT
IF (kpoint%kp_scheme /= "NONE") THEN
IF (kpoint%symmetry) THEN

11
src/metadyn_tools/graph_methods.F
View file

@ -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 (*, *)

6
src/minimax/minimax_exp_k15.F
View file

@ -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

16
src/mixed_cdft_methods.F
View file

@ -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)

4
src/molden_utils.F
View file

@ -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

2
src/motion/helium_io.F
View file

@ -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

2
src/motion/neb_utils.F
View file

@ -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

4
src/motion/pint_io.F
View file

@ -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)

4
src/motion/thermostat/thermostat_mapping.F
View file

@ -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!")

8
src/motion/thermostat/thermostat_utils.F
View file

@ -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

9
src/motion_utils.F
View file

@ -348,7 +348,12 @@ CONTAINS
id_wpc = "FORCE_MIXING_LABELS"
id_extxyz = "force_mixing_label" ! non-standard
CASE DEFAULT
CPABORT("")
CALL cp_abort(__LOCATION__, &
"<TRAJECTORY>, <VELOCITIES>, <FORCES>, "// &
"<FORCE_MIXING_LABELS> are supported as "// &
"the <my_pk_name> 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)))

2
src/mp2.F
View file

@ -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()

2
src/mp2_setup.F
View file

@ -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)

18
src/mpiwrap/mp_perf_test.F
View file

@ -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)

4
src/optimize_input.F
View file

@ -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)

6
src/pair_potential.F
View file

@ -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)

18
src/pair_potential_types.F
View file

@ -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 <ndim> "// &
"or 2 input parameters <ub> and <lb> at each call; found <ndim> "// &
"together with <ub> or <lb>")
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 <ndim> "// &
"or 2 input parameters <ub> and <lb> at each call; found none")
END IF
DO i = loc_lb, loc_ub
NULLIFY (potparm%pot(i)%pot)

2
src/preconditioner.F
View file

@ -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

81
src/pw/ps_wavelet_base.F
View file

@ -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

12
src/pw/ps_wavelet_fft3d.F
View file

@ -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

6
src/pw/ps_wavelet_scaling_function.F
View file

@ -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

27
src/pw/ps_wavelet_util.F
View file

@ -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)

2
src/pw/pw_grids.F
View file

@ -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

2
src/pw/pw_poisson_methods.F
View file

@ -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

8
src/pw/pw_poisson_types.F
View file

@ -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

22
src/pw/pw_spline_utils.F
View file

@ -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

4
src/pw_env_methods.F
View file

@ -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)

10
src/pw_poisson_read_input.F
View file

@ -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

2
src/qmmm_create.F
View file

@ -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)

2
src/qmmm_gaussian_init.F
View file

@ -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))

11
src/qmmm_gpw_energy.F
View file

@ -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, :)

17
src/qmmm_gpw_forces.F
View file

@ -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")

14
src/qmmm_init.F
View file

@ -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

14
src/qmmm_per_elpot.F
View file

@ -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")

4
src/qmmm_tb_methods.F
View file

@ -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

12
src/qmmm_topology_util.F
View file

@ -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

4
src/qs_chargemol.F
View file

@ -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

8
src/qs_collocate_density.F
View file

@ -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

2
src/qs_dftb_dispersion.F
View file

@ -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

4
src/qs_dftb_matrices.F
View file

@ -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

6
src/qs_dftb_parameters.F
View file

@ -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

2
src/qs_dispersion_utils.F
View file

@ -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)')")

6
src/qs_dos.F
View file

@ -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

5
src/qs_fb_filter_matrix_methods.F
View file

@ -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)

15
src/qs_force_types.F
View file

@ -468,7 +468,10 @@ CONTAINS
END DO
END DO
CASE DEFAULT
CPABORT("")
CALL cp_abort(__LOCATION__, &
"<overlap_admm> is supported as the <forcetype> "// &
"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__, &
"<dispersion> is supported as the <forcetype> "// &
"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__, &
"<dispersion> is supported as the <forcetype> "// &
"for get_qs_force, found unknown option "// &
"<"//TRIM(forcetype)//">")
END SELECT
END SUBROUTINE get_qs_force

51
src/qs_initial_guess.F
View file

@ -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

8
src/qs_integrate_potential_single.F
View file

@ -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

6
src/qs_kind_types.F
View file

@ -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

2
src/qs_kinetic.F
View file

@ -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)

2
src/qs_ks_utils.F
View file

@ -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

6
src/qs_linres_current.F
View file

@ -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

4
src/qs_mo_io.F
View file

@ -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

2
src/qs_moments.F
View file

@ -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

Some files were not shown because too many files have changed in this diff Show more