Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2025 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 17531972 : 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 17531972 : ft = 1._dp
86 17531972 : IF (taper%apply_taper) THEN
87 4081047 : dr = taper%rscale*(rij - taper%r0)
88 4081047 : ft = 0.5_dp*(1.0_dp - TANH(dr))
89 : END IF
90 17531972 : END FUNCTION taper_eval
91 :
92 : ! **************************************************************************************************
93 : !> \brief Analytical derivatives for taper function
94 : !> \param taper ...
95 : !> \param rij ...
96 : !> \return ...
97 : ! **************************************************************************************************
98 16662854 : 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 16662854 : dft = 0.0_dp
106 16662854 : IF (taper%apply_taper) THEN
107 3766049 : dr = taper%rscale*(rij - taper%r0)
108 3766049 : dft = -0.5_dp*(1.0_dp - TANH(dr)**2)*taper%rscale
109 : END IF
110 16662854 : END FUNCTION dtaper_eval
111 :
112 0 : END MODULE taper_types
|