From b3e80f73f1033dd88ebc2d362d941a0f2a58d151 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 27 Feb 2022 13:46:00 -0500 Subject: [PATCH 1/2] +(*)Add tmp_scale arguments to global_area_mean Added new tmp_scale optional arguments to global_area_mean, global_layer_mean, global_area_mean_u, global_area_mean_v, global_area_integral, global_volume_mean and global_mass_integral. This argument allows the reproducing sums to work with rescaled variables without undoing the scaling of the returned variable. Also corrected the area_rescaling in global_area_mean_u and global_area_mean_v, which were substantially changing answers when horizontal distances were being rescaled (i.e., if L_RESCALE_POWER is not 0). These routines had only been added recently, so this change is only changing answers with HOMOGENIZE_FORCINGS = True. --- src/diagnostics/MOM_spatial_means.F90 | 105 +++++++++++++++++++------- 1 file changed, 78 insertions(+), 27 deletions(-) diff --git a/src/diagnostics/MOM_spatial_means.F90 b/src/diagnostics/MOM_spatial_means.F90 index 7fc83f9b40..551b821645 100644 --- a/src/diagnostics/MOM_spatial_means.F90 +++ b/src/diagnostics/MOM_spatial_means.F90 @@ -25,89 +25,121 @@ module MOM_spatial_means contains !> Return the global area mean of a variable. This uses reproducing sums. -function global_area_mean(var, G, scale) +function global_area_mean(var, G, scale, tmp_scale) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZI_(G), SZJ_(G)), intent(in) :: var !< The variable to average real, optional, intent(in) :: scale !< A rescaling factor for the variable - - real, dimension(SZI_(G), SZJ_(G)) :: tmpForSumming + real, optional, intent(in) :: tmp_scale !< A temporary rescaling factor for the + !! variable that is reversed in the return value real :: global_area_mean + ! Local variables + real, dimension(SZI_(G), SZJ_(G)) :: tmpForSumming real :: scalefac ! An overall scaling factor for the areas and variable. + real :: temp_scale ! A temporary scaling factor. integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - scalefac = G%US%L_to_m**2 ; if (present(scale)) scalefac = G%US%L_to_m**2*scale + temp_scale = 1.0 ; if (present(tmp_scale)) temp_scale = tmp_scale + scalefac = G%US%L_to_m**2*temp_scale ; if (present(scale)) scalefac = scalefac * scale tmpForSumming(:,:) = 0. do j=js,je ; do i=is,ie tmpForSumming(i,j) = var(i,j) * (scalefac * G%areaT(i,j) * G%mask2dT(i,j)) enddo ; enddo + global_area_mean = reproducing_sum(tmpForSumming) * G%IareaT_global + if ((temp_scale /= 0.0) .and. (temp_scale /= 1.0)) & + global_area_mean = global_area_mean / temp_scale + end function global_area_mean !> Return the global area mean of a variable. This uses reproducing sums. -function global_area_mean_v(var, G) +function global_area_mean_v(var, G, tmp_scale) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G), SZJB_(G)), intent(in) :: var !< The variable to average + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: var !< The variable to average + real, optional, intent(in) :: tmp_scale !< A temporary rescaling factor for the + !! variable that is reversed in the return value - real, dimension(SZI_(G), SZJ_(G)) :: tmpForSumming real :: global_area_mean_v + + ! Local variables + real, dimension(SZI_(G), SZJ_(G)) :: tmpForSumming + real :: scalefac ! An overall scaling factor for the areas and variable. + real :: temp_scale ! A temporary scaling factor integer :: i, j, is, ie, js, je, isB, ieB, jsB, jeB is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isB = G%iscB ; ieB = G%iecB ; jsB = G%jscB ; jeB = G%jecB + temp_scale = 1.0 ; if (present(tmp_scale)) temp_scale = tmp_scale + scalefac = G%US%L_to_m**2*temp_scale + tmpForSumming(:,:) = 0. do J=js,je ; do i=is,ie - tmpForSumming(i,j) = G%areaT(i,j) * (var(i,J) * G%mask2dCv(i,J) + & - var(i,J-1) * G%mask2dCv(i,J-1)) & - / max(1.e-20,G%mask2dCv(i,J)+G%mask2dCv(i,J-1)) + tmpForSumming(i,j) = G%areaT(i,j) * scalefac * & + (var(i,J) * G%mask2dCv(i,J) + var(i,J-1) * G%mask2dCv(i,J-1)) / & + max(1.e-20, G%mask2dCv(i,J)+G%mask2dCv(i,J-1)) enddo ; enddo global_area_mean_v = reproducing_sum(tmpForSumming) * G%IareaT_global + if ((temp_scale /= 0.0) .and. (temp_scale /= 1.0)) & + global_area_mean_v = global_area_mean_v / temp_scale end function global_area_mean_v !> Return the global area mean of a variable on U grid. This uses reproducing sums. -function global_area_mean_u(var, G) +function global_area_mean_u(var, G, tmp_scale) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZIB_(G), SZJ_(G)), intent(in) :: var !< The variable to average + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: var !< The variable to average + real, optional, intent(in) :: tmp_scale !< A temporary rescaling factor for the + !! variable that is reversed in the return value + real :: global_area_mean_u real, dimension(SZI_(G), SZJ_(G)) :: tmpForSumming - real :: global_area_mean_u + real :: scalefac ! An overall scaling factor for the areas and variable. + real :: temp_scale ! A temporary scaling factor integer :: i, j, is, ie, js, je, isB, ieB, jsB, jeB is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isB = G%iscB ; ieB = G%iecB ; jsB = G%jscB ; jeB = G%jecB + temp_scale = 1.0 ; if (present(tmp_scale)) temp_scale = tmp_scale + scalefac = G%US%L_to_m**2*temp_scale + tmpForSumming(:,:) = 0. do j=js,je ; do i=is,ie - tmpForSumming(i,j) = G%areaT(i,j) * (var(I,j) * G%mask2dCu(I,j) + & - var(I-1,j) * G%mask2dCu(I-1,j)) & - / max(1.e-20,G%mask2dCu(I,j)+G%mask2dCu(I-1,j)) + tmpForSumming(i,j) = G%areaT(i,j) * scalefac * & + (var(I,j) * G%mask2dCu(I,j) + var(I-1,j) * G%mask2dCu(I-1,j)) / & + max(1.e-20, G%mask2dCu(I,j)+G%mask2dCu(I-1,j)) enddo ; enddo global_area_mean_u = reproducing_sum(tmpForSumming) * G%IareaT_global + if ((temp_scale /= 0.0) .and. (temp_scale /= 1.0)) & + global_area_mean_u = global_area_mean_u / temp_scale end function global_area_mean_u !> Return the global area integral of a variable, by default using the masked area from the !! grid, but an alternate could be used instead. This uses reproducing sums. -function global_area_integral(var, G, scale, area) +function global_area_integral(var, G, scale, area, tmp_scale) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZI_(G),SZJ_(G)), intent(in) :: var !< The variable to integrate real, optional, intent(in) :: scale !< A rescaling factor for the variable real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: area !< The alternate area to use, including - !! any required masking [L2 ~> m2]. + !! any required masking [L2 ~> m2]. + real, optional, intent(in) :: tmp_scale !< A temporary rescaling factor for the + !! variable that is reversed in the return value real :: global_area_integral !< The returned area integral, usually in the units of var times [m2]. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: tmpForSumming real :: scalefac ! An overall scaling factor for the areas and variable. + real :: temp_scale ! A temporary scaling factor. integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - scalefac = G%US%L_to_m**2 ; if (present(scale)) scalefac = G%US%L_to_m**2*scale + temp_scale = 1.0 ; if (present(tmp_scale)) temp_scale = tmp_scale + scalefac = G%US%L_to_m**2*temp_scale ; if (present(scale)) scalefac = scalefac * scale tmpForSumming(:,:) = 0. if (present(area)) then @@ -119,27 +151,35 @@ function global_area_integral(var, G, scale, area) tmpForSumming(i,j) = var(i,j) * (scalefac * G%areaT(i,j) * G%mask2dT(i,j)) enddo ; enddo endif + global_area_integral = reproducing_sum(tmpForSumming) + if ((temp_scale /= 0.0) .and. (temp_scale /= 1.0)) & + global_area_integral = global_area_integral / temp_scale + end function global_area_integral !> Return the layerwise global thickness-weighted mean of a variable. This uses reproducing sums. -function global_layer_mean(var, h, G, GV, scale) +function global_layer_mean(var, h, G, GV, scale, tmp_scale) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: var !< The variable to average real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, optional, intent(in) :: scale !< A rescaling factor for the variable + real, optional, intent(in) :: tmp_scale !< A temporary rescaling factor for the + !! variable that is reversed in the return value real, dimension(SZK_(GV)) :: global_layer_mean real, dimension(G%isc:G%iec, G%jsc:G%jec, SZK_(GV)) :: tmpForSumming, weight type(EFP_type), dimension(2*SZK_(GV)) :: laysums real, dimension(SZK_(GV)) :: global_temp_scalar, global_weight_scalar + real :: temp_scale ! A temporary scaling factor real :: scalefac ! A scaling factor for the variable. integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - scalefac = 1.0 ; if (present(scale)) scalefac = scale + temp_scale = 1.0 ; if (present(tmp_scale)) temp_scale = tmp_scale + scalefac = temp_scale ; if (present(scale)) scalefac = scale * temp_scale tmpForSumming(:,:,:) = 0. ; weight(:,:,:) = 0. do k=1,nz ; do j=js,je ; do i=is,ie @@ -152,13 +192,13 @@ function global_layer_mean(var, h, G, GV, scale) call EFP_sum_across_PEs(laysums, 2*nz) do k=1,nz - global_layer_mean(k) = EFP_to_real(laysums(k)) / EFP_to_real(laysums(nz+k)) + global_layer_mean(k) = EFP_to_real(laysums(k)) / (temp_scale * EFP_to_real(laysums(nz+k))) enddo end function global_layer_mean !> Find the global thickness-weighted mean of a variable. This uses reproducing sums. -function global_volume_mean(var, h, G, GV, scale) +function global_volume_mean(var, h, G, GV, scale, tmp_scale) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & @@ -166,15 +206,19 @@ function global_volume_mean(var, h, G, GV, scale) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, optional, intent(in) :: scale !< A rescaling factor for the variable + real, optional, intent(in) :: tmp_scale !< A temporary rescaling factor for the + !! variable that is reversed in the return value real :: global_volume_mean !< The thickness-weighted average of var + real :: temp_scale ! A temporary scaling factor real :: scalefac ! A scaling factor for the variable. real :: weight_here real, dimension(SZI_(G), SZJ_(G)) :: tmpForSumming, sum_weight integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - scalefac = 1.0 ; if (present(scale)) scalefac = scale + temp_scale = 1.0 ; if (present(tmp_scale)) temp_scale = tmp_scale + scalefac = temp_scale ; if (present(scale)) scalefac = temp_scale * scale tmpForSumming(:,:) = 0. ; sum_weight(:,:) = 0. do k=1,nz ; do j=js,je ; do i=is,ie @@ -183,13 +227,13 @@ function global_volume_mean(var, h, G, GV, scale) sum_weight(i,j) = sum_weight(i,j) + weight_here enddo ; enddo ; enddo global_volume_mean = (reproducing_sum(tmpForSumming)) / & - (reproducing_sum(sum_weight)) + (temp_scale * reproducing_sum(sum_weight)) end function global_volume_mean !> Find the global mass-weighted integral of a variable. This uses reproducing sums. -function global_mass_integral(h, G, GV, var, on_PE_only, scale) +function global_mass_integral(h, G, GV, var, on_PE_only, scale, tmp_scale) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & @@ -199,16 +243,20 @@ function global_mass_integral(h, G, GV, var, on_PE_only, scale) logical, optional, intent(in) :: on_PE_only !< If present and true, the sum is only !! done on the local PE, and it is _not_ order invariant. real, optional, intent(in) :: scale !< A rescaling factor for the variable + real, optional, intent(in) :: tmp_scale !< A temporary rescaling factor for the + !! variable that is reversed in the return value real :: global_mass_integral !< The mass-weighted integral of var (or 1) in !! kg times the units of var real, dimension(SZI_(G), SZJ_(G)) :: tmpForSumming real :: scalefac ! An overall scaling factor for the areas and variable. + real :: temp_scale ! A temporary scaling factor. logical :: global_sum integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - scalefac = G%US%L_to_m**2 ; if (present(scale)) scalefac = G%US%L_to_m**2*scale + temp_scale = 1.0 ; if (present(tmp_scale)) temp_scale = tmp_scale + scalefac = G%US%L_to_m**2*temp_scale ; if (present(scale)) scalefac = scalefac * scale tmpForSumming(:,:) = 0.0 if (present(var)) then @@ -232,6 +280,9 @@ function global_mass_integral(h, G, GV, var, on_PE_only, scale) enddo ; enddo endif + if ((temp_scale /= 0.0) .and. (temp_scale /= 1.0)) & + global_mass_integral = global_mass_integral / temp_scale + end function global_mass_integral !> Find the global mass-weighted order invariant integral of a variable in mks units, From fa2832c1154f95a7af60c3aa51580f1abe4d7412 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 27 Feb 2022 13:53:37 -0500 Subject: [PATCH 2/2] +(*)Rescale variables with homogenize_forcing Add optional tmp_scale arguments to the various homogenize_field routines and use them in numerous calls in homogenize_forcing and homogenize_mech_forcing, so that the answers will pass the dimensional rescaling tests for large rescaling factors when HOMOGENIZE_FORCINGS = True. Among other changes is the addition of a verticalGrid_type argument to homogenize_forcing. All answers are bitwise identical in the existing MOM6-examples test suite, but it will change answers in other cases with dimensional rescaling active and homogenized forcing. --- src/core/MOM.F90 | 2 +- src/core/MOM_forcing_type.F90 | 151 ++++++++++++++++++---------------- 2 files changed, 81 insertions(+), 72 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 4a82eac903..8f6dab2a1a 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -591,7 +591,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS call homogenize_mech_forcing(forces, G, US, GV%Rho0, CS%update_ustar) ! Note the following computes the mean ustar as the mean of ustar rather than ! ustar of the mean of tau. - call homogenize_forcing(fluxes, G) + call homogenize_forcing(fluxes, G, GV, US) if (CS%update_ustar) then ! These calls corrects the ustar values call copy_common_forcing_fields(forces, fluxes, G) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 3248c09fa4..be40f7bcb7 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -3472,9 +3472,9 @@ subroutine homogenize_mech_forcing(forces, G, US, Rho0, UpdateUstar) type(ocean_grid_type), intent(in) :: G !< Grid metric of target forcing type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(in) :: Rho0 !< A reference density of seawater [R ~> kg m-3], - !! as used to calculate ustar. + !! as used to calculate ustar. logical, optional, intent(in) :: UpdateUstar !< A logical to determine if Ustar should be directly averaged - !! or updated from mean tau. + !! or updated from mean tau. real :: tx_mean, ty_mean, avg real :: iRho0 @@ -3492,52 +3492,54 @@ subroutine homogenize_mech_forcing(forces, G, US, Rho0, UpdateUstar) do_press, do_iceberg) if (do_stress) then - tx_mean = global_area_mean_u(forces%taux, G) + tx_mean = global_area_mean_u(forces%taux, G, tmp_scale=US%Z_to_L*US%RL2_T2_to_Pa) do j=js,je ; do i=isB,ieB if (G%mask2dCu(I,j) > 0.) forces%taux(I,j) = tx_mean enddo ; enddo - ty_mean = global_area_mean_v(forces%tauy, G) + ty_mean = global_area_mean_v(forces%tauy, G, tmp_scale=US%Z_to_L*US%RL2_T2_to_Pa) do j=jsB,jeB ; do i=is,ie if (G%mask2dCv(i,J) > 0.) forces%tauy(i,J) = ty_mean enddo ; enddo if (tau2ustar) then do j=js,je ; do i=is,ie - if (G%mask2dT(i,j) > 0.) forces%ustar(i,j) = sqrt(sqrt(tx_mean**2 + ty_mean**2)*iRho0) + if (G%mask2dT(i,j) > 0.) forces%ustar(i,j) = US%L_to_Z*sqrt(sqrt(tx_mean**2 + ty_mean**2)*iRho0) enddo ; enddo else - call homogenize_field_t(forces%ustar, G) + call homogenize_field_t(forces%ustar, G, tmp_scale=US%Z_to_m*US%s_to_T) endif else if (do_ustar) then - call homogenize_field_t(forces%ustar, G) + call homogenize_field_t(forces%ustar, G, tmp_scale=US%Z_to_m*US%s_to_T) endif endif if (do_shelf) then - call homogenize_field_u(forces%rigidity_ice_u, G) - call homogenize_field_v(forces%rigidity_ice_v, G) + call homogenize_field_u(forces%rigidity_ice_u, G, tmp_scale=US%L_T_to_m_s*US%L_to_m**2*US%L_to_Z) + call homogenize_field_v(forces%rigidity_ice_v, G, tmp_scale=US%L_T_to_m_s*US%L_to_m**2*US%L_to_Z) call homogenize_field_u(forces%frac_shelf_u, G) call homogenize_field_v(forces%frac_shelf_v, G) endif if (do_press) then ! NOTE: p_surf_SSH either points to p_surf or p_surf_full - call homogenize_field_t(forces%p_surf, G) - call homogenize_field_t(forces%p_surf_full, G) - call homogenize_field_t(forces%net_mass_src, G) + call homogenize_field_t(forces%p_surf, G, tmp_scale=US%RL2_T2_to_Pa) + call homogenize_field_t(forces%p_surf_full, G, tmp_scale=US%RL2_T2_to_Pa) + call homogenize_field_t(forces%net_mass_src, G, tmp_scale=US%RZ_T_to_kg_m2s) endif if (do_iceberg) then call homogenize_field_t(forces%area_berg, G) - call homogenize_field_t(forces%mass_berg, G) + call homogenize_field_t(forces%mass_berg, G, tmp_scale=US%RZ_to_kg_m2) endif end subroutine homogenize_mech_forcing !< Homogenize the fluxes -subroutine homogenize_forcing(fluxes, G) - type(forcing), intent(inout) :: fluxes !< Input forcing struct - type(ocean_grid_type), intent(in) :: G !< Grid metric of target forcing +subroutine homogenize_forcing(fluxes, G, GV, US) + type(forcing), intent(inout) :: fluxes !< Input forcing struct + type(ocean_grid_type), intent(in) :: G !< Grid metric of target forcing + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real :: avg logical :: do_ustar, do_water, do_heat, do_salt, do_press, do_shelf, & @@ -3550,97 +3552,98 @@ subroutine homogenize_forcing(fluxes, G) do_shelf, do_iceberg, do_salt, do_heat_added, do_buoy) if (do_ustar) then - call homogenize_field_t(fluxes%ustar, G) - call homogenize_field_t(fluxes%ustar_gustless, G) + call homogenize_field_t(fluxes%ustar, G, tmp_scale=US%Z_to_m*US%s_to_T) + call homogenize_field_t(fluxes%ustar_gustless, G, tmp_scale=US%Z_to_m*US%s_to_T) endif if (do_water) then - call homogenize_field_t(fluxes%evap, G) - call homogenize_field_t(fluxes%lprec, G) - call homogenize_field_t(fluxes%lprec, G) - call homogenize_field_t(fluxes%fprec, G) - call homogenize_field_t(fluxes%vprec, G) - call homogenize_field_t(fluxes%lrunoff, G) - call homogenize_field_t(fluxes%frunoff, G) - call homogenize_field_t(fluxes%seaice_melt, G) - call homogenize_field_t(fluxes%netMassOut, G) - call homogenize_field_t(fluxes%netMassIn, G) + call homogenize_field_t(fluxes%evap, G, tmp_scale=US%RZ_T_to_kg_m2s) + call homogenize_field_t(fluxes%lprec, G, tmp_scale=US%RZ_T_to_kg_m2s) + call homogenize_field_t(fluxes%fprec, G, tmp_scale=US%RZ_T_to_kg_m2s) + call homogenize_field_t(fluxes%vprec, G, tmp_scale=US%RZ_T_to_kg_m2s) + call homogenize_field_t(fluxes%lrunoff, G, tmp_scale=US%RZ_T_to_kg_m2s) + call homogenize_field_t(fluxes%frunoff, G, tmp_scale=US%RZ_T_to_kg_m2s) + call homogenize_field_t(fluxes%seaice_melt, G, tmp_scale=US%RZ_T_to_kg_m2s) + ! These two calls might not be needed. + call homogenize_field_t(fluxes%netMassOut, G, tmp_scale=GV%H_to_mks) + call homogenize_field_t(fluxes%netMassIn, G, tmp_scale=GV%H_to_mks) !This was removed and I don't think replaced. Not needed? !call homogenize_field_t(fluxes%netSalt, G) endif if (do_heat) then - call homogenize_field_t(fluxes%seaice_melt_heat, G) - call homogenize_field_t(fluxes%sw, G) - call homogenize_field_t(fluxes%lw, G) - call homogenize_field_t(fluxes%latent, G) - call homogenize_field_t(fluxes%sens, G) - call homogenize_field_t(fluxes%latent_evap_diag, G) - call homogenize_field_t(fluxes%latent_fprec_diag, G) - call homogenize_field_t(fluxes%latent_frunoff_diag, G) + call homogenize_field_t(fluxes%seaice_melt_heat, G, tmp_scale=US%QRZ_T_to_W_m2) + call homogenize_field_t(fluxes%sw, G, tmp_scale=US%QRZ_T_to_W_m2) + call homogenize_field_t(fluxes%lw, G, tmp_scale=US%QRZ_T_to_W_m2) + call homogenize_field_t(fluxes%latent, G, tmp_scale=US%QRZ_T_to_W_m2) + call homogenize_field_t(fluxes%sens, G, tmp_scale=US%QRZ_T_to_W_m2) + !### These are for diagnostics only and may not be needed. + call homogenize_field_t(fluxes%latent_evap_diag, G, tmp_scale=US%QRZ_T_to_W_m2) + call homogenize_field_t(fluxes%latent_fprec_diag, G, tmp_scale=US%QRZ_T_to_W_m2) + call homogenize_field_t(fluxes%latent_frunoff_diag, G, tmp_scale=US%QRZ_T_to_W_m2) endif - if (do_salt) call homogenize_field_t(fluxes%salt_flux, G) + if (do_salt) call homogenize_field_t(fluxes%salt_flux, G, tmp_scale=US%RZ_T_to_kg_m2s) if (do_heat .and. do_water) then - call homogenize_field_t(fluxes%heat_content_cond, G) - call homogenize_field_t(fluxes%heat_content_icemelt, G) - call homogenize_field_t(fluxes%heat_content_lprec, G) - call homogenize_field_t(fluxes%heat_content_fprec, G) - call homogenize_field_t(fluxes%heat_content_vprec, G) - call homogenize_field_t(fluxes%heat_content_lrunoff, G) - call homogenize_field_t(fluxes%heat_content_frunoff, G) - call homogenize_field_t(fluxes%heat_content_massout, G) - call homogenize_field_t(fluxes%heat_content_massin, G) + call homogenize_field_t(fluxes%heat_content_cond, G, tmp_scale=US%QRZ_T_to_W_m2) + call homogenize_field_t(fluxes%heat_content_icemelt, G, tmp_scale=US%QRZ_T_to_W_m2) + call homogenize_field_t(fluxes%heat_content_lprec, G, tmp_scale=US%QRZ_T_to_W_m2) + call homogenize_field_t(fluxes%heat_content_fprec, G, tmp_scale=US%QRZ_T_to_W_m2) + call homogenize_field_t(fluxes%heat_content_vprec, G, tmp_scale=US%QRZ_T_to_W_m2) + call homogenize_field_t(fluxes%heat_content_lrunoff, G, tmp_scale=US%QRZ_T_to_W_m2) + call homogenize_field_t(fluxes%heat_content_frunoff, G, tmp_scale=US%QRZ_T_to_W_m2) + call homogenize_field_t(fluxes%heat_content_massout, G, tmp_scale=US%QRZ_T_to_W_m2) + call homogenize_field_t(fluxes%heat_content_massin, G, tmp_scale=US%QRZ_T_to_W_m2) endif - if (do_press) call homogenize_field_t(fluxes%p_surf, G) + if (do_press) call homogenize_field_t(fluxes%p_surf, G, tmp_scale=US%RL2_T2_to_Pa) if (do_shelf) then call homogenize_field_t(fluxes%frac_shelf_h, G) - call homogenize_field_t(fluxes%ustar_shelf, G) - call homogenize_field_t(fluxes%iceshelf_melt, G) + call homogenize_field_t(fluxes%ustar_shelf, G, tmp_scale=US%Z_to_m*US%s_to_T) + call homogenize_field_t(fluxes%iceshelf_melt, G, tmp_scale=US%RZ_T_to_kg_m2s) endif if (do_iceberg) then - call homogenize_field_t(fluxes%ustar_berg, G) + call homogenize_field_t(fluxes%ustar_berg, G, tmp_scale=US%Z_to_m*US%s_to_T) call homogenize_field_t(fluxes%area_berg, G) endif if (do_heat_added) then - call homogenize_field_t(fluxes%heat_added, G) + call homogenize_field_t(fluxes%heat_added, G, tmp_scale=US%QRZ_T_to_W_m2) endif ! The following fields are handled by drivers rather than control flags. if (associated(fluxes%sw_vis_dir)) & - call homogenize_field_t(fluxes%sw_vis_dir, G) + call homogenize_field_t(fluxes%sw_vis_dir, G, tmp_scale=US%QRZ_T_to_W_m2) if (associated(fluxes%sw_vis_dif)) & - call homogenize_field_t(fluxes%sw_vis_dif, G) + call homogenize_field_t(fluxes%sw_vis_dif, G, tmp_scale=US%QRZ_T_to_W_m2) if (associated(fluxes%sw_nir_dir)) & - call homogenize_field_t(fluxes%sw_nir_dir, G) + call homogenize_field_t(fluxes%sw_nir_dir, G, tmp_scale=US%QRZ_T_to_W_m2) if (associated(fluxes%sw_nir_dif)) & - call homogenize_field_t(fluxes%sw_nir_dif, G) + call homogenize_field_t(fluxes%sw_nir_dif, G, tmp_scale=US%QRZ_T_to_W_m2) if (associated(fluxes%salt_flux_in)) & - call homogenize_field_t(fluxes%salt_flux_in, G) + call homogenize_field_t(fluxes%salt_flux_in, G, tmp_scale=US%RZ_T_to_kg_m2s) if (associated(fluxes%salt_flux_added)) & - call homogenize_field_t(fluxes%salt_flux_added, G) + call homogenize_field_t(fluxes%salt_flux_added, G, tmp_scale=US%RZ_T_to_kg_m2s) if (associated(fluxes%p_surf_full)) & - call homogenize_field_t(fluxes%p_surf_full, G) + call homogenize_field_t(fluxes%p_surf_full, G, tmp_scale=US%RL2_T2_to_Pa) if (associated(fluxes%buoy)) & - call homogenize_field_t(fluxes%buoy, G) + call homogenize_field_t(fluxes%buoy, G, tmp_scale=US%L_to_m**2*US%s_to_T**3) if (associated(fluxes%TKE_tidal)) & - call homogenize_field_t(fluxes%TKE_tidal, G) + call homogenize_field_t(fluxes%TKE_tidal, G, tmp_scale=US%RZ3_T3_to_W_m2) if (associated(fluxes%ustar_tidal)) & - call homogenize_field_t(fluxes%ustar_tidal, G) + call homogenize_field_t(fluxes%ustar_tidal, G, tmp_scale=US%Z_to_m*US%s_to_T) ! TODO: tracer flux homogenization ! Having a warning causes a lot of errors (each time step). @@ -3649,45 +3652,51 @@ subroutine homogenize_forcing(fluxes, G) end subroutine homogenize_forcing -subroutine homogenize_field_t(var, G) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G), SZJ_(G)), intent(inout) :: var !< The variable to homogenize +subroutine homogenize_field_t(var, G, tmp_scale) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: var !< The variable to homogenize + real, optional, intent(in) :: tmp_scale !< A temporary rescaling factor for the + !! variable that is reversed in the return value real :: avg integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - avg = global_area_mean(var, G) + avg = global_area_mean(var, G, tmp_scale=tmp_scale) do j=js,je ; do i=is,ie if (G%mask2dT(i,j) > 0.) var(i,j) = avg enddo ; enddo end subroutine homogenize_field_t -subroutine homogenize_field_v(var, G) +subroutine homogenize_field_v(var, G, tmp_scale) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G), SZJB_(G)), intent(inout) :: var !< The variable to homogenize + real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: var !< The variable to homogenize + real, optional, intent(in) :: tmp_scale !< A temporary rescaling factor for the + !! variable that is reversed in the return value real :: avg integer :: i, j, is, ie, jsB, jeB is = G%isc ; ie = G%iec ; jsB = G%jscB ; jeB = G%jecB - avg = global_area_mean_v(var, G) + avg = global_area_mean_v(var, G, tmp_scale=tmp_scale) do J=jsB,jeB ; do i=is,ie if (G%mask2dCv(i,J) > 0.) var(i,J) = avg enddo ; enddo end subroutine homogenize_field_v -subroutine homogenize_field_u(var, G) +subroutine homogenize_field_u(var, G, tmp_scale) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G), SZJB_(G)), intent(inout) :: var !< The variable to homogenize + real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: var !< The variable to homogenize + real, optional, intent(in) :: tmp_scale !< A temporary rescaling factor for the + !! variable that is reversed in the return value real :: avg integer :: i, j, isB, ieB, js, je isB = G%iscB ; ieB = G%iecB ; js = G%jsc ; je = G%jec - avg = global_area_mean_u(var, G) + avg = global_area_mean_u(var, G, tmp_scale=tmp_scale) do j=js,je ; do I=isB,ieB if (G%mask2dCu(I,j) > 0.) var(I,j) = avg enddo ; enddo