@@ -591,7 +591,7 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, recnum, G, tr
591
591
592
592
! Horizontally homogenize data to produce perfectly "flat" initial conditions
593
593
if (PRESENT (homogenize)) then ; if (homogenize) then
594
- call homogenize_field(tr_out, mask_out, G, scale, answer_date)
594
+ call homogenize_field(tr_out, G, tmp_scale = I_scale, weights = mask_out, answer_date = answer_date)
595
595
endif ; endif
596
596
597
597
! tr_out contains input z-space data on the model grid with missing values
@@ -908,7 +908,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(field, Time, G, tr_z, mask_z, &
908
908
909
909
! Horizontally homogenize data to produce perfectly "flat" initial conditions
910
910
if (PRESENT (homogenize)) then ; if (homogenize) then
911
- call homogenize_field(tr_out, mask_out, G, scale, answer_date)
911
+ call homogenize_field(tr_out, G, tmp_scale = I_scale, weights = mask_out, answer_date = answer_date)
912
912
endif ; endif
913
913
914
914
! tr_out contains input z-space data on the model grid with missing values
@@ -950,14 +950,15 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(field, Time, G, tr_z, mask_z, &
950
950
end subroutine horiz_interp_and_extrap_tracer_fms_id
951
951
952
952
! > Replace all values of a 2-d field with the weighted average over the valid points.
953
- subroutine homogenize_field (field , weight , G , scale , answer_date , wt_unscale )
953
+ subroutine homogenize_field (field , G , tmp_scale , weights , answer_date , wt_unscale )
954
954
type (ocean_grid_type), intent (inout ) :: G ! < Ocean grid type
955
955
real , dimension (SZI_(G),SZJ_(G)), intent (inout ) :: field ! < The tracer on the model grid in arbitrary units [A ~> a]
956
- real , dimension (SZI_(G),SZJ_(G)), intent (in ) :: weight ! < The weights for the tracer in arbitrary units that
956
+ real , optional , intent (in ) :: tmp_scale ! < A temporary rescaling factor for the
957
+ ! ! variable that is reversed in the
958
+ ! ! return value [a A-1 ~> 1]
959
+ real , dimension (SZI_(G),SZJ_(G)), &
960
+ optional , intent (in ) :: weights ! < The weights for the tracer in arbitrary units that
957
961
! ! typically differ from those used by field [B ~> b]
958
- real , intent (in ) :: scale ! < A rescaling factor that has been used for the
959
- ! ! variable and has to be undone before the
960
- ! ! reproducing sums [A a-1 ~> 1]
961
962
integer , optional , intent (in ) :: answer_date ! < The vintage of the expressions in the code.
962
963
! ! Dates before 20230101 use non-reproducing sums
963
964
! ! in their averages, while later versions use
@@ -971,12 +972,11 @@ subroutine homogenize_field(field, weight, G, scale, answer_date, wt_unscale)
971
972
! In the following comments, [A] and [B] are used to indicate the arbitrary, possibly rescaled
972
973
! units of the input field and the weighting array, while [a] and [b] indicate the corresponding
973
974
! unscaled (e.g., mks) units that can be used with the reproducing sums
974
- real , dimension (SZI_(G),SZJ_(G)) :: field_for_Sums ! The field times the weights with the scaling undone [a b]
975
- real , dimension (SZI_(G),SZJ_(G)) :: wts_for_Sums ! A copy of the wieghts with the scaling undone [b]
975
+ real , dimension (G% isc:G% iec, G% jsc:G% jec) :: field_for_Sums ! The field times the weights [A B ~> a b]
976
+ real , dimension (G% isc:G% iec, G% jsc:G% jec) :: weight ! A copy of weights, if it is present, or the
977
+ ! tracer-point grid mask if it weights is absent [B ~> b]
976
978
real :: var_unscale ! The reciprocal of the scaling factor for the field and weights [a b A-1 B-1 ~> 1]
977
- real :: wt_descale ! A factor that undoes any dimensional scaling of the weights so that they
978
- ! can be used with reproducing sums [b B-1 ~> 1]
979
- real :: wt_sum ! The sum of the weights, in [b] (reproducing) or [B ~> b] (non-reproducing)
979
+ real :: wt_sum ! The sum of the weights, in [B ~> b]
980
980
real :: varsum ! The weighted sum of field being averaged [A B ~> a b]
981
981
real :: varAvg ! The average of the field [A ~> a]
982
982
logical :: use_repro_sums ! If true, use reproducing sums.
@@ -988,23 +988,27 @@ subroutine homogenize_field(field, weight, G, scale, answer_date, wt_unscale)
988
988
989
989
use_repro_sums = .false. ; if (present (answer_date)) use_repro_sums = (answer_date >= 20230101 )
990
990
991
- if (scale == 0.0 ) then
992
- ! This seems like an unlikely case to ever be used, but dealing with it is better than having NaNs arise?
993
- varAvg = 0.0
994
- elseif (use_repro_sums) then
995
- wt_descale = 1.0 ; if (present (wt_unscale)) wt_descale = wt_unscale
996
- var_unscale = wt_descale / scale
991
+ if (present (weights)) then
992
+ do j= js,je ; do i= is,ie
993
+ weight(i,j) = weights(i,j)
994
+ enddo ; enddo
995
+ else
996
+ do j= js,je ; do i= is,ie
997
+ weight(i,j) = G% mask2dT(i,j)
998
+ enddo ; enddo
999
+ endif
1000
+
1001
+ if (use_repro_sums) then
1002
+ var_unscale = 1.0 ; if (present (tmp_scale)) var_unscale = tmp_scale
1003
+ if (present (wt_unscale)) var_unscale = wt_unscale * var_unscale
997
1004
998
- field_for_Sums(:,:) = 0.0
999
- wts_for_Sums(:,:) = 0.0
1000
1005
do j= js,je ; do i= is,ie
1001
- wts_for_Sums(i,j) = wt_descale * weight(i,j)
1002
- field_for_Sums(i,j) = var_unscale * (field(i,j) * weight(i,j))
1006
+ field_for_Sums(i,j) = field(i,j) * weight(i,j)
1003
1007
enddo ; enddo
1004
1008
1005
- wt_sum = reproducing_sum(wts_for_Sums )
1009
+ wt_sum = reproducing_sum(weight, unscale = wt_unscale )
1006
1010
if (abs (wt_sum) > 0.0 ) &
1007
- varAvg = reproducing_sum(field_for_Sums) * (scale / wt_sum)
1011
+ varAvg = reproducing_sum(field_for_Sums, unscale = var_unscale ) * (1.0 / wt_sum)
1008
1012
1009
1013
else ! Do the averages with order-dependent sums to reproduce older answers.
1010
1014
wt_sum = 0 ; varsum = 0 .
@@ -1021,8 +1025,12 @@ subroutine homogenize_field(field, weight, G, scale, answer_date, wt_unscale)
1021
1025
call sum_across_PEs(varsum)
1022
1026
varAvg = varsum / wt_sum
1023
1027
endif
1028
+
1024
1029
endif
1025
1030
1031
+ ! This seems like an unlikely case to ever be used, but it is needed to recreate previous behavior.
1032
+ if (present (tmp_scale)) then ; if (tmp_scale == 0.0 ) varAvg = 0.0 ; endif
1033
+
1026
1034
field(:,:) = varAvg
1027
1035
1028
1036
end subroutine homogenize_field
0 commit comments