bipolar_corner_latlon Subroutine

public pure subroutine bipolar_corner_latlon(lam_deg, s, phi_join, lon_pole, lat, lon)

Map a logical cap location to geographic (lat, lon) in degrees. lam_deg : pseudo-longitude (geographic lon at the join ring), any real (wrapped internally); the i-direction. s : cap-row fraction, 0 = join ring (lat = phi_join), 1 = fold line; the j-direction. phi_join: join latitude (deg); cap covers lat > phi_join. lon_pole: longitude (deg) of the first cap pole; partner at lon_pole + 180.

Arguments

Type IntentOptional Attributes Name
real(kind=wp), intent(in) :: lam_deg
real(kind=wp), intent(in) :: s
real(kind=wp), intent(in) :: phi_join
real(kind=wp), intent(in) :: lon_pole
real(kind=wp), intent(out) :: lat
real(kind=wp), intent(out) :: lon

Called by

proc~~bipolar_corner_latlon~~CalledByGraph proc~bipolar_corner_latlon bipolar_corner_latlon proc~tripolar_node_latlon tripolar_node_latlon proc~tripolar_node_latlon->proc~bipolar_corner_latlon proc~tripolar_supergrid_arrays tripolar_supergrid_arrays proc~tripolar_supergrid_arrays->proc~tripolar_node_latlon proc~metrics_fill_tripolar_whole metrics_fill_tripolar_whole proc~metrics_fill_tripolar_whole->proc~tripolar_supergrid_arrays proc~metrics_fill_tripolar metrics_fill_tripolar proc~metrics_fill_tripolar->proc~metrics_fill_tripolar_whole proc~configure_ocean_metrics configure_ocean_metrics proc~configure_ocean_metrics->proc~metrics_fill_tripolar

Variables

Type Visibility Attributes Name Initial
real(kind=wp), private :: a_focus
real(kind=wp), private :: deni
real(kind=wp), private :: denr
real(kind=wp), private :: dnorm
real(kind=wp), private :: half
real(kind=wp), private :: lpr
real(kind=wp), private :: mu
real(kind=wp), private :: rmag
real(kind=wp), private :: sgn
real(kind=wp), private :: t
real(kind=wp), private :: wi
real(kind=wp), private :: wr
real(kind=wp), private :: xi
real(kind=wp), private :: zi
real(kind=wp), private :: zpi
real(kind=wp), private :: zpr
real(kind=wp), private :: zr

Source Code

   pure subroutine bipolar_corner_latlon(lam_deg, s, phi_join, lon_pole, lat, lon)
      !! Map a logical cap location to geographic (lat, lon) in degrees.
      !!   `lam_deg` : pseudo-longitude (geographic lon at the join ring),
      !!               any real (wrapped internally); the i-direction.
      !!   `s`       : cap-row fraction, 0 = join ring (`lat = phi_join`),
      !!               1 = fold line; the j-direction.
      !!   `phi_join`: join latitude (deg); cap covers lat > phi_join.
      !!   `lon_pole`: longitude (deg) of the first cap pole; partner at
      !!               `lon_pole + 180`.
      real(wp), intent(in) :: lam_deg, s, phi_join, lon_pole
      real(wp), intent(out) :: lat, lon

      real(wp) :: a_focus, half, t, mu, xi, sgn
      real(wp) :: wr, wi, denr, deni, dnorm, zpr, zpi
      real(wp) :: lpr, zr, zi, rmag

      a_focus = tan(DEG2RAD*(90.0_wp - phi_join)*0.5_wp)

      ! mu from the join-continuity relation: lon_join = lon_pole + 2 atan(exp(mu)).
      half = DEG2RAD*(lam_deg - lon_pole)*0.5_wp
      t = tan(half)
      if (t > 0.0_wp) then
         sgn = 1.0_wp
         mu = log(t)
      else if (t < 0.0_wp) then
         sgn = -1.0_wp
         mu = log(-t)
      else
         ! lam == lon_pole (mod 360): a cap pole.  mu -> -inf; clamp finite
         ! so the corner sits arbitrarily close to the pole without an Inf.
         sgn = 1.0_wp
         mu = -50.0_wp
      end if

      ! xi rotates from the join (sgn*pi/2) to the fold (sgn*pi) as s: 0 -> 1.
      xi = sgn*(PI*0.5_wp + s*PI*0.5_wp)

      ! w = exp(mu) * exp(i*xi)
      wr = exp(mu)*cos(xi)
      wi = exp(mu)*sin(xi)

      ! Zp = A * (1 + w)/(1 - w)
      denr = 1.0_wp - wr
      deni = -wi
      dnorm = denr*denr + deni*deni
      if (dnorm <= 0.0_wp) then
         ! w == 1 (mu -> +inf): the other pole.  Place at phi_join on the
         ! partner meridian.
         lat = phi_join
         lon = lon_pole + 180.0_wp
         if (lon >= 180.0_wp) lon = lon - 360.0_wp
         return
      end if
      ! (1+w)/(1-w)
      zpr = ((1.0_wp + wr)*denr + wi*deni)/dnorm
      zpi = (wi*denr - (1.0_wp + wr)*deni)/dnorm
      zpr = a_focus*zpr
      zpi = a_focus*zpi

      ! Z = Zp * exp(i*lon_pole)
      lpr = DEG2RAD*lon_pole
      zr = zpr*cos(lpr) - zpi*sin(lpr)
      zi = zpr*sin(lpr) + zpi*cos(lpr)

      ! stereographic inverse
      rmag = sqrt(zr*zr + zi*zi)
      lat = 90.0_wp - RAD2DEG*2.0_wp*atan(rmag)
      if (zr == 0.0_wp .and. zi == 0.0_wp) then
         lon = lon_pole + 180.0_wp
      else
         lon = RAD2DEG*atan2(zi, zr)
      end if
      ! wrap lon to [-180, 180)
      lon = modulo(lon + 180.0_wp, 360.0_wp) - 180.0_wp
   end subroutine bipolar_corner_latlon