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    17143244 :    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    17143244 :       ft = 1._dp
      86    17143244 :       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    17143244 :    END FUNCTION taper_eval
      91             : 
      92             : ! **************************************************************************************************
      93             : !> \brief Analytical derivatives for taper function
      94             : !> \param taper ...
      95             : !> \param rij ...
      96             : !> \return ...
      97             : ! **************************************************************************************************
      98    16274126 :    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    16274126 :       dft = 0.0_dp
     106    16274126 :       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    16274126 :    END FUNCTION dtaper_eval
     111             : 
     112           0 : END MODULE taper_types