Skip to content
Open
Show file tree
Hide file tree
Changes from 5 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions src/core_init_atmosphere/mpas_init_atm_cases.F
Original file line number Diff line number Diff line change
Expand Up @@ -8154,3 +8154,4 @@ end function read_text_array


end module init_atm_cases

51 changes: 46 additions & 5 deletions src/core_init_atmosphere/mpas_init_atm_vinterp.F
Original file line number Diff line number Diff line change
Expand Up @@ -38,7 +38,7 @@ real (kind=RKIND) function vertical_interp(target_z, nz, zf, order, extrap, surf
real (kind=RKIND), intent(in), optional :: sealev_val
integer, intent(out), optional :: ierr

integer :: k, lm, lp
integer :: k, lm, lp, n_lapse
real (kind=RKIND) :: wm, wp
real (kind=RKIND) :: slope

Expand Down Expand Up @@ -81,7 +81,9 @@ real (kind=RKIND) function vertical_interp(target_z, nz, zf, order, extrap, surf
slope = (zf(2,2) - zf(2,1)) / (zf(1,2) - zf(1,1))
vertical_interp = zf(2,1) + slope * (target_z - zf(1,1))
else if (extrap_type == 2) then
vertical_interp = zf(2,1) - (target_z - zf(1,1))*0.0065
n_lapse = min(nz, 3)
slope = ls_lapse_slope(zf, nz, 1, n_lapse)
vertical_interp = zf(2,1) + slope * (target_z - zf(1,1))
end if
Comment on lines 84 to 88
Copy link

Copilot AI Apr 29, 2026

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The PR description focuses on adding missing upper-boundary support for extrap_type==2, but this diff also changes the lower-boundary extrap_type==2 behavior from a fixed 0.0065 K/m to a least-squares fitted slope from the lowest levels. Please update the PR description (and any user-facing docs for config_extrap_airtemp='lapse-rate') to reflect this broader behavior change.

Copilot uses AI. Check for mistakes.
return
end if
Expand All @@ -92,9 +94,9 @@ real (kind=RKIND) function vertical_interp(target_z, nz, zf, order, extrap, surf
slope = (zf(2,nz) - zf(2,nz-1)) / (zf(1,nz) - zf(1,nz-1))
vertical_interp = zf(2,nz) + slope * (target_z - zf(1,nz))
Comment on lines 78 to 96
Copy link

Copilot AI Apr 29, 2026

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

In the extrapolation branches, the linear extrapolation path assumes nz >= 2 (accesses zf(:,2) / zf(:,nz-1)). If the caller provides only a single vertical level (e.g., nz==1), this becomes an out-of-bounds access. Please add an explicit nz < 2 fallback (e.g., treat as constant extrapolation and/or set ierr + log an error) before computing the slope for extrap_type == 1.

Copilot uses AI. Check for mistakes.
else if (extrap_type == 2) then
call mpas_log_write('extrap_type == 2 not implemented for target_z >= zf(1,nz)', messageType=MPAS_LOG_ERR)
if (present(ierr)) ierr = 1
return
n_lapse = min(nz, 3)
slope = ls_lapse_slope(zf, nz, nz - n_lapse + 1, nz)
vertical_interp = zf(2,nz) + slope * (target_z - zf(1,nz))
end if
Comment on lines +78 to 101
Copy link

Copilot AI Apr 29, 2026

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The extrapolation if/else if chain has no final else to handle unexpected extrap_type values. If a caller passes something other than {0,1,2}, vertical_interp can be returned uninitialized while ierr remains 0. Please add a default branch that logs an error and sets ierr (and/or falls back to constant extrapolation).

Copilot uses AI. Check for mistakes.
return
end if
Expand All @@ -119,4 +121,43 @@ real (kind=RKIND) function vertical_interp(target_z, nz, zf, order, extrap, surf

end function vertical_interp

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Name: ls_lapse_slope
!
! Purpose: Compute an ordinary least-squares slope over levels k_start..k_end of
! zf. Returns 0 when only one level is supplied (constant fallback).
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real (kind=RKIND) function ls_lapse_slope(zf, nz, k_start, k_end)

implicit none

integer, intent(in) :: nz, k_start, k_end
real (kind=RKIND), dimension(2,nz), intent(in) :: zf

integer :: k, n_pts
real (kind=RKIND) :: sum_x, sum_y, sum_x2, sum_xy, n_real

n_pts = k_end - k_start + 1

sum_x = 0.0_RKIND; sum_y = 0.0_RKIND
sum_x2 = 0.0_RKIND; sum_xy = 0.0_RKIND

do k = k_start, k_end
sum_x = sum_x + zf(1,k)
sum_y = sum_y + zf(2,k)
sum_x2 = sum_x2 + zf(1,k)**2
sum_xy = sum_xy + zf(1,k)*zf(2,k)
end do

n_real = real(n_pts, RKIND)

if (n_pts > 1) then
ls_lapse_slope = (n_real*sum_xy - sum_x*sum_y) / (n_real*sum_x2 - sum_x**2)
else
ls_lapse_slope = 0.0_RKIND
Copy link

Copilot AI Apr 29, 2026

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

ls_lapse_slope divides by (n_real*sum_x2 - sum_x**2) without guarding against a zero/near-zero denominator. If the selected z-levels contain duplicate (or nearly duplicate) zf(1,k) values, this will trigger a divide-by-zero (or overflow to Inf/NaN) and silently propagate into the extrapolated field. Please add a tolerance check on the denominator (and return a safe fallback slope, e.g., 0 or a 2-point difference), and consider computing the variance term using centered values to avoid catastrophic cancellation when RKIND is single precision.

Suggested change
real (kind=RKIND) :: sum_x, sum_y, sum_x2, sum_xy, n_real
n_pts = k_end - k_start + 1
sum_x = 0.0_RKIND; sum_y = 0.0_RKIND
sum_x2 = 0.0_RKIND; sum_xy = 0.0_RKIND
do k = k_start, k_end
sum_x = sum_x + zf(1,k)
sum_y = sum_y + zf(2,k)
sum_x2 = sum_x2 + zf(1,k)**2
sum_xy = sum_xy + zf(1,k)*zf(2,k)
end do
n_real = real(n_pts, RKIND)
if (n_pts > 1) then
ls_lapse_slope = (n_real*sum_xy - sum_x*sum_y) / (n_real*sum_x2 - sum_x**2)
else
ls_lapse_slope = 0.0_RKIND
real (kind=RKIND) :: sum_x, sum_y, mean_x, mean_y
real (kind=RKIND) :: dx, dy, var_x, cov_xy, tol, scale_x, denom_2pt
real (kind=RKIND) :: n_real
n_pts = k_end - k_start + 1
if (n_pts <= 1) then
ls_lapse_slope = 0.0_RKIND
return
end if
sum_x = 0.0_RKIND
sum_y = 0.0_RKIND
do k = k_start, k_end
sum_x = sum_x + zf(1,k)
sum_y = sum_y + zf(2,k)
end do
n_real = real(n_pts, RKIND)
mean_x = sum_x / n_real
mean_y = sum_y / n_real
var_x = 0.0_RKIND
cov_xy = 0.0_RKIND
scale_x = 0.0_RKIND
do k = k_start, k_end
dx = zf(1,k) - mean_x
dy = zf(2,k) - mean_y
var_x = var_x + dx*dx
cov_xy = cov_xy + dx*dy
scale_x = max(scale_x, abs(zf(1,k)))
end do
tol = max(1.0_RKIND, scale_x)**2 * epsilon(1.0_RKIND) * n_real
if (var_x > tol) then
ls_lapse_slope = cov_xy / var_x
else
denom_2pt = zf(1,k_end) - zf(1,k_start)
if (abs(denom_2pt) > tol) then
ls_lapse_slope = (zf(2,k_end) - zf(2,k_start)) / denom_2pt
else
ls_lapse_slope = 0.0_RKIND
end if

Copilot uses AI. Check for mistakes.
end if

end function ls_lapse_slope

end module init_atm_vinterp

Loading