Hyperbolic_Step.f90

Go to the documentation of this file.

!
! Hyperbolic step functions for differentiable replacement of IF statements
!
!
! CREATION HISTORY:
!       Written by:     Paul van Delst, 09-Nov-2010
!                       paul.vandelst@noaa.gov
!

MODULE hyperbolic_step

  ! -----------------
  ! Environment setup
  ! -----------------
  ! Module use
  USE type_kinds, ONLY: fp
  ! Disable implicit typing
  IMPLICIT NONE


  ! ------------
  ! Visibilities
  ! ------------
  PRIVATE
  PUBLIC :: step
  PUBLIC :: step_tl
  PUBLIC :: step_ad


  ! -----------------
  ! Module parameters
  ! -----------------
  CHARACTER(*), PARAMETER :: module_version_id = &
  '$Id: Hyperbolic_Step.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $'
  ! Literals
  REAL(fp), PARAMETER :: zero   = 0.0_fp
  REAL(fp), PARAMETER :: point5 = 0.5_fp
  REAL(fp), PARAMETER :: one    = 1.0_fp
  ! X-input maximum value
  REAL(fp), PARAMETER :: xcutoff = 70.0_fp

CONTAINS


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       Step
!
! PURPOSE:
!       Subroutine to compute a hyperbolic, differentiable, step function:
!
!         g(x) = 0.5(1 + TANH(x))
!
!       NOTE: No input checking of the validity of the x-argument for use
!             with TANH() is done.
!
! CALLING SEQUENCE:
!       CALL Step( x, g )
!                             
!
! INPUTS:
!       x:      The function abscissa.
!               UNITS:      N/A
!               TYPE:       REAL(fp)
!               DIMENSION:  Scalar
!               ATTRIBUTES: INTENT(IN)
!
! OUTPUTS:
!       g:      The hyperbolic step function value.
!               UNITS:      N/A
!               TYPE:       REAL(fp)
!               DIMENSION:  Scalar
!               ATTRIBUTES: INTENT(OUT)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  SUBROUTINE step( x, g )
    REAL(fp), INTENT(IN)  :: x
    REAL(fp), INTENT(OUT) :: g
    g = point5 * ( one + tanh(x) )
  END SUBROUTINE step


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       Step_TL
!
! PURPOSE:
!       Subroutine to compute the tangent-linear form of a hyperbolic,
!       differentiable, step function:
!
!         g(x) = 0.5(1 + TANH(x))
!
!       NOTE: Computations are only performed for input |x| < 70 to avoid
!             infinite result for COSH().
!
! CALLING SEQUENCE:
!       CALL Step_TL( x, x_TL, g_TL )
!                             
!
! INPUTS:
!       x:      The function abscissa.
!               UNITS:      N/A
!               TYPE:       REAL(fp)
!               DIMENSION:  Scalar
!               ATTRIBUTES: INTENT(IN)
!
!       x_TL:   The tangent-linear abscissa.
!               UNITS:      N/A
!               TYPE:       REAL(fp)
!               DIMENSION:  Scalar
!               ATTRIBUTES: INTENT(IN)
!
! OUTPUTS:
!       g_TL:   The tangent-linear hyperbolic step function value.
!               UNITS:      N/A
!               TYPE:       REAL(fp)
!               DIMENSION:  Scalar
!               ATTRIBUTES: INTENT(OUT)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  SUBROUTINE step_tl( x, x_TL, g_TL )
    REAL(fp), INTENT(IN)  :: x, x_tl
    REAL(fp), INTENT(OUT) :: g_tl
    IF ( abs(x) < xcutoff ) THEN
      g_tl = point5 * x_tl / cosh(x)**2
    ELSE
      g_tl = zero
    END IF
  END SUBROUTINE step_tl


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       Step_AD
!
! PURPOSE:
!       Subroutine to compute the adjoint of a hyperbolic, differentiable,
!       step function:
!
!         g(x) = 0.5(1 + TANH(x))
!
!       NOTE: Computations are only performed for input |x| < 70 to avoid
!             infinite result for COSH().
!
! CALLING SEQUENCE:
!       CALL Step_AD( x, g_AD, x_AD )
!                             
!
! INPUTS:
!       x:      The function abscissa.
!               UNITS:      N/A
!               TYPE:       REAL(fp)
!               DIMENSION:  Scalar
!               ATTRIBUTES: INTENT(IN)
!
!       g_AD:   The adjoint hyperbolic step function value.
!               NOTE: *** SET TO ZERO UPON EXIT ***
!               UNITS:      N/A
!               TYPE:       REAL(fp)
!               DIMENSION:  Scalar
!               ATTRIBUTES: INTENT(IN OUT)
!
! OUTPUTS:
!       x_AD:   The adjoint abscissa.
!               NOTE: *** MUST CONTAIN VALUE UPON ENTRY ***
!               UNITS:      N/A
!               TYPE:       REAL(fp)
!               DIMENSION:  Scalar
!               ATTRIBUTES: INTENT(IN OUT)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  SUBROUTINE step_ad( x, g_AD, x_AD )
    REAL(fp), INTENT(IN)     :: x
    REAL(fp), INTENT(IN OUT) :: g_ad  ! AD Input
    REAL(fp), INTENT(IN OUT) :: x_ad  ! AD Output
    IF ( abs(x) < xcutoff ) THEN
      x_ad = x_ad + point5 * g_ad / cosh(x)**2
    END IF
    g_ad = zero
  END SUBROUTINE step_ad

END MODULE hyperbolic_step