!--------------------------------------------------------------------------------------------------!
!   CP2K: A general program to perform molecular dynamics simulations                              !
!   Copyright (C) 2000 - 2018  CP2K developers group                                               !
!--------------------------------------------------------------------------------------------------!

! **************************************************************************************************
!> \brief Module with utility for  Nudged Elastic Band Calculation
!> \note
!>      Numerical accuracy for parallel runs:
!>       Each replica starts the SCF run from the one optimized
!>       in a previous run. It may happen then energies and derivatives
!>       of a serial run and a parallel run could be slightly different
!>       'cause of a different starting density matrix.
!>       Exact results are obtained using:
!>          EXTRAPOLATION USE_GUESS in QS section (Teo 09.2006)
!> \author Teodoro Laino 10.2006
! **************************************************************************************************
MODULE neb_utils
   USE bibliography,                    ONLY: E2002,&
                                              Elber1987,&
                                              Jonsson1998,&
                                              Jonsson2000_1,&
                                              Jonsson2000_2,&
                                              Wales2004,&
                                              cite_reference
   USE colvar_utils,                    ONLY: eval_colvar,&
                                              get_clv_force,&
                                              set_colvars_target
   USE cp_log_handling,                 ONLY: cp_get_default_logger,&
                                              cp_logger_type
   USE cp_output_handling,              ONLY: cp_print_key_finished_output,&
                                              cp_print_key_unit_nr
   USE cp_para_types,                   ONLY: cp_para_env_type
   USE cp_parser_methods,               ONLY: parser_get_next_line,&
                                              parser_get_object
   USE cp_parser_types,                 ONLY: cp_parser_type,&
                                              parser_create,&
                                              parser_release
   USE f77_interface,                   ONLY: f_env_add_defaults,&
                                              f_env_rm_defaults,&
                                              f_env_type,&
                                              get_energy,&
                                              get_force,&
                                              get_pos,&
                                              set_pos
   USE force_env_methods,               ONLY: force_env_calc_energy_force
   USE force_env_types,                 ONLY: force_env_get
   USE geo_opt,                         ONLY: cp_geo_opt
   USE global_types,                    ONLY: global_environment_type
   USE input_constants,                 ONLY: &
        band_diis_opt, do_b_neb, do_band_cartesian, do_ci_neb, do_d_neb, do_eb, do_it_neb, do_sm, &
        pot_neb_fe, pot_neb_full, pot_neb_me
   USE input_cp2k_check,                ONLY: remove_restart_info
   USE input_section_types,             ONLY: section_vals_get,&
                                              section_vals_get_subs_vals,&
                                              section_vals_type,&
                                              section_vals_val_get
   USE kinds,                           ONLY: default_path_length,&
                                              default_string_length,&
                                              dp
   USE mathlib,                         ONLY: matvec_3x3
   USE md_run,                          ONLY: qs_mol_dyn
   USE neb_io,                          ONLY: dump_replica_coordinates,&
                                              handle_band_file_names
   USE neb_md_utils,                    ONLY: neb_initialize_velocity
   USE neb_types,                       ONLY: neb_type,&
                                              neb_var_type
   USE particle_types,                  ONLY: particle_type
   USE physcon,                         ONLY: bohr
   USE replica_methods,                 ONLY: rep_env_calc_e_f
   USE replica_types,                   ONLY: rep_env_sync,&
                                              replica_env_type
   USE rmsd,                            ONLY: rmsd3
#include "../base/base_uses.f90"

   IMPLICIT NONE
   PRIVATE
   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'neb_utils'
   LOGICAL, PARAMETER, PRIVATE :: debug_this_module = .FALSE.

   PUBLIC :: build_replica_coords, &
             neb_calc_energy_forces, &
             reorient_images, &
             reparametrize_images, &
             check_convergence

CONTAINS

! **************************************************************************************************
!> \brief Computes the distance between two replica
!> \param particle_set ...
!> \param coords ...
!> \param i0 ...
!> \param i ...
!> \param distance ...
!> \param iw ...
!> \param rotate ...
!> \author Teodoro Laino 09.2006
! **************************************************************************************************
   SUBROUTINE neb_replica_distance(particle_set, coords, i0, i, distance, iw, rotate)
      TYPE(particle_type), DIMENSION(:), OPTIONAL, &
         POINTER                                         :: particle_set
      TYPE(neb_var_type), POINTER                        :: coords
      INTEGER, INTENT(IN)                                :: i0, i
      REAL(KIND=dp), INTENT(OUT)                         :: distance
      INTEGER, INTENT(IN)                                :: iw
      LOGICAL, INTENT(IN), OPTIONAL                      :: rotate

      CHARACTER(len=*), PARAMETER :: routineN = 'neb_replica_distance', &
         routineP = moduleN//':'//routineN

      LOGICAL                                            :: my_rotate

      my_rotate = .FALSE.
      IF (PRESENT(rotate)) my_rotate = rotate
      ! The rotation of the replica is enabled exclusively when working in
      ! cartesian coordinates
      IF (my_rotate .AND. (coords%in_use == do_band_cartesian)) THEN
         CPASSERT(PRESENT(particle_set))
         CALL rmsd3(particle_set, coords%xyz(:, i), coords%xyz(:, i0), &
                    iw, rotate=my_rotate)
      END IF
      distance = SQRT(DOT_PRODUCT(coords%wrk(:, i)-coords%wrk(:, i0), &
                                  coords%wrk(:, i)-coords%wrk(:, i0)))

   END SUBROUTINE neb_replica_distance

! **************************************************************************************************
!> \brief Constructs or Read the coordinates for all replica
!> \param neb_section ...
!> \param particle_set ...
!> \param coords ...
!> \param vels ...
!> \param neb_env ...
!> \param iw ...
!> \param globenv ...
!> \param para_env ...
!> \author Teodoro Laino 09.2006
! **************************************************************************************************
   SUBROUTINE build_replica_coords(neb_section, particle_set, &
                                   coords, vels, neb_env, iw, globenv, para_env)
      TYPE(section_vals_type), POINTER                   :: neb_section
      TYPE(particle_type), DIMENSION(:), POINTER         :: particle_set
      TYPE(neb_var_type), POINTER                        :: coords, vels
      TYPE(neb_type), POINTER                            :: neb_env
      INTEGER, INTENT(IN)                                :: iw
      TYPE(global_environment_type), POINTER             :: globenv
      TYPE(cp_para_env_type), POINTER                    :: para_env

      CHARACTER(len=*), PARAMETER :: routineN = 'build_replica_coords', &
         routineP = moduleN//':'//routineN

      CHARACTER(LEN=default_path_length)                 :: filename
      CHARACTER(LEN=default_string_length)               :: dummy_char
      INTEGER :: handle, i_rep, iatom, ic, input_nr_replica, is, ivar, j, jtarg, n_rep, natom, &
         neb_nr_replica, nr_replica_to_interpolate, nval, nvar, shell_index
      LOGICAL                                            :: check, explicit, my_end, skip_vel_section
      REAL(KIND=dp), ALLOCATABLE, DIMENSION(:)           :: distance
      REAL(KIND=dp), DIMENSION(3)                        :: r
      REAL(KIND=dp), DIMENSION(:), POINTER               :: initial_colvars, rptr
      TYPE(cp_parser_type), POINTER                      :: parser
      TYPE(section_vals_type), POINTER                   :: coord_section, replica_section, &
                                                            vel_section

      NULLIFY (parser)
      CALL timeset(routineN, handle)
      CPASSERT(ASSOCIATED(coords))
      CPASSERT(ASSOCIATED(vels))
      neb_nr_replica = neb_env%number_of_replica
      replica_section => section_vals_get_subs_vals(neb_section, "REPLICA")
      CALL section_vals_get(replica_section, n_repetition=input_nr_replica)
      ! Calculation is aborted if input replicas are more then the requested ones for the BAND..
      CPASSERT(input_nr_replica <= neb_nr_replica)
      ! Read in replicas coordinates
      skip_vel_section = (input_nr_replica /= neb_nr_replica)
      IF ((iw > 0) .AND. skip_vel_section) THEN
         WRITE (iw, '(T2,A)') 'NEB| The number of replica in the input is different from the number', &
            'NEB| of replica requested for NEB. More Replica will be interpolated.', &
            'NEB| Therefore the possibly provided velocities will not be read.'
      END IF
      ! Further check on velocity section...
      DO i_rep = 1, input_nr_replica
         vel_section => section_vals_get_subs_vals(replica_section, "VELOCITY", &
                                                   i_rep_section=i_rep)
         CALL section_vals_get(vel_section, explicit=explicit)
         skip_vel_section = skip_vel_section .OR. (.NOT. explicit)
      END DO
      ! Setup cartesian coordinates and COLVAR (if requested)
      coords%xyz(:, :) = 0.0_dp
      DO i_rep = 1, input_nr_replica
         coord_section => section_vals_get_subs_vals(replica_section, "COORD", &
                                                     i_rep_section=i_rep)
         CALL section_vals_get(coord_section, explicit=explicit)
         ! Cartesian Coordinates
         IF (explicit) THEN
            CALL section_vals_val_get(coord_section, "_DEFAULT_KEYWORD_", &
                                      n_rep_val=natom)
            CPASSERT((natom == SIZE(particle_set)))
            DO iatom = 1, natom
               CALL section_vals_val_get(coord_section, "_DEFAULT_KEYWORD_", &
                                         i_rep_val=iatom, r_vals=rptr)
               ic = 3*(iatom-1)
               coords%xyz(ic+1:ic+3, i_rep) = rptr(1:3)*bohr
               ! Initially core and shell positions are set to the atomic positions
               shell_index = particle_set(iatom)%shell_index
               IF (shell_index /= 0) THEN
                  is = 3*(natom+shell_index-1)
                  coords%xyz(is+1:is+3, i_rep) = coords%xyz(ic+1:ic+3, i_rep)
               END IF
            END DO
         ELSE
            CALL section_vals_val_get(replica_section, "COORD_FILE_NAME", &
                                      i_rep_section=i_rep, c_val=filename)
            CPASSERT(TRIM(filename) /= "")
            CALL parser_create(parser, filename, para_env=para_env, parse_white_lines=.TRUE.)
            CALL parser_get_next_line(parser, 1)
            ! Start parser
            CALL parser_get_object(parser, natom)
            CPASSERT((natom == SIZE(particle_set)))
            CALL parser_get_next_line(parser, 1)
            DO iatom = 1, natom
               ! Atom coordinates
               CALL parser_get_next_line(parser, 1, at_end=my_end)
               IF (my_end) &
                  CALL cp_abort(__LOCATION__, &
                                "Number of lines in XYZ format not equal to the number of atoms."// &
                                " Error in XYZ format for REPLICA coordinates. Very probably the"// &
                                " line with title is missing or is empty. Please check the XYZ file and rerun your job!")
               READ (parser%input_line, *) dummy_char, r(1:3)
               ic = 3*(iatom-1)
               coords%xyz(ic+1:ic+3, i_rep) = r(1:3)*bohr
               ! Initially core and shell positions are set to the atomic positions
               shell_index = particle_set(iatom)%shell_index
               IF (shell_index /= 0) THEN
                  is = 3*(natom+shell_index-1)
                  coords%xyz(is+1:is+3, i_rep) = coords%xyz(ic+1:ic+3, i_rep)
               END IF
            END DO
            CALL parser_release(parser)
         END IF
         ! Collective Variables
         IF (neb_env%use_colvar) THEN
            CALL section_vals_val_get(replica_section, "COLLECTIVE", &
                                      i_rep_section=i_rep, n_rep_val=n_rep)
            IF (n_rep /= 0) THEN
               ! Read the values of the collective variables
               NULLIFY (initial_colvars)
               CALL section_vals_val_get(replica_section, "COLLECTIVE", &
                                         i_rep_section=i_rep, r_vals=initial_colvars)
               check = (neb_env%nsize_int == SIZE(initial_colvars))
               CPASSERT(check)
               coords%int(:, i_rep) = initial_colvars
            ELSE
               ! Compute the values of the collective variables
               CALL eval_colvar(neb_env%force_env, coords%xyz(:, i_rep), coords%int(:, i_rep))
            END IF
         END IF
         ! Dump cartesian and colvar info..
         CALL dump_replica_coordinates(particle_set, coords, i_rep, i_rep, iw, neb_env%use_colvar)
         ! Setup Velocities
         IF (skip_vel_section) THEN
            CALL neb_initialize_velocity(vels%wrk, neb_section, particle_set, &
                                         i_rep, iw, globenv, neb_env)
         ELSE
            vel_section => section_vals_get_subs_vals(replica_section, "VELOCITY", &
                                                      i_rep_section=i_rep)
            CALL section_vals_val_get(vel_section, "_DEFAULT_KEYWORD_", &
                                      n_rep_val=nval)
            ! Setup Velocities for collective or cartesian coordinates
            IF (neb_env%use_colvar) THEN
               nvar = SIZE(vels%wrk, 1)
               CPASSERT(nval == nvar)
               DO ivar = 1, nvar
                  CALL section_vals_val_get(vel_section, "_DEFAULT_KEYWORD_", &
                                            i_rep_val=ivar, r_vals=rptr)
                  vels%wrk(ivar, i_rep) = rptr(1)
               END DO
            ELSE
               natom = SIZE(particle_set)
               CPASSERT(nval == natom)
               DO iatom = 1, natom
                  CALL section_vals_val_get(vel_section, "_DEFAULT_KEYWORD_", &
                                            i_rep_val=iatom, r_vals=rptr)
                  ic = 3*(iatom-1)
                  vels%wrk(ic+1:ic+3, i_rep) = rptr(1:3)
                  ! Initially set shell velocities to core velocity
                  shell_index = particle_set(iatom)%shell_index
                  IF (shell_index /= 0) THEN
                     is = 3*(natom+shell_index-1)
                     vels%wrk(is+1:is+3, i_rep) = vels%wrk(ic+1:ic+3, i_rep)
                  END IF
               END DO
            END IF
         END IF
      END DO ! i_rep
      ALLOCATE (distance(neb_nr_replica-1))
      IF (input_nr_replica < neb_nr_replica) THEN
         ! Interpolate missing replicas
         nr_replica_to_interpolate = neb_nr_replica-input_nr_replica
         distance = 0.0_dp
         IF (iw > 0) THEN
            WRITE (iw, '(T2,A,I0,A)') 'NEB| Interpolating ', nr_replica_to_interpolate, ' missing Replica.'
         END IF
         DO WHILE (nr_replica_to_interpolate > 0)
            ! Compute distances between known images to find the interval
            ! where to add a new image
            DO j = 1, input_nr_replica-1
               CALL neb_replica_distance(particle_set, coords, j, j+1, distance(j), iw, &
                                         rotate=neb_env%align_frames)
            END DO
            jtarg = MAXLOC(distance(1:input_nr_replica), 1)
            IF (iw > 0) THEN
               WRITE (iw, '(T2,3(A,I0),A)') 'NEB| Interpolating Nr. ', &
                  nr_replica_to_interpolate, ' missing Replica between Replica Nr. ', &
                  jtarg, ' and ', jtarg+1, '.'
            END IF
            input_nr_replica = input_nr_replica+1
            nr_replica_to_interpolate = nr_replica_to_interpolate-1
            ! Interpolation is a simple bisection in XYZ
            coords%xyz(:, jtarg+2:input_nr_replica) = coords%xyz(:, jtarg+1:input_nr_replica-1)
            coords%xyz(:, jtarg+1) = (coords%xyz(:, jtarg)+coords%xyz(:, jtarg+2))/2.0_dp
            IF (neb_env%use_colvar) THEN
               ! Interpolation is a simple bisection also in internal coordinates
               ! in this case the XYZ coordinates need only as a starting point for computing
               ! the potential energy function. The reference are the internal coordinates
               ! interpolated here after..
               coords%int(:, jtarg+2:input_nr_replica) = coords%int(:, jtarg+1:input_nr_replica-1)
               coords%int(:, jtarg+1) = (coords%int(:, jtarg)+coords%int(:, jtarg+2))/2.0_dp
            END IF
            vels%wrk(:, jtarg+2:input_nr_replica) = vels%wrk(:, jtarg+1:input_nr_replica-1)
            vels%wrk(:, jtarg+1) = 0.0_dp
            CALL dump_replica_coordinates(particle_set, coords, jtarg+1, &
                                          input_nr_replica, iw, neb_env%use_colvar)
            CALL neb_initialize_velocity(vels%wrk, neb_section, particle_set, &
                                         jtarg+1, iw, globenv, neb_env)
         END DO
      END IF
      vels%wrk(:, 1) = 0.0_dp
      vels%wrk(:, neb_nr_replica) = 0.0_dp
      ! If we perform a DIIS optimization we don't need velocities
      IF (neb_env%opt_type == band_diis_opt) vels%wrk = 0.0_dp
      ! Compute distances between replicas and in case of Cartesian Coordinates
      ! Rotate the frames in order to minimize the RMSD
      DO j = 1, input_nr_replica-1
         CALL neb_replica_distance(particle_set, coords, j, j+1, distance(j), iw, &
                                   rotate=neb_env%align_frames)
      END DO
      DEALLOCATE (distance)

      CALL timestop(handle)

   END SUBROUTINE build_replica_coords

! **************************************************************************************************
!> \brief Driver to compute energy and forces within a NEB,
!>      Based on the use of the replica_env
!> \param rep_env ...
!> \param neb_env ...
!> \param coords ...
!> \param energies ...
!> \param forces ...
!> \param particle_set ...
!> \param output_unit ...
!> \author Teodoro Laino 09.2006
! **************************************************************************************************
   SUBROUTINE neb_calc_energy_forces(rep_env, neb_env, coords, energies, forces, &
                                     particle_set, output_unit)
      TYPE(replica_env_type), POINTER                    :: rep_env
      TYPE(neb_type), OPTIONAL, POINTER                  :: neb_env
      TYPE(neb_var_type), POINTER                        :: coords
      REAL(KIND=dp), DIMENSION(:), INTENT(OUT)           :: energies
      TYPE(neb_var_type), POINTER                        :: forces
      TYPE(particle_type), DIMENSION(:), POINTER         :: particle_set
      INTEGER, INTENT(IN)                                :: output_unit

      CHARACTER(len=*), PARAMETER :: routineN = 'neb_calc_energy_forces', &
         routineP = moduleN//':'//routineN
      CHARACTER(LEN=1), DIMENSION(3), PARAMETER          :: lab = (/"X", "Y", "Z"/)

      INTEGER                                            :: handle, i, irep, j, n_int, n_rep, &
                                                            n_rep_neb, nsize_wrk
      REAL(KIND=dp), ALLOCATABLE, DIMENSION(:)           :: tangent, tmp_a, tmp_b
      REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :)        :: cvalues, Mmatrix, Mmatrix_tmp

      CALL timeset(routineN, handle)
      n_int = neb_env%nsize_int
      n_rep_neb = neb_env%number_of_replica
      n_rep = rep_env%nrep
      nsize_wrk = coords%size_wrk(1)
      energies = 0.0_dp
      ALLOCATE (cvalues(n_int, n_rep))
      ALLOCATE (Mmatrix_tmp(n_int*n_int, n_rep))
      ALLOCATE (Mmatrix(n_int*n_int, n_rep_neb))
      IF (output_unit > 0) WRITE (output_unit, '(/,T2,A)') "NEB| Computing Energies and Forces"
      DO irep = 1, n_rep_neb, n_rep
         DO j = 0, n_rep-1
            IF (irep+j <= n_rep_neb) THEN
               ! If the number of replica in replica_env and the number of replica
               ! used in the NEB does not match, the other replica in replica_env
               ! just compute energies and forces keeping the fixed coordinates and
               ! forces
               rep_env%r(:, j+1) = coords%xyz(:, irep+j)
            END IF
         END DO
         ! Fix file name for BAND replicas.. Each BAND replica has its own file
         ! independently from the number of replicas in replica_env..
         CALL handle_band_file_names(rep_env, irep, n_rep_neb, neb_env%istep)
         ! Let's select the potential we want to use for the band calculation
         SELECT CASE (neb_env%pot_type)
         CASE (pot_neb_full)
            ! Full potential Energy
            CALL rep_env_calc_e_f(rep_env, calc_f=.TRUE.)
         CASE (pot_neb_fe)
            ! Free Energy Case
            CALL perform_replica_md(rep_env, coords, irep, n_rep_neb, cvalues, Mmatrix_tmp)
         CASE (pot_neb_me)
            ! Minimum Potential Energy Case
            CALL perform_replica_geo(rep_env, coords, irep, n_rep_neb, cvalues, Mmatrix_tmp)
         END SELECT

         DO j = 0, n_rep-1
            IF (irep+j <= n_rep_neb) THEN
               ! Copy back Forces and Energies
               forces%wrk(:, irep+j) = rep_env%f(1:nsize_wrk, j+1)
               energies(irep+j) = rep_env%f(rep_env%ndim+1, j+1)
               SELECT CASE (neb_env%pot_type)
               CASE (pot_neb_full)
                  ! Dump Info
                  IF (output_unit > 0) THEN
                     WRITE (output_unit, '(T2,A,I5,A,I5,A)') &
                        "NEB| REPLICA Nr.", irep+j, "- Energy and Forces"
                     WRITE (output_unit, '(T2,A,T42,A,9X,F15.9)') &
                        "NEB|", " Total Energy: ", rep_env%f(rep_env%ndim+1, j+1)
                     WRITE (output_unit, '(T2,"NEB|",T10,"ATOM",T33,3(9X,A,7X))') lab(1), lab(2), lab(3)
                     DO i = 1, SIZE(particle_set)
                        WRITE (output_unit, '(T2,"NEB|",T12,A,T30,3(2X,F15.9))') &
                           particle_set(i)%atomic_kind%name, &
                           rep_env%f((i-1)*3+1:(i-1)*3+3, j+1)
                     END DO
                  END IF
               CASE (pot_neb_fe, pot_neb_me)
                  ! Let's update the cartesian coordinates. This will make
                  ! easier the next evaluation of energies and forces...
                  coords%xyz(:, irep+j) = rep_env%r(1:rep_env%ndim, j+1)
                  Mmatrix(:, irep+j) = Mmatrix_tmp(:, j+1)
                  IF (output_unit > 0) THEN
                     WRITE (output_unit, '(/,T2,A,I5,A,I5,A)') &
                        "NEB| REPLICA Nr.", irep+j, "- Energy, Collective Variables,  Forces"
                     WRITE (output_unit, '(T2,A,T42,A,9X,F15.9)') &
                        "NEB|", " Total Energy: ", rep_env%f(rep_env%ndim+1, j+1)
                     WRITE (output_unit, &
                            '(T2,"NEB|",T10,"CV Nr.",12X,"Expected COLVAR",5X,"Present COLVAR",10X,"Forces")')
                     DO i = 1, n_int
                        WRITE (output_unit, '(T2,"NEB|",T12,I2,7X,3(5X,F15.9))') &
                           i, coords%int(i, irep+j), cvalues(i, j+1), rep_env%f(i, j+1)
                     END DO
                  END IF
               END SELECT
            END IF
         END DO
      END DO
      DEALLOCATE (cvalues)
      DEALLOCATE (Mmatrix_tmp)
      IF (PRESENT(neb_env)) THEN
         ! First identify the image of the chain with the higher potential energy
         ! First and last point of the band are never considered
         neb_env%nr_HE_image = MAXLOC(energies(2:n_rep_neb-1), 1)+1
         ALLOCATE (tangent(nsize_wrk))
         ! Then modify image forces accordingly to the scheme chosen for the
         ! calculation.
         neb_env%spring_energy = 0.0_dp
         IF (neb_env%optimize_end_points) THEN
            ALLOCATE (tmp_a(SIZE(forces%wrk, 1)))
            ALLOCATE (tmp_b(SIZE(forces%wrk, 1)))
            tmp_a(:) = forces%wrk(:, 1)
            tmp_b(:) = forces%wrk(:, SIZE(forces%wrk, 2))
         END IF
         DO i = 2, neb_env%number_of_replica
            CALL get_tangent(neb_env, coords, i, tangent, energies, output_unit)
            CALL get_neb_force(neb_env, tangent, coords, i, forces, Mmatrix=Mmatrix, &
                               iw=output_unit)
         END DO
         IF (neb_env%optimize_end_points) THEN
            forces%wrk(:, 1) = tmp_a ! Image A
            forces%wrk(:, SIZE(forces%wrk, 2)) = tmp_b ! Image B
            DEALLOCATE (tmp_a)
            DEALLOCATE (tmp_b)
         ELSE
            ! Nullify forces on the two end points images
            forces%wrk(:, 1) = 0.0_dp ! Image A
            forces%wrk(:, SIZE(forces%wrk, 2)) = 0.0_dp ! Image B
         END IF
         DEALLOCATE (tangent)
      END IF
      DEALLOCATE (Mmatrix)
      CALL timestop(handle)
   END SUBROUTINE neb_calc_energy_forces

! **************************************************************************************************
!> \brief Driver to perform an MD run on each single replica to
!>      compute specifically Free Energies in a NEB scheme
!> \param rep_env ...
!> \param coords ...
!> \param irep ...
!> \param n_rep_neb ...
!> \param cvalues ...
!> \param Mmatrix ...
!> \author Teodoro Laino  01.2007
! **************************************************************************************************
   SUBROUTINE perform_replica_md(rep_env, coords, irep, n_rep_neb, cvalues, Mmatrix)
      TYPE(replica_env_type), POINTER                    :: rep_env
      TYPE(neb_var_type), POINTER                        :: coords
      INTEGER, INTENT(IN)                                :: irep, n_rep_neb
      REAL(KIND=dp), DIMENSION(:, :), INTENT(OUT)        :: cvalues, Mmatrix

      CHARACTER(len=*), PARAMETER :: routineN = 'perform_replica_md', &
         routineP = moduleN//':'//routineN

      INTEGER                                            :: handle, handle2, ierr, j, n_el
      LOGICAL                                            :: explicit
      TYPE(cp_logger_type), POINTER                      :: logger
      TYPE(f_env_type), POINTER                          :: f_env
      TYPE(global_environment_type), POINTER             :: globenv
      TYPE(section_vals_type), POINTER                   :: md_section, root_section

      CALL timeset(routineN, handle)
      CALL f_env_add_defaults(f_env_id=rep_env%f_env_id, f_env=f_env, &
                              handle=handle2)
      logger => cp_get_default_logger()
      CALL force_env_get(f_env%force_env, globenv=globenv, &
                         root_section=root_section)
      j = rep_env%local_rep_indices(1)-1
      n_el = 3*rep_env%nparticle
      Mmatrix = 0.0_dp
      ! Syncronize position on the replica procs
      CALL set_pos(rep_env%f_env_id, rep_env%r(:, j+1), n_el, ierr)
      CPASSERT(ierr == 0)
      !
      IF (irep+j <= n_rep_neb) THEN
         logger%iter_info%iteration(2) = irep+j
         CALL remove_restart_info(root_section)
         md_section => section_vals_get_subs_vals(root_section, "MOTION%MD")
         CALL section_vals_get(md_section, explicit=explicit)
         CPASSERT(explicit)
         ! Let's syncronize the target of Collective Variables for this run
         CALL set_colvars_target(coords%int(:, irep+j), f_env%force_env)
         ! Do a molecular dynamics and get back the derivative
         ! of the free energy w.r.t. the colvar and the metric tensor
         CALL qs_mol_dyn(f_env%force_env, globenv=globenv)
         ! Collect the equilibrated coordinates
         CALL get_pos(rep_env%f_env_id, rep_env%r(1:n_el, j+1), n_el, ierr)
         CPASSERT(ierr == 0)
         ! Write he gradients in the colvar coordinates into the replica_env array
         ! and copy back also the metric tensor..
         ! work in progress..
         CPABORT("")
         rep_env%f(:, j+1) = 0.0_dp
         Mmatrix = 0.0_dp
      ELSE
         rep_env%r(:, j+1) = 0.0_dp
         rep_env%f(:, j+1) = 0.0_dp
         cvalues(:, j+1) = 0.0_dp
         Mmatrix(:, j+1) = 0.0_dp
      END IF
      CALL rep_env_sync(rep_env, rep_env%f)
      CALL rep_env_sync(rep_env, rep_env%r)
      CALL rep_env_sync(rep_env, cvalues)
      CALL rep_env_sync(rep_env, Mmatrix)
      CALL f_env_rm_defaults(f_env=f_env, ierr=ierr, handle=handle2)
      CPASSERT(ierr == 0)
      CALL timestop(handle)
   END SUBROUTINE perform_replica_md

! **************************************************************************************************
!> \brief Driver to perform a GEO_OPT run on each single replica to
!>        compute specifically minimum energies in a collective variable
!>        NEB scheme
!> \param rep_env ...
!> \param coords ...
!> \param irep ...
!> \param n_rep_neb ...
!> \param cvalues ...
!> \param Mmatrix ...
!> \author Teodoro Laino 05.2007
! **************************************************************************************************
   SUBROUTINE perform_replica_geo(rep_env, coords, irep, n_rep_neb, cvalues, Mmatrix)
      TYPE(replica_env_type), POINTER                    :: rep_env
      TYPE(neb_var_type), POINTER                        :: coords
      INTEGER, INTENT(IN)                                :: irep, n_rep_neb
      REAL(KIND=dp), DIMENSION(:, :), INTENT(OUT)        :: cvalues, Mmatrix

      CHARACTER(len=*), PARAMETER :: routineN = 'perform_replica_geo', &
         routineP = moduleN//':'//routineN

      INTEGER                                            :: handle, handle2, ierr, j, n_el
      LOGICAL                                            :: explicit
      TYPE(cp_logger_type), POINTER                      :: logger
      TYPE(f_env_type), POINTER                          :: f_env
      TYPE(global_environment_type), POINTER             :: globenv
      TYPE(section_vals_type), POINTER                   :: geoopt_section, root_section

      CALL timeset(routineN, handle)
      CALL f_env_add_defaults(f_env_id=rep_env%f_env_id, f_env=f_env, &
                              handle=handle2)
      logger => cp_get_default_logger()
      CALL force_env_get(f_env%force_env, globenv=globenv, &
                         root_section=root_section)
      j = rep_env%local_rep_indices(1)-1
      n_el = 3*rep_env%nparticle
      Mmatrix = 0.0_dp
      ! Syncronize position on the replica procs
      CALL set_pos(rep_env%f_env_id, rep_env%r(:, j+1), n_el, ierr)
      CPASSERT(ierr == 0)
      IF (irep+j <= n_rep_neb) THEN
         logger%iter_info%iteration(2) = irep+j
         CALL remove_restart_info(root_section)
         geoopt_section => section_vals_get_subs_vals(root_section, "MOTION%GEO_OPT")
         CALL section_vals_get(geoopt_section, explicit=explicit)
         CPASSERT(explicit)
         ! Let's syncronize the target of Collective Variables for this run
         CALL set_colvars_target(coords%int(:, irep+j), f_env%force_env)
         ! Do a geometry optimization..
         CALL cp_geo_opt(f_env%force_env, globenv=globenv)
         ! Once the geometry optimization is ended let's do a single run
         ! without any constraints/restraints
         CALL force_env_calc_energy_force(f_env%force_env, &
                                          calc_force=.TRUE., skip_external_control=.TRUE.)
         ! Collect the optimized coordinates
         CALL get_pos(rep_env%f_env_id, rep_env%r(1:n_el, j+1), n_el, ierr)
         CPASSERT(ierr == 0)
         ! Collect the gradients in cartesian coordinates
         CALL get_force(rep_env%f_env_id, rep_env%f(1:n_el, j+1), n_el, ierr)
         CPASSERT(ierr == 0)
         ! Copy the energy
         CALL get_energy(rep_env%f_env_id, rep_env%f(n_el+1, j+1), ierr)
         CPASSERT(ierr == 0)
         ! The gradients in the colvar coordinates
         CALL get_clv_force(f_env%force_env, rep_env%f(1:n_el, j+1), rep_env%r(1:n_el, j+1), &
                            SIZE(coords%xyz, 1), SIZE(coords%wrk, 1), cvalues(:, j+1), Mmatrix(:, j+1))
      ELSE
         rep_env%r(:, j+1) = 0.0_dp
         rep_env%f(:, j+1) = 0.0_dp
         cvalues(:, j+1) = 0.0_dp
         Mmatrix(:, j+1) = 0.0_dp
      END IF
      CALL rep_env_sync(rep_env, rep_env%f)
      CALL rep_env_sync(rep_env, rep_env%r)
      CALL rep_env_sync(rep_env, cvalues)
      CALL rep_env_sync(rep_env, Mmatrix)
      CALL f_env_rm_defaults(f_env=f_env, ierr=ierr, handle=handle2)
      CPASSERT(ierr == 0)
      CALL timestop(handle)
   END SUBROUTINE perform_replica_geo

! **************************************************************************************************
!> \brief Computes the tangent for point i of the NEB chain
!> \param neb_env ...
!> \param coords ...
!> \param i ...
!> \param tangent ...
!> \param energies ...
!> \param iw ...
!> \author Teodoro Laino 09.2006
! **************************************************************************************************
   SUBROUTINE get_tangent(neb_env, coords, i, tangent, energies, iw)
      TYPE(neb_type), POINTER                            :: neb_env
      TYPE(neb_var_type), POINTER                        :: coords
      INTEGER, INTENT(IN)                                :: i
      REAL(KIND=dp), DIMENSION(:), INTENT(OUT)           :: tangent
      REAL(KIND=dp), DIMENSION(:), INTENT(IN)            :: energies
      INTEGER, INTENT(IN)                                :: iw

      CHARACTER(len=*), PARAMETER :: routineN = 'get_tangent', routineP = moduleN//':'//routineN

      REAL(KINd=dp)                                      :: distance0, distance1, distance2, DVmax, &
                                                            Dvmin

      CPASSERT(ASSOCIATED(coords))
      tangent(:) = 0.0_dp
      ! For the last point we don't need any tangent..
      IF (i == neb_env%number_of_replica) RETURN
      ! Several kind of tangents implemented...
      SELECT CASE (neb_env%id_type)
      CASE (do_eb)
         tangent(:) = 0.0_dp
      CASE (do_b_neb)
         CALL neb_replica_distance(coords=coords, i0=i, i=i-1, distance=distance1, iw=iw, &
                                   rotate=.FALSE.)
         CALL neb_replica_distance(coords=coords, i0=i+1, i=i, distance=distance2, iw=iw, &
                                   rotate=.FALSE.)
         tangent(:) = (coords%wrk(:, i)-coords%wrk(:, i-1))/distance1+ &
                      (coords%wrk(:, i+1)-coords%wrk(:, i))/distance2
      CASE (do_it_neb, do_ci_neb, do_d_neb)
         IF ((energies(i+1) .GT. energies(i)) .AND. (energies(i) .GT. (energies(i-1)))) THEN
            tangent(:) = coords%wrk(:, i+1)-coords%wrk(:, i)
         ELSE IF ((energies(i+1) .LT. energies(i)) .AND. (energies(i) .LT. (energies(i-1)))) THEN
            tangent(:) = coords%wrk(:, i)-coords%wrk(:, i-1)
         ELSE
            DVmax = MAX(ABS(energies(i+1)-energies(i)), ABS(energies(i-1)-energies(i)))
            DVmin = MIN(ABS(energies(i+1)-energies(i)), ABS(energies(i-1)-energies(i)))
            IF (energies(i+1) .GE. energies(i-1)) THEN
               tangent(:) = (coords%wrk(:, i+1)-coords%wrk(:, i))*DVmax+(coords%wrk(:, i)-coords%wrk(:, i-1))*DVmin
            ELSE
               tangent(:) = (coords%wrk(:, i+1)-coords%wrk(:, i))*DVmin+(coords%wrk(:, i)-coords%wrk(:, i-1))*DVmax
            END IF
         END IF
      CASE (do_sm)
         ! String method..
         tangent(:) = 0.0_dp
      END SELECT
      distance0 = SQRT(DOT_PRODUCT(tangent(:), tangent(:)))
      IF (distance0 /= 0.0_dp) tangent(:) = tangent(:)/distance0
   END SUBROUTINE get_tangent

! **************************************************************************************************
!> \brief Computes the forces for point i of the NEB chain
!> \param neb_env ...
!> \param tangent ...
!> \param coords ...
!> \param i ...
!> \param forces ...
!> \param tag ...
!> \param Mmatrix ...
!> \param iw ...
!> \author Teodoro Laino 09.2006
! **************************************************************************************************
   RECURSIVE SUBROUTINE get_neb_force(neb_env, tangent, coords, i, forces, tag, Mmatrix, &
                                      iw)
      TYPE(neb_type), POINTER                            :: neb_env
      REAL(KIND=dp), DIMENSION(:), INTENT(IN)            :: tangent
      TYPE(neb_var_type), POINTER                        :: coords
      INTEGER, INTENT(IN)                                :: i
      TYPE(neb_var_type), POINTER                        :: forces
      INTEGER, INTENT(IN), OPTIONAL                      :: tag
      REAL(KIND=dp), DIMENSION(:, :), INTENT(IN)         :: Mmatrix
      INTEGER, INTENT(IN)                                :: iw

      CHARACTER(len=*), PARAMETER :: routineN = 'get_neb_force', routineP = moduleN//':'//routineN

      INTEGER                                            :: j, my_tag, nsize_wrk
      REAL(KIND=dp)                                      :: distance1, distance2, fac, tmp
      REAL(KIND=dp), ALLOCATABLE, DIMENSION(:)           :: dtmp1, wrk

      my_tag = neb_env%id_type
      IF (PRESENT(tag)) my_tag = tag
      CPASSERT(ASSOCIATED(forces))
      CPASSERT(ASSOCIATED(coords))
      nsize_wrk = coords%size_wrk(1)
      ! All methods but not the classical elastic band will skip the force
      ! calculation for the last frame of the band
      SELECT CASE (my_tag)
      CASE (do_b_neb, do_it_neb, do_ci_neb, do_d_neb)
         IF (i == neb_env%number_of_replica) RETURN
      CASE (do_sm)
         ! String Method
         ! The forces do not require any projection. Reparametrization required
         ! after the update of the replica.
         CALL cite_reference(E2002)
         RETURN
      END SELECT
      ! otherwise proceeed normally..
      ALLOCATE (wrk(nsize_wrk))
      ! Spring Energy
      CALL neb_replica_distance(coords=coords, i0=i-1, i=i, distance=distance1, iw=iw, &
                                rotate=.FALSE.)
      tmp = distance1-neb_env%avg_distance
      neb_env%spring_energy = neb_env%spring_energy+0.5_dp*neb_env%k*tmp**2
      SELECT CASE (my_tag)
      CASE (do_eb)
         CALL cite_reference(Elber1987)
         ! Elastic band - Hamiltonian formulation according the original Karplus/Elber
         !                formulation
         ALLOCATE (dtmp1(nsize_wrk))
         ! derivatives of the spring
         tmp = distance1-neb_env%avg_distance
         dtmp1(:) = 1.0_dp/distance1*(coords%wrk(:, i)-coords%wrk(:, i-1))
         wrk(:) = neb_env%k*tmp*dtmp1
         forces%wrk(:, i) = forces%wrk(:, i)-wrk
         forces%wrk(:, i-1) = forces%wrk(:, i-1)+wrk
         ! derivatives due to the average length of the spring
         fac = 1.0_dp/(neb_env%avg_distance*REAL(neb_env%number_of_replica-1, KIND=dp))
         wrk(:) = neb_env%k*fac*(coords%wrk(:, i)-coords%wrk(:, i-1))
         tmp = 0.0_dp
         DO j = 2, neb_env%number_of_replica
            CALL neb_replica_distance(coords=coords, i0=j-1, i=j, distance=distance1, iw=iw, &
                                      rotate=.FALSE.)
            tmp = tmp+distance1-neb_env%avg_distance
         END DO
         forces%wrk(:, i) = forces%wrk(:, i)+wrk*tmp
         forces%wrk(:, i-1) = forces%wrk(:, i-1)-wrk*tmp
         DEALLOCATE (dtmp1)
      CASE (do_b_neb)
         ! Bisection NEB
         CALL cite_reference(Jonsson1998)
         wrk(:) = (coords%wrk(:, i+1)-2.0_dp*coords%wrk(:, i)+coords%wrk(:, i-1))
         tmp = neb_env%k*DOT_PRODUCT(wrk, tangent)
         wrk(:) = forces%wrk(:, i)-dot_product_band(neb_env, forces%wrk(:, i), tangent, Mmatrix)*tangent
         forces%wrk(:, i) = wrk+tmp*tangent
      CASE (do_it_neb)
         ! Improved tangent NEB
         CALL cite_reference(Jonsson2000_1)
         CALL neb_replica_distance(coords=coords, i0=i, i=i+1, distance=distance1, iw=iw, &
                                   rotate=.FALSE.)
         CALL neb_replica_distance(coords=coords, i0=i-1, i=i, distance=distance2, iw=iw, &
                                   rotate=.FALSE.)
         tmp = neb_env%k*(distance1-distance2)
         wrk(:) = forces%wrk(:, i)-dot_product_band(neb_env, forces%wrk(:, i), tangent, Mmatrix)*tangent
         forces%wrk(:, i) = wrk+tmp*tangent
      CASE (do_ci_neb)
         ! Climbing Image NEB
         CALL cite_reference(Jonsson2000_2)
         IF (neb_env%istep <= neb_env%nsteps_it .OR. i /= neb_env%nr_HE_image) THEN
            CALL get_neb_force(neb_env, tangent, coords, i, forces, do_it_neb, Mmatrix, iw)
         ELSE
            wrk(:) = forces%wrk(:, i)
            tmp = -2.0_dp*dot_product_band(neb_env, wrk, tangent, Mmatrix)
            forces%wrk(:, i) = wrk+tmp*tangent
         END IF
      CASE (do_d_neb)
         ! Doubly NEB
         CALL cite_reference(Wales2004)
         ALLOCATE (dtmp1(nsize_wrk))
         dtmp1(:) = forces%wrk(:, i)-dot_product_band(neb_env, forces%wrk(:, i), tangent, Mmatrix)*tangent
         forces%wrk(:, i) = dtmp1
         tmp = SQRT(DOT_PRODUCT(dtmp1, dtmp1))
         dtmp1(:) = dtmp1(:)/tmp
         ! Project out only the spring component interfering with the
         ! orthogonal gradient of the band
         wrk(:) = (coords%wrk(:, i+1)-2.0_dp*coords%wrk(:, i)+coords%wrk(:, i-1))
         tmp = DOT_PRODUCT(wrk, dtmp1)
         dtmp1(:) = neb_env%k*(wrk(:)-tmp*dtmp1(:))
         forces%wrk(:, i) = forces%wrk(:, i)+dtmp1(:)
         DEALLOCATE (dtmp1)
      END SELECT
      DEALLOCATE (wrk)
   END SUBROUTINE get_neb_force

! **************************************************************************************************
!> \brief  Handles the dot_product when using colvar.. in this case
!>         the scalar product needs to take into account the metric
!>         tensor
!> \param neb_env ...
!> \param array1 ...
!> \param array2 ...
!> \param array3 ...
!> \return ...
!> \author Teodoro Laino 09.2006
! **************************************************************************************************
   FUNCTION dot_product_band(neb_env, array1, array2, array3) RESULT(value)
      TYPE(neb_type), POINTER                            :: neb_env
      REAL(KIND=dp), DIMENSION(:), INTENT(IN)            :: array1, array2
      REAL(KIND=dp), DIMENSION(:, :), INTENT(IN)         :: array3
      REAL(KIND=dp)                                      :: value

      CHARACTER(len=*), PARAMETER :: routineN = 'dot_product_band', &
         routineP = moduleN//':'//routineN

      INTEGER                                            :: nsize_int
      LOGICAL                                            :: check

      IF (neb_env%use_colvar) THEN
         nsize_int = neb_env%nsize_int
         check = ((SIZE(array1) /= SIZE(array2)) .OR. &
                  (SIZE(array1) /= nsize_int) .OR. &
                  (SIZE(array3) /= nsize_int*nsize_int))
         ! This condition should always be satisfied..
         CPASSERT(check)
         value = DOT_PRODUCT(MATMUL(RESHAPE(array3, (/nsize_int, nsize_int/)), array1), array2)
      ELSE
         value = DOT_PRODUCT(array1, array2)
      END IF
   END FUNCTION dot_product_band

! **************************************************************************************************
!> \brief Reorient iteratively all images of the NEB chain in order to
!>      have always the smaller RMSD between two following images
!> \param rotate_frames ...
!> \param particle_set ...
!> \param coords ...
!> \param vels ...
!> \param iw ...
!> \param distances ...
!> \param number_of_replica ...
!> \author Teodoro Laino 09.2006
! **************************************************************************************************
   SUBROUTINE reorient_images(rotate_frames, particle_set, coords, vels, iw, &
                              distances, number_of_replica)
      LOGICAL, INTENT(IN)                                :: rotate_frames
      TYPE(particle_type), DIMENSION(:), OPTIONAL, &
         POINTER                                         :: particle_set
      TYPE(neb_var_type), POINTER                        :: coords, vels
      INTEGER, INTENT(IN)                                :: iw
      REAL(KIND=dp), DIMENSION(:), OPTIONAL              :: distances
      INTEGER, INTENT(IN)                                :: number_of_replica

      CHARACTER(len=*), PARAMETER :: routineN = 'reorient_images', &
         routineP = moduleN//':'//routineN

      INTEGER                                            :: i, k, kind
      LOGICAL                                            :: check
      REAL(KIND=dp)                                      :: xtmp
      REAL(KIND=dp), DIMENSION(3)                        :: tmp
      REAL(KIND=dp), DIMENSION(3, 3)                     :: rot

      rot = 0.0_dp
      rot(1, 1) = 1.0_dp
      rot(2, 2) = 1.0_dp
      rot(3, 3) = 1.0_dp
      DO i = 2, number_of_replica
         ! The rotation of the replica is enabled exclusively when working in
         ! cartesian coordinates
         IF (rotate_frames .AND. (coords%in_use == do_band_cartesian)) THEN
            CALL rmsd3(particle_set, coords%xyz(:, i), coords%xyz(:, i-1), iw, &
                       rotate=.TRUE., rot=rot)
            ! Rotate velocities
            DO k = 1, SIZE(vels%xyz, 1)/3
               kind = (k-1)*3
               tmp = vels%xyz(kind+1:kind+3, i)
               CALL matvec_3x3(vels%xyz(kind+1:kind+3, i), TRANSPOSE(rot), tmp)
            END DO
         END IF
         IF (PRESENT(distances)) THEN
            check = SIZE(distances) == (number_of_replica-1)
            CPASSERT(check)
            xtmp = DOT_PRODUCT(coords%wrk(:, i)-coords%wrk(:, i-1), &
                               coords%wrk(:, i)-coords%wrk(:, i-1))
            distances(i-1) = SQRT(xtmp)
         END IF
      END DO
   END SUBROUTINE reorient_images

! **************************************************************************************************
!> \brief Reparametrization of the replica for String Method with splines
!> \param reparametrize_frames ...
!> \param spline_order ...
!> \param smoothing ...
!> \param coords ...
!> \param sline ...
!> \param distances ...
!> \author Teodoro Laino - Rodolphe Vuilleumier 09.2008
! **************************************************************************************************
   SUBROUTINE reparametrize_images(reparametrize_frames, spline_order, smoothing, &
                                   coords, sline, distances)

      LOGICAL, INTENT(IN)                                :: reparametrize_frames
      INTEGER, INTENT(IN)                                :: spline_order
      REAL(KIND=dp), INTENT(IN)                          :: smoothing
      REAL(KIND=dp), DIMENSION(:, :), POINTER            :: coords, sline
      REAL(KIND=dp), DIMENSION(:)                        :: distances

      CHARACTER(len=*), PARAMETER :: routineN = 'reparametrize_images', &
         routineP = moduleN//':'//routineN

      INTEGER                                            :: i, j
      REAL(KIND=dp)                                      :: avg_distance, xtmp
      REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :)        :: tmp_coords

      IF (reparametrize_frames) THEN
         ALLOCATE (tmp_coords(SIZE(coords, 1), SIZE(coords, 2)))
         tmp_coords(:, :) = coords
         ! Smoothing
         DO i = 2, SIZE(coords, 2)-1
            coords(:, i) = tmp_coords(:, i)*(1.0_dp-2.0_dp*smoothing)+ &
                           tmp_coords(:, i-1)*smoothing+tmp_coords(:, i+1)*smoothing
         END DO
         sline = coords-tmp_coords+sline
         tmp_coords(:, :) = coords
         ! Reparametrization
         SELECT CASE (spline_order)
         CASE (1)
            ! Compute distances
            DO i = 2, SIZE(coords, 2)
               xtmp = DOT_PRODUCT(coords(:, i)-coords(:, i-1), coords(:, i)-coords(:, i-1))
               distances(i-1) = SQRT(xtmp)
            END DO
            avg_distance = SUM(distances)/REAL(SIZE(coords, 2)-1, KIND=dp)
            ! Redistribute frames
            DO i = 2, SIZE(coords, 2)-1
               xtmp = 0.0_dp
               DO j = 1, SIZE(coords, 2)-1
                  xtmp = xtmp+distances(j)
                  IF (xtmp > avg_distance*REAL(i-1, KIND=dp)) THEN
                     xtmp = (xtmp-avg_distance*REAL(i-1, KIND=dp))/distances(j)
                     coords(:, i) = (1.0_dp-xtmp)*tmp_coords(:, j+1)+xtmp*tmp_coords(:, j)
                     EXIT
                  END IF
               END DO
            END DO
            ! Re-compute distances
            DO i = 2, SIZE(coords, 2)
               xtmp = DOT_PRODUCT(coords(:, i)-coords(:, i-1), coords(:, i)-coords(:, i-1))
               distances(i-1) = SQRT(xtmp)
            END DO
         CASE DEFAULT
            CPWARN("String Method: Spline order greater than 1 not implemented.")
         END SELECT
         sline = coords-tmp_coords+sline
         DEALLOCATE (tmp_coords)
      END IF
   END SUBROUTINE reparametrize_images

! **************************************************************************************************
!> \brief Checks for convergence criteria during a NEB run
!> \param neb_env ...
!> \param Dcoords ...
!> \param forces ...
!> \return ...
!> \author Teodoro Laino 10.2006
! **************************************************************************************************
   FUNCTION check_convergence(neb_env, Dcoords, forces) RESULT(converged)
      TYPE(neb_type), POINTER                            :: neb_env
      TYPE(neb_var_type), POINTER                        :: Dcoords, forces
      LOGICAL                                            :: converged

      CHARACTER(len=*), PARAMETER :: routineN = 'check_convergence', &
         routineP = moduleN//':'//routineN

      CHARACTER(LEN=3), DIMENSION(4)                     :: labels
      INTEGER                                            :: iw
      REAL(KIND=dp)                                      :: max_dr, max_force, my_max_dr, &
                                                            my_max_force, my_rms_dr, my_rms_force, &
                                                            rms_dr, rms_force
      TYPE(cp_logger_type), POINTER                      :: logger
      TYPE(section_vals_type), POINTER                   :: cc_section

      NULLIFY (logger, cc_section)
      logger => cp_get_default_logger()
      cc_section => section_vals_get_subs_vals(neb_env%neb_section, "CONVERGENCE_CONTROL")
      CALL section_vals_val_get(cc_section, "MAX_DR", r_val=max_dr)
      CALL section_vals_val_get(cc_section, "MAX_FORCE", r_val=max_force)
      CALL section_vals_val_get(cc_section, "RMS_DR", r_val=rms_dr)
      CALL section_vals_val_get(cc_section, "RMS_FORCE", r_val=rms_force)
      converged = .FALSE.
      labels = " NO"
      my_max_dr = MAXVAL(ABS(Dcoords%wrk))
      my_max_force = MAXVAL(ABS(forces%wrk))
      my_rms_dr = SQRT(SUM(Dcoords%wrk*Dcoords%wrk)/REAL(SIZE(Dcoords%wrk, 1)*SIZE(Dcoords%wrk, 2), KIND=dp))
      my_rms_force = SQRT(SUM(forces%wrk*forces%wrk)/REAL(SIZE(forces%wrk, 1)*SIZE(forces%wrk, 2), KIND=dp))
      IF (my_max_dr < max_dr) labels(1) = "YES"
      IF (my_max_force < max_force) labels(2) = "YES"
      IF (my_rms_dr < rms_dr) labels(3) = "YES"
      IF (my_rms_force < rms_force) labels(4) = "YES"
      IF (ALL(labels == "YES")) converged = .TRUE.

      iw = cp_print_key_unit_nr(logger, neb_env%neb_section, "CONVERGENCE_INFO", &
                                extension=".nebLog")
      IF (iw > 0) THEN
         ! Print convergence info
         WRITE (iw, FMT='(A,A)') ' **************************************', &
            '*****************************************'
         WRITE (iw, FMT='(1X,A,2X,F8.5,5X,"[",F8.5,"]",1X,T76,"(",A,")")') &
            'RMS DISPLACEMENT =', my_rms_dr, rms_dr, labels(3), &
            'MAX DISPLACEMENT =', my_max_dr, max_dr, labels(1), &
            'RMS FORCE        =', my_rms_force, rms_force, labels(4), &
            'MAX FORCE        =', my_max_force, max_force, labels(2)
         WRITE (iw, FMT='(A,A)') ' **************************************', &
            '*****************************************'
      END IF
      CALL cp_print_key_finished_output(iw, logger, neb_env%neb_section, &
                                        "CONVERGENCE_INFO")
   END FUNCTION check_convergence

END MODULE neb_utils
