Skip to content

Commit

Permalink
feat: support monotonically increasing/decreasing array in data_overr…
Browse files Browse the repository at this point in the history 
…ide (#1388)
  • Loading branch information
@uramirez8707
uramirez8707 authored Dec 14, 2023
1 parent e2e79fc commit ac0d086
Show file tree
Hide file tree
Showing 15 changed files with 737 additions and 309 deletions.
106 changes: 67 additions & 39 deletions axis_utils/include/axis_utils2.inc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -46,6 +46,9 @@
!! indicating to reproduce the mpp_io bug where
!! the null characters were not removed after reading a string attribute
integer, parameter :: lkind = FMS_AU_KIND_
integer :: edge_index(2) !< Index to use when reading the edges from the file
!! (/1, 2/) if the axis data is monotonically increasing
!! (/2, 1/) if the axis data is monotonically decreasing
ndims = get_variable_num_dimensions(fileobj, name)
allocate(dim_sizes(ndims))
Expand Down Expand Up @@ -108,8 +111,10 @@
allocate(r2d(dim_sizes(1), dim_sizes(2)))
call read_data(fileobj, buffer, r2d)
edge_data(1:dim_sizes(2)) = r2d(1,:)
edge_data(dim_sizes(2)+1) = r2d(2,dim_sizes(2))
edge_index = (/1, 2/)
if (r2d(1,1) .gt. r2d(1,2)) edge_index = (/2, 1 /)
edge_data(1:dim_sizes(2)) = r2d(edge_index(1),:)
edge_data(dim_sizes(2)+1) = r2d(edge_index(2),dim_sizes(2))
deallocate(r2d)
endif
deallocate(dim_sizes)
Expand Down Expand Up @@ -265,7 +270,7 @@
!! inputs:
!!
!! rval = arbitrary data...same units as elements in "array"
!! array = array of data points (must be monotonically increasing)
!! array = array of data points (must be monotonically)
!! ia = dimension of "array"
!!
!! output:
Expand Down Expand Up @@ -293,48 +298,71 @@
!! z(k1) would be the nearest data point to 12.5 and z(k2) would
!! be the nearest data point to 0.0
!! @return integer nearest_index
function NEAREST_INDEX_(rval, array)
real(kind=FMS_AU_KIND_), intent(in) :: rval !< arbitrary data...same units as elements in "array"
real(kind=FMS_AU_KIND_), intent(in), dimension(:) :: array !< array of data points (must be monotonic)
integer :: NEAREST_INDEX_
integer :: ia !< dimension of "array"
integer :: i, ii, iunit
real(kind=FMS_AU_KIND_) :: rval !< arbitrary data...same units as elements in "array"
real(kind=FMS_AU_KIND_), dimension(:) :: array !< array of data points (must be monotonically increasing)
logical :: keep_going
ia = size(array(:))
do i = 2, ia
if (array(i) < array(i-1)) then
iunit = stdout()
write (iunit,*) '=> Error: "nearest_index" array must be monotonically increasing' &
& // 'when searching for nearest value to ', rval
write (iunit,*) ' array(i) < array(i-1) for i=',i
write (iunit,*) ' array(i) for i=1..ia follows:'
do ii = 1, ia
write (iunit,*) 'i=',ii, ' array(i)=', array(ii)
enddo
call mpp_error(FATAL,' "nearest_index" array must be monotonically increasing.')
endif
enddo
integer :: i !< For looping through "array"
ia = SIZE(array(:))
! check if array is monotonous
DO i = 2, ia-1
IF( (array(i-1)<array(i).AND.array(i)>array(i+1)) .OR. (array(i-1)>array(i).AND.array(i)<array(i+1))) THEN
! <ERROR STATUS="FATAL">array NOT monotonously ordered</ERROR>
CALL mpp_error(FATAL, 'axis_utils2::nearest_index array is NOT monotonously ordered')
END IF
END DO
if (array(1) < array(ia)) then
!< increasing array
!< Check if the rval is outside the range of the array
if (rval < array(1)) then
NEAREST_INDEX_ = 1
return
elseif (rval > array(ia)) then
NEAREST_INDEX_ = ia
return
endif
if (rval < array(1) .or. rval > array(ia)) then
if (rval < array(1)) NEAREST_INDEX_ = 1
if (rval > array(ia)) NEAREST_INDEX_ = ia
DO i = 1, ia-1
IF ( (array(i)<=rval).AND.(array(i+1)>= rval) ) THEN
IF( rval - array(i) <= array(i+1) - rval ) THEN
NEAREST_INDEX_ = i
return
ELSE
NEAREST_INDEX_ = i+1
return
ENDIF
EXIT
END IF
END DO
else
i = 1
keep_going = .true.
do while (i <= ia .and. keep_going)
i = i+1
if (rval <= array(i)) then
NEAREST_INDEX_ = i
if (array(i)-rval > rval-array(i-1)) NEAREST_INDEX_ = i-1
keep_going = .false.
endif
enddo
!< Decreasing Array
!< Check if the rval is outside the range of the array
if (rval < array(ia)) then
NEAREST_INDEX_ = ia
return
elseif (rval > array(1)) then
NEAREST_INDEX_ = 1
return
endif
DO i = 1, ia-1
IF ( (array(i)>=rval).AND.(array(i+1)<= rval) ) THEN
IF ( array(i)-rval <= rval-array(i+1) ) THEN
NEAREST_INDEX_ = i
return
ELSE
NEAREST_INDEX_ = i+1
return
END IF
END IF
END DO
endif
end function NEAREST_INDEX_
Expand Down
16 changes: 8 additions & 8 deletions data_override/include/data_override.inc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1279,14 +1279,14 @@ subroutine DATA_OVERRIDE_3D_(gridname,fieldname_code,return_data,time,override,d
ie_src = axis_sizes(1)
js_src = 1
je_src = axis_sizes(2)
do j = 1, axis_sizes(2)+1
if( override_array(curr_position)%lat_in(j) > lat_min ) exit
js_src = j
enddo
do j = 1, axis_sizes(2)+1
je_src = j
if( override_array(curr_position)%lat_in(j) > lat_max ) exit
enddo
! do j = 1, axis_sizes(2)+1
! if( override_array(curr_position)%lat_in(j) > lat_min ) exit
! js_src = j
! enddo
! do j = 1, axis_sizes(2)+1
! je_src = j
! if( override_array(curr_position)%lat_in(j) > lat_max ) exit
! enddo

!--- bicubic interpolation need one extra point in each direction. Also add
!--- one more point for because lat_in is in the corner but the interpolation
Expand Down
7 changes: 1 addition & 6 deletions horiz_interp/horiz_interp_bilinear.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -34,6 +34,7 @@ module horiz_interp_bilinear_mod
use constants_mod, only: PI
use horiz_interp_type_mod, only: horiz_interp_type, stats
use platform_mod, only: r4_kind, r8_kind
use axis_utils2_mod, only: nearest_index

implicit none
private
Expand Down Expand Up @@ -63,12 +64,6 @@ module horiz_interp_bilinear_mod
integer, parameter :: DUMMY = -999

!! Private helper routines, interfaces for mixed real precision support

interface indp
module procedure indp_r4
module procedure indp_r8
end interface

interface intersect
module procedure intersect_r4
module procedure intersect_r8
Expand Down
86 changes: 32 additions & 54 deletions horiz_interp/include/horiz_interp_bilinear.inc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -34,12 +34,20 @@
real(FMS_HI_KIND_) :: wtw, wte, wts, wtn, lon, lat, tpi, hpi
real(FMS_HI_KIND_) :: glt_min, glt_max, gln_min, gln_max, min_lon, max_lon
integer,parameter :: kindl = FMS_HI_KIND_
logical :: decreasing_lat !< .True. if latitude is monotically decreasing
logical :: decreasing_lon !< .True. if longitude is monotically decreasing
warns = 0
if(present(verbose)) warns = verbose
src_is_modulo = .true.
if (present(src_modulo)) src_is_modulo = src_modulo
decreasing_lat = .false.
if (lat_in(1) > lat_in(2)) decreasing_lat = .true.
decreasing_lon = .false.
if (lon_in(1) > lon_in(2)) decreasing_lon = .true.
hpi = 0.5_kindl * real(pi, FMS_HI_KIND_)
tpi = 4.0_kindl * hpi
glt_min = hpi
Expand Down Expand Up @@ -95,11 +103,23 @@
glt_min = min(lat,glt_min); glt_max = max(lat,glt_max)
gln_min = min(lon,gln_min); gln_max = max(lon,gln_max)
is = indp(lon, lon_in )
if( lon_in(is) .gt. lon ) is = max(is-1,1)
is = nearest_index(lon, lon_in )
if (decreasing_lon) then
! Lon_in is increasing
! This is so that is is the lower bound.
! For example, if the array is [50 40 30 20 10] and lon is 11, `is` is going to be 5 from `nearest_index`
! but it needs to be 4 so that it can use the data at lon_in(4) and lon_in(5)
if( lon_in(is) .lt. lon ) is = max(is-1,1)
else
! Lon_in is increasing
! This is so that is is the lower bound.
! For example, if the array is [10 20 30 40 50] and lon is 49, `is` is going to be 5 from `nearest_index`
! but it needs to be 4 so that it can use the data at lon_in(4) and lon_in(5)
if( lon_in(is) .gt. lon ) is = max(is-1,1)
endif
if( lon_in(is) .eq. lon .and. is .eq. nlon_in) is = max(is - 1,1)
ie = min(is+1,nlon_in)
if(lon_in(is) .ne. lon_in(ie) .and. lon_in(is) .le. lon) then
if(lon_in(is) .ne. lon_in(ie) .and. (decreasing_lon .or. lon_in(is) .le. lon)) then
wtw = ( lon_in(ie) - lon) / (lon_in(ie) - lon_in(is) )
else
! east or west of the last data value. this could be because a
Expand All @@ -115,13 +135,18 @@
endif
wte = 1.0_kindl - wtw
js = indp(lat, lat_in )

if( lat_in(js) .gt. lat ) js = max(js - 1, 1)
js = nearest_index(lat, lat_in )
if (decreasing_lat) then
! Lat_in is decreasing
if( lat_in(js) .lt. lat ) js = max(js - 1, 1)
else
! Lat_in is increasing
if( lat_in(js) .gt. lat ) js = max(js - 1, 1)
endif
if( lat_in(js) .eq. lat .and. js .eq. nlat_in) js = max(js - 1, 1)
je = min(js + 1, nlat_in)
if ( lat_in(js) .ne. lat_in(je) .and. lat_in(js) .le. lat) then
if ( lat_in(js) .ne. lat_in(je) .and. (decreasing_lat .or. lat_in(js) .le. lat)) then
wts = ( lat_in(je) - lat )/(lat_in(je)-lat_in(js))
else
! north or south of the last data value. this could be because a
Expand Down Expand Up @@ -1180,51 +1205,4 @@
return
end subroutine


!#######################################################################
!> @returns index of nearest data point to "value"
!! if "value" is outside the domain of "array" then INDP_ = 1
!! or "ia" depending on whether array(1) or array(ia) is
!! closest to "value"
function INDP_ (rval, array)
integer :: INDP_ !< index of nearest data point within "array"
!! corresponding to "value".
real(FMS_HI_KIND_), dimension(:), intent(in) :: array !< array of data points (must be monotonically increasing)
real(FMS_HI_KIND_), intent(in) :: rval !< arbitrary data, same units as elements in 'array'

!=======================================================================

integer i, ia, iunit
logical keep_going
!
ia = size(array(:))
do i=2,ia
if (array(i) .lt. array(i-1)) then
iunit = stdout()
write (iunit,*) &
' => Error: array must be monotonically increasing in "INDP_"' , &
' when searching for nearest element to value=',rval
write (iunit,*) ' array(i) < array(i-1) for i=',i
write (iunit,*) ' array(i) for i=1..ia follows:'
call mpp_error()
endif
enddo
if (rval .lt. array(1) .or. rval .gt. array(ia)) then
if (rval .lt. array(1)) INDP_ = 1
if (rval .gt. array(ia)) INDP_ = ia
else
i=1
keep_going = .true.
do while (i .le. ia .and. keep_going)
i = i+1
if (rval .le. array(i)) then
INDP_ = i
if (array(i)-rval .gt. rval-array(i-1)) INDP_ = i-1
keep_going = .false.
endif
enddo
endif
return
end function INDP_
!> @}
3 changes: 0 additions & 3 deletions horiz_interp/include/horiz_interp_bilinear_r4.fh
View file
Original file line number Diff line number Diff line change
Expand Up @@ -45,8 +45,5 @@
#undef INTERSECT_
#define INTERSECT_ intersect_r4

#undef INDP_
#define INDP_ indp_r4

#include "horiz_interp_bilinear.inc"
!> @}
3 changes: 0 additions & 3 deletions horiz_interp/include/horiz_interp_bilinear_r8.fh
View file
Original file line number Diff line number Diff line change
Expand Up @@ -45,8 +45,5 @@
#undef INTERSECT_
#define INTERSECT_ intersect_r8

#undef INDP_
#define INDP_ indp_r8

#include "horiz_interp_bilinear.inc"
!> @}
Loading

0 comments on commit ac0d086

Please sign in to comment.