diff --git a/src/simulation/m_thinc.fpp b/src/simulation/m_thinc.fpp index a52ec19d76..4edd719756 100644 --- a/src/simulation/m_thinc.fpp +++ b/src/simulation/m_thinc.fpp @@ -30,7 +30,9 @@ module m_thinc real(wp) :: gq3_pts(3) = [-5e-1_wp*0.7745966692414834_wp, 0._wp, 5e-1_wp*0.7745966692414834_wp] !> Weights: 5/18, 8/18, 5/18 real(wp) :: gq3_wts(3) = [5._wp/18._wp, 8._wp/18._wp, 5._wp/18._wp] - $:GPU_DECLARE(copyin='[gq3_pts, gq3_wts]') + !> ln(2) + real(wp) :: ln2 = 0.6931471805599453_wp + $:GPU_DECLARE(create='[gq3_pts, gq3_wts, ln2]') real(wp), allocatable, dimension(:,:,:,:) :: mthinc_nhat !> Unit normal vector real(wp), allocatable, dimension(:,:,:) :: mthinc_d !> Interface position parameter @@ -38,6 +40,22 @@ module m_thinc contains + !> @brief Stable computation of ln(cosh(x)) + function f_log_cosh(x) result(res) + + $:GPU_ROUTINE(parallelism='[seq]') + real(wp), intent(in) :: x + real(wp) :: res, ax + + ax = abs(x) + if (ax > 20._wp) then + res = ax - ln2 + else + res = ax + log(1._wp + exp(-2._wp*ax)) - ln2 + end if + + end function f_log_cosh + !> @brief Stable difference: log_cosh(a+h) - log_cosh(a-h) = 2*atanh(tanh(a)*tanh(h)). Avoids catastrophic cancellation when h !! is small relative to a. function f_log_cosh_diff(a, h) result(res)