Processing math: 100%

transition Subroutine

public subroutine transition(rho, R, S, fT, fTp, fTpp)

Routine to calculate the smooth transition function, fT, and it's first fT and second fT derivative with respect to the computational coordinate, ρ.

Arguments

Type IntentOptional AttributesName
real(kind=wp), intent(in) :: rho

The computational coordinate, ρ, where the transition function should be calculated. Should be between R and S.

real(kind=wp), intent(in) :: R

The value of ρ where fT should be 0.

real(kind=wp), intent(in) :: S

The value of ρ where fT should be 1.

real(kind=wp), intent(out) :: fT

On return contains fT.

real(kind=wp), intent(out) :: fTp

On return contains fT.

real(kind=wp), intent(out) :: fTpp

On return contains fT.


Called by

proc~~transition~~CalledByGraph proc~transition transition proc~scal_schw_init scal_schw_init proc~scal_schw_init->proc~transition interface~scal_schw_init scal_schw_init interface~scal_schw_init->proc~scal_schw_init

Contents

Source Code


Source Code

  subroutine transition ( rho, R, S, fT, fTp, fTpp )
  !! Routine to calculate the smooth transition function, \(fT\), and it's first
  !! \(fT'\) and second \(fT''\) derivative with respect to the computational
  !! coordinate, \(\rho\).

    implicit none

    real(wp), intent(in) :: rho
    !! The computational coordinate, \(\rho\), where the transition function
    !! should be calculated. Should be between \(R\) and \(S\).
    real(wp), intent(in) :: R
    !! The value of \(\rho\) where \(fT\) should be \(0\).
    real(wp), intent(in) :: S
    !! The value of \(\rho\) where \(fT\) should be \(1\).
    real(wp), intent(out) :: fT
    !! On return contains \(fT\).
    real(wp), intent(out) :: fTp
    !! On return contains \(fT'\).
    real(wp), intent(out) :: fTpp
    !! On return contains \(fT''\).
    real(wp), parameter :: es = 1.5_wp
    real(wp), parameter :: q2 = 1.3_wp
    real(wp), parameter :: pi = acos(-1.0_wp)
    real(wp), parameter :: half = 0.5_wp
    real(wp) :: x, tanx, cotx, fac, tanhfac, cscx2, secx2, sechfac2

    x = max ( half * pi * ( rho - R ) / ( S - R ), 0.0_wp )
    if ( x > 0.0_wp ) then
!      print*,'x = ', x
      tanx = tan ( x )
!      print*,'tanx = ', tanx
      cotx = 1.0_wp / tanx
!      print*,'cotx = ', cotx
      fac = es/pi * ( tanx - q2 * cotx )
!      print*,'fac = ', fac
      tanhfac = tanh ( fac)
!      print*,'tanhfac = ', tanhfac
      fT = half + half * tanhfac
!      print*,'fT = ', fT
      cscx2 = 1.0_wp / sin ( x )**2
      secx2 = 1.0_wp / cos ( x )**2
      sechfac2 = 1.0_wp / cosh ( fac )**2
      fTp = 0.25_wp * es * ( q2 * cscx2 + secx2 ) * sechfac2 / ( S - R )
      fTpp = -0.25_wp * es * sechfac2 * ( &
               pi * ( q2 * cotx * cscx2 - secx2 * tanx ) + &
               es * ( q2 * cscx2 + secx2 )**2 * tanhfac ) / ( S - R )**2
    else
      fT = 0.0_wp
      fTp = 0.0_wp
      fTpp = 0.0_wp
    end if
  end subroutine transition