+Add optional scale argument to time_interp_external

Hallberg-NOAA · marshallward · commit 2b5b4388a5a5 · 2022-05-27T15:33:43.000-04:00
Added a new optional scale argument to time_interp_external that can be used
to rescale the values that are set within the infrastructure routines that
underlie time_interp_external.  This new capability has been fully tested,
although it is not being invoked with this commit.  All answers are bitwise
identical, but there is a new optional argument in a public interface.
diff --git a/src/framework/MOM_interpolate.F90 b/src/framework/MOM_interpolate.F90
@@ -26,19 +26,45 @@ module MOM_interpolate
 contains
 
 !> Read a scalar field based on model time.
-subroutine time_interp_external_0d(field_id, time, data_in, verbose)
+subroutine time_interp_external_0d(field_id, time, data_in, verbose, scale)
   integer,           intent(in)    :: field_id !< The integer index of the external field returned
                                                !! from a previous call to init_external_field()
   type(time_type),   intent(in)    :: time     !< The target time for the data
   real,              intent(inout) :: data_in  !< The interpolated value
   logical, optional, intent(in)    :: verbose  !< If true, write verbose output for debugging
+  real,     optional, intent(in)    :: scale   !< A scaling factor that new values of data_in are
+                                               !! multiplied by before it is returned
+  real :: data_in_pre_scale ! The input data before rescaling
+  real :: I_scale ! The inverse of scale
+
+  ! Store the input value in case the scaling factor is perfectly invertable.
+  data_in_pre_scale = data_in
+  I_scale = 1.0
+  if (present(scale)) then ; if ((scale /= 1.0) .and. (scale /= 0.0)) then
+    ! Because time_interp_extern has the ability to only set some values, but no clear
+    ! mechanism to determine which values have been set, the input data has to
+    ! be unscaled so that it will have the right values when it is returned.
+    I_scale = 1.0 / scale
+    data_in = data_in * I_scale
+  endif ; endif
 
   call time_interp_extern(field_id, time, data_in, verbose=verbose)
+
+  if (present(scale)) then ; if (scale /= 1.0) then
+    ! Rescale data that has been newly set and restore the scaling of unset data.
+    if (data_in == I_scale * data_in_pre_scale) then
+      data_in = data_in_pre_scale
+    else
+      data_in = scale * data_in
+    endif
+  endif ; endif
+
 end subroutine time_interp_external_0d
 
 !> Read a 2d field from an external based on model time, potentially including horizontal
 !! interpolation and rotation of the data
-subroutine time_interp_external_2d(field_id, time, data_in, interp, verbose, horz_interp, mask_out, turns)
+subroutine time_interp_external_2d(field_id, time, data_in, interp, &
+                                   verbose, horz_interp, mask_out, turns, scale)
   integer,              intent(in)    :: field_id !< The integer index of the external field returned
                                                   !! from a previous call to init_external_field()
   type(time_type),      intent(in)    :: time     !< The target time for the data
@@ -50,14 +76,32 @@ subroutine time_interp_external_2d(field_id, time, data_in, interp, verbose, hor
   logical, dimension(:,:), &
               optional, intent(out)   :: mask_out !< An array that is true where there is valid data
   integer,    optional, intent(in)    :: turns    !< Number of quarter turns to rotate the data
+  real,       optional, intent(in)    :: scale    !< A scaling factor that new values of data_in are
+                                                  !! multiplied by before it is returned
 
-  real, allocatable :: data_pre_rot(:,:) ! The input data before rotation
+  real, allocatable :: data_in_pre_scale(:,:) ! The input data before rescaling
+  real, allocatable :: data_pre_rot(:,:)      ! The unscaled input data before rotation
+  real    :: I_scale ! The inverse of scale
   integer :: qturns ! The number of quarter turns to rotate the data
+  integer :: i, j
 
   ! TODO: Mask rotation requires logical array rotation support
   if (present(mask_out)) &
     call MOM_error(FATAL, "Rotation of masked output not yet support")
 
+  if (present(scale)) then ; if ((scale /= 1.0) .and. (scale /= 0.0)) then
+    ! Because time_interp_extern has the ability to only set some values, but no clear mechanism
+    ! to determine which values have been set, the input data has to be unscaled so that it will
+    ! have the right values when it is returned.  It may be a problem for some compiler settings
+    ! if there are NaNs in data_in, but they will not spread.
+    if (abs(fraction(scale)) /= 1.0) then
+      ! This scaling factor may not be perfectly invertable, so store the input value
+      allocate(data_in_pre_scale, source=data_in)
+    endif
+    I_scale = 1.0 / scale
+    data_in(:,:) = I_scale * data_in(:,:)
+  endif ; endif
+
   qturns = 0 ; if (present(turns)) qturns = modulo(turns, 4)
 
   if (qturns == 0) then
@@ -70,12 +114,30 @@ subroutine time_interp_external_2d(field_id, time, data_in, interp, verbose, hor
     call rotate_array(data_pre_rot, turns, data_in)
     deallocate(data_pre_rot)
   endif
+
+  if (present(scale)) then ; if (scale /= 1.0) then
+    ! Rescale data that has been newly set and restore the scaling of unset data.
+    if ((abs(fraction(scale)) /= 1.0) .and. (scale /= 0.0)) then
+      do j=LBOUND(data_in,2),UBOUND(data_in,2) ; do i=LBOUND(data_in,1),UBOUND(data_in,1)
+        ! This handles the case where scale is not exactly invertable for data
+        ! values that have not been modified by time_interp_extern.
+        if (data_in(i,j) == I_scale * data_in_pre_scale(i,j)) then
+          data_in(i,j) = data_in_pre_scale(i,j)
+        else
+          data_in(i,j) = scale * data_in(i,j)
+        endif
+      enddo ; enddo
+    else
+      data_in(:,:) = scale * data_in(:,:)
+    endif
+  endif ; endif
+
 end subroutine time_interp_external_2d
 
 
 !> Read a 3d field based on model time, and rotate to the model grid
 subroutine time_interp_external_3d(field_id, time, data_in, interp, &
-    verbose, horz_interp, mask_out, turns)
+                                   verbose, horz_interp, mask_out, turns, scale)
   integer,                intent(in)    :: field_id !< The integer index of the external field returned
                                                     !! from a previous call to init_external_field()
   type(time_type),        intent(in)    :: time     !< The target time for the data
@@ -87,14 +149,32 @@ subroutine time_interp_external_3d(field_id, time, data_in, interp, &
   logical, dimension(:,:,:), &
                 optional, intent(out)   :: mask_out !< An array that is true where there is valid data
   integer,      optional, intent(in)    :: turns    !< Number of quarter turns to rotate the data
+  real,         optional, intent(in)    :: scale    !< A scaling factor that new values of data_in are
+                                                    !! multiplied by before it is returned
 
-  real, allocatable :: data_pre_rot(:,:,:) ! The input data before rotation
+  real, allocatable :: data_in_pre_scale(:,:,:) ! The input data before rescaling
+  real, allocatable :: data_pre_rot(:,:,:)      ! The unscaled input data before rotation
+  real    :: I_scale ! The inverse of scale
   integer :: qturns  ! The number of quarter turns to rotate the data
+  integer :: i, j, k
 
   ! TODO: Mask rotation requires logical array rotation support
   if (present(mask_out)) &
     call MOM_error(FATAL, "Rotation of masked output not yet support")
 
+  if (present(scale)) then ; if ((scale /= 1.0) .and. (scale /= 0.0)) then
+    ! Because time_interp_extern has the ability to only set some values, but no clear mechanism
+    ! to determine which values have been set, the input data has to be unscaled so that it will
+    ! have the right values when it is returned.  It may be a problem for some compiler settings
+    ! if there are NaNs in data_in, but they will not spread.
+    if (abs(fraction(scale)) /= 1.0) then
+      ! This scaling factor may not be perfectly invertable, so store the input value
+      allocate(data_in_pre_scale, source=data_in)
+    endif
+    I_scale = 1.0 / scale
+    data_in(:,:,:) = I_scale * data_in(:,:,:)
+  endif ; endif
+
   qturns = 0 ; if (present(turns)) qturns = modulo(turns, 4)
 
   if (qturns == 0) then
@@ -107,6 +187,28 @@ subroutine time_interp_external_3d(field_id, time, data_in, interp, &
     call rotate_array(data_pre_rot, turns, data_in)
     deallocate(data_pre_rot)
   endif
+
+  if (present(scale)) then ; if (scale /= 1.0) then
+    ! Rescale data that has been newly set and restore the scaling of unset data.
+    if ((abs(fraction(scale)) /= 1.0) .and. (scale /= 0.0)) then
+      do k=LBOUND(data_in,3),UBOUND(data_in,3)
+        do j=LBOUND(data_in,2),UBOUND(data_in,2)
+          do i=LBOUND(data_in,1),UBOUND(data_in,1)
+            ! This handles the case where scale is not exactly invertable for data
+            ! values that have not been modified by time_interp_extern.
+            if (data_in(i,j,k) == I_scale * data_in_pre_scale(i,j,k)) then
+              data_in(i,j,k) = data_in_pre_scale(i,j,k)
+            else
+              data_in(i,j,k) = scale * data_in(i,j,k)
+            endif
+          enddo
+        enddo
+      enddo
+    else
+      data_in(:,:,:) = scale * data_in(:,:,:)
+    endif
+  endif ; endif
+
 end subroutine time_interp_external_3d
 
 end module MOM_interpolate
