det_sign Function

private pure function det_sign(igu, igl, kc, lam) result(sgn)

Sign of det(M(lam)) on rows 2..kc (Sturm/Hallberg recursion).

Arguments

Type IntentOptional Attributes Name
real(kind=wp), intent(in) :: igu(NZ_STACK_MAX+1)
real(kind=wp), intent(in) :: igl(NZ_STACK_MAX+1)
integer, intent(in) :: kc
real(kind=wp), intent(in) :: lam

Return Value integer


Called by

proc~~det_sign~~CalledByGraph proc~det_sign det_sign proc~wavespeed_cg1_column wavespeed_cg1_column proc~wavespeed_cg1_column->proc~det_sign proc~wavespeed_compute_impl wavespeed_compute_impl proc~wavespeed_compute_impl->proc~wavespeed_cg1_column proc~wavespeed_compute wavespeed_compute proc~wavespeed_compute->proc~wavespeed_compute_impl proc~ocean_dyn_step_split ocean_dyn_step_split proc~ocean_dyn_step_split->proc~wavespeed_compute proc~engine_step engine_step proc~engine_step->proc~ocean_dyn_step_split

Variables

Type Visibility Attributes Name Initial
real(kind=wp), private :: absd
real(kind=wp), private :: det
real(kind=wp), private :: detm1
real(kind=wp), private :: detm2
real(kind=wp), private :: dval
integer, private :: k
real(kind=wp), private :: offl
real(kind=wp), private :: sfac

Source Code

   pure integer function det_sign(igu, igl, kc, lam) result(sgn)
      !! Sign of det(M(lam)) on rows 2..kc (Sturm/Hallberg recursion).
      !$acc routine seq
      real(wp), intent(in) :: igu(NZ_STACK_MAX + 1), igl(NZ_STACK_MAX + 1)
      integer, intent(in) :: kc
      real(wp), intent(in) :: lam
      integer :: k
      real(wp) :: det, detm1, detm2, dval, offl, absd, sfac

      detm1 = 1.0_wp
      det = (igu(2) + igl(2)) - lam
      do k = 3, kc
         absd = abs(det)
         sfac = 1.0_wp
         if (absd > RESCALE) then
            sfac = I_RESCALE
         else if (absd < I_RESCALE .and. absd > 0.0_wp) then
            sfac = RESCALE
         end if
         detm2 = C2_SCALE*detm1*sfac
         detm1 = C2_SCALE*det*sfac
         dval = (igu(k) + igl(k)) - lam
         offl = igu(k)*igl(k - 1)
         det = dval*detm1 - offl*detm2
      end do
      sgn = merge(1, -1, det >= 0.0_wp)
   end function det_sign