Line data Source code
1 : !--------------------------------------------------------------------------------------------------! 2 : ! CP2K: A general program to perform molecular dynamics simulations ! 3 : ! Copyright 2000-2024 CP2K developers group <https://cp2k.org> ! 4 : ! ! 5 : ! SPDX-License-Identifier: GPL-2.0-or-later ! 6 : !--------------------------------------------------------------------------------------------------! 7 : 8 : ! ************************************************************************************************** 9 : !> \brief Definition of the semi empirical parameter types. 10 : !> \author Teodoro Laino [tlaino] - 10.2008 University of Zurich 11 : ! ************************************************************************************************** 12 : MODULE taper_types 13 : 14 : USE kinds, ONLY: dp 15 : #include "./base/base_uses.f90" 16 : 17 : IMPLICIT NONE 18 : 19 : PRIVATE 20 : 21 : ! *** Global parameters *** 22 : 23 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'taper_types' 24 : 25 : ! ************************************************************************************************** 26 : !> \brief Taper type 27 : ! ************************************************************************************************** 28 : TYPE taper_type 29 : LOGICAL :: apply_taper = .FALSE. 30 : REAL(KIND=dp) :: r0 = -1.0_dp, rscale = -1.0_dp 31 : END TYPE taper_type 32 : 33 : PUBLIC :: taper_type, taper_create, taper_release, taper_eval, dtaper_eval 34 : 35 : CONTAINS 36 : 37 : ! ************************************************************************************************** 38 : !> \brief Creates taper type 39 : !> \param taper ... 40 : !> \param rc ... 41 : !> \param range ... 42 : ! ************************************************************************************************** 43 2030 : SUBROUTINE taper_create(taper, rc, range) 44 : TYPE(taper_type), POINTER :: taper 45 : REAL(KIND=dp), INTENT(IN) :: rc, range 46 : 47 2030 : CPASSERT(.NOT. ASSOCIATED(taper)) 48 2030 : ALLOCATE (taper) 49 2030 : IF (range > EPSILON(0.0_dp)) THEN 50 104 : taper%apply_taper = .TRUE. 51 104 : CPASSERT(range > 0.0_dp) 52 104 : taper%r0 = 2.0_dp*rc - 20.0_dp*range 53 104 : taper%rscale = 1.0_dp/range 54 : ELSE 55 : taper%apply_taper = .FALSE. 56 : END IF 57 : 58 2030 : END SUBROUTINE taper_create 59 : 60 : ! ************************************************************************************************** 61 : !> \brief Releases taper type 62 : !> \param taper ... 63 : ! ************************************************************************************************** 64 3992 : SUBROUTINE taper_release(taper) 65 : TYPE(taper_type), POINTER :: taper 66 : 67 3992 : IF (ASSOCIATED(taper)) THEN 68 2030 : DEALLOCATE (taper) 69 : END IF 70 3992 : END SUBROUTINE taper_release 71 : 72 : ! ************************************************************************************************** 73 : !> \brief Taper functions 74 : !> \param taper ... 75 : !> \param rij ... 76 : !> \return ... 77 : ! ************************************************************************************************** 78 17147276 : FUNCTION taper_eval(taper, rij) RESULT(ft) 79 : TYPE(taper_type), POINTER :: taper 80 : REAL(KIND=dp), INTENT(IN) :: rij 81 : REAL(KIND=dp) :: ft 82 : 83 : REAL(KIND=dp) :: dr 84 : 85 17147276 : ft = 1._dp 86 17147276 : IF (taper%apply_taper) THEN 87 3899139 : dr = taper%rscale*(rij - taper%r0) 88 3899139 : ft = 0.5_dp*(1.0_dp - TANH(dr)) 89 : END IF 90 17147276 : END FUNCTION taper_eval 91 : 92 : ! ************************************************************************************************** 93 : !> \brief Analytical derivatives for taper function 94 : !> \param taper ... 95 : !> \param rij ... 96 : !> \return ... 97 : ! ************************************************************************************************** 98 16276142 : FUNCTION dtaper_eval(taper, rij) RESULT(dft) 99 : TYPE(taper_type), POINTER :: taper 100 : REAL(KIND=dp), INTENT(IN) :: rij 101 : REAL(KIND=dp) :: dft 102 : 103 : REAL(KIND=dp) :: dr 104 : 105 16276142 : dft = 0.0_dp 106 16276142 : IF (taper%apply_taper) THEN 107 3584141 : dr = taper%rscale*(rij - taper%r0) 108 3584141 : dft = -0.5_dp*(1.0_dp - TANH(dr)**2)*taper%rscale 109 : END IF 110 16276142 : END FUNCTION dtaper_eval 111 : 112 0 : END MODULE taper_types