LCOV - code coverage report
Current view: top level - src - taper_types.F (source / functions) Coverage Total Hit
Test: CP2K Regtests (git:42dac4a) Lines: 96.2 % 26 25
Test Date: 2025-07-25 12:55:17 Functions: 80.0 % 5 4

            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
        

Generated by: LCOV version 2.0-1