From 62d496c929fc5b6e7e82a436e71be5643e160adf Mon Sep 17 00:00:00 2001 From: Hans Pabst <hans.pabst@intel.com> Date: Wed, 30 Oct 2024 08:42:37 +0100 Subject: [PATCH] Fixed CPVERSION_CHECK and improved CPWARN - CPVERSION_CHECK checks if MAJOR_TEST is defined (fixes #3750). - Introduced CPWARN_IF (conditional CPWARN). - Message/format cleanup. --- src/admm_types.F | 2 +- src/almo_scf.F | 4 +--- src/almo_scf_optimizer.F | 6 +++--- src/aobasis/basis_set_types.F | 8 ++++---- src/atoms_input.F | 2 +- src/base/base_uses.f90 | 21 ++++++++++++++------- src/colvar_methods.F | 6 +++--- src/colvar_utils.F | 3 ++- src/cp_dbcsr_operations.F | 3 ++- src/emd/rt_delta_pulse.F | 22 ++++++++-------------- src/ewalds_multipole.F | 2 +- src/fist_pol_scf.F | 3 +-- src/fm/cp_fm_elpa.F | 4 +--- src/force_fields_all.F | 7 ++++--- src/force_fields_ext.F | 10 +++++----- src/hfx_ri.F | 4 ++-- src/hfx_ri_kp.F | 3 ++- src/hfx_types.F | 1 - src/ipi_driver.F | 2 +- src/localization_tb.F | 14 ++++---------- src/ls_matrix_exp.F | 6 ++---- src/matrix_exp.F | 3 +-- src/metadyn_tools/graph.F | 2 +- src/motion/cp_lbfgs_optimizer_gopt.F | 5 ++--- src/motion/helium_methods.F | 2 +- src/motion/md_vel_utils.F | 3 ++- src/pao_io.F | 18 +++++++++++------- src/pao_linpot_rotinv.F | 2 +- src/pao_methods.F | 2 +- src/pao_ml.F | 3 ++- src/pw/ps_implicit_methods.F | 10 +++++----- src/pw/ps_wavelet_methods.F | 4 ++-- src/pw/pw_pool_types.F | 3 +-- src/qmmm_topology_util.F | 2 +- src/qmmmx_update.F | 2 +- src/qs_environment.F | 7 ++++--- src/qs_linres_nmr_utils.F | 6 +++--- src/qs_mo_occupation.F | 15 ++++++--------- src/qs_scf_initialization.F | 6 ++---- src/qs_scf_post_gpw.F | 11 ++++------- src/qs_scf_post_se.F | 20 ++++++++++---------- src/qs_tddfpt2_stda_utils.F | 2 +- src/qs_tddfpt_eigensolver.F | 2 +- src/qs_wannier90.F | 2 +- src/ri_environment_methods.F | 4 +--- src/semi_empirical_int_debug.F | 2 +- src/subsys/external_potential_types.F | 8 ++++---- src/tmc/tmc_file_io.F | 6 ++++-- src/tmc/tmc_master.F | 2 +- src/tmc/tmc_setup.F | 12 ++++++++---- src/tmc/tmc_worker.F | 2 +- src/topology_amber.F | 6 ++---- src/topology_coordinate_util.F | 2 +- src/topology_gromos.F | 24 ++++++++++++------------ src/topology_multiple_unit_cell.F | 2 +- src/topology_xtl.F | 3 +-- src/xas_tp_scf.F | 2 +- 57 files changed, 164 insertions(+), 176 deletions(-) diff --git a/src/admm_types.F b/src/admm_types.F index 4117c42621..d9d9300b92 100644 --- a/src/admm_types.F +++ b/src/admm_types.F @@ -352,7 +352,7 @@ SUBROUTINE admm_env_create(admm_env, admm_control, mos, para_env, natoms, nao_au CALL cp_fm_create(admm_env%lambda_inv2(ispin), fm_struct_nmo_nmo, name="lambda_inv2") CALL cp_fm_create(admm_env%C_hat(ispin), fm_struct_aux_nmo, name="C_hat") CALL cp_fm_create(admm_env%P_tilde(ispin), fm_struct_aux_aux, name="P_tilde") - CALL cp_fm_create(admm_env%ks_to_be_merged(ispin), fm_struct_orb_orb, name="KS_to_be_merged ") + CALL cp_fm_create(admm_env%ks_to_be_merged(ispin), fm_struct_orb_orb, name="KS_to_be_merged") ALLOCATE (admm_env%eigvals_lambda(ispin)%eigvals) ALLOCATE (admm_env%eigvals_P_to_be_purified(ispin)%eigvals) diff --git a/src/almo_scf.F b/src/almo_scf.F index 921ace8e4d..b21d1c3019 100644 --- a/src/almo_scf.F +++ b/src/almo_scf.F @@ -301,9 +301,7 @@ SUBROUTINE almo_scf_init(qs_env, almo_scf_env, calc_forces) nelec_b = nelec - nelec_a !! Initializing an occupation-rescaling trick if smearing is on IF (almo_scf_env%smear) THEN - IF (multip .GT. 1) THEN - CPWARN("BEWARE: Non singlet state detected, treating it as closed-shell") - END IF + CPWARN_IF(multip .GT. 1, "BEWARE: Non singlet state detected, treating it as closed-shell") !! Save real number of electrons of each spin, as it is required for Fermi-dirac smearing !! BEWARE : Non singlet states are allowed but treated as closed-shell almo_scf_env%real_ne_of_domain(idomain, :) = REAL(nelec, KIND=dp)/2.0_dp diff --git a/src/almo_scf_optimizer.F b/src/almo_scf_optimizer.F index 1a7d33ce1b..a0dbcf42c5 100644 --- a/src/almo_scf_optimizer.F +++ b/src/almo_scf_optimizer.F @@ -828,7 +828,7 @@ SUBROUTINE almo_scf_xalmo_eigensolver(qs_env, almo_scf_env, optimizer) END IF IF (.NOT. converged .AND. .NOT. optimizer%early_stopping_on) THEN - CPABORT("SCF for ALMOs on overlapping domains not converged! ") + CPABORT("SCF for ALMOs on overlapping domains not converged!") END IF DO ispin = 1, nspin @@ -1371,7 +1371,7 @@ SUBROUTINE almo_scf_xalmo_pcg(qs_env, almo_scf_env, optimizer, quench_t, & DO ispin = 1, nspins IF (just_started .AND. almo_mathematica) THEN - IF (ispin .GT. 1) CPWARN("Mathematica files will be overwritten") + CPWARN_IF(ispin .GT. 1, "Mathematica files will be overwritten") CALL print_mathematica_matrix(almo_scf_env%matrix_s(1), "matrixS.dat") CALL print_mathematica_matrix(almo_scf_env%matrix_ks(ispin), "matrixF.dat") CALL print_mathematica_matrix(matrix_t_out(ispin), "matrixT.dat") @@ -1902,7 +1902,7 @@ SUBROUTINE almo_scf_xalmo_pcg(qs_env, almo_scf_env, optimizer, quench_t, & DO ispin = 1, nspins IF (converged .AND. almo_mathematica) THEN - IF (ispin .GT. 1) CPWARN("Mathematica files will be overwritten") + CPWARN_IF(ispin .GT. 1, "Mathematica files will be overwritten") CALL print_mathematica_matrix(matrix_t_out(ispin), "matrixTf.dat") END IF END DO ! ispin diff --git a/src/aobasis/basis_set_types.F b/src/aobasis/basis_set_types.F index c5e4071eaf..7e2267febd 100644 --- a/src/aobasis/basis_set_types.F +++ b/src/aobasis/basis_set_types.F @@ -1562,7 +1562,7 @@ SUBROUTINE read_gto_basis_set2(element_symbol, basis_type, gto_basis_set, & NULLIFY (gcc, l, lmax, lmin, n, npgf, nshell, zet) ! Read the basis set information is_ok = cp_sll_val_next(list, val) - IF (.NOT. is_ok) CPABORT("Error reading the Basis set from input file!!") + IF (.NOT. is_ok) CPABORT("Error reading the Basis set from input file!") CALL val_get(val, c_val=line_att) READ (line_att, *) nset @@ -1578,7 +1578,7 @@ SUBROUTINE read_gto_basis_set2(element_symbol, basis_type, gto_basis_set, & DO iset = 1, nset is_ok = cp_sll_val_next(list, val) - IF (.NOT. is_ok) CPABORT("Error reading the Basis set from input file!!") + IF (.NOT. is_ok) CPABORT("Error reading the Basis set from input file!") CALL val_get(val, c_val=line_att) READ (line_att, *) n(1, iset) CALL remove_word(line_att) @@ -1612,10 +1612,10 @@ SUBROUTINE read_gto_basis_set2(element_symbol, basis_type, gto_basis_set, & END DO END DO IF (LEN_TRIM(line_att) /= 0) & - CPABORT("Error reading the Basis from input file!!") + CPABORT("Error reading the Basis from input file!") DO ipgf = 1, npgf(iset) is_ok = cp_sll_val_next(list, val) - IF (.NOT. is_ok) CPABORT("Error reading the Basis set from input file!!") + IF (.NOT. is_ok) CPABORT("Error reading the Basis set from input file!") CALL val_get(val, c_val=line_att) READ (line_att, *) zet(ipgf, iset), (gcc(ipgf, ishell, iset), ishell=1, nshell(iset)) END DO diff --git a/src/atoms_input.F b/src/atoms_input.F index b01f123463..97114acbb7 100644 --- a/src/atoms_input.F +++ b/src/atoms_input.F @@ -451,7 +451,7 @@ SUBROUTINE read_shell_coord_input(particle_set, shell_particle_set, cell, & dab = SQRT(rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3)) IF (shell%max_dist > 0.0_dp .AND. shell%max_dist < dab) THEN IF (output_unit > 0) THEN - WRITE (output_unit, *) "WARNING : shell and core for atom ", at_index(ishell), " seem to be too distant. " + WRITE (output_unit, *) "WARNING : shell and core for atom ", at_index(ishell), " seem to be too distant." END IF END IF diff --git a/src/base/base_uses.f90 b/src/base/base_uses.f90 index 5d4db49e0b..abbbdb1b08 100644 --- a/src/base/base_uses.f90 +++ b/src/base/base_uses.f90 @@ -27,19 +27,26 @@ #endif #define __LOCATION__ cp__l(__SHORT_FILE__,__LINE__) -#define CPWARN(msg) CALL cp__w(__SHORT_FILE__,__LINE__,msg) -#define CPABORT(msg) CALL cp__b(__SHORT_FILE__,__LINE__,msg) +#define CPABORT(MSG) CALL cp__b(__SHORT_FILE__,__LINE__,MSG) + +! Issue a warning; warnings are summarized globally. +! For conditional warnings see CPWARN_IF. +#define CPWARN(MSG) CALL cp__w(__SHORT_FILE__,__LINE__,MSG) + +! Like CPWARN but only if CONDition is true. +#define CPWARN_IF(COND, MSG) IF(COND)CPWARN(MSG) + ! In contrast to CPWARN, the warning counter is not increased -#define CPHINT(msg) CALL cp__h(__SHORT_FILE__,__LINE__,msg) +#define CPHINT(MSG) CALL cp__h(__SHORT_FILE__,__LINE__,MSG) -# define CPASSERT(cond) IF(.NOT.(cond))CALL cp__a(__SHORT_FILE__,__LINE__) +# define CPASSERT(COND) IF(.NOT.(COND))CALL cp__a(__SHORT_FILE__,__LINE__) ! The MARK_USED macro can be used to mark an argument/variable as used. It is intended to make ! it possible to switch on -Werror=unused-dummy-argument, but deal elegantly with, e.g., ! library wrapper routines that take arguments only used if the library is linked in. ! This code should be valid for any Fortran variable, is always standard conforming, ! and will be optimized away completely by the compiler -#define MARK_USED(foo) IF(.FALSE.)THEN; DO ; IF(SIZE(SHAPE(foo))==-1) EXIT ; END DO ; ENDIF +#define MARK_USED(FOO) IF(.FALSE.)THEN;DO;IF(SIZE(SHAPE(FOO))==-1) EXIT;ENDDO;ENDIF ! Calculate version number from 2 or 3 components. Can be used for comparison, e.g., ! CPVERSION3(4, 9, 0) <= CPVERSION3(__GNUC__, __GNUC_MINOR__, __GNUC_PATCHLEVEL__) @@ -53,8 +60,8 @@ ! Perform actual comparison according to COMP argument. ! Note: defined(MAJOR_TEST) and defined(MINOR_TEST) is avoided in macro ! definition due to issues handling it in certain compilers. -#define CPVERSION_CHECK(MAJOR_BASE, MINOR_BASE, COMP, MAJOR_TEST, MINOR_TEST) \ - (CPVERSION2(MAJOR_BASE, MINOR_BASE) COMP CPVERSION2(MAJOR_TEST, MINOR_TEST)) +#define CPVERSION_CHECK(MAJOR_BASE, MINOR_BASE, COMP, MAJOR_TEST, MINOR_TEST) ((MAJOR_TEST) && \ + (CPVERSION2(MAJOR_BASE, MINOR_BASE) COMP CPVERSION2(MAJOR_TEST, MINOR_TEST))) ! Avoid to default initialize type-components (default c'tor) #if CPVERSION_CHECK(9, 5, >, __GNUC__, __GNUC_MINOR__) || defined(__INTEL_COMPILER) || defined(__INTEL_LLVM_COMPILER) diff --git a/src/colvar_methods.F b/src/colvar_methods.F index 585d642953..7af4d26f39 100644 --- a/src/colvar_methods.F +++ b/src/colvar_methods.F @@ -1217,9 +1217,9 @@ RECURSIVE SUBROUTINE colvar_read(colvar, icol, colvar_section, para_env) WRITE (iw, '( A,T71,G10.5)') ' COLVARS| DX', & colvar%combine_cvs_param%dx CASE (reaction_path_colvar_id) - CPWARN("Description header for REACTION_PATH COLVAR missing!!") + CPWARN("Description header for REACTION_PATH COLVAR missing!") CASE (distance_from_path_colvar_id) - CPWARN("Description header for REACTION_PATH COLVAR missing!!") + CPWARN("Description header for REACTION_PATH COLVAR missing!") CASE (hydronium_shell_colvar_id) WRITE (iw, '( A,T71,I10)') ' COLVARS| POH', colvar%hydronium_shell_param%poh WRITE (iw, '( A,T71,I10)') ' COLVARS| QOH', colvar%hydronium_shell_param%qoh @@ -1268,7 +1268,7 @@ RECURSIVE SUBROUTINE colvar_read(colvar, icol, colvar_section, para_env) WRITE (iw, '( A,T71,F10.5)') ' COLVARS| NC', colvar%acid_hyd_shell_param%nc WRITE (iw, '( A,T71,F10.5)') ' COLVARS| LAMBDA', colvar%acid_hyd_shell_param%lambda CASE (rmsd_colvar_id) - CPWARN("Description header for RMSD COLVAR missing!!") + CPWARN("Description header for RMSD COLVAR missing!") CASE (xyz_diag_colvar_id) NULLIFY (section, keyword, enum) CALL create_colvar_xyz_d_section(section) diff --git a/src/colvar_utils.F b/src/colvar_utils.F index 7f5d60b868..36e37e8a09 100644 --- a/src/colvar_utils.F +++ b/src/colvar_utils.F @@ -308,8 +308,9 @@ SUBROUTINE eval_colvar(force_env, coords, cvalues, Bmatrix, MassI, Amatrix) ALLOCATE (Gmatrix_i(n_tot, n_tot)) Gmatrix(:, :) = MATMUL(TRANSPOSE(Bmatrix), Bmatrix) CALL invert_matrix(Gmatrix, Gmatrix_i, inv_error) - IF (ABS(inv_error) > 1.0E-8_dp) & + IF (ABS(inv_error) > 1.0E-8_dp) THEN CPWARN("Error in inverting the Gmatrix larger than 1.0E-8!") + END IF Amatrix = MATMUL(Gmatrix_i, TRANSPOSE(Bmatrix)) DEALLOCATE (Gmatrix_i) DEALLOCATE (Gmatrix) diff --git a/src/cp_dbcsr_operations.F b/src/cp_dbcsr_operations.F index c63a919a87..9d83dd8ce5 100644 --- a/src/cp_dbcsr_operations.F +++ b/src/cp_dbcsr_operations.F @@ -1196,8 +1196,9 @@ SUBROUTINE rebin_distribution(new_bins, images, source_bins, & ! --------------------------------------------------------------------------- - IF (MOD(nbins*nimages, multiplicity) .NE. 0) & + IF (MOD(nbins*nimages, multiplicity) .NE. 0) THEN CPWARN("mulitplicity is not divisor of new process grid coordinate") + END IF old_nbins = (nbins*nimages)/multiplicity ALLOCATE (bin_multiplier(0:old_nbins - 1)) bin_multiplier(:) = 0 diff --git a/src/emd/rt_delta_pulse.F b/src/emd/rt_delta_pulse.F index f2de247b13..0d4768abcc 100644 --- a/src/emd/rt_delta_pulse.F +++ b/src/emd/rt_delta_pulse.F @@ -107,7 +107,7 @@ SUBROUTINE apply_delta_pulse(qs_env, rtp, rtp_control) CHARACTER(LEN=3), DIMENSION(3) :: rlab INTEGER :: i, output_unit - LOGICAL :: my_apply_pulse, periodic_cell + LOGICAL :: my_apply_pulse, periodic REAL(KIND=dp), DIMENSION(3) :: kvec TYPE(cell_type), POINTER :: cell TYPE(cp_fm_type), DIMENSION(:), POINTER :: mos_new, mos_old @@ -129,7 +129,7 @@ SUBROUTINE apply_delta_pulse(qs_env, rtp, rtp_control) output_unit = cp_print_key_unit_nr(logger, rtp_section, "PRINT%PROGRAM_RUN_INFO", & extension=".scfLog") rlab = [CHARACTER(LEN=3) :: "X", "Y", "Z"] - periodic_cell = ANY(cell%perd > 0) + periodic = ANY(cell%perd > 0) ! periodic cell my_apply_pulse = .TRUE. CALL get_qs_env(qs_env, mos=mos) @@ -171,9 +171,7 @@ SUBROUTINE apply_delta_pulse(qs_env, rtp, rtp_control) END IF CALL apply_delta_pulse_electric_periodic(qs_env, mos_old, mos_new, -kvec) ELSE - IF (periodic_cell) THEN - CPWARN("This application of the delta pulse is not compatible with PBC!") - END IF + CPWARN_IF(periodic, "This application of the delta pulse is not compatible with PBC!") IF (output_unit > 0) THEN WRITE (UNIT=output_unit, FMT="(/,(T3,A,T40))") & "An Electric Delta Kick within the length gauge is applied before running RTP. "// & @@ -184,9 +182,7 @@ SUBROUTINE apply_delta_pulse(qs_env, rtp, rtp_control) CALL apply_delta_pulse_electric(qs_env, mos_old, mos_new, -kvec) END IF ELSE IF (rtp_control%apply_delta_pulse_mag) THEN - IF (periodic_cell) THEN - CPWARN("This application of the delta pulse is not compatible with PBC!") - END IF + CPWARN_IF(periodic, "This application of the delta pulse is not compatible with PBC!") ! The prefactor (strength of the magnetic field, should be divided by 2c) IF (output_unit > 0) THEN WRITE (UNIT=output_unit, FMT="(/,(T3,A,T40))") & @@ -224,7 +220,7 @@ SUBROUTINE apply_delta_pulse_electric_periodic(qs_env, mos_old, mos_new, kvec) ncol_local, nmo, nrow_local, nvirt, & reference INTEGER, DIMENSION(:), POINTER :: col_indices, row_indices - LOGICAL :: com_nl, len_rep, periodic_cell + LOGICAL :: com_nl, len_rep, periodic REAL(KIND=dp) :: eps_ppnl, factor REAL(KIND=dp), CONTIGUOUS, DIMENSION(:, :), & POINTER :: local_data @@ -248,7 +244,7 @@ SUBROUTINE apply_delta_pulse_electric_periodic(qs_env, mos_old, mos_new, kvec) CALL timeset(routineN, handle) NULLIFY (cell, mos, rtp, matrix_s, matrix_ks, input, dft_control, particle_set, fm_struct) - ! we need the overlap and ks matrix for a full diagionalization + ! we need the overlap and ks matrix for a full diagonalization CALL get_qs_env(qs_env, & cell=cell, & mos=mos, & @@ -260,7 +256,7 @@ SUBROUTINE apply_delta_pulse_electric_periodic(qs_env, mos_old, mos_new, kvec) particle_set=particle_set) rtp_control => dft_control%rtp_control - periodic_cell = ANY(cell%perd > 0) + periodic = ANY(cell%perd > 0) ! periodic cell ! relevant input parameters com_nl = section_get_lval(section_vals=input, keyword_name="DFT%REAL_TIME_PROPAGATION%COM_NL") @@ -291,9 +287,7 @@ SUBROUTINE apply_delta_pulse_electric_periodic(qs_env, mos_old, mos_new, kvec) ! calculate dipole moment matrix if required, NOT for periodic boundary conditions! IF (len_rep) THEN CALL cite_reference(Mattiat2022) - IF (periodic_cell) THEN - CPWARN("This application of the delta pulse is not compatible with PBC!") - END IF + CPWARN_IF(periodic, "This application of the delta pulse is not compatible with PBC!") ! get reference point reference = section_get_ival(section_vals=input, & keyword_name="DFT%PRINT%MOMENTS%REFERENCE") diff --git a/src/ewalds_multipole.F b/src/ewalds_multipole.F index ac01b96378..024cf0fc77 100644 --- a/src/ewalds_multipole.F +++ b/src/ewalds_multipole.F @@ -194,7 +194,7 @@ RECURSIVE SUBROUTINE ewald_multipole_evaluate(ewald_env, ewald_pw, nonbond_env, CALL debug_ewald_multipoles_fields2(ewald_env, ewald_pw, nonbond_env, & cell, particle_set, local_particles, radii, charges, dipoles, & quadrupoles, task, iw) - CPABORT("Debug Multipole Requested: POT+EFIELDS+GRAD to give the correct energy!!") + CPABORT("Debug Multipole Requested: POT+EFIELDS+GRAD to give the correct energy!") END IF END IF diff --git a/src/fist_pol_scf.F b/src/fist_pol_scf.F index 71db494819..04cdeb3fde 100644 --- a/src/fist_pol_scf.F +++ b/src/fist_pol_scf.F @@ -275,8 +275,7 @@ SUBROUTINE fist_pol_evaluate_sc(atomic_kind_set, multipoles, ewald_env, ewald_pw iwarn = ((rmsd > eps_pol) .AND. (iter == max_ipol_iter)) IF (iwarn .AND. iw > 0) WRITE (iw, FMT='(T5,"POL_SCF|",1X,"Self-consistent Polarization not converged!")') - IF (iwarn) & - CPWARN("Self-consistent Polarization not converged! ") + CPWARN_IF(iwarn, "Self-consistent Polarization not converged!") END DO pol_scf ! Now evaluate after convergence to obtain forces and converged energies diff --git a/src/fm/cp_fm_elpa.F b/src/fm/cp_fm_elpa.F index 2e39447976..ea2f3c2246 100644 --- a/src/fm/cp_fm_elpa.F +++ b/src/fm/cp_fm_elpa.F @@ -518,9 +518,7 @@ SUBROUTINE cp_fm_diag_elpa_base(matrix, eigenvectors, eigenvalues, rdinfo) END IF CALL elpa_obj%set("real_kernel", elpa_kernel, success) - IF (success /= elpa_ok) THEN - CPWARN("Setting real_kernel for ELPA failed") - END IF + CPWARN_IF(success /= elpa_ok, "Setting real_kernel for ELPA failed") IF (use_qr) THEN CALL elpa_obj%set("qr", 1, success) diff --git a/src/force_fields_all.F b/src/force_fields_all.F index d5e941d44d..4794430ba7 100644 --- a/src/force_fields_all.F +++ b/src/force_fields_all.F @@ -1859,7 +1859,7 @@ SUBROUTINE force_field_pack_charges(charges, charges_section, particle_set, & ! Not implemented for core-shell IF (ASSOCIATED(inp_info%shell_list)) THEN - CPABORT("Array of charges not implemented for CORE-SHELL model!!") + CPABORT("Array of charges not implemented for CORE-SHELL model!") END IF ! Allocate array to particle_set size @@ -3293,8 +3293,9 @@ SUBROUTINE issue_duplications(found, tag_label, name_atm_a, name_atm_b, & item = TRIM(item)//" , "//TRIM(name_atm_d) END IF item = TRIM(item)//" )" - IF (found) & - CPWARN("Multiple "//TRIM(tag_label)//" declarations: "//TRIM(item)//" overwriting! ") + IF (found) THEN + CPWARN("Multiple "//TRIM(tag_label)//" declarations: "//TRIM(item)//" overwriting!") + END IF END SUBROUTINE issue_duplications diff --git a/src/force_fields_ext.F b/src/force_fields_ext.F index 5d835ffdd8..2c6e9000d8 100644 --- a/src/force_fields_ext.F +++ b/src/force_fields_ext.F @@ -176,7 +176,7 @@ SUBROUTINE read_force_field_gromos(ff_type, para_env, mm_section) gro_info%bond_k(itype) = cp_unit_to_cp2k(gro_info%bond_k(itype), "kjmol*nm^-2") END IF gro_info%bond_r0(itype) = cp_unit_to_cp2k(gro_info%bond_r0(itype), "nm") - IF (iw > 0) WRITE (iw, *) "GROMOS_FF| PUT BONDTYPE INFO HERE!!!!" + IF (iw > 0) WRITE (iw, *) "GROMOS_FF| PUT BONDTYPE INFO HERE!" END DO END IF @@ -203,7 +203,7 @@ SUBROUTINE read_force_field_gromos(ff_type, para_env, mm_section) gro_info%bend_k(itype) = ekt/ACOS(csq)**2 END IF gro_info%bend_k(itype) = cp_unit_to_cp2k(gro_info%bend_k(itype), "kjmol") - IF (iw > 0) WRITE (iw, *) "GROMOS_FF| PUT BONDANGLETYPE INFO HERE!!!!" + IF (iw > 0) WRITE (iw, *) "GROMOS_FF| PUT BONDANGLETYPE INFO HERE!" END DO END IF @@ -222,7 +222,7 @@ SUBROUTINE read_force_field_gromos(ff_type, para_env, mm_section) CALL parser_get_object(parser, gro_info%impr_phi0(itype)) gro_info%impr_phi0(itype) = cp_unit_to_cp2k(gro_info%impr_phi0(itype), "deg") gro_info%impr_k(itype) = cp_unit_to_cp2k(gro_info%impr_k(itype), "kjmol*deg^-2") - IF (iw > 0) WRITE (iw, *) "GROMOS_FF| PUT IMPDIHEDRALTYPE INFO HERE!!!!" + IF (iw > 0) WRITE (iw, *) "GROMOS_FF| PUT IMPDIHEDRALTYPE INFO HERE!" END DO END IF @@ -243,7 +243,7 @@ SUBROUTINE read_force_field_gromos(ff_type, para_env, mm_section) CALL parser_get_object(parser, gro_info%torsion_m(itype)) gro_info%torsion_phi0(itype) = ACOS(cosphi0) gro_info%torsion_k(itype) = cp_unit_to_cp2k(gro_info%torsion_k(itype), "kjmol") - IF (iw > 0) WRITE (iw, *) "GROMOS_FF| PUT DIHEDRALTYPE INFO HERE!!!!" + IF (iw > 0) WRITE (iw, *) "GROMOS_FF| PUT DIHEDRALTYPE INFO HERE!" END DO END IF @@ -293,7 +293,7 @@ SUBROUTINE read_force_field_gromos(ff_type, para_env, mm_section) gro_info%nonbond_c12_14(jatom, iatom) = gro_info%nonbond_c12_14(iatom, jatom) gro_info%nonbond_c6(jatom, iatom) = gro_info%nonbond_c6(iatom, jatom) gro_info%nonbond_c12(jatom, iatom) = gro_info%nonbond_c12(iatom, jatom) - IF (iw > 0) WRITE (iw, *) "GROMOS_FF| PUT LJPARAMETERS INFO HERE!!!!" + IF (iw > 0) WRITE (iw, *) "GROMOS_FF| PUT LJPARAMETERS INFO HERE!" END DO END IF CALL parser_release(parser) diff --git a/src/hfx_ri.F b/src/hfx_ri.F index 730f1b2a26..6c32b3fc5f 100644 --- a/src/hfx_ri.F +++ b/src/hfx_ri.F @@ -718,7 +718,7 @@ SUBROUTINE hfx_ri_pre_scf_calc_tensors(qs_env, ri_data, t_2c_int_RI, t_2c_int_po max_iter=ri_data%max_iter_lanczos, converged=converged) IF (.NOT. converged) THEN - CPWARN("Condition number estimate of (P|Q) (HFX potential) is not reliable (not converged).") + CPWARN("Not converged: unreliable condition number estimate of (P|Q) matrix (HFX potential).") END IF IF (ri_data%unit_nr > 0) THEN @@ -737,7 +737,7 @@ SUBROUTINE hfx_ri_pre_scf_calc_tensors(qs_env, ri_data, t_2c_int_RI, t_2c_int_po max_iter=ri_data%max_iter_lanczos, converged=converged) IF (.NOT. converged) THEN - CPWARN("Condition number estimate of (P|Q) matrix (RI metric) is not reliable (not converged).") + CPWARN("Not converged: unreliable condition number estimate of (P|Q) matrix (RI metric).") END IF IF (ri_data%unit_nr > 0) THEN diff --git a/src/hfx_ri_kp.F b/src/hfx_ri_kp.F index 08a6706983..c41129a0f2 100644 --- a/src/hfx_ri_kp.F +++ b/src/hfx_ri_kp.F @@ -533,8 +533,9 @@ SUBROUTINE hfx_ri_update_ks_kp(qs_env, ri_data, ks_matrix, ehfx, rho_ao, & CALL section_vals_val_set(hfx_section, "KP_NGROUPS", i_val=ngroups) END IF IF ((MOD(ngroups, natom) .NE. 0) .AND. (MOD(natom, ngroups) .NE. 0) .AND. geometry_did_change) THEN - IF (ngroups > 1) & + IF (ngroups > 1) THEN CPWARN("Better load balancing is reached if NGROUPS is a multiple/divisor of the number of atoms") + END IF END IF group_size = para_env%num_pe/ngroups igroup = para_env%mepos/group_size diff --git a/src/hfx_types.F b/src/hfx_types.F index f269c4e107..139206c249 100644 --- a/src/hfx_types.F +++ b/src/hfx_types.F @@ -2371,7 +2371,6 @@ SUBROUTINE hfx_create_neighbor_cells(x_data, pbc_shells, cell, i_thread, nkp_gri END DO IF (total_number_of_cells < SIZE(x_data%neighbor_cells)) THEN IF (i_thread == 1) THEN - WRITE (char_nshells, '(I3)') SIZE(x_data%neighbor_cells) WRITE (error_msg, '(A,A,A)') "Periodic Hartree Fock calculation requested with use "// & "of a truncated potential. The number of shells to be considered "// & diff --git a/src/ipi_driver.F b/src/ipi_driver.F index 403fcaa21f..7aec5049ed 100644 --- a/src/ipi_driver.F +++ b/src/ipi_driver.F @@ -261,7 +261,7 @@ SUBROUTINE run_driver(force_env, globenv) END IF hasdata = .FALSE. ELSE - IF (output_unit > 0) WRITE (output_unit, *) " @DRIVER MODE: Socket disconnected, time to exit. " + IF (output_unit > 0) WRITE (output_unit, *) " @DRIVER MODE: Socket disconnected, time to exit." EXIT END IF END DO driver_loop diff --git a/src/localization_tb.F b/src/localization_tb.F index 5a5845b2a6..3819a6604a 100644 --- a/src/localization_tb.F +++ b/src/localization_tb.F @@ -126,17 +126,11 @@ SUBROUTINE wfn_localization_tb(qs_env, tb_type) IF (loc_explicit) THEN CALL section_vals_val_get(localize_section, "LIST", explicit=explicit) - IF (explicit) THEN - CPWARN("Localization using LIST of states not implemented for TB methods") - END IF + CPWARN_IF(explicit, "Localization using LIST of states not implemented for TB methods") CALL section_vals_val_get(localize_section, "ENERGY_RANGE", explicit=explicit) - IF (explicit) THEN - CPWARN("Localization using energy range not implemented for TB methods") - END IF + CPWARN_IF(explicit, "Localization using energy range not implemented for TB methods") CALL section_vals_val_get(localize_section, "LIST_UNOCCUPIED", explicit=explicit) - IF (explicit) THEN - CPWARN("Localization of unoccupied states not implemented for TB methods") - END IF + CPWARN_IF(explicit, "Localization of unoccupied states not implemented for TB methods") ! localize all occupied states IF (iounit > 0) THEN WRITE (iounit, "(/,T11,A)") " +++++++++++++ Start Localization of Orbitals +++++++++++++" @@ -152,7 +146,7 @@ SUBROUTINE wfn_localization_tb(qs_env, tb_type) CALL qs_subsys_get(subsys, particles=particles) IF (do_kpoints) THEN - CPWARN("Localization not implemented for k-point calculations!!") + CPWARN("Localization not implemented for k-point calculations!") ELSEIF (dft_control%restricted) THEN IF (iounit > 0) WRITE (iounit, *) & " Unclear how we define MOs / localization in the restricted case ... skipping" diff --git a/src/ls_matrix_exp.F b/src/ls_matrix_exp.F index 4d9150d274..0339b592fb 100644 --- a/src/ls_matrix_exp.F +++ b/src/ls_matrix_exp.F @@ -409,8 +409,7 @@ SUBROUTINE bch_expansion_imaginary_propagator(propagator, density_re, density_im CALL dbcsr_filter(density_re, filter_eps) CALL dbcsr_filter(density_im, filter_eps) - IF (.NOT. convergence) & - CPWARN("BCH method did not converge") + CPWARN_IF(.NOT. convergence, "BCH method did not converge") CALL dbcsr_deallocate_matrix(tmp) CALL dbcsr_deallocate_matrix(tmp2) @@ -499,8 +498,7 @@ SUBROUTINE bch_expansion_complex_propagator(propagator_re, propagator_im, densit CALL dbcsr_filter(density_re, filter_eps) CALL dbcsr_filter(density_im, filter_eps) - IF (.NOT. convergence) & - CPWARN("BCH method did not converge ") + CPWARN_IF(.NOT. convergence, "BCH method did not converge") CALL dbcsr_deallocate_matrix(tmp) CALL dbcsr_deallocate_matrix(tmp2) diff --git a/src/matrix_exp.F b/src/matrix_exp.F index e923734b83..88fce56aa5 100644 --- a/src/matrix_exp.F +++ b/src/matrix_exp.F @@ -946,8 +946,7 @@ SUBROUTINE arnoldi(mos_old, mos_new, eps_exp, Hre, Him, mos_next, narn_old) IF (convergence) EXIT END DO - IF (.NOT. convergence) & - CPWARN("ARNOLDI method did not converge") + CPWARN_IF(.NOT. convergence, "ARNOLDI method did not converge") !deallocate all work matrices CALL cp_fm_release(V_mats) diff --git a/src/metadyn_tools/graph.F b/src/metadyn_tools/graph.F index 1cca3d3a7d..a3238f37f5 100644 --- a/src/metadyn_tools/graph.F +++ b/src/metadyn_tools/graph.F @@ -201,7 +201,7 @@ PROGRAM graph END DO IF (COUNT((/l_orac, l_cp2k, l_cpmd/)) /= 1) & - CPABORT("Error! You've to specify either ORAC, CP2K or CPMD!!") + CPABORT("Error! You've to specify either ORAC, CP2K or CPMD!") ! For CPMD move filename to colvar_mtd IF (l_cpmd) THEN diff --git a/src/motion/cp_lbfgs_optimizer_gopt.F b/src/motion/cp_lbfgs_optimizer_gopt.F index 6c16bae82e..84e2918bd2 100644 --- a/src/motion/cp_lbfgs_optimizer_gopt.F +++ b/src/motion/cp_lbfgs_optimizer_gopt.F @@ -393,9 +393,8 @@ SUBROUTINE cp_opt_gopt_get(optimizer, para_env, & CPASSERT(.NOT. PRESENT(last_f)) CPASSERT(.NOT. PRESENT(actual_projected_gradient)) END IF - ELSE - IF (PRESENT(lower_bound) .OR. PRESENT(upper_bound) .OR. PRESENT(kind_of_bound)) & - CPWARN("asked undefined types") + ELSE IF (PRESENT(lower_bound) .OR. PRESENT(upper_bound) .OR. PRESENT(kind_of_bound)) THEN + CPWARN("asked undefined types") END IF END SUBROUTINE cp_opt_gopt_get diff --git a/src/motion/helium_methods.F b/src/motion/helium_methods.F index 47eeb4647d..576928da91 100644 --- a/src/motion/helium_methods.F +++ b/src/motion/helium_methods.F @@ -777,7 +777,7 @@ SUBROUTINE helium_create(helium_env, input, solute) nnp_section => section_vals_get_subs_vals(helium_section, "NNP") CALL section_vals_get(nnp_section, explicit=explicit) msg_str = "NNP section not explicitly stated. Using default file names." - IF (.NOT. explicit) CPWARN(msg_str) + CPWARN_IF(.NOT. explicit, msg_str) END IF ALLOCATE (helium_env(k)%helium%nnp) CALL cp_logger_create(tmplogger, para_env=helium_env(k)%comm, template_logger=logger) diff --git a/src/motion/md_vel_utils.F b/src/motion/md_vel_utils.F index e540a95cb4..97424226e6 100644 --- a/src/motion/md_vel_utils.F +++ b/src/motion/md_vel_utils.F @@ -2297,8 +2297,9 @@ SUBROUTINE initialize_cascade(simpar, particle_set, molecule_kinds, md_section) norm = 0.0_dp DO iatom = 1, natom iparticle = atom_index(iatom) - IF (particle_set(iparticle)%shell_index /= 0) & + IF (particle_set(iparticle)%shell_index /= 0) THEN CPWARN("Warning: The primary knock-on atom is a core-shell atom") + END IF atomic_kind => particle_set(iparticle)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, mass=matom(iatom)) norm = norm + matom(iatom)*weight(iatom) diff --git a/src/pao_io.F b/src/pao_io.F index 76bc92831f..e47aa04871 100644 --- a/src/pao_io.F +++ b/src/pao_io.F @@ -115,8 +115,9 @@ SUBROUTINE pao_read_restart(pao, qs_env) CALL pao_read_raw(pao%restart_file, param, hmat, kinds, atom2kind, positions, xblocks) ! check cell - IF (MAXVAL(ABS(hmat - cell%hmat)) > 1e-10) & + IF (MAXVAL(ABS(hmat - cell%hmat)) > 1e-10) THEN CPWARN("Restarting from different cell") + END IF ! check parametrization IF (TRIM(param) .NE. TRIM(ADJUSTL(id2str(pao%parameterization)))) & @@ -142,8 +143,7 @@ SUBROUTINE pao_read_restart(pao, qs_env) DO iatom = 1, natoms diff = MAX(diff, MAXVAL(ABS(positions(iatom, :) - particle_set(iatom)%r))) END DO - IF (diff > 1e-10) & - CPWARN("Restarting from different atom positions") + CPWARN_IF(diff > 1e-10, "Restarting from different atom positions") END IF @@ -365,14 +365,18 @@ SUBROUTINE pao_kinds_ensure_equal(pao, qs_env, ikind, pao_kind) CPABORT("Number of PAO_POTENTIALS does not match") DO ipot = 1, SIZE(pao_potentials) - IF (pao_kind%pao_potentials(ipot)%maxl /= pao_potentials(ipot)%maxl) & + IF (pao_kind%pao_potentials(ipot)%maxl /= pao_potentials(ipot)%maxl) THEN CPABORT("PAO_POT_MAXL does not match") - IF (pao_kind%pao_potentials(ipot)%max_projector /= pao_potentials(ipot)%max_projector) & + END IF + IF (pao_kind%pao_potentials(ipot)%max_projector /= pao_potentials(ipot)%max_projector) THEN CPABORT("PAO_POT_MAX_PROJECTOR does not match") - IF (pao_kind%pao_potentials(ipot)%beta /= pao_potentials(ipot)%beta) & + END IF + IF (pao_kind%pao_potentials(ipot)%beta /= pao_potentials(ipot)%beta) THEN CPWARN("PAO_POT_BETA does not match") - IF (pao_kind%pao_potentials(ipot)%weight /= pao_potentials(ipot)%weight) & + END IF + IF (pao_kind%pao_potentials(ipot)%weight /= pao_potentials(ipot)%weight) THEN CPWARN("PAO_POT_WEIGHT does not match") + END IF END DO END SUBROUTINE pao_kinds_ensure_equal diff --git a/src/pao_linpot_rotinv.F b/src/pao_linpot_rotinv.F index 35a1f004a2..5973a0031e 100644 --- a/src/pao_linpot_rotinv.F +++ b/src/pao_linpot_rotinv.F @@ -67,7 +67,7 @@ SUBROUTINE linpot_rotinv_count_terms(qs_env, ikind, nterms) nshells = SUM(basis_set%nshell) npots = SIZE(pao_potentials) - IF (npots == 0) CPWARN("Found no PAO_POTENTIAL section") + CPWARN_IF(npots == 0, "Found no PAO_POTENTIAL section") ! fill shell_l ALLOCATE (shell_l(nshells)) diff --git a/src/pao_methods.F b/src/pao_methods.F index a2934e9433..c694b1df27 100644 --- a/src/pao_methods.F +++ b/src/pao_methods.F @@ -466,7 +466,7 @@ SUBROUTINE pao_test_convergence(pao, ls_scf_env, new_energy, is_converged) IF (pao%istep > 1) THEN IF (pao%iw > 0) WRITE (pao%iw, *) "PAO| energy improvement:", energy_diff - ! IF(energy_diff>0.0_dp) CPWARN("PAO| energy increased") + ! CPWARN_IF(energy_diff>0.0_dp, "PAO| energy increased") ! print one-liner IF (pao%iw > 0) WRITE (pao%iw, '(A,I6,11X,F20.9,1X,E10.3,1X,E10.3,1X,F9.3)') & diff --git a/src/pao_ml.F b/src/pao_ml.F index 4817473128..e8d071d8a7 100644 --- a/src/pao_ml.F +++ b/src/pao_ml.F @@ -190,8 +190,9 @@ SUBROUTINE add_to_training_list(pao, qs_env, training_lists, filename) CALL para_env%bcast(positions) CALL para_env%bcast(ml_range) - IF (ml_range(1) /= 1 .OR. ml_range(2) /= natoms) & + IF (ml_range(1) /= 1 .OR. ml_range(2) /= natoms) THEN CPWARN("Skipping some atoms for PAO-ML training.") + END IF ! create cell from read-in h-matrix CALL cell_create(cell, hmat) diff --git a/src/pw/ps_implicit_methods.F b/src/pw/ps_implicit_methods.F index 2a34d2682d..6c177c15d2 100644 --- a/src/pw/ps_implicit_methods.F +++ b/src/pw/ps_implicit_methods.F @@ -2078,11 +2078,6 @@ SUBROUTINE ps_implicit_print_convergence_msg(iter, max_iter, outp_unit) CALL timeset(routineN, handle) last_iter = iter - 1 - IF (last_iter .EQ. 1) THEN - msg = " iteration. " - ELSE - msg = " iterations." - END IF IF (outp_unit .GT. 0) THEN IF (last_iter .EQ. max_iter) THEN @@ -2090,6 +2085,11 @@ SUBROUTINE ps_implicit_print_convergence_msg(iter, max_iter, outp_unit) "POISSON| No convergence achieved within the maximum number of iterations." END IF IF (last_iter .LT. max_iter) THEN + IF (last_iter .EQ. 1) THEN + msg = " iteration." + ELSE + msg = " iterations." + END IF WRITE (outp_unit, '(T3,A,I0,A)') & "POISSON| Poisson solver converged in ", last_iter, msg END IF diff --git a/src/pw/ps_wavelet_methods.F b/src/pw/ps_wavelet_methods.F index ab4bd5ed3c..19c3a17125 100644 --- a/src/pw/ps_wavelet_methods.F +++ b/src/pw/ps_wavelet_methods.F @@ -234,9 +234,9 @@ SUBROUTINE cp2k_distribution_to_z_slices(density, wavelet, pw_grid) END IF CALL pw_grid%para%group%max(should_warn) - IF (should_warn > 0 .AND. iproc == 0) & + IF (should_warn > 0 .AND. iproc == 0) THEN CPWARN("Density non-zero on the edges of the unit cell: wrong results in WAVELET solver") - + END IF DO i = 0, pw_grid%para%group%num_pe_cart(1) - 1 DO j = 0, pw_grid%para%group%num_pe_cart(2) - 1 cart_pos = (/i, j/) diff --git a/src/pw/pw_pool_types.F b/src/pw/pw_pool_types.F index 2e2256d15f..c4f2240123 100644 --- a/src/pw/pw_pool_types.F +++ b/src/pw/pw_pool_types.F @@ -381,8 +381,7 @@ SUBROUTINE pw_pool_give_back_cr3d(pw_pool, cr3d) IF (cp_sll_3d_r_get_length(pw_pool%r3d_array) < pw_pool%max_cache) THEN CALL cp_sll_3d_r_insert_el(pw_pool%r3d_array, el=cr3d) ELSE - IF (max_max_cache >= 0) & - CPWARN("hit max_cache") + CPWARN_IF(max_max_cache >= 0, "hit max_cache") DEALLOCATE (cr3d) END IF ELSE diff --git a/src/qmmm_topology_util.F b/src/qmmm_topology_util.F index 8a36a868cc..f039a0d260 100644 --- a/src/qmmm_topology_util.F +++ b/src/qmmm_topology_util.F @@ -164,7 +164,7 @@ SUBROUTINE qmmm_connectivity_control(molecule_set, & 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!!" + 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!", & diff --git a/src/qmmmx_update.F b/src/qmmmx_update.F index c335739331..a5f78b645a 100644 --- a/src/qmmmx_update.F +++ b/src/qmmmx_update.F @@ -76,7 +76,7 @@ SUBROUTINE qmmmx_update_force_env(force_env, root_section) CALL force_env_get(force_env, subsys=subsys) CALL update_force_mixing_labels(subsys, qmmm_section, labels_changed=labels_changed) IF (.NOT. labels_changed) RETURN - CPWARN("Adaptive force-mixing labels changed, rebuilding QM/MM calculations! ") + CPWARN("Adaptive force-mixing labels changed, rebuilding QM/MM calculations!") CALL update_force_eval(force_env, root_section, .FALSE.) diff --git a/src/qs_environment.F b/src/qs_environment.F index 19f987aa80..740f8a421e 100644 --- a/src/qs_environment.F +++ b/src/qs_environment.F @@ -1567,8 +1567,9 @@ SUBROUTINE qs_init_subsys(qs_env, para_env, subsys, cell, cell_ref, use_ref_cell ELSE n_mo_add = scf_control%added_mos(1) END IF - IF (n_mo_add > n_ao - n_mo(2)) & + IF (n_mo_add > n_ao - n_mo(2)) THEN CPWARN("More ADDED_MOs requested for beta spin than available.") + END IF scf_control%added_mos(2) = MIN(n_mo_add, n_ao - n_mo(2)) n_mo(2) = n_mo(2) + scf_control%added_mos(2) END IF @@ -1635,9 +1636,9 @@ SUBROUTINE qs_init_subsys(qs_env, para_env, subsys, cell, cell_ref, use_ref_cell ! Compatibility checks for ROKS IF (dft_control%roks .AND. (.NOT. scf_control%use_ot)) THEN - IF (scf_control%roks_scheme == general_roks) & + IF (scf_control%roks_scheme == general_roks) THEN CPWARN("General ROKS scheme is not yet tested!") - + END IF IF (scf_control%smear%do_smear) THEN CALL cp_abort(__LOCATION__, & "The options ROKS and SMEAR are not compatible. "// & diff --git a/src/qs_linres_nmr_utils.F b/src/qs_linres_nmr_utils.F index 2552295d10..3638be1407 100644 --- a/src/qs_linres_nmr_utils.F +++ b/src/qs_linres_nmr_utils.F @@ -168,9 +168,9 @@ SUBROUTINE nmr_env_init(nmr_env, qs_env) !ENDIF ! ! check that the psi0 are localized and you have all the centers - IF (.NOT. linres_control%localized_psi0) & - CPWARN(' To get NMR parameters within PBC you need localized zero order orbitals ') - + IF (.NOT. linres_control%localized_psi0) THEN + CPWARN("To get NMR parameters within PBC you need localized zero order orbitals") + END IF gapw = dft_control%qs_control%gapw nspins = dft_control%nspins natom = SIZE(particle_set, 1) diff --git a/src/qs_mo_occupation.F b/src/qs_mo_occupation.F index 6d84108451..8dfb428e8e 100644 --- a/src/qs_mo_occupation.F +++ b/src/qs_mo_occupation.F @@ -113,8 +113,7 @@ SUBROUTINE set_mo_occupation_3(mo_array, smear) is_large = ABS(MAXVAL(all_occ) - 1.0_dp) > smear%eps_fermi_dirac ! this is not a real problem, but the temperature might be a bit large - IF (is_large) & - CPWARN("Fermi-Dirac smearing includes the first MO") + CPWARN_IF(is_large, "Fermi-Dirac smearing includes the first MO") is_large = ABS(MINVAL(all_occ)) > smear%eps_fermi_dirac IF (is_large) & @@ -124,8 +123,7 @@ SUBROUTINE set_mo_occupation_3(mo_array, smear) ! check that the total electron count is accurate is_large = (ABS(all_nelec - accurate_sum(all_occ(:))) > smear%eps_fermi_dirac*all_nelec) - IF (is_large) & - CPWARN("Total number of electrons is not accurate") + CPWARN_IF(is_large, "Total number of electrons is not accurate") DO i = 1, all_nmo IF (all_index(i) <= nmo_a) THEN @@ -577,8 +575,7 @@ SUBROUTINE set_mo_occupation_1(mo_set, smear, eval_deriv, xas_env, tot_zeff_corr END DO is_large = ABS(MAXVAL(mo_set%occupation_numbers) - mo_set%maxocc) > smear%eps_fermi_dirac ! this is not a real problem, but the temperature might be a bit large - IF (is_large) & - CPWARN("Fermi-Dirac smearing includes the first MO") + CPWARN_IF(is_large, "Fermi-Dirac smearing includes the first MO") ! Find the highest (fractional) occupied MO which will be now the HOMO DO imo = nmo, mo_set%lfomo, -1 @@ -595,8 +592,7 @@ SUBROUTINE set_mo_occupation_1(mo_set, smear, eval_deriv, xas_env, tot_zeff_corr ! check that the total electron count is accurate is_large = (ABS(nelec - accurate_sum(mo_set%occupation_numbers(:))) > smear%eps_fermi_dirac*nelec) - IF (is_large) & - CPWARN("Total number of electrons is not accurate") + CPWARN_IF(is_large, "Total number of electrons is not accurate") CASE (smear_energy_window) ! not implemented @@ -604,8 +600,9 @@ SUBROUTINE set_mo_occupation_1(mo_set, smear, eval_deriv, xas_env, tot_zeff_corr ! Define the energy window for the eigenvalues e1 = mo_set%eigenvalues(mo_set%homo) - 0.5_dp*smear%window_size - IF (e1 <= mo_set%eigenvalues(1)) & + IF (e1 <= mo_set%eigenvalues(1)) THEN CPWARN("Energy window for smearing includes the first MO") + END IF e2 = mo_set%eigenvalues(mo_set%homo) + 0.5_dp*smear%window_size IF (e2 >= mo_set%eigenvalues(nmo)) & diff --git a/src/qs_scf_initialization.F b/src/qs_scf_initialization.F index 64512c751e..f46cc8dfbc 100644 --- a/src/qs_scf_initialization.F +++ b/src/qs_scf_initialization.F @@ -757,12 +757,10 @@ SUBROUTINE qs_scf_ensure_diagonalization(scf_env, scf_section, qs_env, & scf_env%skip_diis = .TRUE. scf_control%use_diag = .FALSE. - IF (.NOT. do_kpoints) & + IF (.NOT. do_kpoints) THEN CPABORT("SMEAGOL requires kpoint calculations") - - IF (scf_control%use_ot) THEN - CPWARN("OT is irrelevant to NEGF method") END IF + CPWARN_IF(scf_control%use_ot, "OT is irrelevant to NEGF method") END IF IF (scf_control%use_diag) THEN diff --git a/src/qs_scf_post_gpw.F b/src/qs_scf_post_gpw.F index ea80310bd6..c2651d2006 100644 --- a/src/qs_scf_post_gpw.F +++ b/src/qs_scf_post_gpw.F @@ -468,9 +468,7 @@ SUBROUTINE scf_post_calculation_gpw(qs_env, wf_type, do_mp2) END IF ! Makes the MOs eigenstates, computes eigenvalues, write cubes IF (do_kpoints) THEN - IF (do_mo_cubes) THEN - CPWARN("Print MO cubes not implemented for k-point calculations") - END IF + CPWARN_IF(do_mo_cubes, "Print MO cubes not implemented for k-point calculations") ELSE CALL get_qs_env(qs_env, & mos=mos, & @@ -506,7 +504,7 @@ SUBROUTINE scf_post_calculation_gpw(qs_env, wf_type, do_mp2) ! - Possibly gets molecular states IF (p_loc_homo) THEN IF (do_kpoints) THEN - CPWARN("Localization not implemented for k-point calculations!!") + CPWARN("Localization not implemented for k-point calculations!") ELSEIF (dft_control%restricted & .AND. (section_get_ival(localize_section, "METHOD") .NE. do_loc_none) & .AND. (section_get_ival(localize_section, "METHOD") .NE. do_loc_jacobi)) THEN @@ -669,7 +667,7 @@ SUBROUTINE scf_post_calculation_gpw(qs_env, wf_type, do_mp2) IF (p_loc_mixed) THEN IF (do_kpoints) THEN - CPWARN("Localization not implemented for k-point calculations!!") + CPWARN("Localization not implemented for k-point calculations!") ELSEIF (dft_control%restricted) THEN IF (output_unit > 0) WRITE (output_unit, *) & " Unclear how we define MOs / localization in the restricted case... skipping" @@ -1531,8 +1529,7 @@ SUBROUTINE qs_scf_post_elf(input, logger, qs_env) ELSE ! not implemented - CPWARN("ELF not implemented for GAPW calculations!!") - + CPWARN("ELF not implemented for GAPW calculations!") END IF END IF ! print key diff --git a/src/qs_scf_post_se.F b/src/qs_scf_post_se.F index 96b84c7bb0..75f6e346dd 100644 --- a/src/qs_scf_post_se.F +++ b/src/qs_scf_post_se.F @@ -169,14 +169,14 @@ SUBROUTINE scf_post_calculation_se(qs_env) print_key => section_vals_get_subs_vals(section_vals=input, & subsection_name="DFT%PRINT%XRAY_DIFFRACTION_SPECTRUM") IF (BTEST(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)) THEN - CPWARN("XRAY_DIFFRACTION_SPECTRUM not implemented for Semi-Empirical calculations!!") + CPWARN("XRAY_DIFFRACTION_SPECTRUM not implemented for Semi-Empirical calculations!") END IF ! Calculation of Electric Field Gradients print_key => section_vals_get_subs_vals(section_vals=input, & subsection_name="DFT%PRINT%ELECTRIC_FIELD_GRADIENT") IF (BTEST(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)) THEN - CPWARN("ELECTRIC_FIELD_GRADIENT not implemented for Semi-Empirical calculations!!") + CPWARN("ELECTRIC_FIELD_GRADIENT not implemented for Semi-Empirical calculations!") END IF ! Calculation of EPR Hyperfine Coupling Tensors @@ -184,7 +184,7 @@ SUBROUTINE scf_post_calculation_se(qs_env) subsection_name="DFT%PRINT%HYPERFINE_COUPLING_TENSOR") IF (BTEST(cp_print_key_should_output(logger%iter_info, print_key), & cp_p_file)) THEN - CPWARN("HYPERFINE_COUPLING_TENSOR not implemented for Semi-Empirical calculations!!") + CPWARN("HYPERFINE_COUPLING_TENSOR not implemented for Semi-Empirical calculations!") END IF CALL timestop(handle) @@ -634,43 +634,43 @@ SUBROUTINE write_available_results(qs_env) dft_section => section_vals_get_subs_vals(input, "DFT") IF (BTEST(cp_print_key_should_output(logger%iter_info, dft_section, "PRINT%PDOS") & , cp_p_file)) THEN - CPWARN("PDOS not implemented for Semi-Empirical calculations!!") + CPWARN("PDOS not implemented for Semi-Empirical calculations!") END IF ! Print the total density (electronic + core charge) IF (BTEST(cp_print_key_should_output(logger%iter_info, input, & "DFT%PRINT%TOT_DENSITY_CUBE"), cp_p_file)) THEN - CPWARN("TOT_DENSITY_CUBE not implemented for Semi-Empirical calculations!!") + CPWARN("TOT_DENSITY_CUBE not implemented for Semi-Empirical calculations!") END IF ! Write cube file with electron density IF (BTEST(cp_print_key_should_output(logger%iter_info, input, & "DFT%PRINT%E_DENSITY_CUBE"), cp_p_file)) THEN - CPWARN("E_DENSITY_CUBE not implemented for Semi-Empirical calculations!!") + CPWARN("E_DENSITY_CUBE not implemented for Semi-Empirical calculations!") END IF ! print key ! Write cube file with EFIELD IF (BTEST(cp_print_key_should_output(logger%iter_info, input, & "DFT%PRINT%EFIELD_CUBE"), cp_p_file)) THEN - CPWARN("EFIELD_CUBE not implemented for Semi-Empirical calculations!!") + CPWARN("EFIELD_CUBE not implemented for Semi-Empirical calculations!") END IF ! print key ! Write cube file with ELF IF (BTEST(cp_print_key_should_output(logger%iter_info, input, & "DFT%PRINT%ELF_CUBE"), cp_p_file)) THEN - CPWARN("ELF function not implemented for Semi-Empirical calculations!!") + CPWARN("ELF function not implemented for Semi-Empirical calculations!") END IF ! print key ! Print the hartree potential IF (BTEST(cp_print_key_should_output(logger%iter_info, input, & "DFT%PRINT%V_HARTREE_CUBE"), cp_p_file)) THEN - CPWARN("V_HARTREE_CUBE not implemented for Semi-Empirical calculations!!") + CPWARN("V_HARTREE_CUBE not implemented for Semi-Empirical calculations!") END IF ! Print the XC potential IF (BTEST(cp_print_key_should_output(logger%iter_info, input, & "DFT%PRINT%V_XC_CUBE"), cp_p_file)) THEN - CPWARN("V_XC_CUBE not available for Semi-Empirical calculations!!") + CPWARN("V_XC_CUBE not available for Semi-Empirical calculations!") END IF ! Write the density matrix diff --git a/src/qs_tddfpt2_stda_utils.F b/src/qs_tddfpt2_stda_utils.F index f5c16e4ea0..89e3159144 100644 --- a/src/qs_tddfpt2_stda_utils.F +++ b/src/qs_tddfpt2_stda_utils.F @@ -369,7 +369,7 @@ SUBROUTINE get_lowdin_mo_coefficients(qs_env, sub_env, work) ELSE CALL get_qs_env(qs_env=qs_env, matrix_s_kp=matrixkp_s) CPASSERT(ASSOCIATED(matrixkp_s)) - IF (SIZE(matrixkp_s, 2) > 1) CPWARN("not implemented for k-points.") + CPWARN_IF(SIZE(matrixkp_s, 2) > 1, "not implemented for k-points.") sm_s => matrixkp_s(1, 1)%matrix END IF sm_h => work%shalf diff --git a/src/qs_tddfpt_eigensolver.F b/src/qs_tddfpt_eigensolver.F index 1abc07d73a..4e83596d1b 100644 --- a/src/qs_tddfpt_eigensolver.F +++ b/src/qs_tddfpt_eigensolver.F @@ -232,7 +232,7 @@ FUNCTION iterative_solver(in_evals, & IF (max_krylovspace_dim <= max_kv) THEN max_kv = max_krylovspace_dim IF (output_unit > 0) THEN - WRITE (output_unit, *) " Setting the maximum number of krylov vectors to ", max_kv, "!!" + WRITE (output_unit, *) " Setting the maximum number of krylov vectors to ", max_kv, "!" END IF END IF diff --git a/src/qs_wannier90.F b/src/qs_wannier90.F index 4c5e8e7dcb..d68724eb42 100644 --- a/src/qs_wannier90.F +++ b/src/qs_wannier90.F @@ -340,7 +340,7 @@ SUBROUTINE wannier90_files(qs_env, input, iw) CALL create_kp_from_gamma(qs_env, qs_env_kp) END IF IF (iw > 0) THEN - WRITE (unit=iw, FMT="(/,T2,A)") "Start K-Point Calculation ... " + WRITE (unit=iw, FMT="(/,T2,A)") "Start K-Point Calculation ..." END IF CALL get_qs_env(qs_env=qs_env_kp, para_env=para_env, blacs_env=blacs_env) CALL kpoint_env_initialize(kpoint, para_env, blacs_env) diff --git a/src/ri_environment_methods.F b/src/ri_environment_methods.F index 017e693480..e8b3876ffd 100644 --- a/src/ri_environment_methods.F +++ b/src/ri_environment_methods.F @@ -331,9 +331,7 @@ SUBROUTINE ri_metric_solver(mat, vecr, vecx, matp, solver, ptr) vect(:) = vect(:) - vecr(:) rerror = MAXVAL(ABS(vect(:))) DEALLOCATE (vect) - IF (rerror > threshold) THEN - CPWARN("RI solver: CG did not converge properly") - END IF + CPWARN_IF(rerror > threshold, "RI solver: CG did not converge properly") END IF CALL timestop(handle) diff --git a/src/semi_empirical_int_debug.F b/src/semi_empirical_int_debug.F index 9ed2f06717..a18921e2e0 100644 --- a/src/semi_empirical_int_debug.F +++ b/src/semi_empirical_int_debug.F @@ -588,7 +588,7 @@ END FUNCTION check_value IF (PRESENT(enuc)) THEN CALL corecore_num(sepi, sepj, rijv, enuc_num, itype, se_int_control, se_taper) IF (.NOT. check_value(enuc, enuc_num, delta, 0.001_dp)) THEN - WRITE (*, *) "ERROR for CORE-CORE energy value (numerical different from analytical)!!" + WRITE (*, *) "ERROR for CORE-CORE energy value (numerical different from analytical)!" CPABORT("") END IF END IF diff --git a/src/subsys/external_potential_types.F b/src/subsys/external_potential_types.F index a9625f8bae..fbe19e260b 100644 --- a/src/subsys/external_potential_types.F +++ b/src/subsys/external_potential_types.F @@ -1364,7 +1364,7 @@ SUBROUTINE read_all_potential(element_symbol, potential_name, potential, zeff_co is_ok = cp_sll_val_next(list, val) IF (.NOT. is_ok) & CALL cp_abort(__LOCATION__, & - "Error reading the Potential from input file!!") + "Error reading the Potential from input file!") CALL val_get(val, c_val=line_att) READ (line_att, *) elec_conf(l) CALL remove_word(line_att) @@ -1404,7 +1404,7 @@ SUBROUTINE read_all_potential(element_symbol, potential_name, potential, zeff_co is_ok = cp_sll_val_next(list, val) IF (.NOT. is_ok) & CALL cp_abort(__LOCATION__, & - "Error reading the Potential from input file!!") + "Error reading the Potential from input file!") CALL val_get(val, c_val=line_att) READ (line_att, *) r ELSE @@ -1550,7 +1550,7 @@ SUBROUTINE read_local_potential(element_symbol, potential_name, potential, & is_ok = cp_sll_val_next(list, val) IF (.NOT. is_ok) & CALL cp_abort(__LOCATION__, & - "Error reading the Potential from input file!!") + "Error reading the Potential from input file!") CALL val_get(val, c_val=line_att) READ (line_att, *) ngau, npol CALL remove_word(line_att) @@ -1572,7 +1572,7 @@ SUBROUTINE read_local_potential(element_symbol, potential_name, potential, & is_ok = cp_sll_val_next(list, val) IF (.NOT. is_ok) & CALL cp_abort(__LOCATION__, & - "Error reading the Potential from input file!!") + "Error reading the Potential from input file!") CALL val_get(val, c_val=line_att) READ (line_att, *) alpha(igau), (cval(igau, ipol), ipol=1, npol) ELSE diff --git a/src/tmc/tmc_file_io.F b/src/tmc/tmc_file_io.F index 8c4de7f142..74f404e9ce 100644 --- a/src/tmc/tmc_file_io.F +++ b/src/tmc/tmc_file_io.F @@ -326,8 +326,9 @@ SUBROUTINE read_restart_file(tmc_env, job_counts, timings, file_name) IF (ANY(ABS(tmc_env%params%Temp(:) - tmp_temp(:)) .GE. 0.005)) & CALL cp_abort(__LOCATION__, "the temperatures differ from the previous calculation. "// & "There were the following temperatures used:") - IF (ANY(mv_weight_tmp(:) .NE. tmc_env%params%move_types%mv_weight(:))) & + IF (ANY(mv_weight_tmp(:) .NE. tmc_env%params%move_types%mv_weight(:))) THEN CPWARN("The amount of mv types differs between the original and the restart run.") + END IF DO i = 1, SIZE(tmc_env%params%Temp) tmc_env%m_env%gt_act%conf(i)%elem => tmc_env%m_env%result_list(i)%elem @@ -856,8 +857,9 @@ SUBROUTINE read_dipole_from_file(elem, tmc_ana, stat, conf_nr) ELSE IF (status .LT. 0) THEN ! end of file reached stat = TMC_STATUS_WAIT_FOR_NEW_TASK ELSE - IF (status .NE. 0) & + IF (status .NE. 0) THEN CPWARN("configuration dipole read error at line: "//cp_to_string(tmc_ana%lc_dip)) + END IF stat = TMC_STATUS_FAILED END IF diff --git a/src/tmc/tmc_master.F b/src/tmc/tmc_master.F index b1ea5946b4..a87dd2f944 100644 --- a/src/tmc/tmc_master.F +++ b/src/tmc/tmc_master.F @@ -833,7 +833,7 @@ SUBROUTINE do_tmc_master(tmc_env, globenv) WRITE (tmc_env%m_env%io_unit, *) & "Time: ", INT(m_walltime() - run_time_start), "of", & INT(tmc_env%m_env%walltime - walltime_delay - walltime_offset), & - "sec needed. " + "sec needed." CALL m_memory(mem) WRITE (tmc_env%m_env%io_unit, *) & "Memory used: ", INT(mem/(1024*1024), KIND=KIND(0)), "MiBytes" diff --git a/src/tmc/tmc_setup.F b/src/tmc/tmc_setup.F index 5fc6f842ec..6a57223bef 100644 --- a/src/tmc/tmc_setup.F +++ b/src/tmc/tmc_setup.F @@ -368,8 +368,9 @@ SUBROUTINE do_analyze_files(input_declaration, root_section, para_env) ! -- spiltting communicator ALLOCATE (tmc_env%tmc_comp_set%para_env_m_ana) CALL tmc_env%tmc_comp_set%para_env_m_ana%from_split(para_env, para_env%mepos, 0) - IF (para_env%num_pe .NE. 1) & + IF (para_env%num_pe .NE. 1) THEN CPWARN("just one out of "//cp_to_string(para_env%num_pe)//"cores is used ") + END IF ! distribute work to availuble cores IF (para_env%mepos .EQ. 0) THEN !TODO get the correct usage of creating and handling the logger... @@ -830,13 +831,15 @@ SUBROUTINE tmc_redistributing_cores(tmc_comp_set, para_env, ana_on_the_fly, & success = .FALSE. ELSE ! check if there are enougth cores available - IF (tmc_comp_set%group_ener_size*tmc_comp_set%group_ener_nr .GT. (para_env%num_pe - 1)) & + IF (tmc_comp_set%group_ener_size*tmc_comp_set%group_ener_nr .GT. (para_env%num_pe - 1)) THEN CPWARN("The selected energy group size is too huge. ") + END IF IF (flag) THEN tmc_comp_set%group_ener_nr = INT((para_env%num_pe - 1)/ & REAL(tmc_comp_set%group_ener_size, KIND=dp)) - IF (tmc_comp_set%group_ener_nr .LT. 1) & + IF (tmc_comp_set%group_ener_nr .LT. 1) THEN CPWARN("The selected energy group size is too huge. ") + END IF IF (flag) success = .FALSE. END IF @@ -856,8 +859,9 @@ SUBROUTINE tmc_redistributing_cores(tmc_comp_set, para_env, ana_on_the_fly, & total_used = tmc_comp_set%group_ener_size*tmc_comp_set%group_ener_nr + & tmc_comp_set%group_cc_size*tmc_comp_set%group_cc_nr + & tmc_comp_set%ana_on_the_fly - IF (para_env%num_pe - 1 .GT. total_used) & + IF (para_env%num_pe - 1 .GT. total_used) THEN CPWARN(" mpi ranks are unused, but can be used for analysis.") + END IF ! determine the master node IF (para_env%mepos == para_env%num_pe - 1) THEN diff --git a/src/tmc/tmc_worker.F b/src/tmc/tmc_worker.F index 405fcff424..340408de1f 100644 --- a/src/tmc/tmc_worker.F +++ b/src/tmc/tmc_worker.F @@ -566,7 +566,7 @@ SUBROUTINE do_tmc_worker(tmc_env, ana_list) IF (DEBUG .GE. 5) & WRITE (tmc_env%w_env%io_unit, *) "worker ", & tmc_env%tmc_comp_set%para_env_sub_group%mepos, "of group ", & - tmc_env%tmc_comp_set%group_nr, "stops working!!!!!!!!!!!!!!!!!!" + tmc_env%tmc_comp_set%group_nr, "stops working!" IF (PRESENT(ana_list)) THEN DO itmp = 1, tmc_env%params%nr_temp diff --git a/src/topology_amber.F b/src/topology_amber.F index aa9c0c9012..8a9e161b86 100644 --- a/src/topology_amber.F +++ b/src/topology_amber.F @@ -207,8 +207,7 @@ SUBROUTINE read_coordinate_crd(topology, para_env, subsys_section) END IF IF (my_end) THEN - IF (j /= natom) & - CPWARN("No VELOCITY or BOX information found in CRD file. ") + CPWARN_IF(j /= natom, "No VELOCITY or BOX information found in CRD file.") ELSE ! Velocities CALL reallocate(velocity, 1, 3, 1, natom) @@ -256,8 +255,7 @@ SUBROUTINE read_coordinate_crd(topology, para_env, subsys_section) DEALLOCATE (velocity) END IF IF (my_end) THEN - IF (j /= natom) & - CPWARN("BOX information missing in CRD file. ") + CPWARN_IF(j /= natom, "BOX information missing in CRD file.") ELSE IF (j /= natom) & CALL cp_warn(__LOCATION__, & diff --git a/src/topology_coordinate_util.F b/src/topology_coordinate_util.F index 991c50e2e0..14d89c00f9 100644 --- a/src/topology_coordinate_util.F +++ b/src/topology_coordinate_util.F @@ -264,7 +264,7 @@ SUBROUTINE topology_coordinate_pack(particle_set, atomic_kind_set, & 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 (*, *) "Two molecules have been defined as identical molecules but atoms mismatch charges!" END IF END DO CPABORT("") diff --git a/src/topology_gromos.F b/src/topology_gromos.F index e6da8332c7..b285f32605 100644 --- a/src/topology_gromos.F +++ b/src/topology_gromos.F @@ -213,7 +213,7 @@ SUBROUTINE read_topology_gromos(file_name, topology, para_env, subsys_section) CALL parser_get_object(parser, atom_info%atm_mass(index_now)) CALL parser_get_object(parser, atom_info%atm_charge(index_now)) CALL parser_get_object(parser, itemp) - IF (iw > 0) WRITE (iw, *) "GTOP_INFO| PUT SOLUTEATOM INFO HERE!!!!" + IF (iw > 0) WRITE (iw, *) "GTOP_INFO| PUT SOLUTEATOM INFO HERE!" CALL parser_get_object(parser, ntype) DO i = 1, 50 ii(i) = -1 @@ -299,7 +299,7 @@ SUBROUTINE read_topology_gromos(file_name, topology, para_env, subsys_section) CALL parser_get_object(parser, conn_info%bond_b(offset + itype)) CALL parser_get_object(parser, itemp) conn_info%bond_type(offset + itype) = itemp - IF (iw > 0) WRITE (iw, *) "GTOP_INFO| PUT BONDH INFO HERE!!!!" + IF (iw > 0) WRITE (iw, *) "GTOP_INFO| PUT BONDH INFO HERE!" END DO conn_info%bond_a(offset + 1:offset + ntype) = conn_info%bond_a(offset + 1:offset + ntype) + natom_prev conn_info%bond_b(offset + 1:offset + ntype) = conn_info%bond_b(offset + 1:offset + ntype) + natom_prev @@ -322,7 +322,7 @@ SUBROUTINE read_topology_gromos(file_name, topology, para_env, subsys_section) CALL parser_get_object(parser, conn_info%bond_b(offset + itype)) CALL parser_get_object(parser, itemp) conn_info%bond_type(offset + itype) = itemp - IF (iw > 0) WRITE (iw, *) "GTOP_INFO| PUT BOND INFO HERE!!!!" + IF (iw > 0) WRITE (iw, *) "GTOP_INFO| PUT BOND INFO HERE!" END DO conn_info%bond_a(offset + 1:offset + ntype) = conn_info%bond_a(offset + 1:offset + ntype) + natom_prev conn_info%bond_b(offset + 1:offset + ntype) = conn_info%bond_b(offset + 1:offset + ntype) + natom_prev @@ -347,7 +347,7 @@ SUBROUTINE read_topology_gromos(file_name, topology, para_env, subsys_section) CALL parser_get_object(parser, conn_info%theta_c(offset + itype)) CALL parser_get_object(parser, itemp) conn_info%theta_type(offset + itype) = itemp - IF (iw > 0) WRITE (iw, *) "GTOP_INFO| PUT BONDANGLEH INFO HERE!!!!" + IF (iw > 0) WRITE (iw, *) "GTOP_INFO| PUT BONDANGLEH INFO HERE!" END DO conn_info%theta_a(offset + 1:offset + ntype) = conn_info%theta_a(offset + 1:offset + ntype) + natom_prev conn_info%theta_b(offset + 1:offset + ntype) = conn_info%theta_b(offset + 1:offset + ntype) + natom_prev @@ -373,7 +373,7 @@ SUBROUTINE read_topology_gromos(file_name, topology, para_env, subsys_section) CALL parser_get_object(parser, conn_info%theta_c(offset + itype)) CALL parser_get_object(parser, itemp) conn_info%theta_type(offset + itype) = itemp - IF (iw > 0) WRITE (iw, *) "GTOP_INFO| PUT BONDANGLE INFO HERE!!!!" + IF (iw > 0) WRITE (iw, *) "GTOP_INFO| PUT BONDANGLE INFO HERE!" END DO conn_info%theta_a(offset + 1:offset + ntype) = conn_info%theta_a(offset + 1:offset + ntype) + natom_prev conn_info%theta_b(offset + 1:offset + ntype) = conn_info%theta_b(offset + 1:offset + ntype) + natom_prev @@ -401,7 +401,7 @@ SUBROUTINE read_topology_gromos(file_name, topology, para_env, subsys_section) CALL parser_get_object(parser, conn_info%impr_d(offset + itype)) CALL parser_get_object(parser, itemp) conn_info%impr_type(offset + itype) = itemp - IF (iw > 0) WRITE (iw, *) "GTOP_INFO| PUT IMPDIHEDRALH INFO HERE!!!!" + IF (iw > 0) WRITE (iw, *) "GTOP_INFO| PUT IMPDIHEDRALH INFO HERE!" END DO conn_info%impr_a(offset + 1:offset + ntype) = conn_info%impr_a(offset + 1:offset + ntype) + natom_prev conn_info%impr_b(offset + 1:offset + ntype) = conn_info%impr_b(offset + 1:offset + ntype) + natom_prev @@ -430,7 +430,7 @@ SUBROUTINE read_topology_gromos(file_name, topology, para_env, subsys_section) CALL parser_get_object(parser, conn_info%impr_d(offset + itype)) CALL parser_get_object(parser, itemp) conn_info%impr_type(offset + itype) = itemp - IF (iw > 0) WRITE (iw, *) "GTOP_INFO| PUT IMPDIHEDRAL INFO HERE!!!!" + IF (iw > 0) WRITE (iw, *) "GTOP_INFO| PUT IMPDIHEDRAL INFO HERE!" END DO conn_info%impr_a(offset + 1:offset + ntype) = conn_info%impr_a(offset + 1:offset + ntype) + natom_prev conn_info%impr_b(offset + 1:offset + ntype) = conn_info%impr_b(offset + 1:offset + ntype) + natom_prev @@ -459,7 +459,7 @@ SUBROUTINE read_topology_gromos(file_name, topology, para_env, subsys_section) CALL parser_get_object(parser, conn_info%phi_d(offset + itype)) CALL parser_get_object(parser, itemp) conn_info%phi_type(offset + itype) = itemp - IF (iw > 0) WRITE (iw, *) "GTOP_INFO| PUT DIHEDRALH INFO HERE!!!!" + IF (iw > 0) WRITE (iw, *) "GTOP_INFO| PUT DIHEDRALH INFO HERE!" END DO conn_info%phi_a(offset + 1:offset + ntype) = conn_info%phi_a(offset + 1:offset + ntype) + natom_prev conn_info%phi_b(offset + 1:offset + ntype) = conn_info%phi_b(offset + 1:offset + ntype) + natom_prev @@ -488,7 +488,7 @@ SUBROUTINE read_topology_gromos(file_name, topology, para_env, subsys_section) CALL parser_get_object(parser, conn_info%phi_d(offset + itype)) CALL parser_get_object(parser, itemp) conn_info%phi_type(offset + itype) = itemp - IF (iw > 0) WRITE (iw, *) "GTOP_INFO| PUT DIHEDRAL INFO HERE!!!!" + IF (iw > 0) WRITE (iw, *) "GTOP_INFO| PUT DIHEDRAL INFO HERE!" END DO conn_info%phi_a(offset + 1:offset + ntype) = conn_info%phi_a(offset + 1:offset + ntype) + natom_prev conn_info%phi_b(offset + 1:offset + ntype) = conn_info%phi_b(offset + 1:offset + ntype) + natom_prev @@ -518,7 +518,7 @@ SUBROUTINE read_topology_gromos(file_name, topology, para_env, subsys_section) CALL parser_get_object(parser, na(iatom)) CALL parser_get_object(parser, am(iatom)) CALL parser_get_object(parser, ac(iatom)) - IF (iw > 0) WRITE (iw, *) "GTOP_INFO| PUT SOLVENTATOM INFO HERE!!!!" + IF (iw > 0) WRITE (iw, *) "GTOP_INFO| PUT SOLVENTATOM INFO HERE!" END DO END IF label = TRIM(avail_section(21)) @@ -722,7 +722,7 @@ SUBROUTINE read_coordinate_g96(topology, para_env, subsys_section) atom_info%r(1, natom) = cp_unit_to_cp2k(atom_info%r(1, natom), "nm") atom_info%r(2, natom) = cp_unit_to_cp2k(atom_info%r(2, natom), "nm") atom_info%r(3, natom) = cp_unit_to_cp2k(atom_info%r(3, natom), "nm") - IF (iw > 0) WRITE (iw, *) "G96_INFO| PUT POSITION INFO HERE!!!!" + IF (iw > 0) WRITE (iw, *) "G96_INFO| PUT POSITION INFO HERE!" CALL parser_get_next_line(parser, 1) CALL parser_get_object(parser, string, string_length=default_string_length) END DO @@ -752,7 +752,7 @@ SUBROUTINE read_coordinate_g96(topology, para_env, subsys_section) velocity(1, natom) = cp_unit_to_cp2k(velocity(1, natom), "nm*ps^-1") velocity(2, natom) = cp_unit_to_cp2k(velocity(2, natom), "nm*ps^-1") velocity(3, natom) = cp_unit_to_cp2k(velocity(3, natom), "nm*ps^-1") - IF (iw > 0) WRITE (iw, *) "G96_INFO| PUT VELOCITY INFO HERE!!!!" + IF (iw > 0) WRITE (iw, *) "G96_INFO| PUT VELOCITY INFO HERE!" CALL parser_get_next_line(parser, 1) CALL parser_get_object(parser, string, string_length=default_string_length) END DO diff --git a/src/topology_multiple_unit_cell.F b/src/topology_multiple_unit_cell.F index 6ed8be2906..8e2bf9628c 100644 --- a/src/topology_multiple_unit_cell.F +++ b/src/topology_multiple_unit_cell.F @@ -69,7 +69,7 @@ SUBROUTINE topology_muc(topology, subsys_section) IF (ANY(iwork /= multiple_unit_cell)) & CALL cp_abort(__LOCATION__, "SUBSYS%TOPOLOGY%MULTIPLE_UNIT_CELL and "// & "SUBSYS%CELL%MULTIPLE_UNIT_CELL have been "// & - "setup to two different values!! Correct this error!!") + "setup to two different values!! Correct this error!") cell => topology%cell_muc natoms = topology%natoms*PRODUCT(multiple_unit_cell) diff --git a/src/topology_xtl.F b/src/topology_xtl.F index 9c7c552805..94b4a33b7c 100644 --- a/src/topology_xtl.F +++ b/src/topology_xtl.F @@ -247,8 +247,7 @@ SUBROUTINE read_coordinate_xtl(topology, para_env, subsys_section) ! Check for SYM MAT CALL parser_search_string(parser, "SYM MAT", ignore_case=.FALSE., found=found, & begin_line=.FALSE., search_from_begin_of_file=.TRUE.) - IF (.NOT. found) & - CPWARN("The field SYM MAT was not found in XTL file! ") + CPWARN_IF(.NOT. found, "The field SYM MAT was not found in XTL file! ") IF (iw > 0) WRITE (iw, '(A,I0)') " XTL_INFO| Number of atoms before applying symmetry operations :: ", natom IF (iw > 0) WRITE (iw, '(A10,1X,3F12.6)') (TRIM(id2str(atom_info%id_atmname(ii))), atom_info%r(1:3, ii), ii=1, natom) IF (found) THEN diff --git a/src/xas_tp_scf.F b/src/xas_tp_scf.F index e4d73bd359..68547ac346 100644 --- a/src/xas_tp_scf.F +++ b/src/xas_tp_scf.F @@ -482,7 +482,7 @@ SUBROUTINE cls_prepare_states(xas_control, xas_env, qs_env, iatom, xas_section, IF (output_unit > 0) THEN WRITE (UNIT=output_unit, FMT="(/,/,T2,A)") " Eigenstates are derived "// & "from the MOs optimized by OT. Follows localization of the core states"// & - " to identify the excited orbital. " + " to identify the excited orbital." END IF CALL get_xas_env(xas_env=xas_env, &