From 9e1cd629dda04ba2dd09113fd380e1afc628d704 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ole=20Sch=C3=BCtt?= Date: Fri, 7 Nov 2025 15:05:12 +0100 Subject: [PATCH] Enable Fortitude rule unnamed-end-statement --- src/ace_wrapper.F | 4 +- src/admm_dm_types.F | 2 +- src/admm_types.F | 6 +- src/almo_scf_types.F | 2 +- src/aobasis/basis_set_types.F | 2 +- src/aobasis/orbital_transformation_matrices.F | 2 +- src/arnoldi/arnoldi_vector.F | 4 +- src/atom_sgp.F | 2 +- src/base/machine.F | 22 ++-- src/bse_full_diag.F | 2 +- src/bse_iterative.F | 34 ++--- src/bse_print.F | 8 +- src/bse_properties.F | 2 +- src/bse_util.F | 10 +- src/common/d3_poly.F | 82 ++++++------- src/common/memory_utilities_unittest.F | 14 +-- src/common/parallel_rng_types.F | 2 +- src/common/parallel_rng_types_unittest.F | 4 +- src/common/reference_manager.F | 4 +- src/common/splines.F | 24 ++-- src/common/string_table.F | 2 +- src/cp2k_info.F | 2 +- src/cp_dbcsr_diag.F | 2 +- src/ct_types.F | 2 +- src/dbt/dbt_allocate_wrap.F | 4 +- src/dbt/dbt_block.F | 52 ++++---- src/dbt/dbt_index.F | 26 ++-- src/dbt/dbt_io.F | 16 +-- src/dbt/dbt_methods.F | 48 ++++---- src/dbt/dbt_reshape_ops.F | 2 +- src/dbt/dbt_test.F | 30 ++--- src/dbt/dbt_types.F | 116 +++++++++--------- src/dbt/dbt_unittest.F | 2 +- src/dbt/tas/dbt_tas_base.F | 76 ++++++------ src/dbt/tas/dbt_tas_global.F | 60 ++++----- src/dbt/tas/dbt_tas_io.F | 10 +- src/dbt/tas/dbt_tas_mm.F | 32 ++--- src/dbt/tas/dbt_tas_reshape_ops.F | 22 ++-- src/dbt/tas/dbt_tas_split.F | 36 +++--- src/dbt/tas/dbt_tas_test.F | 12 +- src/dbt/tas/dbt_tas_types.F | 10 +- src/dbt/tas/dbt_tas_unittest.F | 2 +- src/dbx/cp_dbcsr_api.F | 4 +- src/deepmd_wrapper.F | 6 +- src/dgemm_counter_types.F | 2 +- src/dm_ls_scf_curvy.F | 2 +- src/dm_ls_scf_types.F | 8 +- src/ec_methods.F | 2 +- src/emd/rt_bse.F | 10 +- src/emd/rt_bse_io.F | 18 +-- src/emd/rt_bse_types.F | 10 +- src/emd/rt_propagation_utils.F | 4 +- src/emd/rt_propagator_init.F | 2 +- src/eri_mme/eri_mme_error_control.F | 4 +- src/eri_mme/eri_mme_integrate.F | 8 +- src/eri_mme/eri_mme_types.F | 14 +-- src/et_coupling_types.F | 2 +- src/exclusion_types.F | 2 +- src/farming_methods.F | 2 +- src/farming_types.F | 2 +- src/fist_nonbond_env_types.F | 14 +-- src/fist_nonbond_force.F | 2 +- src/fm/cp_blacs_env.F | 2 +- src/fm/cp_blacs_types.F | 12 +- src/fm/cp_fm_diag_utils.F | 2 +- src/fm/cp_fm_elpa.F | 4 +- src/fm/cp_fm_types.F | 10 +- src/fm/cp_linked_list_fm.F | 2 +- src/fp_methods.F | 2 +- src/graphcon.F | 4 +- src/greenx_interface.F | 2 +- src/gw_communication.F | 2 +- src/gw_integrals.F | 2 +- src/hfx_exx.F | 2 +- src/hfx_load_balance_methods.F | 2 +- src/hfx_ri.F | 24 ++-- src/hfx_ri_kp.F | 2 +- src/hfx_types.F | 64 +++++----- src/input/cp_linked_list_input.F | 2 +- src/input_cp2k_hfx.F | 2 +- src/input_cp2k_loc.F | 2 +- src/input_cp2k_mp2.F | 14 +-- src/kg_vertex_coloring_methods.F | 26 ++-- src/kpoint_coulomb_2c.F | 16 +-- src/libint_2c_3c.F | 6 +- src/libint_wrapper.F | 42 +++---- src/manybody_gal21.F | 2 +- src/metadynamics.F | 4 +- src/minimax/minimax_exp_gw.F | 12 +- src/molsym.F | 2 +- src/motion/bfgs_optimizer.F | 2 +- src/motion/pint_gle.F | 6 +- src/motion/pint_piglet.F | 2 +- src/motion/pint_pile.F | 2 +- src/motion/pint_qtb.F | 2 +- src/mp2_eri_gpw.F | 4 +- src/mp2_gpw.F | 2 +- src/mp2_gpw_method.F | 2 +- src/mp2_grids.F | 4 +- src/mp2_integrals.F | 2 +- src/mp2_optimize_ri_basis.F | 16 +-- src/mp2_ri_grad_util.F | 2 +- src/mp2_types.F | 4 +- src/mscfg_types.F | 2 +- src/nnp_environment_types.F | 12 +- src/optimize_basis_types.F | 16 +-- src/optimize_basis_utils.F | 2 +- src/optimize_input.F | 6 +- src/pao_main.F | 2 +- src/pao_types.F | 2 +- src/pexsi_interface.F | 2 +- src/pexsi_methods.F | 2 +- src/post_scf_bandstructure_utils.F | 2 +- src/preconditioner_types.F | 2 +- src/pw/cp_linked_list_pw.F | 2 +- src/pw/cube_utils.F | 4 +- src/pw/fft/fft_lib.F | 8 +- src/pw/fft/fftsg_lib.F | 6 +- src/pw/fft/fftw3_lib.F | 22 ++-- src/pw/fft/mltfftsg_tools.F | 6 +- src/pw/pw_fpga.F | 10 +- src/pw/pw_grids.F | 2 +- src/pw/realspace_grid_types.F | 4 +- src/qmmm_util.F | 2 +- src/qs_active_space_methods.F | 2 +- src/qs_kind_types.F | 2 +- src/qs_localization_methods.F | 6 +- src/qs_neighbor_list_types.F | 2 +- src/qs_oce_types.F | 2 +- src/qs_tddfpt2_soc.F | 2 +- src/qs_tddfpt2_soc_types.F | 4 +- src/qs_tddfpt2_stda_types.F | 6 +- src/qs_tensors.F | 30 ++--- src/qs_tensors_types.F | 20 +-- src/rpa_communication.F | 2 +- src/rpa_exchange.F | 10 +- src/rpa_grad.F | 38 +++--- src/rpa_gw.F | 10 +- src/rpa_gw_ic.F | 2 +- src/rpa_gw_im_time_util.F | 4 +- src/rpa_gw_kpoints_util.F | 6 +- src/rpa_gw_sigma_x.F | 6 +- src/rpa_sigma_functional.F | 2 +- src/rt_propagation_forces.F | 2 +- src/sockets_interface.F | 18 +-- src/start/cp2k.F | 2 +- src/start/libcp2k.F | 2 +- src/subsys/damping_dipole_types.F | 2 +- src/subsys/shell_potential_types.F | 2 +- src/task_list_methods.F | 4 +- src/tmc/tmc_moves.F | 2 +- src/tmc/tmc_setup.F | 2 +- src/tmc/tmc_types.F | 2 +- src/voronoi_interface.F | 2 +- src/xc/cp_linked_list_xc_deriv.F | 4 +- src/xc/xc.F | 8 +- src/xc/xc_rho_set_types.F | 4 +- src/xc/xc_util.F | 2 +- tools/precommit/fortitude.toml | 1 - 159 files changed, 781 insertions(+), 782 deletions(-) diff --git a/src/ace_wrapper.F b/src/ace_wrapper.F index f37723ca7e..55c8952bd4 100644 --- a/src/ace_wrapper.F +++ b/src/ace_wrapper.F @@ -61,7 +61,7 @@ MODULE ace_wrapper REAL(C_DOUBLE), DIMENSION(1:6) :: virialc REAL(C_DOUBLE), DIMENSION(1:natomc) :: energyc TYPE(C_PTR) :: acedata_ptr - END SUBROUTINE + END SUBROUTINE AcePotCompute ! ************************************************************************************************** !> \brief ... !> \param ntypec ... @@ -144,7 +144,7 @@ CONTAINS MARK_USED(model) CPABORT("CP2K was compiled without ACE library.") #endif - END SUBROUTINE + END SUBROUTINE ace_model_compute ! ************************************************************************************************** !> \brief ... diff --git a/src/admm_dm_types.F b/src/admm_dm_types.F index 9a7dedd75e..4d2cea9e7f 100644 --- a/src/admm_dm_types.F +++ b/src/admm_dm_types.F @@ -47,7 +47,7 @@ MODULE admm_dm_types INTEGER, DIMENSION(:, :), POINTER :: block_map => Null() TYPE(mcweeny_history_p_type), & DIMENSION(:), POINTER :: mcweeny_history => Null() - END TYPE + END TYPE admm_dm_type CONTAINS diff --git a/src/admm_types.F b/src/admm_types.F index d0b6546dd0..8684604703 100644 --- a/src/admm_types.F +++ b/src/admm_types.F @@ -69,11 +69,11 @@ MODULE admm_types TYPE eigvals_type REAL(dp), DIMENSION(:), POINTER :: DATA => NULL() - END TYPE + END TYPE eigvals_type TYPE eigvals_p_type TYPE(eigvals_type), POINTER :: eigvals => NULL() - END TYPE + END TYPE eigvals_p_type ! ************************************************************************************************** !> \brief A subtype of the admm_env that contains the extra data needed for an ADMM GAPW calculation @@ -198,7 +198,7 @@ MODULE admm_types TYPE(cp_fm_type), DIMENSION(:), & POINTER :: mo_derivs_aux_fit => NULL() - END TYPE + END TYPE admm_type CONTAINS diff --git a/src/almo_scf_types.F b/src/almo_scf_types.F index 6cd5d926b0..00bf51a366 100644 --- a/src/almo_scf_types.F +++ b/src/almo_scf_types.F @@ -98,7 +98,7 @@ MODULE almo_scf_types TYPE(dbcsr_type), DIMENSION(:, :), ALLOCATABLE :: matrix_p_up_down !TYPE(dbcsr_type), DIMENSION(:, :), ALLOCATABLE :: matrix_x TYPE(dbcsr_type), DIMENSION(:), ALLOCATABLE :: matrix_t - END TYPE + END TYPE almo_scf_history_type ! the structure contains general info about the system TYPE almo_scf_env_type diff --git a/src/aobasis/basis_set_types.F b/src/aobasis/basis_set_types.F index 39293faecb..777ca80e06 100644 --- a/src/aobasis/basis_set_types.F +++ b/src/aobasis/basis_set_types.F @@ -2878,6 +2878,6 @@ CONTAINS END DO END DO - END SUBROUTINE + END SUBROUTINE sort_gto_basis_set END MODULE basis_set_types diff --git a/src/aobasis/orbital_transformation_matrices.F b/src/aobasis/orbital_transformation_matrices.F index 2a50da3c86..d6c13454fa 100644 --- a/src/aobasis/orbital_transformation_matrices.F +++ b/src/aobasis/orbital_transformation_matrices.F @@ -552,7 +552,7 @@ CONTAINS v = p_func(1, l, ma + 1, mb, r1, r, lr)*(1.0_dp - dd) + p_func(-1, l, -ma - 1, mb, r1, r, lr)*SQRT(1.0_dp + dd) w = p_func(1, l, ma - 1, mb, r1, r, lr) - p_func(-1, l, -ma + 1, mb, r1, r, lr) END IF - END SUBROUTINE + END SUBROUTINE r_recursion ! ************************************************************************************************** !> \brief Release rotation matrices diff --git a/src/arnoldi/arnoldi_vector.F b/src/arnoldi/arnoldi_vector.F index 5a2a9c1742..16a4b8c06e 100644 --- a/src/arnoldi/arnoldi_vector.F +++ b/src/arnoldi/arnoldi_vector.F @@ -60,7 +60,7 @@ MODULE arnoldi_vector TYPE fast_vec_access_type TYPE(hash_table_type) :: hash_table = hash_table_type() TYPE(block_ptr), DIMENSION(:), ALLOCATABLE :: blk_map - END TYPE + END TYPE fast_vec_access_type PUBLIC :: dbcsr_matrix_colvec_multiply, & create_col_vec_from_matrix, & @@ -385,7 +385,7 @@ CONTAINS END IF END DO END DO - END FUNCTION + END FUNCTION matching_prime ! ************************************************************************************************** !> \brief create a hash_table of given initial size. diff --git a/src/atom_sgp.F b/src/atom_sgp.F index 19bd2a1456..f7fed6e92d 100644 --- a/src/atom_sgp.F +++ b/src/atom_sgp.F @@ -55,7 +55,7 @@ MODULE atom_sgp INTEGER :: n_nlcc = 0 REAL(KIND=dp), DIMENSION(:), POINTER :: a_nlcc => Null() REAL(KIND=dp), DIMENSION(:), POINTER :: c_nlcc => Null() - END TYPE + END TYPE atom_sgp_potential_type PRIVATE PUBLIC :: atom_sgp_potential_type, atom_sgp_release diff --git a/src/base/machine.F b/src/base/machine.F index f90b177463..d61fa2e6f3 100644 --- a/src/base/machine.F +++ b/src/base/machine.F @@ -137,7 +137,7 @@ CONTAINS IF (flush_should_flush) FLUSH (lunit) - END SUBROUTINE + END SUBROUTINE m_flush ! ************************************************************************************************** !> \brief returns time from a real-time clock, protected against rolling @@ -407,7 +407,7 @@ CONTAINS SUBROUTINE m_abort() INTERFACE SUBROUTINE abort() BIND(C, name="abort") - END SUBROUTINE + END SUBROUTINE abort END INTERFACE CALL abort() @@ -432,7 +432,7 @@ CONTAINS IMPORT INTEGER(KIND=C_INT), VALUE :: pid, sig INTEGER(KIND=C_INT) :: errno - END FUNCTION + END FUNCTION kill END INTERFACE ! If sig is 0, then no signal is sent, but error checking is still @@ -472,7 +472,7 @@ CONTAINS FUNCTION getpagesize() BIND(C, name="getpagesize") RESULT(RES) IMPORT INTEGER(C_INT) :: RES - END FUNCTION + END FUNCTION getpagesize END INTERFACE ! reading from statm @@ -585,7 +585,7 @@ CONTAINS 999 CONTINUE END IF END IF - END FUNCTION + END FUNCTION get_field_value_in_bytes END SUBROUTINE m_memory_details ! ************************************************************************************************** @@ -608,7 +608,7 @@ CONTAINS CHARACTER(KIND=C_CHAR), DIMENSION(*) :: buf INTEGER(KIND=C_INT), VALUE :: buflen INTEGER(KIND=C_INT) :: errno - END FUNCTION + END FUNCTION gethostname END INTERFACE istat = gethostname(buf, LEN(buf)) @@ -637,7 +637,7 @@ CONTAINS CHARACTER(KIND=C_CHAR), DIMENSION(*) :: buf INTEGER(KIND=C_INT), VALUE :: buflen TYPE(C_PTR) :: stat - END FUNCTION + END FUNCTION getcwd END INTERFACE stat = getcwd(tmp, LEN(tmp)) @@ -663,7 +663,7 @@ CONTAINS IMPORT CHARACTER(KIND=C_CHAR), DIMENSION(*) :: path INTEGER(KIND=C_INT) :: errno - END FUNCTION + END FUNCTION chdir END INTERFACE ierror = chdir(TRIM(dir)//c_null_char) @@ -680,7 +680,7 @@ CONTAINS FUNCTION getpid() BIND(C, name="getpid") RESULT(pid) IMPORT INTEGER(KIND=C_INT) :: pid - END FUNCTION + END FUNCTION getpid END INTERFACE pid = getpid() @@ -702,7 +702,7 @@ CONTAINS IMPORT CHARACTER(KIND=C_CHAR), DIMENSION(*) :: path INTEGER(KIND=C_INT) :: errno - END FUNCTION + END FUNCTION unlink END INTERFACE istat = unlink(TRIM(path)//c_null_char) @@ -724,7 +724,7 @@ CONTAINS IMPORT CHARACTER(KIND=C_CHAR), DIMENSION(*) :: src, dest INTEGER(KIND=C_INT) :: errno - END FUNCTION + END FUNCTION rename END INTERFACE IF (TARGET == source) THEN diff --git a/src/bse_full_diag.F b/src/bse_full_diag.F index 007d528126..260549560e 100644 --- a/src/bse_full_diag.F +++ b/src/bse_full_diag.F @@ -448,7 +448,7 @@ CONTAINS END IF CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE create_hermitian_form_of_ABBA ! ************************************************************************************************** !> \brief Solving eigenvalue equation C Z^n = (Ω^n)^2 Z^n . diff --git a/src/bse_iterative.F b/src/bse_iterative.F index 37c2ffbc51..724aca0f79 100644 --- a/src/bse_iterative.F +++ b/src/bse_iterative.F @@ -305,7 +305,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE do_subspace_iterations ! ************************************************************************************************** !> \brief ... @@ -353,7 +353,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE check_Z_space_dimension ! ************************************************************************************************** !> \brief ... @@ -445,7 +445,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE create_bse_work_arrays ! ************************************************************************************************** !> \brief ... @@ -548,7 +548,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE postprocess_bse ! ************************************************************************************************** !> \brief ... @@ -643,7 +643,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE print_davidson_parameter ! ************************************************************************************************** !> \brief ... @@ -681,7 +681,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE check_en_convergence ! ************************************************************************************************** !> \brief ... @@ -730,7 +730,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE check_res_convergence ! ************************************************************************************************** !> \brief ... @@ -792,7 +792,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE orthonormalize_W ! ************************************************************************************************** !> \brief ... @@ -846,7 +846,7 @@ CONTAINS DEALLOCATE (Subspace_add_dir_reshaped) CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE compute_new_directions ! ************************************************************************************************** !> \brief ... @@ -902,7 +902,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE compute_residuals ! ************************************************************************************************** !> \brief ... @@ -977,7 +977,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE compute_diagonalize_ZAZ ! ************************************************************************************************** !> \brief ... @@ -1027,7 +1027,7 @@ CONTAINS ! we make the sum to sum over all RI basis functions CALL para_env%sum(BZ) - END SUBROUTINE + END SUBROUTINE compute_BZ ! ************************************************************************************************** !> \brief ... @@ -1200,7 +1200,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE compute_AZ ! ************************************************************************************************** !> \brief ... @@ -1301,7 +1301,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE compute_v_ia_jb_part ! ************************************************************************************************** !> \brief ...Eigenval @@ -1347,7 +1347,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE initial_guess_Z_vectors ! ************************************************************************************************** !> \brief ... @@ -1402,7 +1402,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE fill_local_3c_arrays ! ************************************************************************************************** !> \brief ... @@ -1584,6 +1584,6 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE allocate_and_fill_local_array END MODULE bse_iterative diff --git a/src/bse_print.F b/src/bse_print.F index 1f473765e0..16ca683c5c 100644 --- a/src/bse_print.F +++ b/src/bse_print.F @@ -80,7 +80,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE print_BSE_start_flag ! ************************************************************************************************** !> \brief ... @@ -197,7 +197,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE print_output_header ! ************************************************************************************************** !> \brief ... @@ -488,7 +488,7 @@ CONTAINS DEALLOCATE (eigvec_entries) CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE print_transition_amplitudes_core ! ************************************************************************************************** !> \brief Prints exciton descriptors, cf. Mewes et al., JCTC 14, 710-725 (2018) @@ -818,7 +818,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE fm_write_thresh ! ************************************************************************************************** !> \brief Write the atomic coordinates to the output unit. diff --git a/src/bse_properties.F b/src/bse_properties.F index d39b64510c..38189c11a3 100644 --- a/src/bse_properties.F +++ b/src/bse_properties.F @@ -411,7 +411,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE compute_and_print_absorption_spectrum ! ************************************************************************************************** !> \brief ... diff --git a/src/bse_util.F b/src/bse_util.F index 4a45514a00..bdc861e6a5 100644 --- a/src/bse_util.F +++ b/src/bse_util.F @@ -178,7 +178,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE mult_B_with_W ! ************************************************************************************************** !> \brief Adds and reorders full matrices with a combined index structure, e.g. adding W_ij,ab @@ -840,7 +840,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE comp_eigvec_coeff_BSE ! ************************************************************************************************** !> \brief ... @@ -1108,7 +1108,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE filter_eigvec_contrib ! ************************************************************************************************** !> \brief Reads cutoffs for BSE from mp2_env and compares to energies in Eigenval to extract @@ -1179,7 +1179,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE determine_cutoff_indices ! ************************************************************************************************** !> \brief Determines indices within the given energy cutoffs and truncates Eigenvalues and matrices @@ -1923,4 +1923,4 @@ CONTAINS END SUBROUTINE trace_exciton_descr -END MODULE +END MODULE bse_util diff --git a/src/common/d3_poly.F b/src/common/d3_poly.F index caf3f7ce24..8ae54c16c2 100644 --- a/src/common/d3_poly.F +++ b/src/common/d3_poly.F @@ -144,7 +144,7 @@ CONTAINS END DO module_initialized = .TRUE. - END SUBROUTINE + END SUBROUTINE init_d3_poly_module ! ************************************************************************************************** !> \brief size of a polynomial in x up to the given degree @@ -156,7 +156,7 @@ CONTAINS INTEGER :: res res = maxgrad + 1 - END FUNCTION + END FUNCTION poly_size1 ! ************************************************************************************************** !> \brief size of a polynomial in x,y up to the given degree @@ -168,7 +168,7 @@ CONTAINS INTEGER :: res res = (maxgrad + 1)*(maxgrad + 2)/2 - END FUNCTION + END FUNCTION poly_size2 ! ************************************************************************************************** !> \brief size of a polynomial in x,y,z up to the given degree @@ -180,7 +180,7 @@ CONTAINS INTEGER :: res res = (maxgrad + 1)*(maxgrad + 2)*(maxgrad + 3)/6 - END FUNCTION + END FUNCTION poly_size3 ! ************************************************************************************************** !> \brief max grad for a polynom of the given size @@ -192,7 +192,7 @@ CONTAINS INTEGER :: res res = n - 1 - END FUNCTION + END FUNCTION grad_size1 ! ************************************************************************************************** !> \brief max grad for a polynom of the given size @@ -204,7 +204,7 @@ CONTAINS INTEGER :: res res = INT(FLOOR(0.5_dp*(SQRT(1.0_dp + 8.0_dp*REAL(n, dp)) - 1.0_dp) - 2.e-6_dp)) - END FUNCTION + END FUNCTION grad_size2 ! ************************************************************************************************** !> \brief max grad for a polynom of the given size @@ -225,7 +225,7 @@ CONTAINS g1 = (108.0_dp*nn + 12.0_dp*SQRT(81.0_dp*nn*nn - 12.0_dp))**(1.0_dp/3.0_dp) res = FLOOR(g1/6.0_dp + 2.0_dp/g1 - 1.0_dp - 2.e-6_dp) END IF - END FUNCTION + END FUNCTION grad_size3 ! ************************************************************************************************** !> \brief 0-based index of monomial of the given degree @@ -237,7 +237,7 @@ CONTAINS INTEGER :: res res = i - END FUNCTION + END FUNCTION mono_index1 ! ************************************************************************************************** !> \brief 0-based index of monomial of the given degree @@ -253,7 +253,7 @@ CONTAINS grad = i + j res = grad*(grad + 1)/2 + j - END FUNCTION + END FUNCTION mono_index2 ! ************************************************************************************************** !> \brief 0-based index of monomial of the given degree @@ -271,7 +271,7 @@ CONTAINS sgrad = j + k grad = i + sgrad res = grad*(grad + 1)*(grad + 2)/6 + (sgrad)*(sgrad + 1)/2 + k - END FUNCTION + END FUNCTION mono_index3 ! ************************************************************************************************** !> \brief exponents of the monomial at the given 0-based index @@ -283,7 +283,7 @@ CONTAINS INTEGER :: res res = ii - END FUNCTION + END FUNCTION mono_exp1 ! ************************************************************************************************** !> \brief exponents of the monomial at the given 0-based index @@ -299,7 +299,7 @@ CONTAINS grad = INT(FLOOR(0.5_dp*(SQRT(9.0_dp + 8.0_dp*ii) - 1.0_dp) - 2.e-6_dp)) res(2) = ii - (grad)*(grad + 1)/2 res(1) = grad - res(2) - END FUNCTION + END FUNCTION mono_exp2 ! ************************************************************************************************** !> \brief exponents of the monomial at the given 0-based index @@ -321,7 +321,7 @@ CONTAINS res(3) = ii - grad*(grad + 1)/2 res(2) = grad - res(3) res(1) = grad1 - grad - END FUNCTION + END FUNCTION mono_exp3 ! ************************************************************************************************** !> \brief the index of the result of the multiplication of the two monomials @@ -334,7 +334,7 @@ CONTAINS INTEGER :: res res = ii + ij - END FUNCTION + END FUNCTION mono_mult1 ! ************************************************************************************************** !> \brief the index of the result of the multiplication of the two monomials @@ -350,7 +350,7 @@ CONTAINS monoRes = mono_exp2(ii) + mono_exp2(ij) res = mono_index2(monoRes(1), monoRes(2)) - END FUNCTION + END FUNCTION mono_mult2 ! ************************************************************************************************** !> \brief the index of the result of the multiplication of the two monomials @@ -366,7 +366,7 @@ CONTAINS monoRes = mono_exp3(ii) + mono_exp3(ij) res = mono_index3(monoRes(1), monoRes(2), monoRes(3)) - END FUNCTION + END FUNCTION mono_mult3 ! ************************************************************************************************** !> \brief multiplies the polynomials p1 with p2 using pRes to store the result @@ -411,7 +411,7 @@ CONTAINS END DO resShift_0 = resShift_0 + newSize END DO - END SUBROUTINE + END SUBROUTINE poly_mult1 ! ************************************************************************************************** !> \brief multiplies p1 with p2 using pRes to store the result @@ -489,7 +489,7 @@ CONTAINS msize_p1 = msize_p1 + size_p1 END DO END IF - END SUBROUTINE + END SUBROUTINE poly_mult2 ! ************************************************************************************************** !> \brief multiplies p1 with p2 using pRes to store the result @@ -522,7 +522,7 @@ CONTAINS newSize = SIZE(pRes)/myNp1 CPASSERT(newSize >= poly_size3(newGrad)) CALL poly_mult3b(p1, SIZE(p1), grad1, p2, SIZE(p2), grad2, pRes, SIZE(pRes), myNp1, mySumUp) - END SUBROUTINE + END SUBROUTINE poly_mult3 ! ************************************************************************************************** !> \brief low level routine of poly_mult3 without checks @@ -626,7 +626,7 @@ CONTAINS msize_p1 = msize_p1 + my_size_p1 END DO END IF - END SUBROUTINE + END SUBROUTINE poly_mult3b ! ************************************************************************************************** !> \brief low level routine that multiplies with a polynomial of grad 1 @@ -726,7 +726,7 @@ CONTAINS msize_p1 = msize_p1 + my_size_p1 END DO END IF - END SUBROUTINE + END SUBROUTINE poly_mult3ab ! ************************************************************************************************** !> \brief writes out a 1d polynomial in a human readable form @@ -750,7 +750,7 @@ CONTAINS END IF END DO IF (.NOT. did_write) WRITE (out_f, '("0.0")', advance='NO') - END SUBROUTINE + END SUBROUTINE poly_write1 ! ************************************************************************************************** !> \brief writes out a 2d polynomial in a human readable form @@ -778,7 +778,7 @@ CONTAINS END IF END DO IF (.NOT. did_write) WRITE (out_f, '("0.0")', advance='NO') - END SUBROUTINE + END SUBROUTINE poly_write2 ! ************************************************************************************************** !> \brief writes out the polynomial in a human readable form @@ -807,7 +807,7 @@ CONTAINS END IF END DO IF (.NOT. did_write) WRITE (out_f, '("0.0")', advance='NO') - END SUBROUTINE + END SUBROUTINE poly_write3 ! ************************************************************************************************** !> \brief random poly with coeffiecents that are easy to print exactly, @@ -840,7 +840,7 @@ CONTAINS p(i) = 0.0_dp END DO res = pSize - END FUNCTION + END FUNCTION poly_random ! ************************************************************************************************** !> \brief returns in the polynomials pRes the transpose of the @@ -1001,7 +1001,7 @@ CONTAINS ! monoFullDim1=monoFullDim2 END DO DEALLOCATE (monoG1, monoG2) - END SUBROUTINE + END SUBROUTINE poly_affine_t3t ! ************************************************************************************************** !> \brief returns in the polynomials pRes the affine transformation x -> m*x+b of p @@ -1161,7 +1161,7 @@ CONTAINS ! monoFullDim1=monoFullDim2 END DO DEALLOCATE (monoG1, monoG2) - END SUBROUTINE + END SUBROUTINE poly_affine_t3 ! ************************************************************************************************** !> \brief evaluates the 3d polymial at x (the result is a polynomial in two variables) @@ -1190,7 +1190,7 @@ CONTAINS ALLOCATE (xi(grad + 1)) CALL poly_p_eval3b(p, SIZE(p), x, pRes, SIZE(pRes), my_npoly, grad, xi) DEALLOCATE (xi) - END SUBROUTINE + END SUBROUTINE poly_p_eval3 ! ************************************************************************************************** !> \brief low level routine of poly_p_eval3 without checks @@ -1263,7 +1263,7 @@ CONTAINS msize_p = msize_p + inSize END DO END IF - END SUBROUTINE + END SUBROUTINE poly_p_eval3b ! ************************************************************************************************** !> \brief unevaluates a 2d polymial to a 3d polynomial at x @@ -1294,7 +1294,7 @@ CONTAINS ALLOCATE (xi(grad + 1)) CALL poly_padd_uneval3b(p, SIZE(p), x, pRes, SIZE(pRes), my_npoly, grad, xi) DEALLOCATE (xi) - END SUBROUTINE + END SUBROUTINE poly_padd_uneval3 ! ************************************************************************************************** !> \brief low level routine of poly_padd_uneval3 without checks @@ -1368,7 +1368,7 @@ CONTAINS msize_p = msize_p + inSize END DO END IF - END SUBROUTINE + END SUBROUTINE poly_padd_uneval3b ! ************************************************************************************************** !> \brief evaluates the 2d polynomial at x (the result is a polynomial in one variable) @@ -1397,7 +1397,7 @@ CONTAINS ALLOCATE (xi(grad + 1)) CALL poly_p_eval2b(p, SIZE(p), x, pRes, SIZE(pRes), my_npoly, grad, xi) DEALLOCATE (xi) - END SUBROUTINE + END SUBROUTINE poly_p_eval2 ! ************************************************************************************************** !> \brief low level routine of poly_p_eval2 without checks @@ -1465,7 +1465,7 @@ CONTAINS ii0 = ii0 + inSize END DO END IF - END SUBROUTINE + END SUBROUTINE poly_p_eval2b ! ************************************************************************************************** !> \brief unevaluates a 1d polynomial to 2d at x @@ -1496,7 +1496,7 @@ CONTAINS ALLOCATE (xi(grad + 1)) CALL poly_padd_uneval2b(p, SIZE(p), x, pRes, SIZE(pRes), my_npoly, grad, xi) DEALLOCATE (xi) - END SUBROUTINE + END SUBROUTINE poly_padd_uneval2 ! ************************************************************************************************** !> \brief low level routine of poly_p_uneval2 without checks @@ -1565,7 +1565,7 @@ CONTAINS ii0 = ii0 + inSize END DO END IF - END SUBROUTINE + END SUBROUTINE poly_padd_uneval2b ! ************************************************************************************************** !> \brief evaluates the 1d polynomial at the given place, results are stored contiguosly @@ -1598,7 +1598,7 @@ CONTAINS pRes(ipoly) = vv pShift = pShift + size_p END DO - END SUBROUTINE + END SUBROUTINE poly_eval1 ! ************************************************************************************************** !> \brief evaluates the 2d polynomial at the given place, results are stored contiguosly @@ -1664,7 +1664,7 @@ CONTAINS msize_p = msize_p + size_p END DO END IF - END SUBROUTINE + END SUBROUTINE poly_eval2 ! ************************************************************************************************** !> \brief evaluates the 3d polynomial at the given place, results are stored contiguosly @@ -1739,7 +1739,7 @@ CONTAINS msize_p = msize_p + size_p END DO END IF - END SUBROUTINE + END SUBROUTINE poly_eval3 ! ************************************************************************************************** !> \brief returns an array with all dp/dx, the all dp/dy, and finally all dp/dz @@ -1822,7 +1822,7 @@ CONTAINS msize_p = msize_p + size_p END DO END IF - END SUBROUTINE + END SUBROUTINE poly_derive3 ! ************************************************************************************************** !> \brief subroutine that converts from the cp2k poly format to the d3 poly format @@ -1871,7 +1871,7 @@ CONTAINS IF (SIZE(poly_d3) >= size_p) THEN poly_d3(size_p + 1:) = 0.0_dp END IF - END SUBROUTINE + END SUBROUTINE poly_cp2k2d3 ! ************************************************************************************************** !> \brief subroutine that converts from the d3 poly format to the cp2k poly format @@ -1920,6 +1920,6 @@ CONTAINS IF (SIZE(poly_d3) >= size_p) THEN poly_cp2k(size_p + 1:) = 0.0_dp END IF - END SUBROUTINE + END SUBROUTINE poly_d32cp2k END MODULE d3_poly diff --git a/src/common/memory_utilities_unittest.F b/src/common/memory_utilities_unittest.F index 8db81ab410..be26a86c31 100644 --- a/src/common/memory_utilities_unittest.F +++ b/src/common/memory_utilities_unittest.F @@ -41,7 +41,7 @@ CONTAINS DEALLOCATE (real_arr) PRINT *, "check_real_rank1_allocated: OK" - END SUBROUTINE + END SUBROUTINE check_real_rank1_allocated ! ************************************************************************************************** !> \brief Check that an unallocated and unassociated (null) r1 array can be extended @@ -59,7 +59,7 @@ CONTAINS DEALLOCATE (real_arr) PRINT *, "check_real_rank1_unallocated: OK" - END SUBROUTINE + END SUBROUTINE check_real_rank1_unallocated ! ************************************************************************************************** !> \brief Check that an allocated r2 array can be extended @@ -82,7 +82,7 @@ CONTAINS DEALLOCATE (real_arr) PRINT *, "check_real_rank1_allocated: OK" - END SUBROUTINE + END SUBROUTINE check_real_rank2_allocated ! ************************************************************************************************** !> \brief Check that an unallocated and unassociated (null) r2 array can be extended @@ -100,7 +100,7 @@ CONTAINS DEALLOCATE (real_arr) PRINT *, "check_real_rank2_unallocated: OK" - END SUBROUTINE + END SUBROUTINE check_real_rank2_unallocated ! ************************************************************************************************** !> \brief Check that an allocated string array can be extended @@ -123,7 +123,7 @@ CONTAINS DEALLOCATE (str_arr) PRINT *, "check_string_rank1_allocated: OK" - END SUBROUTINE + END SUBROUTINE check_string_rank1_allocated ! ************************************************************************************************** !> \brief Check that an unallocated string array can be extended @@ -141,7 +141,7 @@ CONTAINS DEALLOCATE (str_arr) PRINT *, "check_string_rank1_unallocated: OK" - END SUBROUTINE + END SUBROUTINE check_string_rank1_unallocated -END PROGRAM +END PROGRAM memory_utilities_TEST ! vim: set ts=3 sw=3 tw=132 : diff --git a/src/common/parallel_rng_types.F b/src/common/parallel_rng_types.F index e16f4b24f3..95f0b742c0 100644 --- a/src/common/parallel_rng_types.F +++ b/src/common/parallel_rng_types.F @@ -1197,6 +1197,6 @@ CONTAINS arr(idxa) = arr(idxb) arr(idxb) = tmp END DO - END SUBROUTINE + END SUBROUTINE shuffle END MODULE parallel_rng_types diff --git a/src/common/parallel_rng_types_unittest.F b/src/common/parallel_rng_types_unittest.F index b91c372acb..c8c030c85e 100644 --- a/src/common/parallel_rng_types_unittest.F +++ b/src/common/parallel_rng_types_unittest.F @@ -191,7 +191,7 @@ CONTAINS WRITE (UNIT=default_output_unit, FMT="(T4,A)") & "Serialized record matches the expected output" - END SUBROUTINE + END SUBROUTINE dump_reload_check ! ************************************************************************************************** !> \brief ... @@ -241,6 +241,6 @@ CONTAINS WRITE (UNIT=default_output_unit, FMT="(T4,A)") & " successful" - END SUBROUTINE + END SUBROUTINE shuffle_check END PROGRAM parallel_rng_types_TEST ! vim: set ts=3 sw=3 tw=132 : diff --git a/src/common/reference_manager.F b/src/common/reference_manager.F index 36fd322267..50b34e5fac 100644 --- a/src/common/reference_manager.F +++ b/src/common/reference_manager.F @@ -67,7 +67,7 @@ MODULE reference_manager ! useful to build arrays TYPE reference_p_type TYPE(reference_type), POINTER :: ref => NULL() - END TYPE + END TYPE reference_p_type ! the bibliography INTEGER, SAVE :: nbib = 0 @@ -89,7 +89,7 @@ CONTAINS ! set as cited thebib(key)%ref%is_cited = .TRUE. - END SUBROUTINE + END SUBROUTINE cite_reference ! ************************************************************************************************** !> \brief Checks for each reference if any mpi-rank has marked it for citation. diff --git a/src/common/splines.F b/src/common/splines.F index cfc019a5ab..1b9eb31206 100644 --- a/src/common/splines.F +++ b/src/common/splines.F @@ -66,7 +66,7 @@ CONTAINS ip = iixmin(xnew(i), x, ip) ynew(i) = poly3(xnew(i), c(:, ip)) END DO - END FUNCTION + END FUNCTION spline3 ! ************************************************************************************************** !> \brief ... @@ -94,7 +94,7 @@ CONTAINS IF (PRESENT(dynew)) dynew(i) = dpoly3(xnew(i), c(:, ip)) IF (PRESENT(d2ynew)) d2ynew(i) = d2poly3(xnew(i), c(:, ip)) END DO - END SUBROUTINE + END SUBROUTINE spline3ders ! ************************************************************************************************** !> \brief ... @@ -245,7 +245,7 @@ CONTAINS c(3, i) = 3*c3/hi(i)**2 c(4, i) = (-c3 + c4)/hi(i)**3 END DO - END SUBROUTINE + END SUBROUTINE spline3pars !--------------------------------------------------------------------------------------------------! @@ -283,7 +283,7 @@ CONTAINS ! return value and derivative val = poly3(x, c(:, i1)) der = dpoly3(x, c(:, i1)) - END SUBROUTINE + END SUBROUTINE spline3valder !--------------------------------------------------------------------------------------------------! @@ -340,7 +340,7 @@ CONTAINS END IF END DO END IF - END FUNCTION + END FUNCTION iix ! ************************************************************************************************** !> \brief ... @@ -359,7 +359,7 @@ CONTAINS ELSE ip = iix(x, xi) END IF - END FUNCTION + END FUNCTION iixmin !--------------------------------------------------------------------------------------------------! @@ -395,7 +395,7 @@ CONTAINS IF (i < 1) i = 1 IF (i > n - 1) i = n - 1 iixun = i - END FUNCTION + END FUNCTION iixun !--------------------------------------------------------------------------------------------------! @@ -438,7 +438,7 @@ CONTAINS IF (i < 1) i = 1 IF (i > n - 1) i = n - 1 iixexp = i - END FUNCTION + END FUNCTION iixexp !--------------------------------------------------------------------------------------------------! @@ -460,7 +460,7 @@ CONTAINS dx = x - c(0) poly3 = c(1) + c(2)*dx + c(3)*dx**2 + c(4)*dx**3 - END FUNCTION + END FUNCTION poly3 !--------------------------------------------------------------------------------------------------! @@ -482,7 +482,7 @@ CONTAINS dx = x - c(0) dpoly3 = c(2) + 2*c(3)*dx + 3*c(4)*dx**2 - END FUNCTION + END FUNCTION dpoly3 !--------------------------------------------------------------------------------------------------! @@ -504,7 +504,7 @@ CONTAINS dx = x - c(0) d2poly3 = 2*c(3) + 6*c(4)*dx - END FUNCTION + END FUNCTION d2poly3 !--------------------------------------------------------------------------------------------------! @@ -518,6 +518,6 @@ CONTAINS ! Message to print on stdout CPABORT(msg) - END SUBROUTINE + END SUBROUTINE stop_error END MODULE splines diff --git a/src/common/string_table.F b/src/common/string_table.F index 88e7799722..1dc4af28ff 100644 --- a/src/common/string_table.F +++ b/src/common/string_table.F @@ -49,7 +49,7 @@ MODULE string_table TYPE hash_element_type CHARACTER(LEN=default_string_length), POINTER :: str => NULL() TYPE(hash_element_type), POINTER :: next => NULL() - END TYPE + END TYPE hash_element_type ! the array of linked lists of hashed strings TYPE(hash_element_type), SAVE, ALLOCATABLE, TARGET, DIMENSION(:) :: hash_table diff --git a/src/cp2k_info.F b/src/cp2k_info.F index 1e00f58d71..ea49c3c488 100644 --- a/src/cp2k_info.F +++ b/src/cp2k_info.F @@ -345,7 +345,7 @@ CONTAINS CALL m_timestamp(r_timestamp) CALL m_getcwd(r_cwd) - END SUBROUTINE + END SUBROUTINE get_runtime_info ! ************************************************************************************************** !> \brief Writes the header for the restart file diff --git a/src/cp_dbcsr_diag.F b/src/cp_dbcsr_diag.F index b7377e4cfb..980ccb1478 100644 --- a/src/cp_dbcsr_diag.F +++ b/src/cp_dbcsr_diag.F @@ -317,6 +317,6 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE cp_dbcsr_power END MODULE cp_dbcsr_diag diff --git a/src/ct_types.F b/src/ct_types.F index d2b9a85279..e1493ae0e1 100644 --- a/src/ct_types.F +++ b/src/ct_types.F @@ -124,7 +124,7 @@ MODULE ct_types TYPE(mp_para_env_type), POINTER :: para_env => NULL() TYPE(cp_blacs_env_type), POINTER :: blacs_env => NULL() - END TYPE + END TYPE ct_step_env_type CONTAINS diff --git a/src/dbt/dbt_allocate_wrap.F b/src/dbt/dbt_allocate_wrap.F index 56ea08461b..377613d738 100644 --- a/src/dbt/dbt_allocate_wrap.F +++ b/src/dbt/dbt_allocate_wrap.F @@ -77,6 +77,6 @@ CONTAINS ALLOCATE (array(${arrlist("shape_prv", nmax=dim)}$)) END IF - END SUBROUTINE + END SUBROUTINE allocate_${dim}$d #:endfor -END MODULE +END MODULE dbt_allocate_wrap diff --git a/src/dbt/dbt_block.F b/src/dbt/dbt_block.F index 2ce10237e5..0a1975278f 100644 --- a/src/dbt/dbt_block.F +++ b/src/dbt/dbt_block.F @@ -70,19 +70,19 @@ MODULE dbt_block TYPE block_nd INTEGER, DIMENSION(:), ALLOCATABLE :: sizes REAL(dp), DIMENSION(:), ALLOCATABLE :: blk - END TYPE + END TYPE block_nd INTERFACE create_block MODULE PROCEDURE create_block_data MODULE PROCEDURE create_block_nodata - END INTERFACE + END INTERFACE create_block INTERFACE dbt_put_block #:for ndim in ndims MODULE PROCEDURE dbt_put_${ndim}$d_block #:endfor MODULE PROCEDURE dbt_put_anyd_block - END INTERFACE + END INTERFACE dbt_put_block INTERFACE dbt_get_block #:for ndim in ndims @@ -90,7 +90,7 @@ MODULE dbt_block MODULE PROCEDURE dbt_allocate_and_get_${ndim}$d_block #:endfor MODULE PROCEDURE dbt_get_anyd_block - END INTERFACE + END INTERFACE dbt_get_block INTERFACE dbt_reserve_blocks MODULE PROCEDURE dbt_reserve_blocks_index @@ -98,7 +98,7 @@ MODULE dbt_block MODULE PROCEDURE dbt_reserve_blocks_template MODULE PROCEDURE dbt_reserve_blocks_tensor_to_matrix MODULE PROCEDURE dbt_reserve_blocks_matrix_to_tensor - END INTERFACE + END INTERFACE dbt_reserve_blocks CONTAINS @@ -111,7 +111,7 @@ CONTAINS INTEGER, ALLOCATABLE, DIMENSION(:) :: block_size ALLOCATE (block_size, source=block%sizes) - END FUNCTION + END FUNCTION block_size ! ************************************************************************************************** !> \brief Generalization of block_iterator_start for tensors. @@ -124,7 +124,7 @@ CONTAINS CPASSERT(tensor%valid) CALL dbt_tas_iterator_start(iterator%iter, tensor%matrix_rep) iterator%tensor => tensor - END SUBROUTINE + END SUBROUTINE dbt_iterator_start ! ************************************************************************************************** !> \brief Generalization of block_iterator_stop for tensors. @@ -134,7 +134,7 @@ CONTAINS TYPE(dbt_iterator_type), INTENT(INOUT) :: iterator CALL dbt_tas_iterator_stop(iterator%iter) - END SUBROUTINE + END SUBROUTINE dbt_iterator_stop ! ************************************************************************************************** !> \brief Number of dimensions. @@ -147,7 +147,7 @@ CONTAINS INTEGER :: ndims_iterator ndims_iterator = iterator%tensor%nd_index%ndim_nd - END FUNCTION + END FUNCTION ndims_iterator ! ************************************************************************************************** !> \brief iterate over nd blocks of an nd rank tensor, index only (blocks must be retrieved by @@ -175,7 +175,7 @@ CONTAINS ! offset since block index mapping is not consistent with element index mapping IF (PRESENT(blk_offset)) blk_offset(:) = get_array_elements(iterator%tensor%blk_offsets, ind_nd) - END SUBROUTINE + END SUBROUTINE dbt_iterator_next_block ! ************************************************************************************************** !> \brief Generalization of block_iterator_num_blocks for tensors. @@ -187,7 +187,7 @@ CONTAINS dbt_iterator_num_blocks = dbt_tas_iterator_num_blocks(iterator%iter) - END FUNCTION + END FUNCTION dbt_iterator_num_blocks ! ************************************************************************************************** !> \brief Generalization of block_iterator_blocks_left for tensors. @@ -199,7 +199,7 @@ CONTAINS dbt_iterator_blocks_left = dbt_tas_iterator_blocks_left(iterator%iter) - END FUNCTION + END FUNCTION dbt_iterator_blocks_left ! ************************************************************************************************** !> \brief reserve blocks from indices as array object @@ -219,7 +219,7 @@ CONTAINS #:endfor CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_reserve_blocks_index_array ! ************************************************************************************************** !> \brief reserve tensor blocks using block indices @@ -255,7 +255,7 @@ CONTAINS CALL dbt_tas_reserve_blocks(tensor%matrix_rep, rows=rows, columns=cols) CALL dbt_finalize(tensor) CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_reserve_blocks_index ! ************************************************************************************************** !> \brief reserve tensor blocks using template @@ -289,7 +289,7 @@ CONTAINS !$OMP END PARALLEL CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_reserve_blocks_template ! ************************************************************************************************** !> \brief reserve tensor blocks using matrix template @@ -340,7 +340,7 @@ CONTAINS END IF CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_reserve_blocks_matrix_to_tensor ! ************************************************************************************************** !> \brief reserve matrix blocks using tensor template @@ -384,7 +384,7 @@ CONTAINS CALL dbcsr_finalize(matrix_out) CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_reserve_blocks_tensor_to_matrix ! ************************************************************************************************** !> \brief Swaps two integers @@ -410,7 +410,7 @@ CONTAINS ALLOCATE (block%sizes, source=sizes) ALLOCATE (block%blk, source=array) - END SUBROUTINE + END SUBROUTINE create_block_data ! ************************************************************************************************** !> \brief Create and allocate block, but no data. @@ -421,7 +421,7 @@ CONTAINS TYPE(block_nd), INTENT(OUT) :: block ALLOCATE (block%sizes, source=sizes) ALLOCATE (block%blk(PRODUCT(sizes))) - END SUBROUTINE + END SUBROUTINE create_block_nodata ! ************************************************************************************************** !> \brief @@ -431,7 +431,7 @@ CONTAINS TYPE(block_nd), INTENT(INOUT) :: block DEALLOCATE (block%blk) DEALLOCATE (block%sizes) - END SUBROUTINE + END SUBROUTINE destroy_block ! ************************************************************************************************** !> \brief Determines whether a transpose must be applied @@ -478,7 +478,7 @@ CONTAINS CALL dbt_put_${ndim}$d_block(tensor, ind, block%sizes, block%blk, summation=summation) #:endfor END SELECT - END SUBROUTINE + END SUBROUTINE dbt_put_anyd_block ! ************************************************************************************************** !> \brief Generic implementation of dbt_get_block (arbitrary tensor rank) @@ -511,7 +511,7 @@ CONTAINS #:endfor END SELECT CALL create_block(block, blk_size, block_arr) - END SUBROUTINE + END SUBROUTINE dbt_get_anyd_block #:for ndim in ndims ! ************************************************************************************************** @@ -575,7 +575,7 @@ CONTAINS IF (new_block) DEALLOCATE (block_2d) - END SUBROUTINE + END SUBROUTINE dbt_put_${ndim}$d_block #:endfor #:for ndim in ndims @@ -603,7 +603,7 @@ CONTAINS CALL allocate_any(block, shape_spec=blk_size) CALL dbt_get_${ndim}$d_block(tensor, ind, blk_size, block, found) - END SUBROUTINE + END SUBROUTINE dbt_allocate_and_get_${ndim}$d_block #:endfor #:for ndim in ndims @@ -651,7 +651,7 @@ CONTAINS END ASSOCIATE - END SUBROUTINE + END SUBROUTINE dbt_get_${ndim}$d_block #:endfor -END MODULE +END MODULE dbt_block diff --git a/src/dbt/dbt_index.F b/src/dbt/dbt_index.F index 47b4fc8ffb..68c2ed626b 100644 --- a/src/dbt/dbt_index.F +++ b/src/dbt/dbt_index.F @@ -131,7 +131,7 @@ CONTAINS INTEGER :: ndims_mapping ndims_mapping = map%ndim_nd - END FUNCTION + END FUNCTION ndims_mapping ! ************************************************************************************************** !> \brief how many tensor dimensions are mapped to matrix row @@ -141,7 +141,7 @@ CONTAINS TYPE(nd_to_2d_mapping), INTENT(IN) :: map INTEGER :: ndims_mapping_row ndims_mapping_row = map%ndim1_2d - END FUNCTION + END FUNCTION ndims_mapping_row ! ************************************************************************************************** !> \brief how many tensor dimensions are mapped to matrix column @@ -151,7 +151,7 @@ CONTAINS TYPE(nd_to_2d_mapping), INTENT(IN) :: map INTEGER :: ndims_mapping_column ndims_mapping_column = map%ndim2_2d - END FUNCTION + END FUNCTION ndims_mapping_column ! ************************************************************************************************** !> \brief get mapping info @@ -241,7 +241,7 @@ CONTAINS ind_out = (ind_out - 1)*dims(i_dim) + ind_in(i_dim) END DO - END FUNCTION + END FUNCTION combine_tensor_index ! ************************************************************************************************** !> \brief transform nd index to flat index @@ -260,7 +260,7 @@ CONTAINS DO i_dim = 2, SIZE(dims) ind_out = ind_out*dims(i_dim) + ind_in(i_dim) END DO - END FUNCTION + END FUNCTION combine_pgrid_index ! ************************************************************************************************** !> \brief transform flat index to nd index @@ -283,7 +283,7 @@ CONTAINS tmp = (tmp - 1)/dims(i_dim) + 1 END DO - END FUNCTION + END FUNCTION split_tensor_index ! ************************************************************************************************** !> \brief transform flat index to nd index @@ -305,7 +305,7 @@ CONTAINS ind_out(i_dim) = MOD(tmp, dims(i_dim)) tmp = tmp/dims(i_dim) END DO - END FUNCTION + END FUNCTION split_pgrid_index ! ************************************************************************************************** !> \brief transform nd index to 2d index, using info from index mapping. @@ -330,7 +330,7 @@ CONTAINS ind_tmp(i) = ind_in(map%map2_2d(i)) END DO ind_out(2) = combine_tensor_index(ind_tmp(:map%ndim2_2d), map%dims2_2d) - END FUNCTION + END FUNCTION get_2d_indices_tensor ! ************************************************************************************************** !> \brief transform nd index to 2d index, using info from index mapping. @@ -355,7 +355,7 @@ CONTAINS ind_tmp(i) = ind_in(map%map2_2d(i)) END DO ind_out(2) = combine_pgrid_index(ind_tmp(:map%ndim2_2d), map%dims2_2d) - END FUNCTION + END FUNCTION get_2d_indices_pgrid ! ************************************************************************************************** !> \brief transform 2d index to nd index, using info from index mapping. @@ -383,7 +383,7 @@ CONTAINS ind_out(map%map2_2d(i)) = ind_tmp(i) END DO - END FUNCTION + END FUNCTION get_nd_indices_tensor ! ************************************************************************************************** !> \brief transform 2d index to nd index, using info from index mapping. @@ -400,7 +400,7 @@ CONTAINS ind_out(map%map1_2d) = split_pgrid_index(ind_in(1), map%dims1_2d) ind_out(map%map2_2d) = split_pgrid_index(ind_in(2), map%dims2_2d) - END FUNCTION + END FUNCTION get_nd_indices_pgrid ! ************************************************************************************************** !> \brief Invert order @@ -413,7 +413,7 @@ CONTAINS INTEGER :: i dbt_inverse_order(order) = [(i, i=1, SIZE(order))] - END FUNCTION + END FUNCTION dbt_inverse_order ! ************************************************************************************************** !> \brief reorder tensor index (no data) @@ -438,6 +438,6 @@ CONTAINS map2_2d_reorder(:) = order(map2_2d) CALL create_nd_to_2d_mapping(map_out, dims_reorder, map1_2d_reorder, map2_2d_reorder) - END SUBROUTINE + END SUBROUTINE permute_index END MODULE dbt_index diff --git a/src/dbt/dbt_io.F b/src/dbt/dbt_io.F index f3f0dc548f..0979dc4142 100644 --- a/src/dbt/dbt_io.F +++ b/src/dbt/dbt_io.F @@ -113,7 +113,7 @@ CONTAINS END IF END IF - END SUBROUTINE + END SUBROUTINE dbt_write_tensor_info ! ************************************************************************************************** !> \brief Write info on tensor distribution & load balance @@ -161,7 +161,7 @@ CONTAINS WRITE (unit_nr_prv, "(T15,A,T68,I13)") "Maximum number of matrix elements per CPU:", nelement_max END IF - END SUBROUTINE + END SUBROUTINE dbt_write_tensor_dist ! ************************************************************************************************** !> \brief Write all tensor blocks @@ -203,7 +203,7 @@ CONTAINS #:endfor END DO CALL dbt_iterator_stop(iterator) - END SUBROUTINE + END SUBROUTINE dbt_write_blocks ! ************************************************************************************************** !> \brief Write a tensor block @@ -264,7 +264,7 @@ CONTAINS END IF #:endfor END IF - END SUBROUTINE + END SUBROUTINE dbt_write_block ! ************************************************************************************************** !> \author Patrick Seewald @@ -294,7 +294,7 @@ CONTAINS #:endfor END DO CALL dbt_iterator_stop(iterator) - END SUBROUTINE + END SUBROUTINE dbt_write_block_indices ! ************************************************************************************************** !> \author Patrick Seewald @@ -306,7 +306,7 @@ CONTAINS IF (ALLOCATED(pgrid%tas_split_info)) THEN CALL dbt_tas_write_split_info(pgrid%tas_split_info, unit_nr) END IF - END SUBROUTINE + END SUBROUTINE dbt_write_split_info ! ************************************************************************************************** !> \author Patrick Seewald @@ -321,6 +321,6 @@ CONTAINS unit_nr_out = 0 END IF - END FUNCTION + END FUNCTION prep_output_unit - END MODULE + END MODULE dbt_io diff --git a/src/dbt/dbt_methods.F b/src/dbt/dbt_methods.F index e7d89d5497..af0e7537cb 100644 --- a/src/dbt/dbt_methods.F +++ b/src/dbt/dbt_methods.F @@ -132,7 +132,7 @@ CONTAINS CALL dbt_copy_expert(tensor_in, tensor_out, order, summation, bounds, move_data, unit_nr) CALL tensor_in%pgrid%mp_comm_2d%sync() CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_copy ! ************************************************************************************************** !> \brief expert routine for copying a tensor. For internal use only. @@ -272,7 +272,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_copy_expert ! ************************************************************************************************** !> \brief copy without communication, requires that both tensors have same process grid and distribution @@ -316,7 +316,7 @@ CONTAINS !$OMP END PARALLEL CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_copy_nocomm ! ************************************************************************************************** !> \brief copy matrix to tensor. @@ -376,7 +376,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_copy_matrix_to_tensor ! ************************************************************************************************** !> \brief copy tensor to matrix @@ -426,7 +426,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_copy_tensor_to_matrix ! ************************************************************************************************** !> \brief Contract tensors by multiplying matrix representations. @@ -552,7 +552,7 @@ CONTAINS CALL tensor_1%pgrid%mp_comm_2d%sync() CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_contract ! ************************************************************************************************** !> \brief expert routine for tensor contraction. For internal use only. @@ -1118,7 +1118,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_contract_expert ! ************************************************************************************************** !> \brief align tensor index with data @@ -1142,7 +1142,7 @@ CONTAINS notcontract_out = align(notcontract_in) indp_out(align) = indp_in - END SUBROUTINE + END SUBROUTINE align_tensor ! ************************************************************************************************** !> \brief Prepare tensor for contraction: redistribute to a 2d format which can be contracted by @@ -1377,7 +1377,7 @@ CONTAINS IF (new1 .AND. PRESENT(move_data_1)) move_data_1 = .TRUE. IF (new2 .AND. PRESENT(move_data_2)) move_data_2 = .TRUE. - END SUBROUTINE + END SUBROUTINE reshape_mm_compatible ! ************************************************************************************************** !> \brief Prepare tensor for contraction: redistribute to a 2d format which can be contracted by @@ -1461,7 +1461,7 @@ CONTAINS END IF END IF - END SUBROUTINE + END SUBROUTINE reshape_mm_small ! ************************************************************************************************** !> \brief update contraction storage that keeps track of process grids during a batched contraction @@ -1508,7 +1508,7 @@ CONTAINS change_criterion = MAX(REAL(nsplit, dp)/storage%nsplit_avg, REAL(storage%nsplit_avg, dp)/nsplit) IF (change_criterion > default_nsplit_accept_ratio) do_change_pgrid(2) = .TRUE. - END FUNCTION + END FUNCTION update_contraction_storage ! ************************************************************************************************** !> \brief Check if 2d index is compatible with tensor index @@ -1530,7 +1530,7 @@ CONTAINS compat_map = 2 END IF - END FUNCTION + END FUNCTION compat_map ! ************************************************************************************************** !> \brief @@ -1543,7 +1543,7 @@ CONTAINS CALL sort(ind_ref, SIZE(ind_ref), sort_indices) ind_dep(:) = ind_dep(sort_indices) - END SUBROUTINE + END SUBROUTINE index_linked_sort ! ************************************************************************************************** !> \brief @@ -1563,7 +1563,7 @@ CONTAINS ALLOCATE (opt_pgrid%tas_split_info, SOURCE=tas_split_info) CALL dbt_tas_info_hold(opt_pgrid%tas_split_info) - END FUNCTION + END FUNCTION opt_pgrid ! ************************************************************************************************** !> \brief Copy tensor to tensor with modified index mapping @@ -1667,7 +1667,7 @@ CONTAINS CALL dbt_distribution_destroy(dist) CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_remap ! ************************************************************************************************** !> \brief Align index with data @@ -1694,7 +1694,7 @@ CONTAINS IF (PRESENT(order)) order = order_prv CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_align_index ! ************************************************************************************************** !> \brief Create new tensor by reordering index, data is copied exactly (shallow copy) @@ -1749,7 +1749,7 @@ CONTAINS END IF CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_permute_index ! ************************************************************************************************** !> \brief Map contraction bounds to bounds referring to tensor indices @@ -1811,7 +1811,7 @@ CONTAINS IF (PRESENT(do_crop_1)) do_crop_1 = do_crop(1) IF (PRESENT(do_crop_2)) do_crop_2 = do_crop(2) - END SUBROUTINE + END SUBROUTINE dbt_map_bounds_to_tensors ! ************************************************************************************************** !> \brief print tensor contraction indices in a human readable way @@ -1886,7 +1886,7 @@ CONTAINS WRITE (unit_nr_prv, '(A)') ")" END IF - END SUBROUTINE + END SUBROUTINE dbt_print_contraction_index ! ************************************************************************************************** !> \brief Initialize batched contraction for this tensor. @@ -1969,7 +1969,7 @@ CONTAINS END IF #:endfor - END SUBROUTINE + END SUBROUTINE dbt_batched_contract_init ! ************************************************************************************************** !> \brief finalize batched contraction. This performs all communication that has been postponed in @@ -2009,7 +2009,7 @@ CONTAINS CALL tensor%pgrid%mp_comm_2d%sync() CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_batched_contract_finalize ! ************************************************************************************************** !> \brief change the process grid of a tensor @@ -2120,7 +2120,7 @@ CONTAINS IF (PRESENT(pgrid_changed)) pgrid_changed = .TRUE. CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_change_pgrid ! ************************************************************************************************** !> \brief map tensor to a new 2d process grid for the matrix representation. @@ -2175,6 +2175,6 @@ CONTAINS END IF CALL dbt_pgrid_destroy(pgrid) - END SUBROUTINE + END SUBROUTINE dbt_change_pgrid_2d -END MODULE +END MODULE dbt_methods diff --git a/src/dbt/dbt_reshape_ops.F b/src/dbt/dbt_reshape_ops.F index 2bbe3d3d77..03026307ef 100644 --- a/src/dbt/dbt_reshape_ops.F +++ b/src/dbt/dbt_reshape_ops.F @@ -42,7 +42,7 @@ MODULE dbt_reshape_ops TYPE block_buffer_type INTEGER, DIMENSION(:, :), ALLOCATABLE :: blocks REAL(dp), DIMENSION(:), ALLOCATABLE :: data - END TYPE + END TYPE block_buffer_type CONTAINS diff --git a/src/dbt/dbt_test.F b/src/dbt/dbt_test.F index 3948e35031..522f66e346 100644 --- a/src/dbt/dbt_test.F +++ b/src/dbt/dbt_test.F @@ -53,7 +53,7 @@ MODULE dbt_test #:for ndim in ndims MODULE PROCEDURE dist_sparse_tensor_to_repl_dense_${ndim}$d_array #:endfor - END INTERFACE + END INTERFACE dist_sparse_tensor_to_repl_dense_array INTEGER, SAVE :: randmat_counter = 0 INTEGER, PARAMETER, PRIVATE :: rand_seed_init = 12341313 @@ -104,7 +104,7 @@ CONTAINS !$OMP END PARALLEL CALL dbt_destroy(tensor2_tmp) - END FUNCTION + END FUNCTION dbt_equal ! ************************************************************************************************** !> \brief check if two blocks are equal @@ -116,7 +116,7 @@ CONTAINS blocks_equal = MAXVAL(ABS(block1%blk - block2%blk)) < 1.0E-12_dp - END FUNCTION + END FUNCTION blocks_equal ! ************************************************************************************************** !> \brief Compute factorial @@ -127,7 +127,7 @@ CONTAINS INTEGER :: k INTEGER :: factorial factorial = PRODUCT([(k, k=1, n)]) - END FUNCTION + END FUNCTION factorial ! ************************************************************************************************** !> \brief Compute all permutations p of (1, 2, ..., n) @@ -160,8 +160,8 @@ CONTAINS pp(j) = t END DO END IF - END SUBROUTINE - END SUBROUTINE + END SUBROUTINE perm + END SUBROUTINE permute ! ************************************************************************************************** !> \brief Test equivalence of all tensor formats, using a random distribution. @@ -356,7 +356,7 @@ CONTAINS END DO END DO CALL dbt_pgrid_destroy(comm_nd) - END SUBROUTINE + END SUBROUTINE dbt_test_formats ! ************************************************************************************************** !> \brief Allocate and fill test tensor - entries are enumerated by their index s.t. they only depend @@ -473,7 +473,7 @@ CONTAINS CALL dbt_iterator_stop(iterator) !$OMP END PARALLEL - END SUBROUTINE + END SUBROUTINE dbt_setup_test_tensor ! ************************************************************************************************** !> \brief Enumerate tensor entries in block @@ -510,7 +510,7 @@ CONTAINS END IF #:endfor - END SUBROUTINE + END SUBROUTINE enumerate_block_elements #:for ndim in ndims ! ************************************************************************************************** @@ -556,7 +556,7 @@ CONTAINS !$OMP END PARALLEL CALL tensor%pgrid%mp_comm_2d%sum(array) - END SUBROUTINE + END SUBROUTINE dist_sparse_tensor_to_repl_dense_${ndim}$d_array #:endfor ! ************************************************************************************************** @@ -773,7 +773,7 @@ CONTAINS IF (io_unit > 0) WRITE (io_unit, *) 'Test passed!', eql_diff END IF - END SUBROUTINE + END SUBROUTINE dbt_contract_test ! ************************************************************************************************** !> \brief mapped sizes in 2d @@ -784,7 +784,7 @@ CONTAINS INTEGER, DIMENSION(2) :: sizes_2d sizes_2d(1) = PRODUCT(nd_sizes(map1)) sizes_2d(2) = PRODUCT(nd_sizes(map2)) - END FUNCTION + END FUNCTION sizes_2d ! ************************************************************************************************** !> \brief checksum of a tensor consistent with block_checksum @@ -794,7 +794,7 @@ CONTAINS TYPE(dbt_type), INTENT(IN) :: tensor REAL(KIND=dp) :: dbt_checksum dbt_checksum = dbt_tas_checksum(tensor%matrix_rep) - END FUNCTION + END FUNCTION dbt_checksum ! ************************************************************************************************** !> \brief Reset the seed used for generating random matrices to default value @@ -802,6 +802,6 @@ CONTAINS ! ************************************************************************************************** SUBROUTINE dbt_reset_randmat_seed() randmat_counter = rand_seed_init - END SUBROUTINE + END SUBROUTINE dbt_reset_randmat_seed - END MODULE + END MODULE dbt_test diff --git a/src/dbt/dbt_types.F b/src/dbt/dbt_types.F index 0b5ffb7541..72b6eb5c95 100644 --- a/src/dbt/dbt_types.F +++ b/src/dbt/dbt_types.F @@ -100,14 +100,14 @@ MODULE dbt_types TYPE(mp_cart_type) :: mp_comm_2d TYPE(dbt_tas_split_info), ALLOCATABLE :: tas_split_info INTEGER :: nproc = -1 - END TYPE + END TYPE dbt_pgrid_type TYPE dbt_contraction_storage REAL(dp) :: nsplit_avg = 0.0_dp INTEGER :: ibatch = -1 TYPE(array_list) :: batch_ranges LOGICAL :: static = .FALSE. - END TYPE + END TYPE dbt_contraction_storage TYPE dbt_type TYPE(dbt_tas_type), POINTER :: matrix_rep => NULL() @@ -134,7 +134,7 @@ MODULE dbt_types TYPE(array_list) :: nd_dist ! lightweight reference counting for communicators: INTEGER, POINTER :: refcount => NULL() - END TYPE + END TYPE dbt_distribution_type ! ************************************************************************************************** !> \brief tas matrix distribution function object for one matrix index @@ -151,7 +151,7 @@ MODULE dbt_types CONTAINS PROCEDURE :: dist => tas_dist_t PROCEDURE :: rowcols => tas_rowcols_t - END TYPE + END TYPE dbt_tas_dist_t ! ************************************************************************************************** !> \brief block size object for one matrix index @@ -163,21 +163,21 @@ MODULE dbt_types TYPE(array_list) :: blk_size CONTAINS PROCEDURE :: data => tas_blk_size_t - END TYPE + END TYPE dbt_tas_blk_size_t INTERFACE dbt_create MODULE PROCEDURE dbt_create_new MODULE PROCEDURE dbt_create_template MODULE PROCEDURE dbt_create_matrix - END INTERFACE + END INTERFACE dbt_create INTERFACE dbt_tas_dist_t MODULE PROCEDURE new_dbt_tas_dist_t - END INTERFACE + END INTERFACE dbt_tas_dist_t INTERFACE dbt_tas_blk_size_t MODULE PROCEDURE new_dbt_tas_blk_size_t - END INTERFACE + END INTERFACE dbt_tas_blk_size_t CONTAINS @@ -229,7 +229,7 @@ CONTAINS new_dbt_tas_dist_t%nd_dist = array_sublist(nd_dist, index_map) new_dbt_tas_dist_t%nprowcol = grid_dims(which_dim) new_dbt_tas_dist_t%nmrowcol = matrix_dims(which_dim) - END FUNCTION + END FUNCTION new_dbt_tas_dist_t ! ************************************************************************************************** !> \author Patrick Seewald @@ -244,7 +244,7 @@ CONTAINS ind_blk(:SIZE(t%dims)) = split_tensor_index(rowcol, t%dims) dist_blk(:SIZE(t%dims)) = get_array_elements(t%nd_dist, ind_blk(:SIZE(t%dims))) tas_dist_t = combine_pgrid_index(dist_blk(:SIZE(t%dims)), t%dims_grid) - END FUNCTION + END FUNCTION tas_dist_t ! ************************************************************************************************** !> \author Patrick Seewald @@ -310,7 +310,7 @@ CONTAINS END IF #:endfor - END FUNCTION + END FUNCTION tas_rowcols_t ! ************************************************************************************************** !> \brief Create block size object for one matrix dimension @@ -351,7 +351,7 @@ CONTAINS new_dbt_tas_blk_size_t%nfullrowcol = PRODUCT(INT(sum_of_arrays(new_dbt_tas_blk_size_t%blk_size), & KIND=int_8)) - END FUNCTION + END FUNCTION new_dbt_tas_blk_size_t ! ************************************************************************************************** !> \author Patrick Seewald @@ -367,7 +367,7 @@ CONTAINS blk_size(:) = get_array_elements(t%blk_size, ind_blk) tas_blk_size_t = PRODUCT(blk_size) - END FUNCTION + END FUNCTION tas_blk_size_t ! ************************************************************************************************** !> \brief load balancing criterion whether to accept process grid dimension based on total number of @@ -394,7 +394,7 @@ CONTAINS END IF END IF - END FUNCTION + END FUNCTION accept_pdims_loadbalancing ! ************************************************************************************************** !> \brief Create process grid dimensions corresponding to one dimension of the matrix representation @@ -474,7 +474,7 @@ CONTAINS dims(sort_indices) = dims - END SUBROUTINE + END SUBROUTINE dbt_mp_dims_create ! ************************************************************************************************** !> \brief Create an n-dimensional process grid. @@ -541,7 +541,7 @@ CONTAINS pgrid%nproc = nproc CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_pgrid_create_expert ! ************************************************************************************************** !> \brief Create a default nd process topology that is consistent with a given 2d topology. @@ -635,7 +635,7 @@ CONTAINS CALL timestop(handle) - END FUNCTION + END FUNCTION dbt_nd_mp_comm ! ************************************************************************************************** !> \brief Release the MPI communicator. @@ -670,7 +670,7 @@ CONTAINS CALL dbt_tas_info_hold(pgrid_out%tas_split_info) END IF END IF - END SUBROUTINE + END SUBROUTINE dbt_pgrid_remap ! ************************************************************************************************** !> \brief as mp_environ but for special pgrid type @@ -685,7 +685,7 @@ CONTAINS task_coor_2d = pgrid%mp_comm_2d%mepos_cart CALL dbt_get_mapping_info(pgrid%nd_index_grid, dims_nd=dims) task_coor = get_nd_indices_pgrid(pgrid%nd_index_grid, task_coor_2d) - END SUBROUTINE + END SUBROUTINE mp_environ_pgrid ! ************************************************************************************************** !> \brief Create a tensor distribution. @@ -775,7 +775,7 @@ CONTAINS dist%refcount = 1 CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_distribution_new_expert ! ************************************************************************************************** !> \brief Create a tensor distribution. @@ -795,7 +795,7 @@ CONTAINS CALL dbt_distribution_new_expert(dist, pgrid, map1_2d, map2_2d, ${varlist("nd_dist")}$) - END SUBROUTINE + END SUBROUTINE dbt_distribution_new ! ************************************************************************************************** !> \brief destroy process grid @@ -817,7 +817,7 @@ CONTAINS CALL dbt_tas_release_info(pgrid%tas_split_info) DEALLOCATE (pgrid%tas_split_info) END IF - END SUBROUTINE + END SUBROUTINE dbt_pgrid_destroy ! ************************************************************************************************** !> \brief Destroy tensor distribution @@ -854,7 +854,7 @@ CONTAINS END IF CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_distribution_destroy ! ************************************************************************************************** !> \brief reference counting for distribution @@ -870,7 +870,7 @@ CONTAINS END IF ref => dist%refcount ref = ref + 1 - END SUBROUTINE + END SUBROUTINE dbt_distribution_hold ! ************************************************************************************************** !> \brief get distribution from tensor @@ -885,7 +885,7 @@ CONTAINS dbt_distribution%pgrid = tensor%pgrid dbt_distribution%nd_dist = tensor%nd_dist dbt_distribution%refcount => dbt_distribution%refcount - END FUNCTION + END FUNCTION dbt_distribution ! ************************************************************************************************** !> \author Patrick Seewald @@ -903,7 +903,7 @@ CONTAINS CALL dbt_distribution_new_expert(dist_out, dist_in%pgrid, map1_2d, map2_2d, ${varlist("dist", nmax=ndim)}$) END IF #:endfor - END SUBROUTINE + END SUBROUTINE dbt_distribution_remap ! ************************************************************************************************** !> \brief create a tensor. @@ -1020,7 +1020,7 @@ CONTAINS tensor%valid = .TRUE. CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_create_new ! ************************************************************************************************** !> \brief reference counting for tensors @@ -1037,7 +1037,7 @@ CONTAINS ref => tensor%refcount ref = ref + 1 - END SUBROUTINE + END SUBROUTINE dbt_hold ! ************************************************************************************************** !> \brief how many tensor dimensions are mapped to matrix row @@ -1049,7 +1049,7 @@ CONTAINS ndims_matrix_row = ndims_mapping_row(tensor%nd_index_blk) - END FUNCTION + END FUNCTION ndims_matrix_row ! ************************************************************************************************** !> \brief how many tensor dimensions are mapped to matrix column @@ -1060,7 +1060,7 @@ CONTAINS INTEGER(int_8) :: ndims_matrix_column ndims_matrix_column = ndims_mapping_column(tensor%nd_index_blk) - END FUNCTION + END FUNCTION ndims_matrix_column ! ************************************************************************************************** !> \brief tensor rank @@ -1071,7 +1071,7 @@ CONTAINS INTEGER :: ndims_tensor ndims_tensor = tensor%nd_index%ndim_nd - END FUNCTION + END FUNCTION ndims_tensor ! ************************************************************************************************** !> \brief tensor dimensions @@ -1084,7 +1084,7 @@ CONTAINS CPASSERT(tensor%valid) dims = tensor%nd_index%dims_nd - END SUBROUTINE + END SUBROUTINE dims_tensor ! ************************************************************************************************** !> \brief create a tensor from template @@ -1170,7 +1170,7 @@ CONTAINS END IF END IF CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_create_template ! ************************************************************************************************** !> \brief Create 2-rank tensor from matrix. @@ -1230,7 +1230,7 @@ CONTAINS CALL dbt_distribution_destroy(dist) CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_create_matrix ! ************************************************************************************************** !> \brief Destroy a tensor @@ -1286,7 +1286,7 @@ CONTAINS tensor%valid = .FALSE. tensor%name = "" CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_destroy ! ************************************************************************************************** !> \brief tensor block dimensions @@ -1299,7 +1299,7 @@ CONTAINS CPASSERT(tensor%valid) dims = tensor%nd_index_blk%dims_nd - END SUBROUTINE + END SUBROUTINE blk_dims_tensor ! ************************************************************************************************** !> \brief Size of tensor block @@ -1313,7 +1313,7 @@ CONTAINS INTENT(OUT) :: blk_size blk_size(:) = get_array_elements(tensor%blk_sizes, ind) - END SUBROUTINE + END SUBROUTINE dbt_blk_sizes ! ************************************************************************************************** !> \brief offset of tensor block @@ -1330,7 +1330,7 @@ CONTAINS CPASSERT(tensor%valid) blk_offset(:) = get_array_elements(tensor%blk_offsets, ind) - END SUBROUTINE + END SUBROUTINE dbt_blk_offsets ! ************************************************************************************************** !> \brief Generalization of block_get_stored_coordinates for tensors. @@ -1346,7 +1346,7 @@ CONTAINS ind_2d(:) = get_2d_indices_tensor(tensor%nd_index_blk, ind_nd) CALL dbt_tas_get_stored_coordinates(tensor%matrix_rep, ind_2d(1), ind_2d(2), processor) - END SUBROUTINE + END SUBROUTINE dbt_get_stored_coordinates ! ************************************************************************************************** !> \author Patrick Seewald @@ -1368,7 +1368,7 @@ CONTAINS CALL dbt_pgrid_create_expert(mp_comm, dims, pgrid, map1_2d, map2_2d, tensor_dims) - END SUBROUTINE + END SUBROUTINE dbt_pgrid_create ! ************************************************************************************************** !> \brief freeze current split factor such that it is never changed during contraction @@ -1377,7 +1377,7 @@ CONTAINS SUBROUTINE dbt_pgrid_set_strict_split(pgrid) TYPE(dbt_pgrid_type), INTENT(INOUT) :: pgrid IF (ALLOCATED(pgrid%tas_split_info)) CALL dbt_tas_set_strict_split(pgrid%tas_split_info) - END SUBROUTINE + END SUBROUTINE dbt_pgrid_set_strict_split ! ************************************************************************************************** !> \brief change dimensions of an existing process grid. @@ -1408,7 +1408,7 @@ CONTAINS END IF CALL dbt_pgrid_destroy(pgrid) pgrid = pgrid_tmp - END SUBROUTINE + END SUBROUTINE dbt_pgrid_change_dims ! ************************************************************************************************** !> \brief As block_filter @@ -1420,7 +1420,7 @@ CONTAINS CALL dbt_tas_filter(tensor%matrix_rep, eps) - END SUBROUTINE + END SUBROUTINE dbt_filter ! ************************************************************************************************** !> \brief local number of blocks along dimension idim @@ -1437,7 +1437,7 @@ CONTAINS dbt_nblks_local = tensor%nblks_local(idim) END IF - END FUNCTION + END FUNCTION dbt_nblks_local ! ************************************************************************************************** !> \brief total numbers of blocks along dimension idim @@ -1453,7 +1453,7 @@ CONTAINS ELSE dbt_nblks_total = tensor%nd_index_blk%dims_nd(idim) END IF - END FUNCTION + END FUNCTION dbt_nblks_total ! ************************************************************************************************** !> \brief As block_get_info but for tensors @@ -1529,7 +1529,7 @@ CONTAINS IF (PRESENT(distribution)) distribution = dbt_distribution(tensor) IF (PRESENT(name)) name = tensor%name - END SUBROUTINE + END SUBROUTINE dbt_get_info ! ************************************************************************************************** !> \brief As block_get_num_blocks: get number of local blocks @@ -1539,7 +1539,7 @@ CONTAINS TYPE(dbt_type), INTENT(IN) :: tensor INTEGER :: num_blocks num_blocks = dbt_tas_get_num_blocks(tensor%matrix_rep) - END FUNCTION + END FUNCTION dbt_get_num_blocks ! ************************************************************************************************** !> \brief Get total number of blocks @@ -1549,7 +1549,7 @@ CONTAINS TYPE(dbt_type), INTENT(IN) :: tensor INTEGER(KIND=int_8) :: num_blocks num_blocks = dbt_tas_get_num_blocks_total(tensor%matrix_rep) - END FUNCTION + END FUNCTION dbt_get_num_blocks_total ! ************************************************************************************************** !> \brief Clear tensor (s.t. it does not contain any blocks) @@ -1559,7 +1559,7 @@ CONTAINS TYPE(dbt_type), INTENT(INOUT) :: tensor CALL dbt_tas_clear(tensor%matrix_rep) - END SUBROUTINE + END SUBROUTINE dbt_clear ! ************************************************************************************************** !> \brief Finalize tensor, as block_finalize. This should be taken care of internally in DBT @@ -1569,7 +1569,7 @@ CONTAINS SUBROUTINE dbt_finalize(tensor) TYPE(dbt_type), INTENT(INOUT) :: tensor CALL dbt_tas_finalize(tensor%matrix_rep) - END SUBROUTINE + END SUBROUTINE dbt_finalize ! ************************************************************************************************** !> \brief as block_scale @@ -1579,7 +1579,7 @@ CONTAINS TYPE(dbt_type), INTENT(INOUT) :: tensor REAL(dp), INTENT(IN) :: alpha CALL dbm_scale(tensor%matrix_rep%matrix, alpha) - END SUBROUTINE + END SUBROUTINE dbt_scale ! ************************************************************************************************** !> \author Patrick Seewald @@ -1588,7 +1588,7 @@ CONTAINS TYPE(dbt_type), INTENT(IN) :: tensor INTEGER :: dbt_get_nze dbt_get_nze = dbt_tas_get_nze(tensor%matrix_rep) - END FUNCTION + END FUNCTION dbt_get_nze ! ************************************************************************************************** !> \author Patrick Seewald @@ -1597,7 +1597,7 @@ CONTAINS TYPE(dbt_type), INTENT(IN) :: tensor INTEGER(KIND=int_8) :: dbt_get_nze_total dbt_get_nze_total = dbt_tas_get_nze_total(tensor%matrix_rep) - END FUNCTION + END FUNCTION dbt_get_nze_total ! ************************************************************************************************** !> \brief block size of block with index ind along dimension idim @@ -1617,7 +1617,7 @@ CONTAINS blk_size(:) = get_array_elements(tensor%blk_sizes, ind) dbt_blk_size = blk_size(idim) END IF - END FUNCTION + END FUNCTION dbt_blk_size ! ************************************************************************************************** !> \brief returns an estimate of maximum number of local blocks in tensor @@ -1642,7 +1642,7 @@ CONTAINS blk_count = INT(blk_count_total/nproc*max_load_imbalance) - END FUNCTION + END FUNCTION dbt_max_nblks_local ! ************************************************************************************************** !> \brief get a load-balanced and randomized distribution along one tensor dimension @@ -1659,7 +1659,7 @@ CONTAINS INTEGER, DIMENSION(nblk), INTENT(OUT) :: dist CALL dbt_tas_default_distvec(nblk, nproc, blk_size, dist) - END SUBROUTINE + END SUBROUTINE dbt_default_distvec ! ************************************************************************************************** !> \author Patrick Seewald @@ -1684,6 +1684,6 @@ CONTAINS IF (ALLOCATED(tensor_out%contraction_storage)) DEALLOCATE (tensor_out%contraction_storage) IF (ALLOCATED(tensor_storage_tmp)) CALL move_alloc(tensor_storage_tmp, tensor_out%contraction_storage) - END SUBROUTINE + END SUBROUTINE dbt_copy_contraction_storage - END MODULE + END MODULE dbt_types diff --git a/src/dbt/dbt_unittest.F b/src/dbt/dbt_unittest.F index fca7d93cee..6dabbf0010 100644 --- a/src/dbt/dbt_unittest.F +++ b/src/dbt/dbt_unittest.F @@ -790,4 +790,4 @@ PROGRAM dbt_unittest ! finalize mpi CALL mp_world_finalize() -END PROGRAM +END PROGRAM dbt_unittest diff --git a/src/dbt/tas/dbt_tas_base.F b/src/dbt/tas/dbt_tas_base.F index 50b5c63f71..3220188763 100644 --- a/src/dbt/tas/dbt_tas_base.F +++ b/src/dbt/tas/dbt_tas_base.F @@ -190,7 +190,7 @@ CONTAINS matrix%valid = .TRUE. CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_tas_create_new ! ************************************************************************************************** !> \brief Create matrix from template @@ -222,7 +222,7 @@ CONTAINS matrix%nfullcols = matrix_in%nfullcols matrix%valid = .TRUE. - END SUBROUTINE + END SUBROUTINE dbt_tas_create_template ! ************************************************************************************************** !> \brief ... @@ -237,7 +237,7 @@ CONTAINS DEALLOCATE (matrix%row_blk_size) DEALLOCATE (matrix%col_blk_size) matrix%valid = .FALSE. - END SUBROUTINE + END SUBROUTINE dbt_tas_destroy ! ************************************************************************************************** !> \brief Copy matrix_a to matrix_b @@ -280,7 +280,7 @@ CONTAINS !$OMP END PARALLEL CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_tas_copy ! ************************************************************************************************** !> \brief Make sure that matrix_out has same blocks reserved as matrix_in. @@ -316,7 +316,7 @@ CONTAINS !$OMP END PARALLEL CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_tas_reserve_blocks_template ! ************************************************************************************************** !> \brief ... @@ -327,7 +327,7 @@ CONTAINS TYPE(dbt_tas_type), INTENT(INOUT) :: matrix CALL dbm_finalize(matrix%matrix) - END SUBROUTINE + END SUBROUTINE dbt_tas_finalize ! ************************************************************************************************** !> \brief create new distribution. @@ -422,7 +422,7 @@ CONTAINS !IF(PRESENT(strict_split)) dist%strict_split = strict_split CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_tas_distribution_new ! ************************************************************************************************** !> \brief ... @@ -448,7 +448,7 @@ CONTAINS END IF CALL dbt_tas_release_info(dist%info) CALL dbm_distribution_release(dist%dbm_dist) - END SUBROUTINE + END SUBROUTINE dbt_tas_distribution_destroy ! ************************************************************************************************** !> \brief As dbt_get_stored_coordinates @@ -473,7 +473,7 @@ CONTAINS ! workaround for inefficient mpi_cart_rank processor = pcoord(1)*info%pdims(2) + pcoord(2) - END SUBROUTINE + END SUBROUTINE dbt_tas_get_stored_coordinates ! ************************************************************************************************** !> \brief Get all processors for a given row/col combination if matrix is replicated on each process @@ -511,7 +511,7 @@ CONTAINS pcoord(2) = matrix%dist%col_dist%dist(col_s) END SELECT END DO - END SUBROUTINE + END SUBROUTINE dbt_repl_get_stored_coordinates ! ************************************************************************************************** !> \brief Convert a tall-and-skinny matrix into a normal DBM matrix. @@ -595,7 +595,7 @@ CONTAINS CALL dbm_finalize(matrix_dbm) CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_tas_convert_to_dbm ! ************************************************************************************************** !> \brief Converts a DBM matrix into the tall-and-skinny matrix type. @@ -658,7 +658,7 @@ CONTAINS CALL dbt_tas_finalize(matrix_rect) CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_tas_convert_to_tas ! ************************************************************************************************** !> \brief As dbm_iterator_start @@ -673,7 +673,7 @@ CONTAINS CALL dbm_iterator_start(iter%iter, matrix_in%matrix) iter%dist => matrix_in%dist - END SUBROUTINE + END SUBROUTINE dbt_tas_iterator_start ! ************************************************************************************************** !> \brief As dbm_iterator_num_blocks @@ -686,7 +686,7 @@ CONTAINS INTEGER :: dbt_tas_iterator_num_blocks dbt_tas_iterator_num_blocks = dbm_iterator_num_blocks(iter%iter) - END FUNCTION + END FUNCTION dbt_tas_iterator_num_blocks ! ************************************************************************************************** !> \brief As dbm_iterator_blocks_left @@ -699,7 +699,7 @@ CONTAINS LOGICAL :: dbt_tas_iterator_blocks_left dbt_tas_iterator_blocks_left = dbm_iterator_blocks_left(iter%iter) - END FUNCTION + END FUNCTION dbt_tas_iterator_blocks_left ! ************************************************************************************************** !> \brief As dbm_iterator_stop @@ -710,7 +710,7 @@ CONTAINS TYPE(dbt_tas_iterator), INTENT(INOUT) :: iter CALL dbm_iterator_stop(iter%iter) - END SUBROUTINE + END SUBROUTINE dbt_tas_iterator_stop ! ************************************************************************************************** !> \brief As dbm_iterator_next_block @@ -734,7 +734,7 @@ CONTAINS CALL dbt_index_local_to_global(iterator%dist%info, iterator%dist, row_group=row_group, column_group=column_group, & row=row, column=column) - END SUBROUTINE + END SUBROUTINE dbt_tas_iterator_next_block_index ! ************************************************************************************************** !> \brief As dbm_reserve_blocks @@ -767,7 +767,7 @@ CONTAINS CALL dbm_reserve_blocks(matrix%matrix, rows_group, columns_group) CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_tas_reserve_blocks_index ! ************************************************************************************************** !> \brief Copy a distribution @@ -795,7 +795,7 @@ CONTAINS END IF dist_out = dist_in - END SUBROUTINE + END SUBROUTINE dbt_tas_copy_distribution ! ************************************************************************************************** !> \brief Get block size for a given row & column @@ -813,7 +813,7 @@ CONTAINS row_size = matrix%row_blk_size%data(row) col_size = matrix%col_blk_size%data(col) - END SUBROUTINE + END SUBROUTINE dbt_tas_blk_sizes ! ************************************************************************************************** !> \brief get info on mpi grid splitting @@ -826,7 +826,7 @@ CONTAINS TYPE(dbt_tas_split_info), POINTER :: dbt_tas_info dbt_tas_info => matrix%dist%info - END FUNCTION + END FUNCTION dbt_tas_info ! ************************************************************************************************** !> \brief ... @@ -839,7 +839,7 @@ CONTAINS INTEGER(KIND=int_8) :: nblkrows_total nblkrows_total = matrix%nblkrows - END FUNCTION + END FUNCTION dbt_tas_nblkrows_total ! ************************************************************************************************** !> \brief ... @@ -852,7 +852,7 @@ CONTAINS INTEGER(KIND=int_8) :: nfullrows_total nfullrows_total = matrix%nfullrows - END FUNCTION + END FUNCTION dbt_tas_nfullrows_total ! ************************************************************************************************** !> \brief ... @@ -865,7 +865,7 @@ CONTAINS INTEGER(KIND=int_8) :: nblkcols_total nblkcols_total = matrix%nblkcols - END FUNCTION + END FUNCTION dbt_tas_nblkcols_total ! ************************************************************************************************** !> \brief ... @@ -878,7 +878,7 @@ CONTAINS INTEGER(KIND=int_8) :: nfullcols_total nfullcols_total = matrix%nfullcols - END FUNCTION + END FUNCTION dbt_tas_nfullcols_total ! ************************************************************************************************** !> \brief ... @@ -891,7 +891,7 @@ CONTAINS INTEGER :: nblkcols_local nblkcols_local = SIZE(dbm_get_col_block_sizes(matrix%matrix)) - END FUNCTION + END FUNCTION dbt_tas_nblkcols_local ! ************************************************************************************************** !> \brief ... @@ -904,7 +904,7 @@ CONTAINS INTEGER :: nblkrows_local nblkrows_local = SIZE(dbm_get_row_block_sizes(matrix%matrix)) - END FUNCTION + END FUNCTION dbt_tas_nblkrows_local ! ************************************************************************************************** !> \brief As dbt_get_num_blocks: get number of local blocks @@ -917,7 +917,7 @@ CONTAINS INTEGER :: num_blocks num_blocks = dbm_get_num_blocks(matrix%matrix) - END FUNCTION + END FUNCTION dbt_tas_get_num_blocks ! ************************************************************************************************** !> \brief get total number of blocks @@ -935,7 +935,7 @@ CONTAINS num_blocks = dbt_tas_get_num_blocks(matrix) CALL info%mp_comm%sum(num_blocks) - END FUNCTION + END FUNCTION dbt_tas_get_num_blocks_total ! ************************************************************************************************** !> \brief As dbt_get_nze: get number of local non-zero elements @@ -949,7 +949,7 @@ CONTAINS dbt_tas_get_nze = dbm_get_nze(matrix%matrix) - END FUNCTION + END FUNCTION dbt_tas_get_nze ! ************************************************************************************************** !> \brief Get total number of non-zero elements @@ -966,7 +966,7 @@ CONTAINS dbt_tas_get_nze_total = dbt_tas_get_nze(matrix) info = dbt_tas_info(matrix) CALL info%mp_comm%sum(dbt_tas_get_nze_total) - END FUNCTION + END FUNCTION dbt_tas_get_nze_total ! ************************************************************************************************** !> \brief Clear matrix (erase all data) @@ -977,7 +977,7 @@ CONTAINS TYPE(dbt_tas_type), INTENT(INOUT) :: matrix CALL dbm_clear(matrix%matrix) - END SUBROUTINE + END SUBROUTINE dbt_tas_clear ! ************************************************************************************************** !> \brief ... @@ -1043,7 +1043,7 @@ CONTAINS IF (PRESENT(col_blk_size)) ALLOCATE (col_blk_size, SOURCE=matrix%col_blk_size) IF (PRESENT(distribution)) distribution = matrix%dist - END SUBROUTINE + END SUBROUTINE dbt_tas_get_info ! ************************************************************************************************** !> \brief As dbm_iterator_next_block @@ -1069,7 +1069,7 @@ CONTAINS CALL dbt_index_local_to_global(iterator%dist%info, iterator%dist, row_group=row_group, column_group=column_group, & row=row, column=column) - END SUBROUTINE + END SUBROUTINE dbt_tas_iterator_next_block_d ! ************************************************************************************************** !> \brief As dbm_put_block @@ -1093,7 +1093,7 @@ CONTAINS CALL dbm_put_block(matrix%matrix, row_group, col_group, block, summation=summation) - END SUBROUTINE + END SUBROUTINE dbt_tas_put_block ! ************************************************************************************************** !> \brief As dbm_get_block_p @@ -1119,7 +1119,7 @@ CONTAINS CALL dbm_get_block_p(matrix%matrix, row_group, col_group, block, & row_size=row_size, col_size=col_size) - END SUBROUTINE + END SUBROUTINE dbt_tas_get_block_p ! ************************************************************************************************** !> \brief As dbm_filter @@ -1133,6 +1133,6 @@ CONTAINS CALL dbm_filter(matrix%matrix, eps) - END SUBROUTINE + END SUBROUTINE dbt_tas_filter -END MODULE +END MODULE dbt_tas_base diff --git a/src/dbt/tas/dbt_tas_global.F b/src/dbt/tas/dbt_tas_global.F index 109831cabc..ada5653d53 100644 --- a/src/dbt/tas/dbt_tas_global.F +++ b/src/dbt/tas/dbt_tas_global.F @@ -50,7 +50,7 @@ MODULE dbt_tas_global CONTAINS PROCEDURE(rowcol_dist), deferred :: dist PROCEDURE(dist_rowcols), deferred :: rowcols - END TYPE + END TYPE dbt_tas_distribution ! ************************************************************************************************** !> \brief type for cyclic (round robin) distribution: @@ -62,7 +62,7 @@ MODULE dbt_tas_global CONTAINS PROCEDURE :: dist => cyclic_dist PROCEDURE :: rowcols => cyclic_rowcols - END TYPE + END TYPE dbt_tas_dist_cyclic ! ************************************************************************************************** !> \brief type for arbitrary distributions @@ -74,7 +74,7 @@ MODULE dbt_tas_global CONTAINS PROCEDURE :: dist => arb_dist PROCEDURE :: rowcols => arb_rowcols - END TYPE + END TYPE dbt_tas_dist_arb ! ************************************************************************************************** !> \brief type for replicated distribution @@ -89,7 +89,7 @@ MODULE dbt_tas_global CONTAINS PROCEDURE :: dist => repl_dist PROCEDURE :: rowcols => repl_rowcols - END TYPE + END TYPE dbt_tas_dist_repl ! ************************************************************************************************** !> \brief abstract type for integer data (e.g. block sizes) along one dimension @@ -102,7 +102,7 @@ MODULE dbt_tas_global INTEGER(KIND=int_8) :: nfullrowcol = -1 CONTAINS PROCEDURE(rowcol_data), deferred :: DATA - END TYPE + END TYPE dbt_tas_rowcol_data ! ************************************************************************************************** !> \brief type for arbitrary block sizes @@ -113,7 +113,7 @@ MODULE dbt_tas_global INTEGER, DIMENSION(:), ALLOCATABLE :: blk_size_vec CONTAINS PROCEDURE :: DATA => blk_size_arb - END TYPE + END TYPE dbt_tas_blk_size_arb ! ************************************************************************************************** !> \brief type for replicated block sizes @@ -125,7 +125,7 @@ MODULE dbt_tas_global INTEGER :: nmrowcol_local = -1 CONTAINS PROCEDURE :: DATA => blk_size_repl - END TYPE + END TYPE dbt_tas_blk_size_repl ! ************************************************************************************************** !> \brief type for blocks of size one @@ -134,7 +134,7 @@ MODULE dbt_tas_global TYPE, EXTENDS(dbt_tas_rowcol_data) :: dbt_tas_blk_size_one CONTAINS PROCEDURE :: DATA => blk_size_one - END TYPE + END TYPE dbt_tas_blk_size_one ABSTRACT INTERFACE @@ -149,7 +149,7 @@ MODULE dbt_tas_global CLASS(dbt_tas_distribution), INTENT(IN) :: t INTEGER(KIND=int_8), INTENT(IN) :: rowcol INTEGER :: rowcol_dist - END FUNCTION + END FUNCTION rowcol_dist ! ************************************************************************************************** !> \brief map distribution rows/cols to matrix rows/cols @@ -162,7 +162,7 @@ MODULE dbt_tas_global CLASS(dbt_tas_distribution), INTENT(IN) :: t INTEGER, INTENT(IN) :: dist INTEGER(KIND=int_8), DIMENSION(:), ALLOCATABLE :: dist_rowcols - END FUNCTION + END FUNCTION dist_rowcols ! ************************************************************************************************** !> \brief integer data for each block row / col @@ -175,7 +175,7 @@ MODULE dbt_tas_global CLASS(dbt_tas_rowcol_data), INTENT(IN) :: t INTEGER(KIND=int_8), INTENT(IN) :: rowcol INTEGER :: rowcol_data - END FUNCTION + END FUNCTION rowcol_data END INTERFACE @@ -217,7 +217,7 @@ CONTAINS INTEGER(KIND=int_8), INTENT(IN) :: rowcol INTEGER :: blk_size_arb blk_size_arb = t%blk_size_vec(rowcol) - END FUNCTION + END FUNCTION blk_size_arb ! ************************************************************************************************** !> \brief ... @@ -237,7 +237,7 @@ CONTAINS rowcol_local = INT(MOD(rowcol - 1_int_8, INT(t%nmrowcol_local, KIND=int_8))) + 1 blk_size_repl = t%blk_size_vec(rowcol_local) - END FUNCTION + END FUNCTION blk_size_repl ! ************************************************************************************************** !> \brief ... @@ -254,7 +254,7 @@ CONTAINS MARK_USED(t) MARK_USED(rowcol) blk_size_one = 1 - END FUNCTION + END FUNCTION blk_size_one ! ************************************************************************************************** !> \brief ... @@ -270,7 +270,7 @@ CONTAINS new_block_tas_blk_size_arb%blk_size_vec(:) = blk_size_vec(:) new_block_tas_blk_size_arb%nmrowcol = SIZE(blk_size_vec) new_block_tas_blk_size_arb%nfullrowcol = SUM(blk_size_vec) - END FUNCTION + END FUNCTION new_block_tas_blk_size_arb ! ************************************************************************************************** !> \brief ... @@ -289,7 +289,7 @@ CONTAINS new_block_tas_blk_size_repl%blk_size_vec(:) = blk_size_vec(:) new_block_tas_blk_size_repl%nmrowcol = new_block_tas_blk_size_repl%nmrowcol_local*n_repl new_block_tas_blk_size_repl%nfullrowcol = SUM(blk_size_vec)*n_repl - END FUNCTION + END FUNCTION new_block_tas_blk_size_repl ! ************************************************************************************************** !> \brief ... @@ -303,7 +303,7 @@ CONTAINS new_block_tas_blk_size_one%nmrowcol = nrowcol new_block_tas_blk_size_one%nfullrowcol = nrowcol - END FUNCTION + END FUNCTION new_block_tas_blk_size_one ! ************************************************************************************************** !> \brief ... @@ -318,7 +318,7 @@ CONTAINS INTEGER :: arb_dist arb_dist = t%dist_vec(rowcol) - END FUNCTION + END FUNCTION arb_dist ! ************************************************************************************************** !> \brief ... @@ -339,7 +339,7 @@ CONTAINS repl_dist = t%dist_vec(rowcol_local) + igroup*t%dist_size - END FUNCTION + END FUNCTION repl_dist ! ************************************************************************************************** !> \brief ... @@ -375,7 +375,7 @@ CONTAINS ALLOCATE (repl_rowcols(count)) repl_rowcols(:) = rowcols_tmp(1:count) + igroup*t%nmrowcol_local - END FUNCTION + END FUNCTION repl_rowcols ! ************************************************************************************************** !> \brief ... @@ -404,7 +404,7 @@ CONTAINS ALLOCATE (arb_rowcols(count)) arb_rowcols(:) = rowcols_tmp(1:count) - END FUNCTION + END FUNCTION arb_rowcols ! ************************************************************************************************** !> \brief ... @@ -422,7 +422,7 @@ CONTAINS new_block_tas_dist_cyclic%split_size = split_size new_block_tas_dist_cyclic%nprowcol = nprowcol new_block_tas_dist_cyclic%nmrowcol = nmrowcol - END FUNCTION + END FUNCTION new_block_tas_dist_cyclic ! ************************************************************************************************** !> \brief ... @@ -442,7 +442,7 @@ CONTAINS new_block_tas_dist_arb%dist_vec(:) = dist_vec(:) new_block_tas_dist_arb%nprowcol = nprowcol new_block_tas_dist_arb%nmrowcol = nmrowcol - END FUNCTION + END FUNCTION new_block_tas_dist_arb ! ************************************************************************************************** !> \brief Distribution that is more or less cyclic (round robin) and load balanced with different @@ -471,7 +471,7 @@ CONTAINS CALL dbt_tas_default_distvec(INT(nmrowcol), nprowcol, bsize_vec, dist_vec) dbt_tas_dist_arb_default = dbt_tas_dist_arb(dist_vec, nprowcol, nmrowcol) - END FUNCTION + END FUNCTION dbt_tas_dist_arb_default ! ************************************************************************************************** !> \brief get a load-balanced and randomized distribution along one tensor dimension @@ -488,7 +488,7 @@ CONTAINS CALL distribute_lpt_random(nblk, nproc, blk_size, dist) - END SUBROUTINE + END SUBROUTINE dbt_tas_default_distvec ! ************************************************************************************************** !> \brief distribute `nel` elements with weights `weights` over `nbin` bins. @@ -552,7 +552,7 @@ CONTAINS occup(ibin) = occup(ibin) + weights_s(iel) END DO - END SUBROUTINE + END SUBROUTINE distribute_lpt_random ! ************************************************************************************************** !> \brief ... @@ -576,7 +576,7 @@ CONTAINS new_block_tas_dist_repl%nprowcol = nprowcol new_block_tas_dist_repl%nmrowcol_local = nmrowcol new_block_tas_dist_repl%nmrowcol = nmrowcol*n_repl - END FUNCTION + END FUNCTION new_block_tas_dist_repl ! ************************************************************************************************** !> \brief ... @@ -592,7 +592,7 @@ CONTAINS cyclic_dist = INT(MOD((rowcol - 1)/INT(t%split_size, KIND=int_8), INT(t%nprowcol, KIND=int_8))) - END FUNCTION + END FUNCTION cyclic_dist ! ************************************************************************************************** !> \brief ... @@ -629,6 +629,6 @@ CONTAINS ALLOCATE (cyclic_rowcols(count)) cyclic_rowcols(:) = rowcols_tmp(1:count) - END FUNCTION + END FUNCTION cyclic_rowcols -END MODULE +END MODULE dbt_tas_global diff --git a/src/dbt/tas/dbt_tas_io.F b/src/dbt/tas/dbt_tas_io.F index 533b6725c4..0070b33cb1 100644 --- a/src/dbt/tas/dbt_tas_io.F +++ b/src/dbt/tas/dbt_tas_io.F @@ -109,7 +109,7 @@ CONTAINS WRITE (unit_nr_prv, *) END IF - END SUBROUTINE + END SUBROUTINE dbt_tas_write_matrix_info ! ************************************************************************************************** !> \brief Write info on tall-and-skinny matrix distribution & load balance @@ -201,7 +201,7 @@ CONTAINS END IF END IF END IF - END SUBROUTINE + END SUBROUTINE dbt_tas_write_dist ! ************************************************************************************************** !> \brief Print info on how matrix is split @@ -252,7 +252,7 @@ CONTAINS groupdims(1), "x", groupdims(2) END IF - END SUBROUTINE + END SUBROUTINE dbt_tas_write_split_info ! ************************************************************************************************** !> \brief ... @@ -270,7 +270,7 @@ CONTAINS unit_nr_out = 0 END IF - END FUNCTION + END FUNCTION prep_output_unit -END MODULE +END MODULE dbt_tas_io diff --git a/src/dbt/tas/dbt_tas_mm.F b/src/dbt/tas/dbt_tas_mm.F index 081ce20ec9..8829fbe10f 100644 --- a/src/dbt/tas/dbt_tas_mm.F +++ b/src/dbt/tas/dbt_tas_mm.F @@ -775,7 +775,7 @@ CONTAINS CALL timestop(handle2) CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_tas_multiply ! ************************************************************************************************** !> \brief ... @@ -813,7 +813,7 @@ CONTAINS CALL dbm_add(matrix_out, matrix_in) END IF - END SUBROUTINE + END SUBROUTINE redistribute_and_sum ! ************************************************************************************************** !> \brief Make sure that smallest matrix involved in a multiplication is not split and bring it to @@ -873,7 +873,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE reshape_mm_small ! ************************************************************************************************** !> \brief Reshape either matrix1 or matrix2 to make sure that their process grids are compatible @@ -1127,7 +1127,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE reshape_mm_compatible ! ************************************************************************************************** !> \brief Change split factor without redistribution @@ -1220,7 +1220,7 @@ CONTAINS END IF CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE change_split ! ************************************************************************************************** !> \brief Check whether matrices have same distribution and same split. @@ -1298,7 +1298,7 @@ CONTAINS END IF END IF - END FUNCTION + END FUNCTION dist_compatible ! ************************************************************************************************** !> \brief Reshape matrix_in s.t. it has same process grid, distribution and split as template @@ -1382,7 +1382,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE reshape_mm_template ! ************************************************************************************************** !> \brief Estimate sparsity pattern of C resulting from A x B = C @@ -1467,7 +1467,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_tas_estimate_result_nze ! ************************************************************************************************** !> \brief Estimate optimal split factor for AxB=C from occupancies (number of non-zero elements) @@ -1509,7 +1509,7 @@ CONTAINS nsplit = INT(MIN(INT(numnodes, KIND=int_8), NINT(REAL(max_nze, dp)/(REAL(min_nze, dp)*s_opt_factor), KIND=int_8))) IF (nsplit == 0) nsplit = 1 - END FUNCTION + END FUNCTION split_factor_estimate ! ************************************************************************************************** !> \brief Create a matrix with block sizes one that contains the block norms of matrix_in @@ -1562,7 +1562,7 @@ CONTAINS !$OMP END PARALLEL END IF - END SUBROUTINE + END SUBROUTINE create_block_norms_matrix ! ************************************************************************************************** !> \brief Convert a DBM matrix to a new process grid @@ -1639,7 +1639,7 @@ CONTAINS END IF CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE convert_to_new_pgrid ! ************************************************************************************************** !> \brief ... @@ -1652,7 +1652,7 @@ CONTAINS CALL dbt_tas_set_batched_state(matrix, state=1) ALLOCATE (matrix%mm_storage) matrix%mm_storage%batched_out = .FALSE. - END SUBROUTINE + END SUBROUTINE dbt_tas_batched_mm_init ! ************************************************************************************************** !> \brief ... @@ -1683,7 +1683,7 @@ CONTAINS CALL matrix%dist%info%mp_comm%sync() CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_tas_batched_mm_finalize ! ************************************************************************************************** !> \brief set state flags during batched multiplication @@ -1721,7 +1721,7 @@ CONTAINS CPABORT("should not happen") END SELECT END IF - END SUBROUTINE + END SUBROUTINE dbt_tas_set_batched_state ! ************************************************************************************************** !> \brief ... @@ -1760,6 +1760,6 @@ CONTAINS CALL dbt_tas_set_batched_state(matrix, state=2) - END SUBROUTINE + END SUBROUTINE dbt_tas_batched_mm_complete -END MODULE +END MODULE dbt_tas_mm diff --git a/src/dbt/tas/dbt_tas_reshape_ops.F b/src/dbt/tas/dbt_tas_reshape_ops.F index af86bd3cc2..4d8f8053d1 100644 --- a/src/dbt/tas/dbt_tas_reshape_ops.F +++ b/src/dbt/tas/dbt_tas_reshape_ops.F @@ -64,7 +64,7 @@ MODULE dbt_tas_reshape_ops INTEGER(KIND=int_8), DIMENSION(:, :), ALLOCATABLE :: indx REAL(dp), DIMENSION(:), ALLOCATABLE :: msg INTEGER :: endpos = -1 - END TYPE + END TYPE dbt_buffer_type CONTAINS @@ -254,7 +254,7 @@ CONTAINS CALL dbt_tas_finalize(matrix_out) CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_tas_reshape ! ************************************************************************************************** !> \brief Replicate matrix_in such that each submatrix of matrix_out is an exact copy of matrix_in @@ -488,7 +488,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_tas_replicate ! ************************************************************************************************** !> \brief Merge submatrices of matrix_in to matrix_out by sum @@ -657,7 +657,7 @@ CONTAINS CALL dbm_finalize(matrix_out) CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_tas_merge ! ************************************************************************************************** !> \brief get all indices from buffer @@ -681,7 +681,7 @@ CONTAINS ALLOCATE (INDEX(indx_shape(1), indx_shape(2))) INDEX(:, :) = buffer%indx(1:indx_shape(1), 1:indx_shape(2)) CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_buffer_get_index ! ************************************************************************************************** !> \brief how many blocks left in iterator @@ -694,7 +694,7 @@ CONTAINS LOGICAL :: dbt_buffer_blocks_left dbt_buffer_blocks_left = buffer%endpos < buffer%nblock - END FUNCTION + END FUNCTION dbt_buffer_blocks_left ! ************************************************************************************************** !> \brief Create block buffer for MPI communication. @@ -711,7 +711,7 @@ CONTAINS buffer%endpos = 0 ALLOCATE (buffer%msg(ndata)) ALLOCATE (buffer%indx(nblock, 3)) - END SUBROUTINE + END SUBROUTINE dbt_buffer_create ! ************************************************************************************************** !> \brief ... @@ -777,7 +777,7 @@ CONTAINS buffer%indx(p + 1, 3) = INT(ndata, KIND=int_8) END IF buffer%endpos = buffer%endpos + 1 - END SUBROUTINE + END SUBROUTINE dbt_buffer_add_block ! ************************************************************************************************** !> \brief get next block from buffer. Iterator is advanced only if block is retrieved or advance_iter. @@ -824,7 +824,7 @@ CONTAINS END IF IF (do_advance) buffer%endpos = buffer%endpos + 1 - END SUBROUTINE + END SUBROUTINE dbt_buffer_get_next_block ! ************************************************************************************************** !> \brief communicate buffer @@ -884,6 +884,6 @@ CONTAINS END IF END IF CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_tas_communicate_buffer -END MODULE +END MODULE dbt_tas_reshape_ops diff --git a/src/dbt/tas/dbt_tas_split.F b/src/dbt/tas/dbt_tas_split.F index 7d10ae7908..4ae4409a52 100644 --- a/src/dbt/tas/dbt_tas_split.F +++ b/src/dbt/tas/dbt_tas_split.F @@ -140,7 +140,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_tas_create_split_rows_or_cols ! ************************************************************************************************** !> \brief Create default cartesian process grid that is consistent with default split heuristic @@ -170,7 +170,7 @@ CONTAINS CALL dbt_tas_mp_comm%create(mp_comm, 2, npdims) CALL timestop(handle) - END FUNCTION + END FUNCTION dbt_tas_mp_comm ! ************************************************************************************************** !> \brief Get optimal process grid dimensions consistent with dbt_tas_create_split @@ -210,7 +210,7 @@ CONTAINS dbt_tas_mp_dims(:) = [group_dims(1), group_dims(2)*nsplit_opt] END SELECT - END FUNCTION + END FUNCTION dbt_tas_mp_dims ! ************************************************************************************************** !> \brief Heuristic to get good split factor for a given process grid OR a given number of processes @@ -290,7 +290,7 @@ CONTAINS END DO END IF - END FUNCTION + END FUNCTION get_opt_nsplit ! ************************************************************************************************** !> \brief Derive optimal cartesian process grid from matrix sizes. This ensures optimality for @@ -317,7 +317,7 @@ CONTAINS END IF mp_comm_new = dbt_tas_mp_comm(mp_comm, split_rowcol, nsplit) - END FUNCTION + END FUNCTION dbt_tas_mp_comm_from_matrix_sizes ! ************************************************************************************************** !> \brief Split Cartesian process grid using a default split heuristic. @@ -387,7 +387,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_tas_create_split ! ************************************************************************************************** !> \brief Whether to accept proposed process grid dimensions (based on ratio of dimensions) @@ -410,7 +410,7 @@ CONTAINS ELSE accept_pgrid_dims = (MAXVAL(REAL(dims, dp))/MINVAL(dims) < default_pdims_accept_ratio**2) END IF - END FUNCTION + END FUNCTION accept_pgrid_dims ! ************************************************************************************************** !> \brief Get info on split @@ -446,7 +446,7 @@ CONTAINS END SELECT END IF - END SUBROUTINE + END SUBROUTINE dbt_tas_get_split_info ! ************************************************************************************************** !> \brief ... @@ -481,7 +481,7 @@ CONTAINS split_info%pdims = 0 IF (ALLOCATED(split_info%ngroup_opt)) DEALLOCATE (split_info%ngroup_opt) - END SUBROUTINE + END SUBROUTINE dbt_tas_release_info ! ************************************************************************************************** !> \brief ... @@ -498,7 +498,7 @@ CONTAINS END IF ref => split_info%refcount ref = ref + 1 - END SUBROUTINE + END SUBROUTINE dbt_tas_info_hold ! ************************************************************************************************** !> \brief map global process info to group @@ -539,7 +539,7 @@ CONTAINS IF (PRESENT(iproc_group)) pcoord_group = [pcoord(1), MOD(pcoord(2), pgrid_split_size)] END SELECT IF (PRESENT(iproc_group)) iproc_group = pcoord_group(1)*pdims_group(2) + pcoord_group(2) - END SUBROUTINE + END SUBROUTINE world_to_group_proc_map ! ************************************************************************************************** !> \brief map local process info to global info @@ -576,7 +576,7 @@ CONTAINS pcoord = [pcoord_group(1), igroup*pgrid_split_size + pcoord_group(2)] END SELECT iproc = pcoord(1)*pdims(2) + pcoord(2) - END SUBROUTINE + END SUBROUTINE group_to_world_proc_map ! ************************************************************************************************** !> \brief map group local block index to global matrix index @@ -606,7 +606,7 @@ CONTAINS IF (PRESENT(column)) column = cols(column_group) END ASSOCIATE END SELECT - END SUBROUTINE + END SUBROUTINE dbt_index_local_to_global ! ************************************************************************************************** !> \brief map global block index to group local index @@ -633,7 +633,7 @@ CONTAINS IF (PRESENT(column_group)) column_group = i8_bsearch(dist%local_rowcols, column) END SELECT - END SUBROUTINE + END SUBROUTINE dbt_index_global_to_local ! ************************************************************************************************** !> \brief binary search for 8-byte integers @@ -664,7 +664,7 @@ CONTAINS END IF END DO res = lindex - END FUNCTION + END FUNCTION i8_bsearch ! ************************************************************************************************** !> \brief maps a process subgroup to matrix rows/columns @@ -702,7 +702,7 @@ CONTAINS ALLOCATE (sort_indices(nrowcols)) CALL sort(rowcols, nrowcols, sort_indices) - END SUBROUTINE + END SUBROUTINE group_to_mrowcol ! ************************************************************************************************** !> \brief freeze current split factor such that it is never changed during multiplication @@ -713,6 +713,6 @@ CONTAINS TYPE(dbt_tas_split_info), INTENT(INOUT) :: info info%strict_split = [.TRUE., .TRUE.] - END SUBROUTINE + END SUBROUTINE dbt_tas_set_strict_split -END MODULE +END MODULE dbt_tas_split diff --git a/src/dbt/tas/dbt_tas_test.F b/src/dbt/tas/dbt_tas_test.F index 516fb23a99..6dc669f335 100644 --- a/src/dbt/tas/dbt_tas_test.F +++ b/src/dbt/tas/dbt_tas_test.F @@ -163,7 +163,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE dbt_tas_setup_test_matrix ! ************************************************************************************************** !> \brief Benchmark routine. Due to random sparsity (as opposed to structured sparsity pattern), @@ -301,7 +301,7 @@ CONTAINS CALL comm_dbm%free() END IF - END SUBROUTINE + END SUBROUTINE dbt_tas_benchmark_mm ! ************************************************************************************************** !> \brief Test tall-and-skinny matrix multiplication for accuracy @@ -480,7 +480,7 @@ CONTAINS CALL dbt_tas_convert_to_dbm(matrix, dbm_m) dbt_tas_checksum = dbm_checksum(dbm_m) CALL dbm_release(dbm_m) - END FUNCTION + END FUNCTION dbt_tas_checksum ! ************************************************************************************************** !> \brief Create random block sizes @@ -500,7 +500,7 @@ CONTAINS size_i = MOD((d - 1)/repeat, SIZE(sizes)) + 1 dbt_sizes(d) = sizes(size_i) END DO - END SUBROUTINE + END SUBROUTINE dbt_tas_random_bsizes ! ************************************************************************************************** !> \brief Reset the seed used for generating random matrices to default value @@ -508,6 +508,6 @@ CONTAINS ! ************************************************************************************************** SUBROUTINE dbt_tas_reset_randmat_seed() randmat_counter = rand_seed_init - END SUBROUTINE + END SUBROUTINE dbt_tas_reset_randmat_seed -END MODULE +END MODULE dbt_tas_test diff --git a/src/dbt/tas/dbt_tas_types.F b/src/dbt/tas/dbt_tas_types.F index dad5d505f5..607b5401c4 100644 --- a/src/dbt/tas/dbt_tas_types.F +++ b/src/dbt/tas/dbt_tas_types.F @@ -61,7 +61,7 @@ MODULE dbt_tas_types INTEGER, ALLOCATABLE :: ngroup_opt LOGICAL, DIMENSION(2) :: strict_split = [.FALSE., .FALSE.] INTEGER, POINTER :: refcount => NULL() - END TYPE + END TYPE dbt_tas_split_info TYPE dbt_tas_distribution_type TYPE(dbt_tas_split_info) :: info @@ -69,7 +69,7 @@ MODULE dbt_tas_types CLASS(dbt_tas_distribution), ALLOCATABLE :: row_dist CLASS(dbt_tas_distribution), ALLOCATABLE :: col_dist INTEGER(KIND=int_8), ALLOCATABLE, DIMENSION(:) :: local_rowcols - END TYPE + END TYPE dbt_tas_distribution_type ! ************************************************************************************************** !> \brief storage for batched matrix multiplication @@ -84,7 +84,7 @@ MODULE dbt_tas_types LOGICAL :: batched_out = .FALSE. LOGICAL :: batched_trans = .FALSE. REAL(dp) :: batched_beta = 1.0_dp - END TYPE + END TYPE dbt_tas_mm_storage ! ************************************************************************************************** !> \brief type for tall-and-skinny matrices @@ -113,11 +113,11 @@ MODULE dbt_tas_types INTEGER :: do_batched = 0 TYPE(dbt_tas_mm_storage), ALLOCATABLE :: mm_storage LOGICAL :: has_opt_pgrid = .FALSE. - END TYPE + END TYPE dbt_tas_type TYPE dbt_tas_iterator TYPE(dbt_tas_distribution_type), POINTER :: dist => NULL() TYPE(dbm_iterator) :: iter END TYPE dbt_tas_iterator -END MODULE +END MODULE dbt_tas_types diff --git a/src/dbt/tas/dbt_tas_unittest.F b/src/dbt/tas/dbt_tas_unittest.F index e48684fb8a..1f61aff3dc 100644 --- a/src/dbt/tas/dbt_tas_unittest.F +++ b/src/dbt/tas/dbt_tas_unittest.F @@ -166,4 +166,4 @@ PROGRAM dbt_tas_unittest CALL dbcsr_finalize_lib() ! Needed for DBM_VALIDATE_AGAINST_DBCSR. CALL mp_world_finalize() -END PROGRAM +END PROGRAM dbt_tas_unittest diff --git a/src/dbx/cp_dbcsr_api.F b/src/dbx/cp_dbcsr_api.F index 36e359cd0f..107dbcb1a0 100644 --- a/src/dbx/cp_dbcsr_api.F +++ b/src/dbx/cp_dbcsr_api.F @@ -171,7 +171,7 @@ MODULE cp_dbcsr_api TYPE dbcsr_p_type TYPE(dbcsr_type), POINTER :: matrix => Null() - END TYPE + END TYPE dbcsr_p_type TYPE dbcsr_type PRIVATE @@ -308,7 +308,7 @@ CONTAINS ELSE CALL dbm_clear(matrix%dbm) END IF - END SUBROUTINE + END SUBROUTINE dbcsr_clear ! ************************************************************************************************** !> \brief ... diff --git a/src/deepmd_wrapper.F b/src/deepmd_wrapper.F index f0fae70972..618ba93d40 100644 --- a/src/deepmd_wrapper.F +++ b/src/deepmd_wrapper.F @@ -59,7 +59,7 @@ CONTAINS IMPORT :: C_PTR, C_CHAR CHARACTER(kind=C_CHAR), DIMENSION(*) :: filename TYPE(C_PTR) :: NewDeepPot - END FUNCTION + END FUNCTION NewDeepPot END INTERFACE INTERFACE FUNCTION DeepPotCheckOK(model) BIND(C, name="DP_DeepPotCheckOK") @@ -149,7 +149,7 @@ CONTAINS REAL(C_DOUBLE), DIMENSION(9) :: virial REAL(C_DOUBLE), DIMENSION(natom) :: atomic_energy REAL(C_DOUBLE), DIMENSION(natom, 9) :: atomic_virial - END SUBROUTINE + END SUBROUTINE DeepPotCompute END INTERFACE CALL timeset(routineN, handle) @@ -181,7 +181,7 @@ CONTAINS #endif CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE deepmd_model_compute ! ************************************************************************************************** !> \brief Releases a deepmd model and all its ressources. diff --git a/src/dgemm_counter_types.F b/src/dgemm_counter_types.F index b79094b027..5f3bc84a81 100644 --- a/src/dgemm_counter_types.F +++ b/src/dgemm_counter_types.F @@ -35,7 +35,7 @@ MODULE dgemm_counter_types INTEGER :: num_dgemm_call = 0 INTEGER :: unit_nr = -1 LOGICAL :: print_info = .FALSE. - END TYPE + END TYPE dgemm_counter_type CONTAINS diff --git a/src/dm_ls_scf_curvy.F b/src/dm_ls_scf_curvy.F index 943f078940..4758c3af1b 100644 --- a/src/dm_ls_scf_curvy.F +++ b/src/dm_ls_scf_curvy.F @@ -749,7 +749,7 @@ CONTAINS CALL dbcsr_release(matrix_work) CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE transform_matrix_orth ! ************************************************************************************************** !> \brief ... diff --git a/src/dm_ls_scf_types.F b/src/dm_ls_scf_types.F index 570bcd191a..5aaf2c555c 100644 --- a/src/dm_ls_scf_types.F +++ b/src/dm_ls_scf_types.F @@ -45,12 +45,12 @@ MODULE dm_ls_scf_types INTEGER, DIMENSION(:), ALLOCATABLE :: atom_to_molecule TYPE(dbcsr_type) :: matrix_A = dbcsr_type() TYPE(dbcsr_type) :: matrix_B = dbcsr_type() - END TYPE + END TYPE ls_mstruct_type TYPE ls_mat_history_type INTEGER :: istore = 0, nstore = 0 TYPE(dbcsr_type), DIMENSION(:, :), ALLOCATABLE :: matrix - END TYPE + END TYPE ls_mat_history_type TYPE ls_scf_curvy_type TYPE(dbcsr_type), DIMENSION(:), ALLOCATABLE :: matrix_dp @@ -73,7 +73,7 @@ MODULE dm_ls_scf_types REAL(KIND=dp) :: filter_factor = 0.0_dp REAL(KIND=dp) :: min_shift = 0.0_dp REAL(KIND=dp) :: min_filter = 0.0_dp - END TYPE + END TYPE ls_scf_curvy_type TYPE chebyshev_type LOGICAL :: compute_chebyshev = .FALSE. @@ -83,7 +83,7 @@ MODULE dm_ls_scf_types REAL(KIND=dp), DIMENSION(:), POINTER :: max_energy => NULL() TYPE(section_vals_type), POINTER :: print_key_dos => NULL() TYPE(section_vals_type), POINTER :: print_key_cube => NULL() - END TYPE + END TYPE chebyshev_type TYPE ls_scf_env_type INTEGER :: nspins = 0, natoms = 0 diff --git a/src/ec_methods.F b/src/ec_methods.F index bc9291830e..5353e55b28 100644 --- a/src/ec_methods.F +++ b/src/ec_methods.F @@ -145,7 +145,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE create_kernel ! ************************************************************************************************** !> \brief Allocate and initiate molecular orbitals environment diff --git a/src/emd/rt_bse.F b/src/emd/rt_bse.F index 07a388f8e8..83afd38642 100644 --- a/src/emd/rt_bse.F +++ b/src/emd/rt_bse.F @@ -576,7 +576,7 @@ CONTAINS ! Deallocate workspace IF (.NOT. PRESENT(workspace_opt)) CALL cp_cfm_release(workspace) DEALLOCATE (partial_metric) - END FUNCTION + END FUNCTION rho_metric ! ************************************************************************************************** !> \brief Determines the metric of the antihermitian part of the matrix @@ -601,7 +601,7 @@ CONTAINS complex_one = CMPLX(1.0, 0.0, kind=dp) CALL cp_cfm_scale_and_add(complex_one, workspace(1), -complex_one, workspace(2)) metric = cp_cfm_norm(workspace(1), "M") - END SUBROUTINE + END SUBROUTINE antiherm_metric ! ************************************************************************************************** !> \brief For Taylor and Exact exp_method, calculates the matrix exponential of the @@ -640,7 +640,7 @@ CONTAINS END DO CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE ham_to_exp ! ************************************************************************************************** !> \brief Updates the effective Hamiltonian, given a density matrix rho !> \param rtbse_env Entry point of the calculation - contains current state of variables @@ -902,7 +902,7 @@ CONTAINS END IF CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE propagate_density ! ************************************************************************************************** !> \brief Outputs the number of electrons in the system from the density matrix @@ -1219,7 +1219,7 @@ CONTAINS ! DEALLOCATE(metric_fm) CALL cp_fm_release(work_fm) CALL cp_fm_release(metric_inv_fm) - END SUBROUTINE + END SUBROUTINE init_hartree ! ************************************************************************************************** !> \brief Calculates the Hartree matrix in the atomic orbital basis, given a density matrix, in local arrays !> Calculates the values for single spin species present in given rho diff --git a/src/emd/rt_bse_io.F b/src/emd/rt_bse_io.F index 0f7d870839..f836a8a75a 100644 --- a/src/emd/rt_bse_io.F +++ b/src/emd/rt_bse_io.F @@ -121,7 +121,7 @@ CONTAINS WRITE (rtbse_env%unit_nr, '(A)') '' - END SUBROUTINE + END SUBROUTINE print_rtbse_header_info ! ************************************************************************************************** !> \brief Writes the update after single etrs iteration - only for log level > medium @@ -139,7 +139,7 @@ CONTAINS WRITE (rtbse_env%unit_nr, '(A7,I5, E20.8E3)') ' RTBSE|', step, metric END IF - END SUBROUTINE + END SUBROUTINE print_etrs_info ! ************************************************************************************************** !> \brief Writes the header for the etrs iteration updates - only for log level > medium !> \param rtbse_env Entry point - rtbse environment @@ -154,7 +154,7 @@ CONTAINS WRITE (rtbse_env%unit_nr, '(A13, A20)') ' RTBSE| Iter.', 'Convergence' END IF - END SUBROUTINE + END SUBROUTINE print_etrs_info_header ! ************************************************************************************************** !> \brief Writes the header for the etrs iteration updates - only for log level > medium !> \param rtbse_env Entry point - rtbse environment @@ -176,7 +176,7 @@ CONTAINS electron_num_re, etrs_num END IF - END SUBROUTINE + END SUBROUTINE print_timestep_info ! ************************************************************************************************** !> \brief Outputs the matrix in MO basis for matrix coefficients corresponding to contravariant @@ -227,7 +227,7 @@ CONTAINS CALL cp_print_key_finished_output(rho_unit_re, logger, print_key_section) CALL cp_print_key_finished_output(rho_unit_im, logger, print_key_section) END DO - END SUBROUTINE + END SUBROUTINE output_mos_contravariant ! ************************************************************************************************** !> \brief Outputs the matrix in MO basis for matrix components corresponding to covariant representation, !> i.e. the Hamiltonian matrix @@ -267,7 +267,7 @@ CONTAINS CALL cp_print_key_finished_output(rho_unit_re, logger, print_key_section) CALL cp_print_key_finished_output(rho_unit_im, logger, print_key_section) END DO - END SUBROUTINE + END SUBROUTINE output_mos_covariant ! ************************************************************************************************** !> \brief Prints the current field components into a file provided by input !> \param rtbse_env Entry point - gwbse environment @@ -297,7 +297,7 @@ CONTAINS rtbse_env%time_trace%series(n) = rtbse_env%sim_time CALL cp_print_key_finished_output(field_unit, logger, rtbse_env%field_section) - END SUBROUTINE + END SUBROUTINE output_field ! ************************************************************************************************** !> \brief Reads the field from the files provided by input - useful for the continuation run !> \param rtbse_env Entry point - gwbse environment @@ -408,7 +408,7 @@ CONTAINS rtbse_env%moments_trace(i)%series(n) = rtbse_env%moments_trace(i)%series(n) + CMPLX(0.0, moments(i), kind=dp) END DO END DO - END SUBROUTINE + END SUBROUTINE output_moments ! ************************************************************************************************** !> \brief Outputs the restart info (last finished iteration step) + restard density matrix !> \param restart_section Print key section for the restart files @@ -889,5 +889,5 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE ft_simple END MODULE rt_bse_io diff --git a/src/emd/rt_bse_types.F b/src/emd/rt_bse_types.F index d0edccc2dd..85573eafcf 100644 --- a/src/emd/rt_bse_types.F +++ b/src/emd/rt_bse_types.F @@ -598,7 +598,7 @@ CONTAINS ! Depending on the chosen methods, allocate extra workspace CALL create_hartree_ri_workspace(rtbse_env, qs_env) - END SUBROUTINE + END SUBROUTINE create_rtbse_env ! ************************************************************************************************** !> \brief Simple reimplementation of cp_fm_release_pp1 for complex matrices @@ -673,7 +673,7 @@ CONTAINS ! Nullify to make sure it is not used again NULLIFY (rtbse_env) - END SUBROUTINE + END SUBROUTINE release_rtbse_env ! ************************************************************************************************** !> \brief Allocates the workspaces for Hartree RI method !> \note RI method calculates the Hartree contraction without the use of DBT, as it cannot emulate vectors @@ -856,7 +856,7 @@ CONTAINS CALL dbt_create(screened_dbcsr, screened_dbt) ! greens_dbt CALL dbt_create(bs_env%mat_ao_ao%matrix, work_dbt_2c) - END SUBROUTINE + END SUBROUTINE create_sigma_workspace_qs_only ! ************************************************************************************************** !> \brief Releases the workspaces for self-energy determination !> \param rtbse_env @@ -872,7 +872,7 @@ CONTAINS CALL dbt_destroy(rtbse_env%screened_dbt) CALL dbt_destroy(rtbse_env%greens_dbt) CALL dbcsr_release(rtbse_env%w_dbcsr) - END SUBROUTINE + END SUBROUTINE release_sigma_workspace ! ************************************************************************************************** !> \brief Multiplies real matrix by a complex matrix from the right !> \note So far only converts the real matrix to complex one, potentially doubling the work @@ -971,4 +971,4 @@ CONTAINS CALL cp_fm_release(res_im) END SUBROUTINE multiply_cfm_fm -END MODULE +END MODULE rt_bse_types diff --git a/src/emd/rt_propagation_utils.F b/src/emd/rt_propagation_utils.F index 9e4c03b27e..86dddda24d 100644 --- a/src/emd/rt_propagation_utils.F +++ b/src/emd/rt_propagation_utils.F @@ -248,7 +248,7 @@ CONTAINS CALL dbcsr_deallocate_matrix(tmp_mat) CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE calc_S_derivs ! ************************************************************************************************** !> \brief reads the restart file. At the moment only SCF (means only real) @@ -893,6 +893,6 @@ CONTAINS target_section => section_vals_get_subs_vals(section, subsection_name) CALL section_vals_get(target_section, explicit=explicit) IF (explicit) CPWARN(error_message) - END SUBROUTINE + END SUBROUTINE warn_section_unused END MODULE rt_propagation_utils diff --git a/src/emd/rt_propagator_init.F b/src/emd/rt_propagator_init.F index a4174f32c5..69eb1020ee 100644 --- a/src/emd/rt_propagator_init.F +++ b/src/emd/rt_propagator_init.F @@ -369,7 +369,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE get_maxabs_eigval_sparse ! ************************************************************************************************** !> \brief Is still left from diagonalization, should be removed later but is diff --git a/src/eri_mme/eri_mme_error_control.F b/src/eri_mme/eri_mme_error_control.F index cb9c0f717c..1ecb6fa359 100644 --- a/src/eri_mme/eri_mme_error_control.F +++ b/src/eri_mme/eri_mme_error_control.F @@ -261,7 +261,7 @@ CONTAINS END DO err_mm = 32*pi**4/vol*delta_mm*prod_mm_k - END SUBROUTINE + END SUBROUTINE minimax_error ! ************************************************************************************************** !> \brief Cutoff error, estimating G > G_c part of Ewald sum by using C/3 * 1/(Gx^2*Gy^2*Gz^2)^1/3 as an @@ -376,7 +376,7 @@ CONTAINS END DO err_ctff = err_ctff_curr - END SUBROUTINE + END SUBROUTINE cutoff_error ! ************************************************************************************************** !> \brief Calculate cutoff error estimate by using C_mm/3 * 1/(Gx^2*Gy^2*Gz^2)^1/3 diff --git a/src/eri_mme/eri_mme_integrate.F b/src/eri_mme/eri_mme_integrate.F index bfc805901a..515a039bea 100644 --- a/src/eri_mme/eri_mme_integrate.F +++ b/src/eri_mme/eri_mme_integrate.F @@ -405,7 +405,7 @@ CONTAINS CALL eri_mme_3c_collect_ortho(vol, la_min, la_max, lb_min, lb_max, lc_min, lc_max, & zeta, zetb, zetc, n_aw, aw, S_G, S_G_0, prefac, habc, o1, o2, o3) - END SUBROUTINE + END SUBROUTINE eri_mme_3c_integrate_ortho ! ************************************************************************************************** !> \brief ... @@ -639,7 +639,7 @@ CONTAINS CALL eri_mme_3c_collect_nonortho(vol, la_min, la_max, lb_min, lb_max, lc_min, lc_max, & zeta, zetb, zetc, n_aw, aw, S_G_no, S_G_0_no, prefac, habc, o1, o2, o3) - END SUBROUTINE + END SUBROUTINE eri_mme_3c_integrate_nonortho ! ************************************************************************************************** !> \brief ... @@ -731,7 +731,7 @@ CONTAINS lc_prev = lc END DO ! lc - END SUBROUTINE + END SUBROUTINE eri_mme_3c_collect_ortho ! ************************************************************************************************** !> \brief ... @@ -817,6 +817,6 @@ CONTAINS lc_prev = lc END DO ! lc - END SUBROUTINE + END SUBROUTINE eri_mme_3c_collect_nonortho END MODULE eri_mme_integrate diff --git a/src/eri_mme/eri_mme_types.F b/src/eri_mme/eri_mme_types.F index 813c970fe4..02a68bac03 100644 --- a/src/eri_mme/eri_mme_types.F +++ b/src/eri_mme/eri_mme_types.F @@ -58,7 +58,7 @@ MODULE eri_mme_types REAL(KIND=dp), POINTER, & DIMENSION(:) :: minimax_aw => NULL() REAL(KIND=dp) :: error = 0.0_dp - END TYPE + END TYPE minimax_grid TYPE eri_mme_param INTEGER :: n_minimax = 0 @@ -301,7 +301,7 @@ CONTAINS cutoff_max, cutoff_min, param%G_min, & param%mm_delta, potential=potential, pot_par=pot_par) - END SUBROUTINE + END SUBROUTINE eri_mme_set_potential ! ************************************************************************************************** !> \brief ... @@ -364,7 +364,7 @@ CONTAINS END DO cutoff = cutoff/cutoff_delta END DO - END SUBROUTINE + END SUBROUTINE eri_mme_create_minimax_grids ! ************************************************************************************************** !> \brief ... @@ -384,7 +384,7 @@ CONTAINS END DO DEALLOCATE (minimax_grids) END IF - END SUBROUTINE + END SUBROUTINE eri_mme_destroy_minimax_grids ! ************************************************************************************************** !> \brief ... @@ -407,7 +407,7 @@ CONTAINS grid%minimax_aw(:) = minimax_aw(:) grid%error = error - END SUBROUTINE + END SUBROUTINE create_minimax_grid ! ************************************************************************************************** !> \brief ... @@ -441,7 +441,7 @@ CONTAINS minimax_aw => grids(igrid)%minimax_aw grid_no = igrid END IF - END SUBROUTINE + END SUBROUTINE get_minimax_from_cutoff ! ************************************************************************************************** !> \brief ... @@ -461,7 +461,7 @@ CONTAINS WRITE (unit_nr, *) END IF - END SUBROUTINE + END SUBROUTINE eri_mme_print_grid_info ! ************************************************************************************************** !> \brief ... diff --git a/src/et_coupling_types.F b/src/et_coupling_types.F index 66987de856..262f82a5d7 100644 --- a/src/et_coupling_types.F +++ b/src/et_coupling_types.F @@ -44,7 +44,7 @@ MODULE et_coupling_types LOGICAL :: first_run = .FALSE. LOGICAL :: keep_matrix = .FALSE. REAL(KIND=dp) :: energy = 0.0_dp, e1 = 0.0_dp, order_p = 0.0_dp - END TYPE + END TYPE et_coupling_type CONTAINS diff --git a/src/exclusion_types.F b/src/exclusion_types.F index a8e808c2ee..576973f7e0 100644 --- a/src/exclusion_types.F +++ b/src/exclusion_types.F @@ -22,7 +22,7 @@ MODULE exclusion_types INTEGER, POINTER, DIMENSION(:) :: list_exclude_vdw => NULL() INTEGER, POINTER, DIMENSION(:) :: list_exclude_ei => NULL() INTEGER, POINTER, DIMENSION(:) :: list_onfo => NULL() - END TYPE + END TYPE exclusion_type PUBLIC :: exclusion_type, & exclusion_release diff --git a/src/farming_methods.F b/src/farming_methods.F index fc790022db..4811d97855 100644 --- a/src/farming_methods.F +++ b/src/farming_methods.F @@ -312,6 +312,6 @@ CONTAINS END IF CALL para_env%bcast(farming_env%restart_n) - END SUBROUTINE + END SUBROUTINE farming_parse_input END MODULE farming_methods diff --git a/src/farming_types.F b/src/farming_types.F index 634f903a29..904264770e 100644 --- a/src/farming_types.F +++ b/src/farming_types.F @@ -78,7 +78,7 @@ CONTAINS farming_env%max_steps = 65535 NULLIFY (farming_env%Job) END IF - END SUBROUTINE + END SUBROUTINE init_farming_env ! ************************************************************************************************** !> \brief provide a default initialization diff --git a/src/fist_nonbond_env_types.F b/src/fist_nonbond_env_types.F index 92b84a8176..a67d1a9ffc 100644 --- a/src/fist_nonbond_env_types.F +++ b/src/fist_nonbond_env_types.F @@ -47,39 +47,39 @@ MODULE fist_nonbond_env_types ! ************************************************************************************************** TYPE pos_type REAL(KIND=dp) :: r(3) = 0.0_dp - END TYPE + END TYPE pos_type TYPE eam_type REAL(KIND=dp) :: f_embed = 0.0_dp REAL(KIND=dp) :: rho = 0.0_dp - END TYPE + END TYPE eam_type TYPE quip_data_type INTEGER, POINTER :: use_indices(:) => NULL() REAL(KIND=dp), POINTER :: force(:, :) => NULL() REAL(KIND=dp) :: virial(3, 3) = 0.0_dp - END TYPE + END TYPE quip_data_type TYPE nequip_data_type INTEGER, POINTER :: use_indices(:) => NULL() REAL(KIND=dp), POINTER :: force(:, :) => NULL() REAL(KIND=dp) :: virial(3, 3) = 0.0_dp TYPE(torch_model_type) :: model - END TYPE + END TYPE nequip_data_type TYPE allegro_data_type INTEGER, POINTER :: use_indices(:) => NULL() REAL(KIND=dp), POINTER :: force(:, :) => NULL() REAL(KIND=dp) :: virial(3, 3) = 0.0_dp TYPE(torch_model_type) :: model - END TYPE + END TYPE allegro_data_type TYPE deepmd_data_type INTEGER, POINTER :: use_indices(:) => NULL() REAL(KIND=dp), POINTER :: force(:, :) => NULL() REAL(KIND=dp) :: virial(3, 3) = 0.0_dp TYPE(deepmd_model_type) :: model - END TYPE + END TYPE deepmd_data_type TYPE ace_data_type INTEGER, ALLOCATABLE :: use_indices(:) @@ -98,7 +98,7 @@ MODULE fist_nonbond_env_types REAL(KIND=dp), ALLOCATABLE :: atpos(:, :) REAL(KIND=dp) :: virial(3, 3) = 0.0_dp TYPE(ace_model_type) :: model - END TYPE + END TYPE ace_data_type ! ************************************************************************************************** TYPE fist_nonbond_env_type diff --git a/src/fist_nonbond_force.F b/src/fist_nonbond_force.F index cdc863eb07..69f3a12407 100644 --- a/src/fist_nonbond_force.F +++ b/src/fist_nonbond_force.F @@ -615,7 +615,7 @@ CONTAINS pv(3, 3) = pv(3, 3) + rab(3)*fr(3) END IF - END SUBROUTINE + END SUBROUTINE add_force_nonbond ! ************************************************************************************************** !> \brief corrects electrostatics for bonded terms diff --git a/src/fm/cp_blacs_env.F b/src/fm/cp_blacs_env.F index 6f5f271b38..9f6445dda6 100644 --- a/src/fm/cp_blacs_env.F +++ b/src/fm/cp_blacs_env.F @@ -129,7 +129,7 @@ CONTAINS ALLOCATE (blacs_env) CALL blacs_env%create(para_env, blacs_grid_layout, blacs_repeatable, row_major, grid_2d) - END SUBROUTINE + END SUBROUTINE cp_blacs_env_create ! ************************************************************************************************** !> \brief allocates and initializes a type that represent a blacs context diff --git a/src/fm/cp_blacs_types.F b/src/fm/cp_blacs_types.F index caf4fc6bd1..4d69473922 100644 --- a/src/fm/cp_blacs_types.F +++ b/src/fm/cp_blacs_types.F @@ -51,7 +51,7 @@ MODULE cp_blacs_types GENERIC, PUBLIC :: OPERATOR(/=) => cp_context_is_not_equal PROCEDURE, PUBLIC, PASS(this), NON_OVERRIDABLE :: interconnect => cp_blacs_interconnect - END TYPE + END TYPE cp_blacs_type !*** CONTAINS @@ -163,7 +163,7 @@ CONTAINS MARK_USED(A) MARK_USED(LDA) #endif - END SUBROUTINE + END SUBROUTINE cp_blacs_zgebs2d ! ************************************************************************************************** !> \brief ... !> \param this ... @@ -195,7 +195,7 @@ CONTAINS MARK_USED(RSRC) MARK_USED(CSRC) #endif - END SUBROUTINE + END SUBROUTINE cp_blacs_zgebr2d ! ************************************************************************************************** !> \brief ... @@ -223,7 +223,7 @@ CONTAINS MARK_USED(A) MARK_USED(LDA) #endif - END SUBROUTINE + END SUBROUTINE cp_blacs_dgebs2d ! ************************************************************************************************** !> \brief ... !> \param this ... @@ -255,7 +255,7 @@ CONTAINS MARK_USED(RSRC) MARK_USED(CSRC) #endif - END SUBROUTINE + END SUBROUTINE cp_blacs_dgebr2d ! ************************************************************************************************** !> \brief ... @@ -270,7 +270,7 @@ CONTAINS MARK_USED(this) cp_blacs_get_handle = -1 #endif - END FUNCTION + END FUNCTION cp_blacs_get_handle ! ************************************************************************************************** !> \brief ... diff --git a/src/fm/cp_fm_diag_utils.F b/src/fm/cp_fm_diag_utils.F index d58d2226d2..1e05d63271 100644 --- a/src/fm/cp_fm_diag_utils.F +++ b/src/fm/cp_fm_diag_utils.F @@ -48,7 +48,7 @@ MODULE cp_fm_diag_utils LOGICAL :: redistribute = .FALSE. ! whether or not the matrix was actually redistributed CONTAINS PROCEDURE, PASS(self) :: write => cp_fm_redistribute_info_write - END TYPE + END TYPE cp_fm_redistribute_info ! Container for redistribution settings and temporary work structs TYPE cp_fm_redistribute_type diff --git a/src/fm/cp_fm_elpa.F b/src/fm/cp_fm_elpa.F index f70b71a9b4..6572700806 100644 --- a/src/fm/cp_fm_elpa.F +++ b/src/fm/cp_fm_elpa.F @@ -180,7 +180,7 @@ CONTAINS #else CPABORT("Initialization of ELPA library requested but not enabled during build") #endif - END SUBROUTINE + END SUBROUTINE initialize_elpa_library ! ************************************************************************************************** !> \brief Finalize the ELPA library @@ -191,7 +191,7 @@ CONTAINS #else CPABORT("Finalization of ELPA library requested but not enabled during build") #endif - END SUBROUTINE + END SUBROUTINE finalize_elpa_library ! ************************************************************************************************** !> \brief Sets the active ELPA kernel. diff --git a/src/fm/cp_fm_types.F b/src/fm/cp_fm_types.F index 97a667ca75..67865cdd9c 100644 --- a/src/fm/cp_fm_types.F +++ b/src/fm/cp_fm_types.F @@ -1189,7 +1189,7 @@ CONTAINS DEALLOCATE (values) CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE cp_fm_maxabsrownorm ! ************************************************************************************************** !> \brief find the inorm of each column norm_{j}= sqrt( \sum_{i} A_{ij}*A_{ij} ) @@ -1227,7 +1227,7 @@ CONTAINS norm_array = SQRT(norm_array) CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE cp_fm_vectorsnorm ! ************************************************************************************************** !> \brief summing up all the elements along the matrix's i-th index @@ -1292,7 +1292,7 @@ CONTAINS CALL matrix%matrix_struct%para_env%sum(sum_array) CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE cp_fm_vectorssum ! ************************************************************************************************** !> \brief copy one identically sized matrix in the other @@ -2443,7 +2443,7 @@ CONTAINS INTEGER :: res res = cp_fm_mm_type - END FUNCTION + END FUNCTION cp_fm_get_mm_type ! ************************************************************************************************** !> \brief ... @@ -2464,6 +2464,6 @@ CONTAINS res = -1 #endif - END FUNCTION + END FUNCTION cp_fm_pilaenv END MODULE cp_fm_types diff --git a/src/fm/cp_linked_list_fm.F b/src/fm/cp_linked_list_fm.F index 741ae981c7..0793ab07ec 100644 --- a/src/fm/cp_linked_list_fm.F +++ b/src/fm/cp_linked_list_fm.F @@ -26,4 +26,4 @@ MODULE cp_linked_list_fm #:endmute $:inst(nametype1, type1, type1in, type1out, eq, arrayeq, type1arrayEl, arrayEl, private_routines, default_init) -END MODULE +END MODULE cp_linked_list_fm diff --git a/src/fp_methods.F b/src/fp_methods.F index 0bcbc0a092..85fe9fcb62 100644 --- a/src/fp_methods.F +++ b/src/fp_methods.F @@ -232,6 +232,6 @@ CONTAINS c = (1.0_dp + ERF(arg))/2.0_dp dcdr = (-oorootpi/width)*EXP(-arg**2) - END SUBROUTINE + END SUBROUTINE smooth_count END MODULE fp_methods diff --git a/src/graphcon.F b/src/graphcon.F index 741099066d..a74560ea27 100644 --- a/src/graphcon.F +++ b/src/graphcon.F @@ -59,7 +59,7 @@ MODULE graphcon TYPE superclass INTEGER :: Nele = -1 INTEGER, DIMENSION(:), POINTER :: classes => NULL() - END TYPE + END TYPE superclass CONTAINS @@ -572,6 +572,6 @@ CONTAINS m = m - 1 k = k + 1 END DO - END SUBROUTINE + END SUBROUTINE all_permutations END MODULE graphcon diff --git a/src/greenx_interface.F b/src/greenx_interface.F index 9ddd775633..12abaf7bdc 100644 --- a/src/greenx_interface.F +++ b/src/greenx_interface.F @@ -265,7 +265,7 @@ CONTAINS MARK_USED(n_pade_opt) CPABORT("Calls to GreenX require CP2K to be compiled with support for GreenX.") #endif - END SUBROUTINE + END SUBROUTINE greenx_refine_ft ! ************************************************************************************************** !> \brief ... diff --git a/src/gw_communication.F b/src/gw_communication.F index c5d207e7fb..994311c54a 100644 --- a/src/gw_communication.F +++ b/src/gw_communication.F @@ -50,7 +50,7 @@ MODULE gw_communication INTEGER, DIMENSION(:, :), POINTER :: indx => NULL() INTEGER :: proc = -1 INTEGER :: msg_req = -1 - END TYPE + END TYPE buffer_type CONTAINS diff --git a/src/gw_integrals.F b/src/gw_integrals.F index 1a4e7a8f42..7743144b07 100644 --- a/src/gw_integrals.F +++ b/src/gw_integrals.F @@ -448,5 +448,5 @@ CONTAINS END SUBROUTINE build_3c_integral_block -END MODULE +END MODULE gw_integrals diff --git a/src/hfx_exx.F b/src/hfx_exx.F index 8d6983d6c4..03a5feacdb 100644 --- a/src/hfx_exx.F +++ b/src/hfx_exx.F @@ -795,7 +795,7 @@ CONTAINS energy%exc1_aux_fit = 0.0_dp energy%ex = 0.0_dp - END SUBROUTINE + END SUBROUTINE remove_exc_energy END MODULE hfx_exx diff --git a/src/hfx_load_balance_methods.F b/src/hfx_load_balance_methods.F index aa461da1fb..bc8abac56e 100644 --- a/src/hfx_load_balance_methods.F +++ b/src/hfx_load_balance_methods.F @@ -1148,7 +1148,7 @@ CONTAINS nBins = p*q/a - END SUBROUTINE + END SUBROUTINE hfx_calculate_PQ ! ************************************************************************************************** !> \brief Recursive permutation routine for the load balancing of the integral diff --git a/src/hfx_ri.F b/src/hfx_ri.F index 65bf180668..0851ee1ad8 100644 --- a/src/hfx_ri.F +++ b/src/hfx_ri.F @@ -342,7 +342,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE hfx_ri_pre_scf_mo ! ************************************************************************************************** !> \brief ... @@ -379,7 +379,7 @@ CONTAINS END IF CALL dbcsr_release(matrix_tmp) - END SUBROUTINE + END SUBROUTINE check_inverse ! ************************************************************************************************** !> \brief ... @@ -429,7 +429,7 @@ CONTAINS CALL dbcsr_release(matrix_copy) END IF - END SUBROUTINE + END SUBROUTINE check_sqrt ! ************************************************************************************************** !> \brief Calculate 2-center and 3-center integrals @@ -762,7 +762,7 @@ CONTAINS END IF CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE hfx_ri_pre_scf_calc_tensors ! ************************************************************************************************** !> \brief Pre-SCF steps in rho flavor of RI HFX @@ -951,7 +951,7 @@ CONTAINS CALL dbt_copy(ri_data%t_3c_int_ctr_3(1, 1), ri_data%t_3c_int_ctr_2(1, 1), order=[2, 1, 3], move_data=.TRUE.) CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE hfx_ri_pre_scf_Pmat ! ************************************************************************************************** !> \brief Sorts 2d indices w.r.t. rows and columns @@ -1022,7 +1022,7 @@ CONTAINS blk_ind(:, :) = blk_ind_tmp(:nblk, :) - END SUBROUTINE + END SUBROUTINE sort_unique_blkind_2d ! ************************************************************************************************** !> \brief ... @@ -1177,7 +1177,7 @@ CONTAINS END IF CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE hfx_ri_update_ks ! ************************************************************************************************** !> \brief Calculate Fock (AKA Kohn-Sham) matrix in MO flavor @@ -1524,7 +1524,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE hfx_ri_update_ks_mo ! ************************************************************************************************** !> \brief Calculate Fock (AKA Kohn-Sham) matrix in rho flavor @@ -1774,7 +1774,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE hfx_ri_update_ks_Pmat ! ************************************************************************************************** !> \brief Implementation based on the MO flavor @@ -4266,7 +4266,7 @@ CONTAINS REAL(KIND=dp), DIMENSION(SIZE(values)) :: my_sqrt my_sqrt = SQRT(values) - END FUNCTION + END FUNCTION my_sqrt ! ************************************************************************************************** !> \brief Function for calculation inverse sqrt of a matrix @@ -4278,5 +4278,5 @@ CONTAINS REAL(KIND=dp), DIMENSION(SIZE(values)) :: my_invsqrt my_invsqrt = SQRT(1.0_dp/values) - END FUNCTION -END MODULE + END FUNCTION my_invsqrt +END MODULE hfx_ri diff --git a/src/hfx_ri_kp.F b/src/hfx_ri_kp.F index 9a9e0747c7..84bc656c35 100644 --- a/src/hfx_ri_kp.F +++ b/src/hfx_ri_kp.F @@ -5367,4 +5367,4 @@ CONTAINS END SUBROUTINE get_force_from_3c_trace -END MODULE +END MODULE hfx_ri_kp diff --git a/src/hfx_types.F b/src/hfx_types.F index 4f78c932b1..f86f2084ff 100644 --- a/src/hfx_types.F +++ b/src/hfx_types.F @@ -144,7 +144,7 @@ MODULE hfx_types REAL(dp) :: scale_gaussian = 0.0_dp!! scaling factor for mixed potential REAL(dp) :: cutoff_radius = 0.0_dp!! cutoff radius if cutoff potential in use CHARACTER(default_path_length) :: filename = "" - END TYPE + END TYPE hfx_potential_type ! ************************************************************************************************** TYPE hfx_screening_type @@ -152,7 +152,7 @@ MODULE hfx_types REAL(dp) :: eps_schwarz_forces = 0.0_dp !! threshold LOGICAL :: do_p_screening_forces = .FALSE. !! screen on P^2 ? LOGICAL :: do_initial_p_screening = .FALSE. !! screen on initial guess? - END TYPE + END TYPE hfx_screening_type ! ************************************************************************************************** TYPE hfx_memory_type @@ -173,7 +173,7 @@ MODULE hfx_types INTEGER(int_8) :: size_p_screen = 0_int_8 LOGICAL :: treat_forces_in_core = .FALSE. LOGICAL :: recalc_forces = .FALSE. - END TYPE + END TYPE hfx_memory_type ! ************************************************************************************************** TYPE hfx_periodic_type @@ -183,7 +183,7 @@ MODULE hfx_types INTEGER :: mode = -1 REAL(dp) :: R_max_stress = 0.0_dp INTEGER :: number_of_shells_from_input = 0 - END TYPE + END TYPE hfx_periodic_type ! ************************************************************************************************** TYPE hfx_load_balance_type @@ -193,19 +193,19 @@ MODULE hfx_types LOGICAL :: rtp_redistribute = .FALSE. LOGICAL :: blocks_initialized = .FALSE. LOGICAL :: do_randomize = .FALSE. - END TYPE + END TYPE hfx_load_balance_type ! ************************************************************************************************** TYPE hfx_general_type REAL(dp) :: fraction = 0.0_dp !! for hybrids LOGICAL :: treat_lsd_in_core = .FALSE. - END TYPE + END TYPE hfx_general_type ! ************************************************************************************************** TYPE hfx_cell_type REAL(dp) :: cell(3) = 0.0_dp REAL(dp) :: cell_r(3) = 0.0_dp - END TYPE + END TYPE hfx_cell_type ! ************************************************************************************************** TYPE hfx_distribution @@ -216,7 +216,7 @@ MODULE hfx_types REAL(KIND=dp) :: time_other_scf = 0.0_dp REAL(KIND=dp) :: time_forces = 0.0_dp INTEGER(int_8) :: ram_counter = 0_int_8 - END TYPE + END TYPE hfx_distribution ! ************************************************************************************************** TYPE pair_list_element_type @@ -225,12 +225,12 @@ MODULE hfx_types INTEGER, DIMENSION(2) :: kind_pair = 0 REAL(KIND=dp) :: r1(3) = 0.0_dp, r2(3) = 0.0_dp REAL(KIND=dp) :: dist2 = 0.0_dp - END TYPE + END TYPE pair_list_element_type ! ************************************************************************************************** TYPE pair_set_list_type INTEGER, DIMENSION(2) :: pair = 0 - END TYPE + END TYPE pair_set_list_type ! ************************************************************************************************** TYPE pair_list_type @@ -242,13 +242,13 @@ MODULE hfx_types TYPE hfx_cache_type INTEGER(int_8), DIMENSION(CACHE_SIZE) :: DATA = 0_int_8 INTEGER :: element_counter = 0 - END TYPE + END TYPE hfx_cache_type ! ************************************************************************************************** TYPE hfx_container_node TYPE(hfx_container_node), POINTER :: next => NULL(), prev => NULL() INTEGER(int_8), DIMENSION(CACHE_SIZE) :: DATA = 0_int_8 - END TYPE + END TYPE hfx_container_node ! ************************************************************************************************** TYPE hfx_container_type @@ -258,7 +258,7 @@ MODULE hfx_types CHARACTER(LEN=5) :: desc = "" INTEGER :: unit = -1 CHARACTER(default_path_length) :: filename = "" - END TYPE + END TYPE hfx_container_type ! ************************************************************************************************** TYPE hfx_basis_type @@ -279,30 +279,30 @@ MODULE hfx_types REAL(dp), DIMENSION(:), POINTER :: set_radius => NULL() REAL(dp), DIMENSION(:, :), POINTER :: pgf_radius => NULL() REAL(dp) :: kind_radius = 0.0_dp - END TYPE + END TYPE hfx_basis_type ! ************************************************************************************************** TYPE hfx_basis_info_type INTEGER :: max_set = 0 INTEGER :: max_sgf = 0 INTEGER :: max_am = 0 - END TYPE + END TYPE hfx_basis_info_type ! ************************************************************************************************** TYPE hfx_screen_coeff_type REAL(dp) :: x(2) = 0.0_dp - END TYPE + END TYPE hfx_screen_coeff_type ! ************************************************************************************************** TYPE hfx_p_kind REAL(dp), DIMENSION(:, :, :, :), POINTER :: p_kind => NULL() - END TYPE + END TYPE hfx_p_kind ! ************************************************************************************************** TYPE hfx_2D_map INTEGER, DIMENSION(:), POINTER :: iatom_list => NULL() INTEGER, DIMENSION(:), POINTER :: jatom_list => NULL() - END TYPE + END TYPE hfx_2D_map ! ************************************************************************************************** TYPE hfx_pgf_image @@ -313,7 +313,7 @@ MODULE hfx_types REAL(dp) :: R = 0.0_dp REAL(dp) :: pgf_max = 0.0_dp REAL(dp), DIMENSION(3) :: bcell = 0.0_dp - END TYPE + END TYPE hfx_pgf_image ! ************************************************************************************************** TYPE hfx_pgf_list @@ -324,7 +324,7 @@ MODULE hfx_types REAL(dp) :: ZetaInv = 0.0_dp REAL(dp) :: zeta = 0.0_dp, zetb = 0.0_dp INTEGER :: ipgf = 0, jpgf = 0 - END TYPE + END TYPE hfx_pgf_list ! ************************************************************************************************** TYPE hfx_pgf_product_list @@ -334,20 +334,20 @@ MODULE hfx_types REAL(dp) :: P(3) = 0.0_dp, Q(3) = 0.0_dp, W(3) = 0.0_dp REAL(dp) :: AB(3) = 0.0_dp, CD(3) = 0.0_dp REAL(dp) :: Fm(prim_data_f_size) = 0.0_dp - END TYPE + END TYPE hfx_pgf_product_list ! ************************************************************************************************** TYPE hfx_block_range_type INTEGER :: istart = 0, iend = 0 INTEGER(int_8) :: cost = 0_int_8 - END TYPE + END TYPE hfx_block_range_type ! ************************************************************************************************** TYPE hfx_task_list_type INTEGER :: thread_id = 0 INTEGER :: bin_id = 0 INTEGER(int_8) :: cost = 0_int_8 - END TYPE + END TYPE hfx_task_list_type TYPE :: hfx_compression_type TYPE(hfx_container_type), DIMENSION(:), & @@ -363,11 +363,11 @@ MODULE hfx_types TYPE(hfx_cache_type) :: integral_caches_disk(64) = hfx_cache_type() TYPE(hfx_container_type), POINTER, & DIMENSION(:) :: integral_containers_disk => NULL() - END TYPE + END TYPE hfx_compression_type TYPE :: block_ind_type INTEGER, DIMENSION(:, :), ALLOCATABLE :: ind - END TYPE + END TYPE block_ind_type TYPE hfx_ri_type ! input parameters (see input_cp2k_hfx) @@ -470,7 +470,7 @@ MODULE hfx_types INTEGER :: num_pe = 0 TYPE(hfx_compression_type), DIMENSION(:, :), ALLOCATABLE :: store_3c - END TYPE + END TYPE hfx_ri_type ! ************************************************************************************************** !> \brief stores some data used in construction of Kohn-Sham matrix @@ -1198,7 +1198,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE hfx_ri_init_read_input ! ************************************************************************************************** !> \brief ... @@ -1437,7 +1437,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE hfx_ri_init ! ************************************************************************************************** !> \brief ... @@ -1458,7 +1458,7 @@ CONTAINS IF (unit_nr > 0) WRITE (UNIT=unit_nr, FMT="(T2,A,T66,F15.2)") & "RI-HFX PERFORMANCE| DBT flop rate (Gflops / MPI rank):", my_flop_rate END ASSOCIATE - END SUBROUTINE + END SUBROUTINE hfx_ri_write_stats ! ************************************************************************************************** !> \brief ... @@ -1644,7 +1644,7 @@ CONTAINS END IF CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE hfx_ri_release ! ************************************************************************************************** !> \brief - This routine allocates and initializes the basis_info and basis_parameter types @@ -2772,7 +2772,7 @@ CONTAINS "HFX_RI_INFO| Memory reduction factor", ri_data%n_mem_input END IF - END SUBROUTINE + END SUBROUTINE hfx_print_ri_info ! ************************************************************************************************** !> \brief ... @@ -2867,7 +2867,7 @@ CONTAINS CALL cp_print_key_finished_output(iw, logger, hfx_section, & "HF_INFO") - END SUBROUTINE + END SUBROUTINE hfx_print_info ! ************************************************************************************************** !> \brief ... diff --git a/src/input/cp_linked_list_input.F b/src/input/cp_linked_list_input.F index 2e62de76c2..3da349e6a8 100644 --- a/src/input/cp_linked_list_input.F +++ b/src/input/cp_linked_list_input.F @@ -27,4 +27,4 @@ MODULE cp_linked_list_input #:endmute $:inst(nametype1, type1, type1in, type1out, eq, arrayeq, type1arrayEl, arrayEl, private_routines, default_init) -END MODULE +END MODULE cp_linked_list_input diff --git a/src/input_cp2k_hfx.F b/src/input_cp2k_hfx.F index 11108ae9d4..03b0584068 100644 --- a/src/input_cp2k_hfx.F +++ b/src/input_cp2k_hfx.F @@ -815,6 +815,6 @@ CONTAINS CALL section_add_subsection(section, subsection) CALL section_release(subsection) - END SUBROUTINE + END SUBROUTINE create_hf_ri_section END MODULE input_cp2k_hfx diff --git a/src/input_cp2k_loc.F b/src/input_cp2k_loc.F index d083117798..a0310e44be 100644 --- a/src/input_cp2k_loc.F +++ b/src/input_cp2k_loc.F @@ -542,4 +542,4 @@ CONTAINS CALL section_release(print_key2) END SUBROUTINE create_wannier_states_section -END MODULE +END MODULE input_cp2k_loc diff --git a/src/input_cp2k_mp2.F b/src/input_cp2k_mp2.F index 7873e824bf..8d41a4f54b 100644 --- a/src/input_cp2k_mp2.F +++ b/src/input_cp2k_mp2.F @@ -1174,7 +1174,7 @@ CONTAINS CALL section_add_subsection(section, gw_dos_section) CALL section_release(gw_dos_section) - END SUBROUTINE + END SUBROUTINE create_print_section ! ************************************************************************************************** !> \brief ... @@ -1282,7 +1282,7 @@ CONTAINS CALL section_add_keyword(section, keyword) CALL keyword_release(keyword) - END SUBROUTINE + END SUBROUTINE create_periodic_gw_correction_section ! ************************************************************************************************** !> \brief ... @@ -1439,7 +1439,7 @@ CONTAINS CALL section_add_subsection(section, subsection) CALL section_release(subsection) - END SUBROUTINE + END SUBROUTINE create_bse_section SUBROUTINE create_bse_screening_section(section) TYPE(section_type), POINTER :: section @@ -1627,7 +1627,7 @@ CONTAINS CALL section_add_keyword(section, keyword) CALL keyword_release(keyword) - END SUBROUTINE + END SUBROUTINE create_bse_spectrum_section ! ************************************************************************************************** !> \brief ... @@ -1721,7 +1721,7 @@ CONTAINS type_of_var=real_t, default_r_val=-1.0_dp) CALL section_add_keyword(section, keyword) CALL keyword_release(keyword) - END SUBROUTINE + END SUBROUTINE create_bse_iterat_section ! ************************************************************************************************** !> \brief ... @@ -1757,7 +1757,7 @@ CONTAINS CALL section_add_keyword(section, keyword) CALL keyword_release(keyword) - END SUBROUTINE + END SUBROUTINE create_ic_section ! ************************************************************************************************** !> \brief ... @@ -2022,7 +2022,7 @@ CONTAINS CALL section_add_subsection(section, subsection) CALL section_release(subsection) - END SUBROUTINE + END SUBROUTINE create_low_scaling ! ************************************************************************************************** !> \brief ... diff --git a/src/kg_vertex_coloring_methods.F b/src/kg_vertex_coloring_methods.F index cbf7f9c50c..1bb33a62e8 100644 --- a/src/kg_vertex_coloring_methods.F +++ b/src/kg_vertex_coloring_methods.F @@ -155,7 +155,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE kg_create_graph ! greedy algorithm ! ************************************************************************************************** @@ -206,7 +206,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE color_graph_greedy ! prints the subset info to the screen - useful for vmd visualization ! note that the index starts with '0' and not with '1' @@ -253,7 +253,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE print_subsets ! ************************************************************************************************** !> \brief ... @@ -272,7 +272,7 @@ CONTAINS value = (huge_4 - INT(dsat, KIND=int_8))*huge_4 + huge_4 - degree - END FUNCTION + END FUNCTION kg_get_value ! ************************************************************************************************** !> \brief ... @@ -300,7 +300,7 @@ CONTAINS DEALLOCATE (values) - END SUBROUTINE + END SUBROUTINE kg_cp_heap_fill ! ************************************************************************************************** !> \brief ... @@ -328,7 +328,7 @@ CONTAINS END IF - END SUBROUTINE + END SUBROUTINE kg_update_node ! Subroutine revised by Samuel Andermatt (2013.11) ! ************************************************************************************************** @@ -438,7 +438,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE kg_dsatur ! ************************************************************************************************** !> \brief Checks if the color of two nodes can be exchanged legally @@ -487,7 +487,7 @@ CONTAINS END IF END DO - END SUBROUTINE + END SUBROUTINE kg_check_switch ! ************************************************************************************************** !> \brief An algorithm that works on an already colored graph and tries to @@ -558,7 +558,7 @@ CONTAINS DEALLOCATE (color_present) CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE kg_pair_switching ! ************************************************************************************************** !> \brief ... @@ -596,7 +596,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE check_coloring ! ************************************************************************************************** !> \brief ... @@ -615,7 +615,7 @@ CONTAINS END DO DEALLOCATE (graph) - END SUBROUTINE + END SUBROUTINE deallocate_graph ! ************************************************************************************************** !> \brief ... @@ -698,6 +698,6 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE kg_vertex_coloring -END MODULE +END MODULE kg_vertex_coloring_methods diff --git a/src/kpoint_coulomb_2c.F b/src/kpoint_coulomb_2c.F index 53902c8079..babcd9dc97 100644 --- a/src/kpoint_coulomb_2c.F +++ b/src/kpoint_coulomb_2c.F @@ -53,7 +53,7 @@ MODULE kpoint_coulomb_2c TYPE two_d_util_type REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: block - END TYPE + END TYPE two_d_util_type CONTAINS @@ -395,7 +395,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE deallocate_blocks_v_kp ! ************************************************************************************************** !> \brief ... @@ -418,7 +418,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE deallocate_blocks_v_L ! ************************************************************************************************** !> \brief ... @@ -472,7 +472,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE allocate_blocks_v_L ! ************************************************************************************************** !> \brief ... @@ -540,7 +540,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE allocate_blocks_v_kp ! ************************************************************************************************** !> \brief ... @@ -631,7 +631,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE get_factor_and_xyz_min_max ! ************************************************************************************************** !> \brief ... @@ -661,7 +661,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE allocate_tmp ! ************************************************************************************************** !> \brief ... @@ -681,7 +681,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE deallocate_tmp ! ************************************************************************************************** !> \brief ... diff --git a/src/libint_2c_3c.F b/src/libint_2c_3c.F index e149001eac..0dbcad7bd2 100644 --- a/src/libint_2c_3c.F +++ b/src/libint_2c_3c.F @@ -53,14 +53,14 @@ MODULE libint_2c_3c REAL(dp) :: ZetaInv = 0.0_dp, EtaInv = 0.0_dp, ZetapEtaInv = 0.0_dp, Rho = 0.0_dp REAL(dp), DIMENSION(3) :: W = 0.0_dp REAL(dp), DIMENSION(prim_data_f_size) :: Fm = 0.0_dp - END TYPE + END TYPE params_2c TYPE :: params_3c INTEGER :: m_max = 0 REAL(dp) :: ZetaInv = 0.0_dp, EtaInv = 0.0_dp, ZetapEtaInv = 0.0_dp, Rho = 0.0_dp REAL(dp), DIMENSION(3) :: Q = 0.0_dp, W = 0.0_dp REAL(dp), DIMENSION(prim_data_f_size) :: Fm = 0.0_dp - END TYPE + END TYPE params_3c ! A potential type based on the hfx_potential_type concept, but only for implemented ! 2- and 3-center operators @@ -71,7 +71,7 @@ MODULE libint_2c_3c CHARACTER(default_path_length) :: filename = "" REAL(dp) :: scale_coulomb = 0.0_dp ! Only, for WFC methods REAL(dp) :: scale_longrange = 0.0_dp ! Only, for WFC methods - END TYPE + END TYPE libint_potential_type CONTAINS diff --git a/src/libint_wrapper.F b/src/libint_wrapper.F index 74eadd8624..3e0ad3162c 100644 --- a/src/libint_wrapper.F +++ b/src/libint_wrapper.F @@ -74,7 +74,7 @@ MODULE libint_wrapper #else INTEGER :: unused = -1 #endif - END TYPE + END TYPE cp_libint_t CONTAINS @@ -144,7 +144,7 @@ CONTAINS CPABORT("This CP2K executable has not been linked against the required library libint.") #endif - END SUBROUTINE + END SUBROUTINE cp_libint_set_params_eri_screen SUBROUTINE cp_libint_set_params_eri_deriv(libint, A, B, C, D, P, Q, W, zeta_A, zeta_B, zeta_C, zeta_D, & ZetaInv, EtaInv, ZetapEtaInv, Rho, m_max, F) @@ -241,7 +241,7 @@ CONTAINS CPABORT("This CP2K executable has not been linked against the required library libint.") #endif - END SUBROUTINE + END SUBROUTINE cp_libint_set_params_eri_deriv SUBROUTINE cp_libint_set_params_eri(libint, A, B, C, D, ZetaInv, EtaInv, ZetapEtaInv, Rho, P, Q, W, m_max, F) TYPE(cp_libint_t) :: libint @@ -309,7 +309,7 @@ CONTAINS CPABORT("This CP2K executable has not been linked against the required library libint.") #endif - END SUBROUTINE + END SUBROUTINE cp_libint_set_params_eri ! ************************************************************************************************** !> \brief ... !> \param n_d ... @@ -496,7 +496,7 @@ CONTAINS CPABORT("This CP2K executable has not been linked against the required library libint.") #endif - END SUBROUTINE + END SUBROUTINE cp_libint_get_2eris ! ************************************************************************************************** !> \brief ... @@ -560,7 +560,7 @@ CONTAINS CPABORT("This CP2K executable has not been linked against the required library libint.") #endif - END FUNCTION + END FUNCTION get_ssss_f_val SUBROUTINE cp_libint_init_eri(lib, max_am) TYPE(cp_libint_t) :: lib @@ -572,7 +572,7 @@ CONTAINS MARK_USED(max_am) CPABORT("This CP2K executable has not been linked against the required library libint.") #endif - END SUBROUTINE + END SUBROUTINE cp_libint_init_eri SUBROUTINE cp_libint_set_contrdepth(lib, contrdepth) TYPE(cp_libint_t) :: lib @@ -590,7 +590,7 @@ CONTAINS CPABORT("This CP2K executable has not been linked against the required library libint.") #endif - END SUBROUTINE + END SUBROUTINE cp_libint_set_contrdepth SUBROUTINE cp_libint_init_eri1(lib, max_am) TYPE(cp_libint_t) :: lib @@ -602,7 +602,7 @@ CONTAINS MARK_USED(max_am) CPABORT("This CP2K executable has not been linked against the required library libint.") #endif - END SUBROUTINE + END SUBROUTINE cp_libint_init_eri1 SUBROUTINE cp_libint_init_3eri(lib, max_am) TYPE(cp_libint_t) :: lib @@ -614,7 +614,7 @@ CONTAINS MARK_USED(max_am) CPABORT("This CP2K executable has not been linked against the required library libint.") #endif - END SUBROUTINE + END SUBROUTINE cp_libint_init_3eri SUBROUTINE cp_libint_init_3eri1(lib, max_am) TYPE(cp_libint_t) :: lib @@ -626,7 +626,7 @@ CONTAINS MARK_USED(max_am) CPABORT("This CP2K executable has not been linked against the required library libint.") #endif - END SUBROUTINE + END SUBROUTINE cp_libint_init_3eri1 SUBROUTINE cp_libint_init_2eri1(lib, max_am) TYPE(cp_libint_t) :: lib @@ -638,7 +638,7 @@ CONTAINS MARK_USED(max_am) CPABORT("This CP2K executable has not been linked against the required library libint.") #endif - END SUBROUTINE + END SUBROUTINE cp_libint_init_2eri1 SUBROUTINE cp_libint_init_2eri(lib, max_am) TYPE(cp_libint_t) :: lib @@ -650,7 +650,7 @@ CONTAINS MARK_USED(max_am) CPABORT("This CP2K executable has not been linked against the required library libint.") #endif - END SUBROUTINE + END SUBROUTINE cp_libint_init_2eri SUBROUTINE cp_libint_cleanup_eri(lib) TYPE(cp_libint_t) :: lib @@ -660,7 +660,7 @@ CONTAINS MARK_USED(lib) CPABORT("This CP2K executable has not been linked against the required library libint.") #endif - END SUBROUTINE + END SUBROUTINE cp_libint_cleanup_eri SUBROUTINE cp_libint_cleanup_eri1(lib) TYPE(cp_libint_t) :: lib @@ -670,7 +670,7 @@ CONTAINS MARK_USED(lib) CPABORT("This CP2K executable has not been linked against the required library libint.") #endif - END SUBROUTINE + END SUBROUTINE cp_libint_cleanup_eri1 SUBROUTINE cp_libint_cleanup_3eri(lib) TYPE(cp_libint_t) :: lib @@ -680,7 +680,7 @@ CONTAINS MARK_USED(lib) CPABORT("This CP2K executable has not been linked against the required library libint.") #endif - END SUBROUTINE + END SUBROUTINE cp_libint_cleanup_3eri SUBROUTINE cp_libint_cleanup_3eri1(lib) TYPE(cp_libint_t) :: lib @@ -690,7 +690,7 @@ CONTAINS MARK_USED(lib) CPABORT("This CP2K executable has not been linked against the required library libint.") #endif - END SUBROUTINE + END SUBROUTINE cp_libint_cleanup_3eri1 SUBROUTINE cp_libint_cleanup_2eri1(lib) TYPE(cp_libint_t) :: lib @@ -700,7 +700,7 @@ CONTAINS MARK_USED(lib) CPABORT("This CP2K executable has not been linked against the required library libint.") #endif - END SUBROUTINE + END SUBROUTINE cp_libint_cleanup_2eri1 SUBROUTINE cp_libint_cleanup_2eri(lib) TYPE(cp_libint_t) :: lib @@ -710,7 +710,7 @@ CONTAINS MARK_USED(lib) CPABORT("This CP2K executable has not been linked against the required library libint.") #endif - END SUBROUTINE + END SUBROUTINE cp_libint_cleanup_2eri SUBROUTINE cp_libint_static_init() #if(__LIBINT) @@ -718,7 +718,7 @@ CONTAINS #else CPABORT("This CP2K executable has not been linked against the required library libint.") #endif - END SUBROUTINE + END SUBROUTINE cp_libint_static_init SUBROUTINE cp_libint_static_cleanup() #if(__LIBINT) @@ -726,6 +726,6 @@ CONTAINS #else CPABORT("This CP2K executable has not been linked against the required library libint.") #endif - END SUBROUTINE + END SUBROUTINE cp_libint_static_cleanup END MODULE libint_wrapper diff --git a/src/manybody_gal21.F b/src/manybody_gal21.F index 14ddf19c42..92b1836b56 100644 --- a/src/manybody_gal21.F +++ b/src/manybody_gal21.F @@ -378,7 +378,7 @@ CONTAINS "PRINT%PROGRAM_RUN_INFO") END IF - END SUBROUTINE + END SUBROUTINE angular ! ************************************************************************************************** !> \brief forces generated by the GAL2119 potential diff --git a/src/metadynamics.F b/src/metadynamics.F index a9ad024c57..3930661f63 100644 --- a/src/metadynamics.F +++ b/src/metadynamics.F @@ -191,7 +191,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE metadyn_initialise_plumed ! ************************************************************************************************** !> \brief makes sure PLUMED is shut down cleanly @@ -210,7 +210,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE metadyn_finalise_plumed ! ************************************************************************************************** !> \brief General driver for applying metadynamics diff --git a/src/minimax/minimax_exp_gw.F b/src/minimax/minimax_exp_gw.F index 0c9b21d334..d6e9c42d9e 100644 --- a/src/minimax/minimax_exp_gw.F +++ b/src/minimax/minimax_exp_gw.F @@ -82,7 +82,7 @@ CONTAINS E_ratio = 1.0_dp END IF aw(:) = aw(:)*E_ratio - END SUBROUTINE + END SUBROUTINE rescale_grid ! ************************************************************************************************** !> \brief ... @@ -1180,7 +1180,7 @@ CONTAINS 2.5445132697805617_dp, & 4.694880341120372_dp] END IF - END SUBROUTINE + END SUBROUTINE get_coeff_26 ! ************************************************************************************************** !> \brief ... @@ -2880,7 +2880,7 @@ CONTAINS 2.625732716141634_dp, & 4.78747600908045_dp] END IF - END SUBROUTINE + END SUBROUTINE get_coeff_28 ! ************************************************************************************************** !> \brief ... @@ -4697,7 +4697,7 @@ CONTAINS 2.7023644845108916_dp, & 4.874923027763007_dp] END IF - END SUBROUTINE + END SUBROUTINE get_coeff_30 ! ************************************************************************************************** !> \brief ... @@ -5969,7 +5969,7 @@ CONTAINS 2.7738272660229994_dp, & 4.9565545529977175_dp] END IF - END SUBROUTINE + END SUBROUTINE get_coeff_32 ! ************************************************************************************************** !> \brief ... @@ -6547,6 +6547,6 @@ CONTAINS 2.848850144582029_dp, & 5.042342061181277_dp] END IF - END SUBROUTINE + END SUBROUTINE get_coeff_34 END MODULE minimax_exp_gw diff --git a/src/molsym.F b/src/molsym.F index 4168f6fe65..660df857b8 100644 --- a/src/molsym.F +++ b/src/molsym.F @@ -1757,7 +1757,7 @@ CONTAINS d = SQRT(SUM((a - b)**2)) - END FUNCTION + END FUNCTION dist ! ************************************************************************************************** !> \brief Write atomic coordinates to output unit iw. !> \param coord ... diff --git a/src/motion/bfgs_optimizer.F b/src/motion/bfgs_optimizer.F index 05304f1856..67e829133c 100644 --- a/src/motion/bfgs_optimizer.F +++ b/src/motion/bfgs_optimizer.F @@ -1148,7 +1148,7 @@ CONTAINS REAL(KIND=dp) :: d, rho, deriv deriv = 0.45_dp*rho*(r1(i)*r1(j))/d**2 - END FUNCTION + END FUNCTION dist_second_deriv ! ************************************************************************************************** !> \brief ... diff --git a/src/motion/pint_gle.F b/src/motion/pint_gle.F index 3792dadbd4..50b4224f14 100644 --- a/src/motion/pint_gle.F +++ b/src/motion/pint_gle.F @@ -44,7 +44,7 @@ CONTAINS pint_env%e_gle = pint_env%e_gle + pint_env%gle%nvt(i)%thermostat_energy END DO END IF - END SUBROUTINE + END SUBROUTINE pint_calc_gle_energy ! ************************************************************************************************** !> \brief ... @@ -139,5 +139,5 @@ CONTAINS pint_env%e_kin_t = 0.0_dp DEALLOCATE (e_tmp, s_tmp, h_tmp) CALL timestop(handle) - END SUBROUTINE -END MODULE + END SUBROUTINE pint_gle_step +END MODULE pint_gle diff --git a/src/motion/pint_piglet.F b/src/motion/pint_piglet.F index 9753318f27..b730068cff 100644 --- a/src/motion/pint_piglet.F +++ b/src/motion/pint_piglet.F @@ -563,7 +563,7 @@ CONTAINS END DO END DO - END SUBROUTINE + END SUBROUTINE a_mat_to_cp2k ! *************************************************************************** !> \brief adjust the unit of C MAT for piglet !> \param c_mat ... diff --git a/src/motion/pint_pile.F b/src/motion/pint_pile.F index 989b321cc7..4083d50f48 100644 --- a/src/motion/pint_pile.F +++ b/src/motion/pint_pile.F @@ -191,4 +191,4 @@ CONTAINS END IF END SUBROUTINE pint_calc_pile_energy -END MODULE +END MODULE pint_pile diff --git a/src/motion/pint_qtb.F b/src/motion/pint_qtb.F index 4f0e3f76c3..ca2e5ce31c 100644 --- a/src/motion/pint_qtb.F +++ b/src/motion/pint_qtb.F @@ -967,4 +967,4 @@ CONTAINS CALL fft_destroy_plan(plan) END SUBROUTINE pint_qtb_fft -END MODULE +END MODULE pint_qtb diff --git a/src/mp2_eri_gpw.F b/src/mp2_eri_gpw.F index 21328ad339..c61ac4fcb8 100644 --- a/src/mp2_eri_gpw.F +++ b/src/mp2_eri_gpw.F @@ -343,7 +343,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE mp2_eri_2c_integrate_gpw ! ************************************************************************************************** !> \brief Integrates the potential of a RI function obtaining the forces and stress tensor @@ -937,7 +937,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE integrate_potential ! ************************************************************************************************** !> \brief Prepares GPW calculation for RI-MP2/RI-RPA diff --git a/src/mp2_gpw.F b/src/mp2_gpw.F index 5c748b2102..837b03079c 100644 --- a/src/mp2_gpw.F +++ b/src/mp2_gpw.F @@ -1278,7 +1278,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE create_matrix_P ! ************************************************************************************************** !> \brief ... diff --git a/src/mp2_gpw_method.F b/src/mp2_gpw_method.F index d67b922b3e..ba9c3932c9 100644 --- a/src/mp2_gpw_method.F +++ b/src/mp2_gpw_method.F @@ -587,7 +587,7 @@ CONTAINS ! Mb mem_try = mem_try*8.0D+00/1024.0D+00**2 - END SUBROUTINE + END SUBROUTINE estimate_memory_usage ! ************************************************************************************************** !> \brief ... diff --git a/src/mp2_grids.F b/src/mp2_grids.F index b73b0f5d99..8080365e32 100644 --- a/src/mp2_grids.F +++ b/src/mp2_grids.F @@ -1507,7 +1507,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE gap_and_max_eig_diff_kpoints ! ************************************************************************************************** !> \brief returns minimal and maximal energy values for the E_range for the minimax grid selection @@ -1585,6 +1585,6 @@ CONTAINS END IF CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE determine_energy_range END MODULE mp2_grids diff --git a/src/mp2_integrals.F b/src/mp2_integrals.F index ad7cb0a875..42f1ecce90 100644 --- a/src/mp2_integrals.F +++ b/src/mp2_integrals.F @@ -1238,7 +1238,7 @@ CONTAINS CALL cp_fm_release(intermed_mat%fm_BIb_jb) DEALLOCATE (intermed_mat%local_col_row_info) - END SUBROUTINE + END SUBROUTINE release_intermediate_matrices ! ************************************************************************************************** !> \brief ... diff --git a/src/mp2_optimize_ri_basis.F b/src/mp2_optimize_ri_basis.F index 86d946a801..b6596cbdcf 100644 --- a/src/mp2_optimize_ri_basis.F +++ b/src/mp2_optimize_ri_basis.F @@ -671,7 +671,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE calc_energy_func_der ! ************************************************************************************************** !> \brief ... @@ -811,7 +811,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE calc_energy_func ! ************************************************************************************************** !> \brief ... @@ -839,7 +839,7 @@ CONTAINS END DO END DO - END SUBROUTINE + END SUBROUTINE init_transf ! ************************************************************************************************** !> \brief ... @@ -868,7 +868,7 @@ CONTAINS END DO END DO - END SUBROUTINE + END SUBROUTINE p2basis ! ************************************************************************************************** !> \brief ... @@ -1023,7 +1023,7 @@ CONTAINS END DO END DO - END SUBROUTINE + END SUBROUTINE reset_basis ! ************************************************************************************************** !> \brief ... @@ -1102,7 +1102,7 @@ CONTAINS DEALLOCATE (mat_ab) - END SUBROUTINE + END SUBROUTINE contract_integrals ! ************************************************************************************************** !> \brief ... @@ -1162,7 +1162,7 @@ CONTAINS valout = 0.0_dp valout = lower_B + max_dev/(1.0_dp + EXP(-alpha*valin)) - END FUNCTION + END FUNCTION transf_val ! ************************************************************************************************** !> \brief ... @@ -1775,7 +1775,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE create_ri_basis END MODULE mp2_optimize_ri_basis diff --git a/src/mp2_ri_grad_util.F b/src/mp2_ri_grad_util.F index e71385c96a..f8ec0c5521 100644 --- a/src/mp2_ri_grad_util.F +++ b/src/mp2_ri_grad_util.F @@ -57,7 +57,7 @@ MODULE mp2_ri_grad_util TYPE index_map INTEGER, DIMENSION(:, :), ALLOCATABLE :: map - END TYPE + END TYPE index_map CONTAINS diff --git a/src/mp2_types.F b/src/mp2_types.F index 834b741716..fda5e0c716 100644 --- a/src/mp2_types.F +++ b/src/mp2_types.F @@ -99,7 +99,7 @@ MODULE mp2_types TYPE mp2_direct_type LOGICAL :: big_send = .FALSE. - END TYPE + END TYPE mp2_direct_type TYPE mp2_gpw_type REAL(KIND=dp) :: eps_grid = 0.0_dp, & @@ -109,7 +109,7 @@ MODULE mp2_types REAL(KIND=dp) :: cutoff = 0.0_dp, & relative_cutoff = 0.0_dp INTEGER :: size_lattice_sum = 0 - END TYPE + END TYPE mp2_gpw_type TYPE ri_mp2_type INTEGER :: block_size = 0, & diff --git a/src/mscfg_types.F b/src/mscfg_types.F index a0d05df79f..babc6a59cf 100644 --- a/src/mscfg_types.F +++ b/src/mscfg_types.F @@ -50,7 +50,7 @@ MODULE mscfg_types INTEGER, DIMENSION(:), ALLOCATABLE :: nmosets_of_frag TYPE(dbcsr_type), DIMENSION(:, :), ALLOCATABLE :: mos_of_frag - END TYPE + END TYPE molecular_scf_guess_env_type CONTAINS diff --git a/src/nnp_environment_types.F b/src/nnp_environment_types.F index 95386d0f02..eee14db180 100644 --- a/src/nnp_environment_types.F +++ b/src/nnp_environment_types.F @@ -153,7 +153,7 @@ MODULE nnp_environment_types INTEGER, DIMENSION(:), ALLOCATABLE :: ele_ind CHARACTER(LEN=2), DIMENSION(:), ALLOCATABLE :: ele REAL(KIND=dp) :: cutoff = -1.0_dp - END TYPE + END TYPE nnp_symfgrp_type ! ************************************************************************************************** !> \brief Set of radial symmetry function type @@ -183,7 +183,7 @@ MODULE nnp_environment_types INTEGER, ALLOCATABLE, DIMENSION(:) :: nuc_ele INTEGER :: n_symfgrp = -1 TYPE(nnp_symfgrp_type), DIMENSION(:), ALLOCATABLE :: symfgrp - END TYPE + END TYPE nnp_acsf_rad_type ! ************************************************************************************************** !> \brief Set of angular symmetry function type @@ -218,7 +218,7 @@ MODULE nnp_environment_types INTEGER, ALLOCATABLE, DIMENSION(:) :: nuc_ele2 INTEGER :: n_symfgrp = -1 TYPE(nnp_symfgrp_type), DIMENSION(:), ALLOCATABLE :: symfgrp - END TYPE + END TYPE nnp_acsf_ang_type ! ************************************************************************************************** !> \brief Contains neighbors list of an atom @@ -238,7 +238,7 @@ MODULE nnp_environment_types REAL(KIND=dp), DIMENSION(:, :, :), ALLOCATABLE :: dist_rad REAL(KIND=dp), DIMENSION(:, :, :), ALLOCATABLE :: dist_ang1 REAL(KIND=dp), DIMENSION(:, :, :), ALLOCATABLE :: dist_ang2 - END TYPE + END TYPE nnp_neighbor_type ! ************************************************************************************************** !> \brief Data type for artificial neural networks @@ -248,7 +248,7 @@ MODULE nnp_environment_types TYPE nnp_arc_type TYPE(nnp_arc_layer_type), POINTER, DIMENSION(:) :: layer => NULL() ! DIM(n_layer) INTEGER, ALLOCATABLE, DIMENSION(:) :: n_nodes - END TYPE + END TYPE nnp_arc_type ! ************************************************************************************************** !> \brief Data type for individual layer @@ -261,7 +261,7 @@ MODULE nnp_environment_types REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: node ! DIM(n_nodes) REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: node_grad ! DIM(n_nodes) REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: tmp_der ! DIM(n_sym,n_nodes) - END TYPE + END TYPE nnp_arc_layer_type CONTAINS diff --git a/src/optimize_basis_types.F b/src/optimize_basis_types.F index 15e4b8c4e1..81f2418eca 100644 --- a/src/optimize_basis_types.F +++ b/src/optimize_basis_types.F @@ -26,7 +26,7 @@ MODULE optimize_basis_types INTEGER :: const_type = -1 REAL(KIND=dp) :: llim = -1.0_dp, ulim = -1.0_dp REAL(KIND=dp) :: init = -1.0_dp, var_fac = -1.0_dp - END TYPE + END TYPE exp_constraint_type ! Subset of a basis+ additional information on what to optimize. ! *_x_ind maps to the index in the optimization vector @@ -45,7 +45,7 @@ MODULE optimize_basis_types LOGICAL, DIMENSION(:), ALLOCATABLE :: exp_has_const TYPE(exp_constraint_type), DIMENSION(:), & ALLOCATABLE :: exp_const - END TYPE + END TYPE subset_type ! Top level information for basis sets+ vector subset with the real information TYPE flex_basis_type @@ -53,12 +53,12 @@ MODULE optimize_basis_types INTEGER :: nopt = -1 INTEGER :: nsets = -1 TYPE(subset_type), DIMENSION(:), ALLOCATABLE :: subset - END TYPE + END TYPE flex_basis_type ! information for optimization: whether coeff has to be optimized or not TYPE use_contr_type LOGICAL, DIMENSION(:), ALLOCATABLE :: in_use - END TYPE + END TYPE use_contr_type ! information about how to generate the derived basis sets TYPE derived_basis_info @@ -69,7 +69,7 @@ MODULE optimize_basis_types INTEGER, DIMENSION(:), ALLOCATABLE :: remove_set LOGICAL, DIMENSION(:), ALLOCATABLE :: in_use_set TYPE(use_contr_type), DIMENSION(:), ALLOCATABLE :: use_contr - END TYPE + END TYPE derived_basis_info ! some usual stuff for basis information and an info type containing the ! the translated input on how to genrate the derived basis sets @@ -83,12 +83,12 @@ MODULE optimize_basis_types TYPE(derived_basis_info), DIMENSION(:), & ALLOCATABLE :: deriv_info TYPE(flex_basis_type), DIMENSION(:), ALLOCATABLE :: flex_basis - END TYPE + END TYPE kind_basis_type ! vector of length nparallel_groups containing the id's of the calculations in the group TYPE comp_group_type INTEGER, DIMENSION(:), ALLOCATABLE :: member_list - END TYPE + END TYPE comp_group_type ! ************************************************************************************************** !> \brief type containing all information needed for basis matching @@ -117,7 +117,7 @@ MODULE optimize_basis_types CHARACTER(LEN=default_path_length) :: template_basis_file = "" TYPE(kind_basis_type), DIMENSION(:), ALLOCATABLE :: kind_basis INTEGER :: opt_id = -1 - END TYPE + END TYPE basis_optimization_type CONTAINS diff --git a/src/optimize_basis_utils.F b/src/optimize_basis_utils.F index f843fed4ca..8e24999a12 100644 --- a/src/optimize_basis_utils.F +++ b/src/optimize_basis_utils.F @@ -233,7 +233,7 @@ CONTAINS set_id = (calc_id)/ncom + 1 bas_id = MOD(calc_id, ncom) + 1 - END SUBROUTINE + END SUBROUTINE get_set_and_basis_id ! ************************************************************************************************** !> \brief Pack calculations in groups. If less MPI tasks than systems are used diff --git a/src/optimize_input.F b/src/optimize_input.F index 1eb4d19639..dcb1b90ba3 100644 --- a/src/optimize_input.F +++ b/src/optimize_input.F @@ -67,13 +67,13 @@ MODULE optimize_input REAL(KIND=dp) :: shift_qm = -1.0_dp LOGICAL :: shift_average = .FALSE. INTEGER :: frame_start = -1, frame_stop = -1, frame_stride = -1, frame_count = -1 - END TYPE + END TYPE fm_env_type TYPE variable_type CHARACTER(LEN=default_string_length) :: label = "" REAL(KIND=dp) :: value = -1.0_dp LOGICAL :: fixed = .FALSE. - END TYPE + END TYPE variable_type TYPE oi_env_type INTEGER :: method = -1 @@ -86,7 +86,7 @@ MODULE optimize_input INTEGER :: iter_start_val = -1 REAL(KIND=dp) :: randomize_variables = -1.0_dp REAL(KIND=dp) :: start_time = -1.0_dp, target_time = -1.0_dp - END TYPE + END TYPE oi_env_type CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'optimize_input' diff --git a/src/pao_main.F b/src/pao_main.F index 520425e0b0..d038af7e96 100644 --- a/src/pao_main.F +++ b/src/pao_main.F @@ -340,7 +340,7 @@ CONTAINS IF (ls_scf_env%calculate_forces) CALL pao_add_forces(qs_env, ls_scf_env) CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE pao_post_scf ! ************************************************************************************************** !> \brief Finish a PAO optimization run. diff --git a/src/pao_types.F b/src/pao_types.F index 4e01803f90..80f9330ff7 100644 --- a/src/pao_types.F +++ b/src/pao_types.F @@ -226,7 +226,7 @@ MODULE pao_types DIMENSION(:) :: models TYPE(dbcsr_distribution_type) :: diag_distribution - END TYPE + END TYPE pao_env_type CONTAINS diff --git a/src/pexsi_interface.F b/src/pexsi_interface.F index 154b30758a..fad21c4be4 100644 --- a/src/pexsi_interface.F +++ b/src/pexsi_interface.F @@ -477,6 +477,6 @@ CONTAINS MARK_USED(plan) CPABORT("Requires linking to the PEXSI library.") #endif - END SUBROUTINE + END SUBROUTINE cp_pexsi_plan_finalize END MODULE pexsi_interface diff --git a/src/pexsi_methods.F b/src/pexsi_methods.F index fea91aefb5..d88a14112b 100644 --- a/src/pexsi_methods.F +++ b/src/pexsi_methods.F @@ -563,7 +563,7 @@ CONTAINS CALL cp_pexsi_set_options(pexsi_env%options, numElectronPEXSITolerance=tol_nel) CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE pexsi_set_convergence_tolerance ! ************************************************************************************************** !> \brief Pass energy weighted density matrix and entropic energy contribution diff --git a/src/post_scf_bandstructure_utils.F b/src/post_scf_bandstructure_utils.F index a18de03642..78689dc6e4 100644 --- a/src/post_scf_bandstructure_utils.F +++ b/src/post_scf_bandstructure_utils.F @@ -2168,7 +2168,7 @@ CONTAINS Gaussian = 0.0_dp END IF - END FUNCTION + END FUNCTION Gaussian ! ************************************************************************************************** !> \brief ... diff --git a/src/preconditioner_types.F b/src/preconditioner_types.F index 0e9ddd92c4..807ab020c8 100644 --- a/src/preconditioner_types.F +++ b/src/preconditioner_types.F @@ -74,7 +74,7 @@ CONTAINS LOGICAL :: preconditioner_in_use preconditioner_in_use = .NOT. (preconditioner%in_use == 0) - END FUNCTION + END FUNCTION preconditioner_in_use ! ************************************************************************************************** !> \brief ... diff --git a/src/pw/cp_linked_list_pw.F b/src/pw/cp_linked_list_pw.F index 98ce9bfcbd..055e7dc40a 100644 --- a/src/pw/cp_linked_list_pw.F +++ b/src/pw/cp_linked_list_pw.F @@ -37,4 +37,4 @@ MODULE cp_linked_list_pw #:endmute $:inst(nametype1, type1, type1in, type1out, eq, arrayeq, type1arrayEl, arrayEl, private_routines, default_init) -END MODULE +END MODULE cp_linked_list_pw diff --git a/src/pw/cube_utils.F b/src/pw/cube_utils.F index 7567ed53d3..5736ee14a1 100644 --- a/src/pw/cube_utils.F +++ b/src/pw/cube_utils.F @@ -197,7 +197,7 @@ CONTAINS ELSE ! no info to be deallocated END IF - END SUBROUTINE + END SUBROUTINE destroy_cube_info ! ************************************************************************************************** !> \brief ... @@ -317,7 +317,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE init_cube_info ! try to hide things from the optimizer, so that we get the same numbers, ! always (this solves the optimisation problems with the intel and nag compiler diff --git a/src/pw/fft/fft_lib.F b/src/pw/fft/fft_lib.F index 9fe277e57b..6dd57e63ec 100644 --- a/src/pw/fft/fft_lib.F +++ b/src/pw/fft/fft_lib.F @@ -72,7 +72,7 @@ CONTAINS CALL fftw3_do_init(wisdom_file) END SELECT - END SUBROUTINE + END SUBROUTINE fft_do_init ! ************************************************************************************************** !> \brief ... @@ -94,7 +94,7 @@ CONTAINS CALL fftw3_do_cleanup(wisdom_file, ionode) END SELECT - END SUBROUTINE + END SUBROUTINE fft_do_cleanup ! ************************************************************************************************** !> \brief ... @@ -247,7 +247,7 @@ CONTAINS plan%valid = .FALSE. END IF - END SUBROUTINE + END SUBROUTINE fft_destroy_plan ! ************************************************************************************************** !> \brief ... @@ -283,5 +283,5 @@ CONTAINS END SUBROUTINE fft_1dm -END MODULE +END MODULE fft_lib diff --git a/src/pw/fft/fftsg_lib.F b/src/pw/fft/fftsg_lib.F index 83f0457c17..7432a59828 100644 --- a/src/pw/fft/fftsg_lib.F +++ b/src/pw/fft/fftsg_lib.F @@ -25,7 +25,7 @@ CONTAINS ! no init needed - END SUBROUTINE + END SUBROUTINE fftsg_do_init ! ************************************************************************************************** !> \brief ... @@ -34,7 +34,7 @@ CONTAINS ! no cleanup needed - END SUBROUTINE + END SUBROUTINE fftsg_do_cleanup ! ************************************************************************************************** !> \brief ... @@ -155,5 +155,5 @@ CONTAINS END SUBROUTINE fftsg1dm -END MODULE +END MODULE fftsg_lib diff --git a/src/pw/fft/fftw3_lib.F b/src/pw/fft/fftw3_lib.F index b09f891cf2..bc38354ed0 100644 --- a/src/pw/fft/fftw3_lib.F +++ b/src/pw/fft/fftw3_lib.F @@ -46,13 +46,13 @@ MODULE fftw3_lib MODULE PROCEDURE :: fftw_alloc_complex_1d MODULE PROCEDURE :: fftw_alloc_complex_2d MODULE PROCEDURE :: fftw_alloc_complex_3d - END INTERFACE + END INTERFACE fftw_alloc INTERFACE fftw_dealloc MODULE PROCEDURE :: fftw_dealloc_complex_1d MODULE PROCEDURE :: fftw_dealloc_complex_2d MODULE PROCEDURE :: fftw_dealloc_complex_3d - END INTERFACE + END INTERFACE fftw_dealloc CONTAINS @@ -130,7 +130,7 @@ CONTAINS MARK_USED(FFTW_NO_SLOW) MARK_USED(FFTW_NO_FIXED_RADIX_LARGE_N) MARK_USED(FFTW_ALLOW_PRUNING) - END SUBROUTINE + END SUBROUTINE dummy_routine_to_call_mark_used #endif ! ************************************************************************************************** @@ -174,7 +174,7 @@ CONTAINS MARK_USED(ionode) #endif - END SUBROUTINE + END SUBROUTINE fftw3_do_cleanup ! ************************************************************************************************** !> \brief ... @@ -222,7 +222,7 @@ CONTAINS MARK_USED(wisdom_file) #endif - END SUBROUTINE + END SUBROUTINE fftw3_do_init ! ************************************************************************************************** !> \brief ... @@ -502,7 +502,7 @@ CONTAINS #endif - END SUBROUTINE + END SUBROUTINE fftw3_create_guru_plan ! ************************************************************************************************** @@ -549,7 +549,7 @@ CONTAINS guru_supported = .FALSE. #endif - END FUNCTION + END FUNCTION fftw3_is_guru_supported ! ************************************************************************************************** @@ -581,7 +581,7 @@ CONTAINS th_planB = nt - th_planA END IF - END SUBROUTINE + END SUBROUTINE fftw3_compute_rows_per_th ! ************************************************************************************************** @@ -642,7 +642,7 @@ CONTAINS CPABORT("fftw3_create_plan (remaining)") END IF - END SUBROUTINE + END SUBROUTINE fftw3_create_3d_plans ! ************************************************************************************************** @@ -892,7 +892,7 @@ CONTAINS IF (.FALSE.) THEN; DO; IF (ABS(input(1)) > ABS(output(1))) EXIT; END DO; END IF #endif - END SUBROUTINE + END SUBROUTINE fftw3_workshare_execute_dft ! ************************************************************************************************** @@ -1201,4 +1201,4 @@ CONTAINS END SUBROUTINE fftw31dm - END MODULE + END MODULE fftw3_lib diff --git a/src/pw/fft/mltfftsg_tools.F b/src/pw/fft/mltfftsg_tools.F index 81badd6671..0bcff2ea02 100644 --- a/src/pw/fft/mltfftsg_tools.F +++ b/src/pw/fft/mltfftsg_tools.F @@ -174,7 +174,7 @@ CONTAINS CALL C_F_POINTER(C_LOC(zout), zout_real, [2, nn, n]) CALL fftstp(mm, nfft, m, nn, n, zin_real, zout_real, trig, now, after, before, isign) - END SUBROUTINE + END SUBROUTINE fftstp_cmplx ! ************************************************************************************************** !> \brief ... @@ -207,7 +207,7 @@ CONTAINS CALL fftpre(mm, nfft, m, nn, n, zin_real, zout_real, trig, now, after, before, isign) - END SUBROUTINE + END SUBROUTINE fftpre_cmplx ! ************************************************************************************************** !> \brief ... @@ -241,7 +241,7 @@ CONTAINS CALL fftrot(mm, nfft, m, nn, n, zin_real, zout_real, trig, now, after, before, isign) - END SUBROUTINE + END SUBROUTINE fftrot_cmplx !-----------------------------------------------------------------------------! ! Copyright (C) Stefan Goedecker, Lausanne, Switzerland, August 1, 1991 diff --git a/src/pw/pw_fpga.F b/src/pw/pw_fpga.F index 0006676630..58d164b40a 100644 --- a/src/pw/pw_fpga.F +++ b/src/pw/pw_fpga.F @@ -159,7 +159,7 @@ CONTAINS CALL timestop(handle3) #endif - END SUBROUTINE + END SUBROUTINE pw_fpga_r3dc1d_3d_dp ! ************************************************************************************************** !> \brief perform an in-place double precision inverse fft3d on the FPGA @@ -183,7 +183,7 @@ CONTAINS CALL timestop(handle3) #endif - END SUBROUTINE + END SUBROUTINE pw_fpga_c1dr3d_3d_dp ! ************************************************************************************************** !> \brief perform an in-place single precision fft3d on the FPGA @@ -217,7 +217,7 @@ CONTAINS DEALLOCATE (c_in_sp) #endif - END SUBROUTINE + END SUBROUTINE pw_fpga_r3dc1d_3d_sp ! ************************************************************************************************** !> \brief perform an in-place single precision inverse fft3d on the FPGA @@ -251,7 +251,7 @@ CONTAINS DEALLOCATE (c_in_sp) #endif - END SUBROUTINE + END SUBROUTINE pw_fpga_c1dr3d_3d_sp ! ************************************************************************************************** !> \brief Invoke the pw_fpga_check_bitstream C function passing the path to the data dir @@ -276,7 +276,7 @@ CONTAINS res = pw_fpga_check_bitstream(data_path, n) #endif - END FUNCTION + END FUNCTION pw_fpga_init_bitstream END MODULE pw_fpga diff --git a/src/pw/pw_grids.F b/src/pw/pw_grids.F index 9fbd65dccf..5fafcd9861 100644 --- a/src/pw/pw_grids.F +++ b/src/pw/pw_grids.F @@ -1354,7 +1354,7 @@ CONTAINS length = length_x**2 + length_y**2 + length_z**2 - END SUBROUTINE + END SUBROUTINE pw_vec_length ! ************************************************************************************************** !> \brief Count total number of g vectors diff --git a/src/pw/realspace_grid_types.F b/src/pw/realspace_grid_types.F index b14ca1e20b..f2792e2fbc 100644 --- a/src/pw/realspace_grid_types.F +++ b/src/pw/realspace_grid_types.F @@ -567,7 +567,7 @@ CONTAINS desc%virtual_group_coor(:) = desc%rank2coord(:, desc%my_virtual_pos) END IF - END SUBROUTINE + END SUBROUTINE rs_grid_reorder_ranks ! ************************************************************************************************** !> \brief Print information on grids to output @@ -2089,7 +2089,7 @@ CONTAINS shift_coords(dir) = MODULO(shift_coords(dir) - disp, rs_grid%desc%group_dim(dir)) source = rs_grid%desc%virtual2real(rs_grid%desc%coord2rank(shift_coords(1), shift_coords(2), shift_coords(3))) - END SUBROUTINE + END SUBROUTINE cart_shift ! ************************************************************************************************** !> \brief returns the maximum number of points in the local grid of any process diff --git a/src/qmmm_util.F b/src/qmmm_util.F index bf05cd41dd..c299d86acc 100644 --- a/src/qmmm_util.F +++ b/src/qmmm_util.F @@ -535,7 +535,7 @@ CONTAINS mean_z = mean_z/ABS(mean_z) qmmm_pbc_aware_mean = MATMUL(mm_cell%hmat, & REAL(LOG(mean_z)/(gaussi*2.0_dp*pi), dp)) - END FUNCTION + END FUNCTION qmmm_pbc_aware_mean ! ************************************************************************************************** !> \brief minimum image lattice coordinates difference vector diff --git a/src/qs_active_space_methods.F b/src/qs_active_space_methods.F index 8616c0157b..7cbf1814b1 100644 --- a/src/qs_active_space_methods.F +++ b/src/qs_active_space_methods.F @@ -176,7 +176,7 @@ MODULE qs_active_space_methods INTEGER :: unit_nr = -1, bra_start = -1, ket_start = -1 CONTAINS PROCEDURE :: func => eri_fcidump_print_func - END TYPE + END TYPE eri_fcidump_print TYPE, EXTENDS(eri_type_eri_element_func) :: eri_fcidump_checksum INTEGER :: bra_start = 0, ket_start = 0 diff --git a/src/qs_kind_types.F b/src/qs_kind_types.F index 30560e66da..fae5b80547 100644 --- a/src/qs_kind_types.F +++ b/src/qs_kind_types.F @@ -2791,7 +2791,7 @@ CONTAINS IF (istat /= 0) n = -1 END IF - END FUNCTION + END FUNCTION parse_valence_electrons ! ************************************************************************************************** !> \brief Read an atomic kind set data set from the input file. diff --git a/src/qs_localization_methods.F b/src/qs_localization_methods.F index bb0be11c74..e6f198d072 100644 --- a/src/qs_localization_methods.F +++ b/src/qs_localization_methods.F @@ -77,11 +77,11 @@ MODULE qs_localization_methods TYPE set_c_1d_type COMPLEX(KIND=dp), POINTER, DIMENSION(:) :: c_array => NULL() - END TYPE + END TYPE set_c_1d_type TYPE set_c_2d_type COMPLEX(KIND=dp), POINTER, DIMENSION(:, :) :: c_array => NULL() - END TYPE + END TYPE set_c_2d_type CONTAINS ! ************************************************************************************************** @@ -2167,7 +2167,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE direct_mini ! ************************************************************************************************** !> \brief Parallel algorithm for jacobi rotations diff --git a/src/qs_neighbor_list_types.F b/src/qs_neighbor_list_types.F index 01b20b59a4..6853fdbaed 100644 --- a/src/qs_neighbor_list_types.F +++ b/src/qs_neighbor_list_types.F @@ -526,7 +526,7 @@ CONTAINS iter_stat = nl_sub_iterate_ref(iter_sub, iter_ref) END IF - END FUNCTION + END FUNCTION nl_sub_iterate_ref ! ************************************************************************************************** !> \brief ... diff --git a/src/qs_oce_types.F b/src/qs_oce_types.F index 887dc311e7..81d1d1f377 100644 --- a/src/qs_oce_types.F +++ b/src/qs_oce_types.F @@ -36,7 +36,7 @@ MODULE qs_oce_types ! ************************************************************************************************** TYPE oce_matrix_type TYPE(sap_int_type), DIMENSION(:), POINTER :: intac => NULL() - END TYPE + END TYPE oce_matrix_type ! *** Public data types *** diff --git a/src/qs_tddfpt2_soc.F b/src/qs_tddfpt2_soc.F index 1621222cfc..862abcbf98 100644 --- a/src/qs_tddfpt2_soc.F +++ b/src/qs_tddfpt2_soc.F @@ -191,7 +191,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE tddfpt_soc ! ************************************************************************************************** !> \brief Will perform the soc-calculation for restricted-closed-shell systems diff --git a/src/qs_tddfpt2_soc_types.F b/src/qs_tddfpt2_soc_types.F index 29077baff3..337a9be3e0 100644 --- a/src/qs_tddfpt2_soc_types.F +++ b/src/qs_tddfpt2_soc_types.F @@ -59,7 +59,7 @@ MODULE qs_tddfpt2_soc_types b_coeff = cp_fm_type() REAL(dp), ALLOCATABLE, DIMENSION(:) :: soc_evals, & soc_osc - END TYPE + END TYPE soc_env_type ! ************************************************************************************************ ! \bief: an environment type analog to the xas_atom_env in xas_tdp_types:343 @@ -75,7 +75,7 @@ MODULE qs_tddfpt2_soc_types TYPE(harmonics_atom_p_type), DIMENSION(:), POINTER :: harmonics_atom_set => Null() TYPE(cp_2d_r_p_type), DIMENSION(:), POINTER :: orb_sphi_so => Null() TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: soc_pp => Null() - END TYPE + END TYPE soc_atom_env_type CONTAINS diff --git a/src/qs_tddfpt2_stda_types.F b/src/qs_tddfpt2_stda_types.F index 7a0171cc29..af6ca107ed 100644 --- a/src/qs_tddfpt2_stda_types.F +++ b/src/qs_tddfpt2_stda_types.F @@ -36,11 +36,11 @@ MODULE qs_tddfpt2_stda_types INTEGER :: kind_number = -1 !kind number REAL(KIND=dp) :: hardness_param = -1.0_dp !hardness_parameter eta REAL(KIND=dp) :: rcut = -1.0_dp !cutoff radius for short-range Coulomb - END TYPE + END TYPE stda_kind_type TYPE stda_kind_p_type TYPE(stda_kind_type), POINTER :: kind_param => NULL() - END TYPE + END TYPE stda_kind_p_type TYPE stda_env_type !fraction of non-local HF exchange @@ -55,7 +55,7 @@ MODULE qs_tddfpt2_stda_types !number of atomic orbitals, number of occupied orbitals INTEGER, DIMENSION(2) :: n_ao = -1 INTEGER, DIMENSION(2) :: nactive = -1 - END TYPE + END TYPE stda_env_type !PARAMETERS !&< diff --git a/src/qs_tensors.F b/src/qs_tensors.F index 89a2d35611..e1564fa2f0 100644 --- a/src/qs_tensors.F +++ b/src/qs_tensors.F @@ -118,7 +118,7 @@ MODULE qs_tensors TYPE one_dim_int_array INTEGER, DIMENSION(:), ALLOCATABLE :: array - END TYPE + END TYPE one_dim_int_array ! cache size for integral compression INTEGER, PARAMETER, PRIVATE :: cache_size = 1024 @@ -254,7 +254,7 @@ CONTAINS CALL atom2d_cleanup(atom2d) - END SUBROUTINE + END SUBROUTINE build_2c_neighbor_lists ! ************************************************************************************************** !> \brief Build a 3-center neighbor list @@ -353,7 +353,7 @@ CONTAINS END IF CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE build_3c_neighbor_lists ! ************************************************************************************************** !> \brief Symmetry criterion @@ -371,7 +371,7 @@ CONTAINS include_symmetric = (MODULO(a + b, 2) == 0) END IF - END FUNCTION + END FUNCTION include_symmetric ! ************************************************************************************************** !> \brief Destroy 3c neighborlist @@ -387,7 +387,7 @@ CONTAINS CALL distribution_3d_destroy(ijk_list%dist_3d) END IF - END SUBROUTINE + END SUBROUTINE neighbor_list_3c_destroy ! ************************************************************************************************** !> \brief Create a 3-center neighborlist iterator @@ -415,7 +415,7 @@ CONTAINS iterator%bounds_k = 0 CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE neighbor_list_3c_iterator_create ! ************************************************************************************************** !> \brief impose atomic upper and lower bounds @@ -433,7 +433,7 @@ CONTAINS IF (PRESENT(bounds_j)) iterator%bounds_j = bounds_j IF (PRESENT(bounds_k)) iterator%bounds_k = bounds_k - END SUBROUTINE + END SUBROUTINE nl_3c_iter_set_bounds ! ************************************************************************************************** !> \brief Destroy 3c-nl iterator @@ -454,7 +454,7 @@ CONTAINS NULLIFY (iterator%iter_jk) CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE neighbor_list_3c_iterator_destroy ! ************************************************************************************************** !> \brief Iterate 3c-nl iterator @@ -538,7 +538,7 @@ CONTAINS RETURN END IF - END FUNCTION + END FUNCTION neighbor_list_3c_iterate ! ************************************************************************************************** !> \brief Get info of current iteration @@ -596,7 +596,7 @@ CONTAINS IF (PRESENT(cell_j)) cell_j = cell_1 IF (PRESENT(cell_k)) cell_k = cell_1 + cell_2 - END SUBROUTINE + END SUBROUTINE get_3c_iterator_info ! ************************************************************************************************** !> \brief Allocate blocks of a 3-center tensor based on neighborlist @@ -891,7 +891,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE alloc_block_3c ! ************************************************************************************************** !> \brief Build 3-center derivative tensors @@ -3520,7 +3520,7 @@ CONTAINS memory_usage, .FALSE.) END DO - END SUBROUTINE + END SUBROUTINE compress_tensor ! ************************************************************************************************** !> \brief ... @@ -3612,7 +3612,7 @@ CONTAINS CALL hfx_reset_cache_and_container(integral_caches(i), integral_containers(i), & memory_usage, .FALSE.) END DO - END SUBROUTINE + END SUBROUTINE decompress_tensor ! ************************************************************************************************** !> \brief ... @@ -3631,6 +3631,6 @@ CONTAINS CALL dbt_get_info(tensor, nfull_total=dims) occ = REAL(nze, dp)/PRODUCT(REAL(dims, dp)) - END SUBROUTINE + END SUBROUTINE get_tensor_occupancy -END MODULE +END MODULE qs_tensors diff --git a/src/qs_tensors_types.F b/src/qs_tensors_types.F index b412db0919..243fc3419c 100644 --- a/src/qs_tensors_types.F +++ b/src/qs_tensors_types.F @@ -65,7 +65,7 @@ MODULE qs_tensors_types INTEGER :: sym = symmetric_none TYPE(distribution_3d_type) :: dist_3d = distribution_3d_type() LOGICAL :: owns_dist = .FALSE. - END TYPE + END TYPE neighbor_list_3c_type TYPE neighbor_list_3c_iterator_type TYPE(neighbor_list_iterator_p_type), DIMENSION(:), POINTER :: iter_ij => NULL() @@ -73,7 +73,7 @@ MODULE qs_tensors_types INTEGER :: iter_level = 0 TYPE(neighbor_list_3c_type) :: ijk_nl = neighbor_list_3c_type() INTEGER, DIMENSION(2) :: bounds_i = 0, bounds_j = 0, bounds_k = 0 - END TYPE + END TYPE neighbor_list_3c_iterator_type CONTAINS ! ************************************************************************************************** @@ -125,7 +125,7 @@ CONTAINS dist_3d%comm_2d_2 = comm_2d_2 CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE distribution_3d_create ! ************************************************************************************************** !> \brief Destroy a 3d distribution @@ -148,7 +148,7 @@ CONTAINS NULLIFY (dist%dist_2d_1, dist%dist_2d_2) CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE distribution_3d_destroy ! ************************************************************************************************** !> \brief Create a 2d distribution. This mainly wraps distribution_2d_create @@ -251,7 +251,7 @@ CONTAINS END IF CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE distribution_2d_create ! ************************************************************************************************** !> \brief contiguous distribution of weighted elements @@ -365,7 +365,7 @@ CONTAINS CALL dbt_distribution_destroy(dist) CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE create_3c_tensor ! ************************************************************************************************** !> \brief ... @@ -416,7 +416,7 @@ CONTAINS CALL dbt_distribution_destroy(dist) CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE create_2c_tensor ! ************************************************************************************************** !> \brief ... @@ -506,7 +506,7 @@ CONTAINS ALLOCATE (pgf_blk_sizes(blk_count)) pgf_blk_sizes(:) = pgf_blk_sizes_tmp(:blk_count) - END SUBROUTINE + END SUBROUTINE pgf_block_sizes ! ************************************************************************************************** !> \brief ... @@ -539,6 +539,6 @@ CONTAINS bsum = bsum + SUM(sizes(starts_array_block(imem):ends_array_block(imem))) ends_array(imem) = bsum END DO - END SUBROUTINE + END SUBROUTINE create_tensor_batches -END MODULE +END MODULE qs_tensors_types diff --git a/src/rpa_communication.F b/src/rpa_communication.F index f9d43da176..1cd95220ca 100644 --- a/src/rpa_communication.F +++ b/src/rpa_communication.F @@ -48,7 +48,7 @@ MODULE rpa_communication TYPE index_map INTEGER, DIMENSION(:, :), ALLOCATABLE :: map - END TYPE + END TYPE index_map CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'rpa_communication' diff --git a/src/rpa_exchange.F b/src/rpa_exchange.F index f700451976..3a60673ac6 100644 --- a/src/rpa_exchange.F +++ b/src/rpa_exchange.F @@ -100,11 +100,11 @@ MODULE rpa_exchange PROCEDURE, PASS(exchange_env), NON_OVERRIDABLE :: create => hfx_create_subgroup !PROCEDURE, PASS(exchange_env), NON_OVERRIDABLE :: integrate => integrate_exchange PROCEDURE, PASS(exchange_env), NON_OVERRIDABLE :: release => hfx_release_subgroup - END TYPE + END TYPE rpa_exchange_env_type TYPE dbcsr_matrix_p_set TYPE(dbcsr_type), ALLOCATABLE, DIMENSION(:) :: matrix_set - END TYPE + END TYPE dbcsr_matrix_p_set TYPE rpa_exchange_work_type PRIVATE @@ -128,7 +128,7 @@ MODULE rpa_exchange PROCEDURE, PRIVATE, PASS(exchange_work), NON_OVERRIDABLE :: redistribute_into_subgroups PROCEDURE, PRIVATE, PASS(exchange_work), NON_OVERRIDABLE :: compute_fm => rpa_exchange_work_compute_fm PROCEDURE, PRIVATE, PASS(exchange_work), NON_OVERRIDABLE :: compute_hfx => rpa_exchange_work_compute_hfx - END TYPE + END TYPE rpa_exchange_work_type CONTAINS @@ -245,7 +245,7 @@ CONTAINS END DO DEALLOCATE (qs_env%mp2_env%ri_rpa%mo_coeff_v) END IF - END SUBROUTINE + END SUBROUTINE rpa_exchange_work_create ! ************************************************************************************************** !> \brief ... Initializes x_data on a subgroup @@ -369,7 +369,7 @@ CONTAINS CALL cp_fm_release(exchange_work%fm_mat_R_half_gemm) CALL exchange_work%exchange_env%release() - END SUBROUTINE + END SUBROUTINE rpa_exchange_work_release ! ************************************************************************************************** !> \brief ... diff --git a/src/rpa_grad.F b/src/rpa_grad.F index abb4d4b83e..a1eafb914e 100644 --- a/src/rpa_grad.F +++ b/src/rpa_grad.F @@ -84,7 +84,7 @@ MODULE rpa_grad INTEGER, DIMENSION(:, :), ALLOCATABLE :: pair_list TYPE(one_dim_int_array), DIMENSION(:), ALLOCATABLE :: index2send, index2recv REAL(KIND=dp), DIMENSION(:), ALLOCATABLE :: P - END TYPE + END TYPE sos_mp2_grad_work_type TYPE rpa_grad_work_type TYPE(cp_fm_type) :: fm_mat_Q_copy = cp_fm_type() @@ -93,7 +93,7 @@ MODULE rpa_grad TYPE(group_dist_d1_type), DIMENSION(:), ALLOCATABLE :: gd_homo, gd_virtual INTEGER, DIMENSION(2) :: grid = -1, mepos = -1 TYPE(two_dim_real_array), DIMENSION(:), ALLOCATABLE :: P_ij, P_ab - END TYPE + END TYPE rpa_grad_work_type TYPE rpa_grad_type PRIVATE @@ -101,7 +101,7 @@ MODULE rpa_grad TYPE(cp_fm_type), DIMENSION(:), ALLOCATABLE :: fm_Y TYPE(sos_mp2_grad_work_type), ALLOCATABLE, DIMENSION(:) :: sos_mp2_work_occ, sos_mp2_work_virt TYPE(rpa_grad_work_type) :: rpa_work - END TYPE + END TYPE rpa_grad_type INTEGER, PARAMETER :: spla_threshold = 128*128*128*2 INTEGER, PARAMETER :: blksize_threshold = 4 @@ -261,7 +261,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE sos_mp2_work_type_create ! ************************************************************************************************** !> \brief ... @@ -397,7 +397,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE rpa_work_type_create ! ************************************************************************************************** !> \brief ... @@ -571,7 +571,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE prepare_comm_Pij ! ************************************************************************************************** !> \brief ... @@ -702,7 +702,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE prepare_comm_Pab ! ************************************************************************************************** !> \brief ... @@ -715,7 +715,7 @@ CONTAINS CALL cp_fm_to_fm(fm_mat_Q, rpa_grad%rpa_work%fm_mat_Q_copy) - END SUBROUTINE + END SUBROUTINE rpa_grad_copy_Q ! ************************************************************************************************** !> \brief ... @@ -877,7 +877,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE rpa_grad_matrix_operations ! ************************************************************************************************** !> \brief ... @@ -972,7 +972,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE calc_P_sos_mp2 ! ************************************************************************************************** !> \brief ... @@ -1271,7 +1271,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE calc_P_rpa ! ************************************************************************************************** !> \brief ... @@ -1490,7 +1490,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE kahan_step ! ************************************************************************************************** !> \brief ... @@ -1742,7 +1742,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE calc_Pij_degen ! ************************************************************************************************** !> \brief ... @@ -1901,7 +1901,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE calc_Pab_degen ! ************************************************************************************************** !> \brief ... @@ -2009,7 +2009,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE redistribute_fm_mat_S ! ************************************************************************************************** !> \brief ... @@ -2388,7 +2388,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE sos_mp2_grad_finalize ! ************************************************************************************************** !> \brief ... @@ -2584,7 +2584,7 @@ CONTAINS END IF CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE rpa_grad_work_finalize ! ************************************************************************************************** !> \brief Dereplicate data from fm_sub and collect in fm_global, overlapping data will be added @@ -2831,7 +2831,7 @@ CONTAINS index2send(proc)%array(data2send(proc)) = i_local END DO - END SUBROUTINE + END SUBROUTINE get_elements2send_col ! ************************************************************************************************** !> \brief ... @@ -2874,6 +2874,6 @@ CONTAINS index2send(proc)%array(data2send(proc)) = i_local END DO - END SUBROUTINE + END SUBROUTINE get_elements2send_row END MODULE rpa_grad diff --git a/src/rpa_gw.F b/src/rpa_gw.F index 40fb2e40af..7ee2508170 100644 --- a/src/rpa_gw.F +++ b/src/rpa_gw.F @@ -2023,7 +2023,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE add_dbcsr_submatrix ! ************************************************************************************************** !> \brief ... @@ -2109,7 +2109,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE create_cfm_double_row_col_size ! ************************************************************************************************** !> \brief ... @@ -2192,7 +2192,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE check_NaN ! ************************************************************************************************** !> \brief ... @@ -6709,7 +6709,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE contract_cubic_gw ! ************************************************************************************************** !> \brief ... @@ -6796,7 +6796,7 @@ CONTAINS vec_Sigma(mo_bounds_off(1):mo_bounds_off(2)) + vec_Sigma_prv CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE trace_sigma_gw ! ************************************************************************************************** !> \brief ... diff --git a/src/rpa_gw_ic.F b/src/rpa_gw_ic.F index 1e6b413210..4bfece0bfc 100644 --- a/src/rpa_gw_ic.F +++ b/src/rpa_gw_ic.F @@ -282,7 +282,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE trace_ic_gw ! ************************************************************************************************** !> \brief ... diff --git a/src/rpa_gw_im_time_util.F b/src/rpa_gw_im_time_util.F index add91fcf0b..056078f8fe 100644 --- a/src/rpa_gw_im_time_util.F +++ b/src/rpa_gw_im_time_util.F @@ -436,7 +436,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE get_tensor_3c_overl_int_gw ! ************************************************************************************************** !> \brief reflect from V = (A,B|B,A) to V_reflected = (B,A|A,B) where A belongs to the block of the molecule @@ -731,7 +731,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE reflect_mat_row ! ************************************************************************************************** !> \brief ... diff --git a/src/rpa_gw_kpoints_util.F b/src/rpa_gw_kpoints_util.F index b9a8db5d17..447bd2dab8 100644 --- a/src/rpa_gw_kpoints_util.F +++ b/src/rpa_gw_kpoints_util.F @@ -653,7 +653,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE get_dummys ! ************************************************************************************************** !> \brief ... @@ -680,7 +680,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE release_dummys ! ************************************************************************************************** !> \brief ... @@ -1414,7 +1414,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE compute_wkp_W ! ************************************************************************************************** !> \brief ... diff --git a/src/rpa_gw_sigma_x.F b/src/rpa_gw_sigma_x.F index 504a3638fe..ef1b9dd4e8 100644 --- a/src/rpa_gw_sigma_x.F +++ b/src/rpa_gw_sigma_x.F @@ -989,7 +989,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE transform_sigma_x_minus_vxc_to_MO_basis ! ************************************************************************************************** !> \brief ... @@ -1036,7 +1036,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE transform_matrix_ks_to_kp ! ************************************************************************************************** !> \brief ... @@ -1096,7 +1096,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE allocate_matrix_ks_kp END MODULE rpa_gw_sigma_x diff --git a/src/rpa_sigma_functional.F b/src/rpa_sigma_functional.F index b71b854846..622b7c2424 100644 --- a/src/rpa_sigma_functional.F +++ b/src/rpa_sigma_functional.F @@ -47,7 +47,7 @@ MODULE rpa_sigma_functional TYPE(cp_fm_type) :: fm_evec = cp_fm_type() REAL(KIND=dp), DIMENSION(:), ALLOCATABLE :: sigma_eigenvalue INTEGER :: dimen_RI_red = 0 - END TYPE + END TYPE rpa_sigma_type CONTAINS diff --git a/src/rt_propagation_forces.F b/src/rt_propagation_forces.F index 9a14a37c61..a84eb50190 100644 --- a/src/rt_propagation_forces.F +++ b/src/rt_propagation_forces.F @@ -146,7 +146,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE calc_c_mat_force ! ************************************************************************************************** !> \brief ... diff --git a/src/sockets_interface.F b/src/sockets_interface.F index 23bd2467a9..cb3a1f8a92 100644 --- a/src/sockets_interface.F +++ b/src/sockets_interface.F @@ -52,7 +52,7 @@ MODULE sockets_interface USE ISO_C_BINDING, ONLY: C_DOUBLE REAL(C_DOUBLE) :: sec - END SUBROUTINE + END SUBROUTINE uwait END INTERFACE INTERFACE @@ -135,7 +135,7 @@ CONTAINS CALL writebuffer_csocket(psockfd, c_loc(cdata), 8) CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE writebuffer_d ! ************************************************************************************************** !> \brief ... @@ -156,7 +156,7 @@ CONTAINS CALL writebuffer_csocket(psockfd, c_loc(cdata), 4) CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE writebuffer_i ! ************************************************************************************************** !> \brief ... @@ -183,7 +183,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE writebuffer_s ! ************************************************************************************************** !> \brief ... @@ -204,7 +204,7 @@ CONTAINS CALL writebuffer_csocket(psockfd, c_loc(fdata(1)), 8*plen) CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE writebuffer_dv ! ************************************************************************************************** !> \brief ... @@ -226,7 +226,7 @@ CONTAINS fdata = cdata CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE readbuffer_d ! ************************************************************************************************** !> \brief ... @@ -248,7 +248,7 @@ CONTAINS fdata = cdata CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE readbuffer_i ! ************************************************************************************************** !> \brief ... @@ -276,7 +276,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE readbuffer_s ! ************************************************************************************************** !> \brief ... @@ -298,7 +298,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE readbuffer_dv #endif END MODULE sockets_interface diff --git a/src/start/cp2k.F b/src/start/cp2k.F index 6d53f237d3..4e447bbb70 100644 --- a/src/start/cp2k.F +++ b/src/start/cp2k.F @@ -390,4 +390,4 @@ PROGRAM cp2k DEALLOCATE (initial_variables) CPASSERT(ierr == 0) -END PROGRAM +END PROGRAM cp2k diff --git a/src/start/libcp2k.F b/src/start/libcp2k.F index 39d7078677..c22a92bd14 100755 --- a/src/start/libcp2k.F +++ b/src/start/libcp2k.F @@ -55,7 +55,7 @@ MODULE libcp2k INTEGER :: idx = 1 CONTAINS PROCEDURE :: func => eri2array_func - END TYPE + END TYPE eri2array CONTAINS diff --git a/src/subsys/damping_dipole_types.F b/src/subsys/damping_dipole_types.F index d6edcadabc..9512e8b56a 100644 --- a/src/subsys/damping_dipole_types.F +++ b/src/subsys/damping_dipole_types.F @@ -44,7 +44,7 @@ MODULE damping_dipole_types TYPE damping_p_type TYPE(damping_type), DIMENSION(:), POINTER :: damp => NULL() - END TYPE + END TYPE damping_p_type ! ************************************************************************************************** diff --git a/src/subsys/shell_potential_types.F b/src/subsys/shell_potential_types.F index 4a5370b04f..0725baced7 100644 --- a/src/subsys/shell_potential_types.F +++ b/src/subsys/shell_potential_types.F @@ -84,7 +84,7 @@ CONTAINS IF (PRESENT(max_dist)) max_dist = shell%max_dist IF (PRESENT(shell_cutoff)) shell_cutoff = shell%shell_cutoff - END SUBROUTINE + END SUBROUTINE get_shell ! ************************************************************************************************** !> \brief ... diff --git a/src/task_list_methods.F b/src/task_list_methods.F index a9fca0a190..f08f621cdb 100644 --- a/src/task_list_methods.F +++ b/src/task_list_methods.F @@ -2892,7 +2892,7 @@ CONTAINS encoded_int = rank*n_levels + grid_level - 1 - END FUNCTION + END FUNCTION encode_rank ! ************************************************************************************************** !> \brief ... @@ -2908,7 +2908,7 @@ CONTAINS rank = INT(encoded_int/n_levels) - END FUNCTION + END FUNCTION decode_rank ! ************************************************************************************************** !> \brief ... diff --git a/src/tmc/tmc_moves.F b/src/tmc/tmc_moves.F index de3ab8dffd..8cb3ee00ce 100644 --- a/src/tmc/tmc_moves.F +++ b/src/tmc/tmc_moves.F @@ -396,7 +396,7 @@ CONTAINS ! convert to indeces mapped for the position array (multiple dim per atom) start_ind = (start_ind - 1)*tmc_params%dim_per_elem + 1 end_ind = (end_ind - 1)*tmc_params%dim_per_elem + 1 - END SUBROUTINE + END SUBROUTINE get_mol_indeces ! ************************************************************************************************** !> \brief checks if a position is within the sub box diff --git a/src/tmc/tmc_setup.F b/src/tmc/tmc_setup.F index 019e3a5b6b..072633d989 100644 --- a/src/tmc/tmc_setup.F +++ b/src/tmc/tmc_setup.F @@ -1046,4 +1046,4 @@ CONTAINS END SUBROUTINE tmc_print_params -END MODULE +END MODULE tmc_setup diff --git a/src/tmc/tmc_types.F b/src/tmc/tmc_types.F index 08c8627f52..b5acdfb166 100644 --- a/src/tmc/tmc_types.F +++ b/src/tmc/tmc_types.F @@ -124,7 +124,7 @@ MODULE tmc_types TYPE tmc_atom_type CHARACTER(LEN=default_string_length) :: name = "" REAL(KIND=dp) :: mass = 0.0_dp - END TYPE + END TYPE tmc_atom_type ! to estimate the prior acceptance TYPE prior_estimate_acceptance_type diff --git a/src/voronoi_interface.F b/src/voronoi_interface.F index 6d12cb04f1..43a068386f 100644 --- a/src/voronoi_interface.F +++ b/src/voronoi_interface.F @@ -814,7 +814,7 @@ CONTAINS INTEGER(KIND=C_INT) :: ret ret = libvori_finalize() #endif - END SUBROUTINE + END SUBROUTINE finalize_libvori ! ************************************************************************************************** !> \brief ... diff --git a/src/xc/cp_linked_list_xc_deriv.F b/src/xc/cp_linked_list_xc_deriv.F index 4d2702293c..c40057eca2 100644 --- a/src/xc/cp_linked_list_xc_deriv.F +++ b/src/xc/cp_linked_list_xc_deriv.F @@ -44,7 +44,7 @@ MODULE cp_linked_list_xc_deriv end if end do end if - end function + end function cp_sll_deriv_less_q #:enddef #:set private_routines = get_private_routines() @@ -52,4 +52,4 @@ MODULE cp_linked_list_xc_deriv #:endmute $:inst(nametype1, type1, type1in, type1out, eq, arrayeq, type1arrayEl, arrayEl, private_routines, default_init) -END MODULE +END MODULE cp_linked_list_xc_deriv diff --git a/src/xc/xc.F b/src/xc/xc.F index ec74d4e86f..313b533672 100644 --- a/src/xc/xc.F +++ b/src/xc/xc.F @@ -100,7 +100,7 @@ CONTAINS calc_potential=.FALSE.) res = (needs%tau_spin .OR. needs%tau) - END FUNCTION + END FUNCTION xc_uses_kinetic_energy_density ! ************************************************************************************************** !> \brief ... @@ -120,7 +120,7 @@ CONTAINS calc_potential=.FALSE.) res = (needs%norm_drho .OR. needs%norm_drho_spin) - END FUNCTION + END FUNCTION xc_uses_norm_drho ! ************************************************************************************************** !> \brief Exchange and Correlation functional calculations. @@ -4209,7 +4209,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE calc_drho_from_ab ! ************************************************************************************************** !> \brief allocates and calculates drho from given spin densities drhoa, drhob @@ -4239,7 +4239,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE calc_drho_from_a ! ************************************************************************************************** !> \brief allocates and calculates dot products of two density gradients diff --git a/src/xc/xc_rho_set_types.F b/src/xc/xc_rho_set_types.F index 055a803ba4..911a3944fc 100644 --- a/src/xc/xc_rho_set_types.F +++ b/src/xc/xc_rho_set_types.F @@ -464,7 +464,7 @@ CONTAINS $:recover(variable) #:endfor - END SUBROUTINE + END SUBROUTINE xc_rho_set_recover_pw SUBROUTINE xc_rho_set_recover_pw_low(rho_pw, rho, pw_grid, pw_pool, rhoa, rhob) TYPE(pw_r3d_rs_type), INTENT(OUT) :: rho_pw @@ -486,7 +486,7 @@ CONTAINS "have to be associated in rho_set!") END IF - END SUBROUTINE + END SUBROUTINE xc_rho_set_recover_pw_low ! ************************************************************************************************** !> \brief cleans (releases) most of the data stored in the rho_set giving back diff --git a/src/xc/xc_util.F b/src/xc/xc_util.F index c9bba484d5..a8f1cf6cad 100644 --- a/src/xc/xc_util.F +++ b/src/xc/xc_util.F @@ -61,7 +61,7 @@ CONTAINS requires = (xc_deriv_id == xc_deriv_spline2) .OR. & (xc_deriv_id == xc_deriv_spline3) .OR. & (xc_deriv_id == xc_deriv_pw) - END FUNCTION + END FUNCTION xc_requires_tmp_g ! ************************************************************************************************** !> \brief ... diff --git a/tools/precommit/fortitude.toml b/tools/precommit/fortitude.toml index f23a535a4f..9c3f139e3e 100644 --- a/tools/precommit/fortitude.toml +++ b/tools/precommit/fortitude.toml @@ -9,7 +9,6 @@ ignore = [ "missing-intent", "missing-exit-or-cycle-label", "assumed-size", - "unnamed-end-statement", "assumed-size-character-intent", "external-procedure", "literal-kind",