scnc
/
quantum-espresso
mirror of https://gitlab.com/QEF/q-e.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity
quantum-espresso/Modules/path_opt_routines.f90

400 lines
12 KiB
Fortran
Raw Blame History

!
! Copyright (C) 2003-2004 PWSCF-FPMD-CPV group
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
#define USE_SMART_STEP
!#define DEBUG_SMART_STEP
!
!--------------------------------------------------------------------------
MODULE path_opt_routines
!---------------------------------------------------------------------------
!
! ... This module contains all subroutines and functions needed for
! ... the optimization of the reaction path (NEB and SMD calculations)
! ... Written by Carlo Sbraccia ( 2003-2004 )
!
USE kinds, ONLY : DP
USE constants, ONLY : eps32
USE path_variables, ONLY : ds
USE path_variables, ONLY : pos, grad, norm_grad, frozen
USE path_variables, ONLY : ft_pos, ft_grad, norm_ft_grad, ft_frozen
!
USE basic_algebra_routines
!
IMPLICIT NONE
!
CONTAINS
!
! ... "real space" routines
!
!----------------------------------------------------------------------
SUBROUTINE r_steepest_descent( index )
!----------------------------------------------------------------------
!
! ... this routine is also used for the langevin dynamics
!
USE path_variables, ONLY : llangevin, lang
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: index
!
!
IF ( frozen(index) ) RETURN
!
pos(:,index) = pos(:,index) - ds * grad(:,index)
!
IF ( llangevin ) &
pos(:,index) = pos(:,index) + SQRT( ds ) * lang(:,index)
!
RETURN
!
END SUBROUTINE r_steepest_descent
!
! ... Molecular Dynamics based algorithms
! ... velocity Verlet and quick min
!
!----------------------------------------------------------------------
SUBROUTINE r_velocity_Verlet_first_step( index )
!----------------------------------------------------------------------
!
USE path_variables, ONLY : vel, vel_zeroed, pos_old, grad_old
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: index
!
!
IF ( frozen(index) ) RETURN
!
! ... pos_old and grad_old are updated here
!
pos_old(:,index) = pos(:,index)
grad_old(:,index) = grad(:,index)
!
IF ( vel_zeroed(index) ) THEN
!
vel(:,index) = vel(:,index) - 0.5D0 * grad(:,index)
!
pos(:,index) = pos(:,index) + vel(:,index)
!
vel_zeroed(index) = .FALSE.
!
ELSE
!
vel(:,index) = vel(:,index) - 0.5D0 * ds * grad(:,index)
!
pos(:,index) = pos(:,index) + ds * vel(:,index)
!
END IF
!
RETURN
!
END SUBROUTINE r_velocity_Verlet_first_step
!
!
!----------------------------------------------------------------------
SUBROUTINE r_velocity_Verlet_second_step( index )
!----------------------------------------------------------------------
!
USE path_variables, ONLY : vel, damp, ldamped_dyn, lmol_dyn
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: index
!
!
IF ( frozen(index) ) RETURN
!
IF ( ldamped_dyn ) THEN
!
vel(:,index) = damp * ( vel(:,index) - &
0.5D0 * ds * grad(:,index) )
!
ELSE IF ( lmol_dyn ) THEN
!
vel(:,index) = vel(:,index) - 0.5D0 * ds * grad(:,index)
!
END IF
!
RETURN
!
END SUBROUTINE r_velocity_Verlet_second_step
!
!----------------------------------------------------------------------
SUBROUTINE r_quick_min_second_step( index )
!----------------------------------------------------------------------
!
USE constants, ONLY : eps8
USE path_variables, ONLY : pos_old, grad_old, vel, &
dim, vel_zeroed
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: index
REAL (KIND=DP) :: force_versor(dim)
REAL (KIND=DP) :: vel_component
REAL (KIND=DP), ALLOCATABLE :: y(:), s(:)
!
!
IF ( frozen(index) ) RETURN
!
vel(:,index) = vel(:,index) - 0.5D0 * ds * grad(:,index)
!
IF ( norm_grad(index) > eps32 ) THEN
!
force_versor = - grad(:,index) / norm_grad(index)
!
vel_component = ( vel(:,index) .dot. force_versor )
!
IF ( vel_component > 0.D0 ) THEN
!
vel(:,index) = vel_component * force_versor
!
ELSE
!
#if defined (DEBUG_SMART_STEP) && defined (USE_SMART_STEP)
PRINT '(/5X,"IMAGE = ",I2," resetting velocity"/)', index
#endif
!
vel(:,index) = 0.D0
!
#if defined (USE_SMART_STEP)
!
vel_zeroed(index) = .TRUE.
!
! ... an approximate newton-raphson step is performed
!
IF ( norm( pos_old(:,index) ) > 0.D0 .AND. &
norm( grad_old(:,index) ) > 0.D0 ) THEN
!
ALLOCATE( y( dim ), s( dim ) )
!
y = grad(:,index) - grad_old(:,index)
s = pos(:,index) - pos_old(:,index)
!
# if defined (DEBUG_SMART_STEP)
PRINT '(5X,"projection = ",F7.4)', &
( s .dot. grad(:,index) ) / &
( norm( s ) * norm_grad(index) )
# endif
!
IF ( ABS( y .dot. s ) > eps8 ) THEN
!
grad(:,index) = 2.D0 * s * &
ABS( ( s .dot. grad(:,index) ) / ( y .dot. s ) )
!
END IF
!
# if defined (DEBUG_SMART_STEP)
PRINT '(5X,"step length: ",F12.8)', norm( grad(:,index) )
# endif
!
DEALLOCATE( y, s )
!
END IF
!
#endif
!
END IF
!
ELSE
!
vel(:,index) = 0.D0
!
END IF
!
RETURN
!
END SUBROUTINE r_quick_min_second_step
!
! ... "reciprocal space" routines
!
! ... steepest descent
!
!----------------------------------------------------------------------
SUBROUTINE ft_steepest_descent( mode )
!----------------------------------------------------------------------
!
! ... this routine is also used for the langevin dynamics
!
USE path_variables, ONLY : llangevin, ft_lang
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: mode
!
!
IF ( ft_frozen(mode) ) RETURN
!
ft_pos(:,mode) = ft_pos(:,mode) - ds * ft_grad(:,mode)
!
IF ( llangevin ) &
ft_pos(:,mode) = ft_pos(:,mode) + SQRT( ds ) * ft_lang(:,mode)
!
RETURN
!
END SUBROUTINE ft_steepest_descent
!
! ... Molecular Dynamics based algorithms
! ... velocity Verlet and quick min
!
!----------------------------------------------------------------------
SUBROUTINE ft_velocity_Verlet_first_step( mode )
!----------------------------------------------------------------------
!
USE path_variables, ONLY : ft_vel, ft_vel_zeroed, &
ft_pos_old, ft_grad_old
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: mode
!
!
IF ( ft_frozen(mode) ) RETURN
!
! ... ft_pos_old and ft_grad_old are updated here
!
ft_pos_old(:,mode) = ft_pos(:,mode)
ft_grad_old(:,mode) = ft_grad(:,mode)
!
IF ( ft_vel_zeroed(mode) ) THEN
!
ft_vel(:,mode) = ft_vel(:,mode) - 0.5D0 * ft_grad(:,mode)
!
ft_pos(:,mode) = ft_pos(:,mode) + ft_vel(:,mode)
!
ft_vel_zeroed(mode) = .FALSE.
!
ELSE
!
ft_vel(:,mode) = ft_vel(:,mode) - &
0.5D0 * ds * ft_grad(:,mode)
!
ft_pos(:,mode) = ft_pos(:,mode) + ds * ft_vel(:,mode)
!
END IF
!
RETURN
!
END SUBROUTINE ft_velocity_Verlet_first_step
!
!----------------------------------------------------------------------
SUBROUTINE ft_velocity_Verlet_second_step( mode )
!----------------------------------------------------------------------
!
USE path_variables, ONLY : ft_vel, damp, ldamped_dyn, lmol_dyn
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: mode
!
!
IF ( ft_frozen(mode) ) RETURN
!
IF ( ldamped_dyn ) THEN
!
ft_vel(:,mode) = damp * ( ft_vel(:,mode) - &
0.5D0 * ds * ft_grad(:,mode) )
!
ELSE IF ( lmol_dyn ) THEN
!
ft_vel(:,mode) = ft_vel(:,mode) - 0.5D0 * ds * ft_grad(:,mode)
!
END IF
!
RETURN
!
END SUBROUTINE ft_velocity_Verlet_second_step
!
!----------------------------------------------------------------------
SUBROUTINE ft_quick_min_second_step( mode )
!----------------------------------------------------------------------
!
USE constants, ONLY : eps8
USE path_variables, ONLY : ft_pos_old, ft_grad_old, &
ft_vel, dim, ft_vel_zeroed
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: mode
REAL (KIND=DP) :: ft_force_versor(dim)
REAL (KIND=DP) :: ft_vel_component
REAL (KIND=DP), ALLOCATABLE :: y(:), s(:)
!
!
IF ( ft_frozen(mode) ) RETURN
!
ft_vel(:,mode) = ft_vel(:,mode) - 0.5D0 * ds * ft_grad(:,mode)
!
IF ( norm_ft_grad(mode) > eps32 ) THEN
!
ft_force_versor = - ft_grad(:,mode) / norm_ft_grad(mode)
!
ft_vel_component = ( ft_vel(:,mode) .dot. ft_force_versor )
!
IF ( ft_vel_component > 0.D0 ) THEN
!
ft_vel(:,mode) = ft_vel_component * ft_force_versor
!
ELSE
!
#if defined (DEBUG_SMART_STEP) && defined (USE_SMART_STEP)
PRINT '(/5X,"MODE = ",I2," resetting velocity"/)', mode
#endif
!
ft_vel(:,mode) = 0.D0
!
#if defined (USE_SMART_STEP)
!
ft_vel_zeroed(mode) = .TRUE.
!
! ... an approximate newton-raphson step is performed
!
IF ( norm( ft_pos_old(:,mode) ) > 0.D0 .AND. &
norm( ft_grad_old(:,mode) ) > 0.D0 ) THEN
!
ALLOCATE( y( dim ), s( dim ) )
!
y = ft_grad(:,mode) - ft_grad_old(:,mode)
s = ft_pos(:,mode) - ft_pos_old(:,mode)
!
# if defined (DEBUG_SMART_STEP)
PRINT '(5X,"projection = ",F7.4)', &
( s .dot. ft_grad(:,mode) ) / ( norm( s ) * norm_ft_grad(mode) )
# endif
!
IF ( ABS( y .dot. s ) > eps8 ) THEN
!
ft_grad(:,mode) = 2.D0 * s * &
ABS( ( s .dot. ft_grad(:,mode) ) / ( y .dot. s ) )
!
END IF
!
# if defined (DEBUG_SMART_STEP)
PRINT '(5X,"step length: ",F12.8)', norm( ft_grad(:,mode) )
# endif
!
DEALLOCATE( y, s )
!
END IF
!
#endif
!
END IF
!
ELSE
!
ft_vel(:,mode) = 0.D0
!
END IF
!
RETURN
!
END SUBROUTINE ft_quick_min_second_step
!
END MODULE path_opt_routines
Reference in New Issue View Git Blame Copy Permalink