Fixed CPVERSION_CHECK and improved CPWARN

- CPVERSION_CHECK checks if MAJOR_TEST is defined (fixes cp2k#3750).
- Introduced CPWARN_IF (conditional CPWARN).
- Message/format cleanup.

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)

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

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

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

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
 

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)

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)

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)

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

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

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
 

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

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)

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
 

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)