diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index bb6270c177..9241e69ebd 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -230,7 +230,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc PmE_adj, & ! The adjustment to PminusE that will cause the salinity ! to be restored toward its target value [kg m-1 s-1] net_FW, & ! The area integrated net freshwater flux into the ocean [kg s-1] - net_FW2, & ! The area integrated net freshwater flux into the ocean [kg s-1] + net_FW2, & ! The net freshwater flux into the ocean [kg m-2 s-1] work_sum, & ! A 2-d array that is used as the work space for global sums [m2] or [kg s-1] open_ocn_mask ! a binary field indicating where ice is present based on frazil criteria [nondim] @@ -327,7 +327,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc ! allocation and initialization on first call to this routine if (CS%area_surf < 0.0) then do j=js,je ; do i=is,ie - work_sum(i,j) = G%areaT(i,j) * G%mask2dT(i,j) + work_sum(i,j) = US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j) enddo ; enddo CS%area_surf = reproducing_sum(work_sum, isr, ier, jsr, jer) endif ! endif for allocation and initialization @@ -359,7 +359,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc call adjust_area_mean_to_zero(fluxes%salt_flux, G, fluxes%saltFluxGlobalScl) fluxes%saltFluxGlobalAdj = 0. else - work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) + work_sum(is:ie,js:je) = US%L_to_m**2*G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) fluxes%saltFluxGlobalAdj = reproducing_sum(work_sum(:,:), isr,ier, jsr,jer)/CS%area_surf fluxes%salt_flux(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) - fluxes%saltFluxGlobalAdj endif @@ -380,7 +380,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc call adjust_area_mean_to_zero(fluxes%vprec, G, fluxes%vPrecGlobalScl) fluxes%vPrecGlobalAdj = 0. else - work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) + work_sum(is:ie,js:je) = US%L_to_m**2*G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) fluxes%vPrecGlobalAdj = reproducing_sum(work_sum(:,:), isr, ier, jsr, jer) / CS%area_surf do j=js,je ; do i=is,ie fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%vPrecGlobalAdj ) * G%mask2dT(i,j) @@ -512,7 +512,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc do j=js,je ; do i=is,ie net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(i,j)) + & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j))) + & - (fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * G%areaT(i,j) + (fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * US%L_to_m**2*G%areaT(i,j) ! The following contribution appears to be calculating the volume flux of sea-ice ! melt. This calculation is clearly WRONG if either sea-ice has variable ! salinity or the sea-ice is completely fresh. @@ -520,15 +520,16 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc ! is constant. ! To do this correctly we will need a sea-ice melt field added to IOB. -AJA if (associated(IOB%salt_flux) .and. (CS%ice_salt_concentration>0.0)) & - net_FW(i,j) = net_FW(i,j) + sign_for_net_FW_bug * G%areaT(i,j) * & + net_FW(i,j) = net_FW(i,j) + sign_for_net_FW_bug * US%L_to_m**2*G%areaT(i,j) * & (IOB%salt_flux(i-i0,j-j0) / CS%ice_salt_concentration) - net_FW2(i,j) = net_FW(i,j) / G%areaT(i,j) + net_FW2(i,j) = net_FW(i,j) / (US%L_to_m**2*G%areaT(i,j)) enddo ; enddo if (CS%adjust_net_fresh_water_by_scaling) then call adjust_area_mean_to_zero(net_FW2, G, fluxes%netFWGlobalScl) do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = fluxes%vprec(i,j) + (net_FW2(i,j) - net_FW(i,j)/G%areaT(i,j)) * G%mask2dT(i,j) + fluxes%vprec(i,j) = fluxes%vprec(i,j) + & + (net_FW2(i,j) - net_FW(i,j)/(US%L_to_m**2*G%areaT(i,j))) * G%mask2dT(i,j) enddo ; enddo else fluxes%netFWGlobalAdj = reproducing_sum(net_FW(:,:), isr, ier, jsr, jer) / CS%area_surf diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index f9b84a97e1..96366a78e9 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -393,7 +393,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) call extract_surface_state(OS%MOM_CSp, OS%sfc_state) - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) endif @@ -505,7 +505,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda call convert_IOB_to_forces(Ice_ocean_boundary, OS%forces, index_bnds, OS%Time_dyn, OS%grid, OS%US, & OS%forcing_CSp, dt_forcing=dt_coupling, reset_avg=OS%fluxes%fluxes_used) if (OS%use_ice_shelf) & - call add_shelf_forces(OS%grid, OS%Ice_shelf_CSp, OS%forces) + call add_shelf_forces(OS%grid, OS%US, OS%Ice_shelf_CSp, OS%forces) if (OS%icebergs_alter_ocean) & call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & OS%sfc_state, dt_coupling, OS%marine_ice_CSp) @@ -659,9 +659,9 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda endif ! Translate state into Ocean. -! call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, & +! call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US, & ! Ice_ocean_boundary%p, OS%press_to_z) - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) Time1 = OS%Time ; if (do_dyn) Time1 = OS%Time_dyn call coupler_type_send_data(Ocean_sfc%fields, Time1) @@ -817,7 +817,7 @@ end subroutine initialize_ocean_public_type !! code that calculates the surface state in the first place. !! Note the offset in the arrays because the ocean_data_type has no !! halo points in its arrays and always uses absolute indicies. -subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z) +subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, US, patm, press_to_z) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(ocean_public_type), & @@ -825,6 +825,7 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z !! visible ocean surface fields, whose elements !! have their data set here. type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, optional, intent(in) :: patm(:,:) !< The pressure at the ocean surface [Pa]. real, optional, intent(in) :: press_to_z !< A conversion factor between pressure and !! ocean depth in m, usually 1/(rho_0*g) [m Pa-1]. @@ -871,12 +872,12 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z if (present(patm)) then do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd Ocean_sfc%sea_lev(i,j) = sfc_state%sea_lev(i+i0,j+j0) + patm(i,j) * press_to_z - Ocean_sfc%area(i,j) = G%areaT(i+i0,j+j0) + Ocean_sfc%area(i,j) = US%L_to_m**2*G%areaT(i+i0,j+j0) enddo ; enddo else do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd Ocean_sfc%sea_lev(i,j) = sfc_state%sea_lev(i+i0,j+j0) - Ocean_sfc%area(i,j) = G%areaT(i+i0,j+j0) + Ocean_sfc%area(i,j) = US%L_to_m**2*G%areaT(i+i0,j+j0) enddo ; enddo endif @@ -938,7 +939,7 @@ subroutine ocean_model_init_sfc(OS, Ocean_sfc) call extract_surface_state(OS%MOM_CSp, OS%sfc_state) - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) end subroutine ocean_model_init_sfc @@ -1036,7 +1037,7 @@ subroutine ocean_model_data2D_get(OS, Ocean, name, array2D, isc, jsc) select case(name) case('area') - array2D(isc:,jsc:) = OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%US%L_to_m**2*OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) case('mask') array2D(isc:,jsc:) = OS%grid%mask2dT(g_isc:g_iec,g_jsc:g_jec) !OR same result diff --git a/config_src/ice_solo_driver/MOM_surface_forcing.F90 b/config_src/ice_solo_driver/MOM_surface_forcing.F90 index efacc07dc5..ad2352d460 100644 --- a/config_src/ice_solo_driver/MOM_surface_forcing.F90 +++ b/config_src/ice_solo_driver/MOM_surface_forcing.F90 @@ -693,12 +693,12 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) call MOM_read_data(trim(CS%inputdir)//trim(CS%freshdischarge_file), "disch_w", & temp(:,:), G%Domain, timelevel=time_lev_monthly) do j=js,je ; do i=is,ie - fluxes%lrunoff(i,j) = temp(i,j)*G%IareaT(i,j) + fluxes%lrunoff(i,j) = temp(i,j)*US%m_to_L**2*G%IareaT(i,j) enddo ; enddo call MOM_read_data(trim(CS%inputdir)//trim(CS%freshdischarge_file), "disch_s", & temp(:,:), G%Domain, timelevel=time_lev_monthly) do j=js,je ; do i=is,ie - fluxes%frunoff(i,j) = temp(i,j)*G%IareaT(i,j) + fluxes%frunoff(i,j) = temp(i,j)*US%m_to_L**2*G%IareaT(i,j) enddo ; enddo ! Read the SST and SSS fields for damping. diff --git a/config_src/mct_driver/mom_ocean_model_mct.F90 b/config_src/mct_driver/mom_ocean_model_mct.F90 index ec894f1ebb..4f1c7d963a 100644 --- a/config_src/mct_driver/mom_ocean_model_mct.F90 +++ b/config_src/mct_driver/mom_ocean_model_mct.F90 @@ -411,7 +411,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i call extract_surface_state(OS%MOM_CSp, OS%sfc_state) - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) endif call close_param_file(param_file) @@ -684,7 +684,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! Translate state into Ocean. ! call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, & ! Ice_ocean_boundary%p, OS%press_to_z) - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) call coupler_type_send_data(Ocean_sfc%fields, OS%Time) call callTree_leave("update_ocean_model()") @@ -858,7 +858,7 @@ end subroutine initialize_ocean_public_type !! code that calculates the surface state in the first place. !! Note the offset in the arrays because the ocean_data_type has no !! halo points in its arrays and always uses absolute indicies. -subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z) +subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, US, patm, press_to_z) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(ocean_public_type), & @@ -866,6 +866,7 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z !! visible ocean surface fields, whose elements !! have their data set here. type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, optional, intent(in) :: patm(:,:) !< The pressure at the ocean surface, in Pa. real, optional, intent(in) :: press_to_z !< A conversion factor between pressure and !! ocean depth in m, usually 1/(rho_0*g), in m Pa-1. @@ -913,12 +914,12 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z if (present(patm)) then do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd Ocean_sfc%sea_lev(i,j) = sfc_state%sea_lev(i+i0,j+j0) + patm(i,j) * press_to_z - Ocean_sfc%area(i,j) = G%areaT(i+i0,j+j0) + Ocean_sfc%area(i,j) = US%L_to_m**2*G%areaT(i+i0,j+j0) enddo ; enddo else do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd Ocean_sfc%sea_lev(i,j) = sfc_state%sea_lev(i+i0,j+j0) - Ocean_sfc%area(i,j) = G%areaT(i+i0,j+j0) + Ocean_sfc%area(i,j) = US%L_to_m**2*G%areaT(i+i0,j+j0) enddo ; enddo endif @@ -992,7 +993,7 @@ subroutine ocean_model_init_sfc(OS, Ocean_sfc) call extract_surface_state(OS%MOM_CSp, OS%sfc_state) - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) end subroutine ocean_model_init_sfc @@ -1090,7 +1091,7 @@ subroutine ocean_model_data2D_get(OS,Ocean, name, array2D,isc,jsc) select case(name) case('area') - array2D(isc:,jsc:) = OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%US%L_to_m**2*OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) case('mask') array2D(isc:,jsc:) = OS%grid%mask2dT(g_isc:g_iec,g_jsc:g_jec) !OR same result diff --git a/config_src/mct_driver/mom_surface_forcing_mct.F90 b/config_src/mct_driver/mom_surface_forcing_mct.F90 index 100b08e678..d43f9f064b 100644 --- a/config_src/mct_driver/mom_surface_forcing_mct.F90 +++ b/config_src/mct_driver/mom_surface_forcing_mct.F90 @@ -331,7 +331,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & ! allocation and initialization on first call to this routine if (CS%area_surf < 0.0) then do j=js,je ; do i=is,ie - work_sum(i,j) = G%areaT(i,j) * G%mask2dT(i,j) + work_sum(i,j) = US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j) enddo; enddo CS%area_surf = reproducing_sum(work_sum, isr, ier, jsr, jer) endif ! endif for allocation and initialization @@ -363,7 +363,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & call adjust_area_mean_to_zero(fluxes%salt_flux, G, fluxes%saltFluxGlobalScl) fluxes%saltFluxGlobalAdj = 0. else - work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) + work_sum(is:ie,js:je) = US%L_to_m**2*G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) fluxes%saltFluxGlobalAdj = reproducing_sum(work_sum(:,:), isr,ier, jsr,jer)/CS%area_surf fluxes%salt_flux(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) - fluxes%saltFluxGlobalAdj endif @@ -384,7 +384,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & call adjust_area_mean_to_zero(fluxes%vprec, G, fluxes%vPrecGlobalScl) fluxes%vPrecGlobalAdj = 0. else - work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) + work_sum(is:ie,js:je) = US%L_to_m**2*G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) fluxes%vPrecGlobalAdj = reproducing_sum(work_sum(:,:), isr, ier, jsr, jer) / CS%area_surf do j=js,je ; do i=is,ie fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%vPrecGlobalAdj ) * G%mask2dT(i,j) @@ -535,15 +535,16 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & do j=js,je ; do i=is,ie net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(i,j) + fluxes%seaice_melt(i,j)) + & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j))) + & - (fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * G%areaT(i,j) + (fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * US%L_to_m**2*G%areaT(i,j) - net_FW2(i,j) = net_FW(i,j)/G%areaT(i,j) + net_FW2(i,j) = net_FW(i,j) / (US%L_to_m**2*G%areaT(i,j)) enddo; enddo if (CS%adjust_net_fresh_water_by_scaling) then call adjust_area_mean_to_zero(net_FW2, G, fluxes%netFWGlobalScl) do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = fluxes%vprec(i,j) + (net_FW2(i,j) - net_FW(i,j)/G%areaT(i,j)) * G%mask2dT(i,j) + fluxes%vprec(i,j) = fluxes%vprec(i,j) + & + (net_FW2(i,j) - net_FW(i,j)/(US%L_to_m**2*G%areaT(i,j))) * G%mask2dT(i,j) enddo; enddo else fluxes%netFWGlobalAdj = reproducing_sum(net_FW(:,:), isr, ier, jsr, jer) / CS%area_surf diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 index b42fa8ca7e..0b7a331458 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -212,7 +212,7 @@ subroutine ocn_export(ind, ocn_public, grid, o2x, dt_int, ncouple_per_day) ! d/dx ssh do j=grid%jsc, grid%jec ; do i=grid%isc,grid%iec ! This is a simple second-order difference - ! o2x(ind%o2x_So_dhdx, n) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%IdxT(i,j) * grid%mask2dT(i,j) + ! o2x(ind%o2x_So_dhdx, n) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%US%m_to_L*grid%IdxT(i,j) * grid%mask2dT(i,j) ! This is a PLM slope which might be less prone to the A-grid null mode slp_L = (ssh(I,j) - ssh(I-1,j)) * grid%mask2dCu(I-1,j) if (grid%mask2dCu(I-1,j)==0.) slp_L = 0. @@ -230,14 +230,14 @@ subroutine ocn_export(ind, ocn_public, grid, o2x, dt_int, ncouple_per_day) ! larger extreme values. slope = 0.0 endif - sshx(i,j) = slope * grid%IdxT(i,j) * grid%mask2dT(i,j) + sshx(i,j) = slope * grid%US%m_to_L*grid%IdxT(i,j) * grid%mask2dT(i,j) if (grid%mask2dT(i,j)==0.) sshx(i,j) = 0.0 enddo; enddo ! d/dy ssh do j=grid%jsc, grid%jec ; do i=grid%isc,grid%iec ! This is a simple second-order difference - ! o2x(ind%o2x_So_dhdy, n) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%IdyT(i,j) * grid%mask2dT(i,j) + ! o2x(ind%o2x_So_dhdy, n) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%US%m_to_L*grid%IdyT(i,j) * grid%mask2dT(i,j) ! This is a PLM slope which might be less prone to the A-grid null mode slp_L = ssh(i,J) - ssh(i,J-1) * grid%mask2dCv(i,J-1) if (grid%mask2dCv(i,J-1)==0.) slp_L = 0. @@ -257,7 +257,7 @@ subroutine ocn_export(ind, ocn_public, grid, o2x, dt_int, ncouple_per_day) ! larger extreme values. slope = 0.0 endif - sshy(i,j) = slope * grid%IdyT(i,j) * grid%mask2dT(i,j) + sshy(i,j) = slope * grid%US%m_to_L*grid%IdyT(i,j) * grid%mask2dT(i,j) if (grid%mask2dT(i,j)==0.) sshy(i,j) = 0.0 enddo; enddo diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index 5b581e0427..2b4f2ba158 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -636,7 +636,7 @@ subroutine ocn_domain_mct( lsize, gsMap_ocn, dom_ocn) integer, pointer :: idata(:) integer :: i,j,k real(kind=SHR_REAL_R8), pointer :: data(:) - real(kind=SHR_REAL_R8) :: m2_to_rad2 + real(kind=SHR_REAL_R8) :: L2_to_rad2 type(ocean_grid_type), pointer :: grid => NULL() ! A pointer to a grid structure grid => glb%grid ! for convenience @@ -681,11 +681,11 @@ subroutine ocn_domain_mct( lsize, gsMap_ocn, dom_ocn) call mct_gGrid_importRattr(dom_ocn,"lat",data,lsize) k = 0 - m2_to_rad2 = 1./grid%Rad_Earth**2 + L2_to_rad2 = grid%US%L_to_m**2 / grid%Rad_Earth**2 do j = grid%jsc, grid%jec do i = grid%isc, grid%iec k = k + 1 ! Increment position within gindex - data(k) = grid%AreaT(i,j) * m2_to_rad2 + data(k) = grid%AreaT(i,j) * L2_to_rad2 enddo enddo call mct_gGrid_importRattr(dom_ocn,"area",data,lsize) @@ -743,7 +743,7 @@ subroutine ocean_model_init_sfc(OS, Ocean_sfc) call extract_surface_state(OS%MOM_CSp, OS%sfc_state) - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) end subroutine ocean_model_init_sfc diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index d6a7837c83..1aeaaa7a3a 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1560,7 +1560,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) dataPtr_xcen(i1,j1) = ocean_grid%geolonT(ig,jg) dataPtr_ycen(i1,j1) = ocean_grid%geolatT(ig,jg) if(grid_attach_area) then - dataPtr_area(i1,j1) = ocean_grid%areaT(ig,jg) + dataPtr_area(i1,j1) = ocean_grid%US%L_to_m**2 * ocean_grid%areaT(ig,jg) endif enddo enddo diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 8cb1a2ca4c..2f872c7da5 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -548,7 +548,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! d/dx ssh ! This is a simple second-order difference - ! dhdx(i,j) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(ig,jg) + ! dhdx(i,j) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * ocean_grid%US%m_to_L*ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(ig,jg) do jglob = jsc, jec j = jglob + ocean_grid%jsc - jsc @@ -571,14 +571,14 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! larger extreme values. slope = 0.0 endif - dhdx(iglob,jglob) = slope * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) + dhdx(iglob,jglob) = slope * ocean_grid%US%m_to_L*ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) if (ocean_grid%mask2dT(i,j)==0.) dhdx(iglob,jglob) = 0.0 enddo enddo ! d/dy ssh ! This is a simple second-order difference - ! dhdy(i,j) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(ig,jg) + ! dhdy(i,j) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * ocean_grid%US%m_to_L*ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(ig,jg) do jglob = jsc, jec j = jglob + ocean_grid%jsc - jsc @@ -601,7 +601,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! larger extreme values. slope = 0.0 endif - dhdy(iglob,jglob) = slope * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) + dhdy(iglob,jglob) = slope * ocean_grid%US%m_to_L*ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) if (ocean_grid%mask2dT(i,j)==0.) dhdy(iglob,jglob) = 0.0 enddo enddo diff --git a/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 b/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 index 95b1bcc6e3..e04064f672 100644 --- a/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 +++ b/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 @@ -408,7 +408,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i call extract_surface_state(OS%MOM_CSp, OS%sfc_state) - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) endif @@ -519,7 +519,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & if (do_thermo) & call shelf_calc_flux(OS%sfc_state, OS%fluxes, OS%Time, dt_coupling, OS%Ice_shelf_CSp) if (do_dyn) & - call add_shelf_forces(OS%grid, OS%Ice_shelf_CSp, OS%forces) + call add_shelf_forces(OS%grid, OS%US, OS%Ice_shelf_CSp, OS%forces) endif if (OS%icebergs_alter_ocean) then if (do_dyn) & @@ -550,7 +550,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & if (do_thermo) & call shelf_calc_flux(OS%sfc_state, OS%flux_tmp, OS%Time, dt_coupling, OS%Ice_shelf_CSp) if (do_dyn) & - call add_shelf_forces(OS%grid, OS%Ice_shelf_CSp, OS%forces) + call add_shelf_forces(OS%grid, OS%US, OS%Ice_shelf_CSp, OS%forces) endif if (OS%icebergs_alter_ocean) then if (do_dyn) & @@ -671,7 +671,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! Translate state into Ocean. ! call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, & ! Ice_ocean_boundary%p, OS%press_to_z) - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) call coupler_type_send_data(Ocean_sfc%fields, OS%Time) call callTree_leave("update_ocean_model()") @@ -845,7 +845,7 @@ end subroutine initialize_ocean_public_type !! code that calculates the surface state in the first place. !! Note the offset in the arrays because the ocean_data_type has no !! halo points in its arrays and always uses absolute indicies. -subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z) +subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, US, patm, press_to_z) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(ocean_public_type), & @@ -853,6 +853,7 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z !! visible ocean surface fields, whose elements !! have their data set here. type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, optional, intent(in) :: patm(:,:) !< The pressure at the ocean surface, in Pa. real, optional, intent(in) :: press_to_z !< A conversion factor between pressure and !! ocean depth in m, usually 1/(rho_0*g), in m Pa-1. @@ -899,12 +900,12 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z if (present(patm)) then do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd Ocean_sfc%sea_lev(i,j) = sfc_state%sea_lev(i+i0,j+j0) + patm(i,j) * press_to_z - Ocean_sfc%area(i,j) = G%areaT(i+i0,j+j0) + Ocean_sfc%area(i,j) = US%L_to_m**2*G%areaT(i+i0,j+j0) enddo ; enddo else do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd Ocean_sfc%sea_lev(i,j) = sfc_state%sea_lev(i+i0,j+j0) - Ocean_sfc%area(i,j) = G%areaT(i+i0,j+j0) + Ocean_sfc%area(i,j) = US%L_to_m**2*G%areaT(i+i0,j+j0) enddo ; enddo endif @@ -978,7 +979,7 @@ subroutine ocean_model_init_sfc(OS, Ocean_sfc) call extract_surface_state(OS%MOM_CSp, OS%sfc_state) - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) end subroutine ocean_model_init_sfc @@ -1076,7 +1077,7 @@ subroutine ocean_model_data2D_get(OS, Ocean, name, array2D, isc, jsc) select case(name) case('area') - array2D(isc:,jsc:) = OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%US%L_to_m**2*OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) case('mask') array2D(isc:,jsc:) = OS%grid%mask2dT(g_isc:g_iec,g_jsc:g_jec) !OR same result diff --git a/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 b/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 index 061e6bac02..cdd93a8772 100644 --- a/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 +++ b/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 @@ -337,7 +337,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & ! allocation and initialization on first call to this routine if (CS%area_surf < 0.0) then do j=js,je ; do i=is,ie - work_sum(i,j) = G%areaT(i,j) * G%mask2dT(i,j) + work_sum(i,j) = US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j) enddo ; enddo CS%area_surf = reproducing_sum(work_sum, isr, ier, jsr, jer) endif ! endif for allocation and initialization @@ -369,7 +369,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & call adjust_area_mean_to_zero(fluxes%salt_flux, G, fluxes%saltFluxGlobalScl) fluxes%saltFluxGlobalAdj = 0. else - work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) + work_sum(is:ie,js:je) = US%L_to_m**2*G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) fluxes%saltFluxGlobalAdj = reproducing_sum(work_sum(:,:), isr,ier, jsr,jer)/CS%area_surf fluxes%salt_flux(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) - fluxes%saltFluxGlobalAdj endif @@ -390,7 +390,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & call adjust_area_mean_to_zero(fluxes%vprec, G, fluxes%vPrecGlobalScl) fluxes%vPrecGlobalAdj = 0. else - work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) + work_sum(is:ie,js:je) = US%L_to_m**2*G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) fluxes%vPrecGlobalAdj = reproducing_sum(work_sum(:,:), isr, ier, jsr, jer) / CS%area_surf do j=js,je ; do i=is,ie fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%vPrecGlobalAdj ) * G%mask2dT(i,j) @@ -529,15 +529,15 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & do j=js,je ; do i=is,ie net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(i,j) + fluxes%seaice_melt(i,j)) + & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j))) + & - (fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * G%areaT(i,j) - - net_FW2(i,j) = net_FW(i,j) / G%areaT(i,j) + (fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * US%L_to_m**2*G%areaT(i,j) + net_FW2(i,j) = net_FW(i,j) / (US%L_to_m**2*G%areaT(i,j)) enddo ; enddo if (CS%adjust_net_fresh_water_by_scaling) then call adjust_area_mean_to_zero(net_FW2, G, fluxes%netFWGlobalScl) do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = fluxes%vprec(i,j) + (net_FW2(i,j) - net_FW(i,j)/G%areaT(i,j)) * G%mask2dT(i,j) + fluxes%vprec(i,j) = fluxes%vprec(i,j) + & + (net_FW2(i,j) - net_FW(i,j)/(US%L_to_m**2*G%areaT(i,j))) * G%mask2dT(i,j) enddo ; enddo else fluxes%netFWGlobalAdj = reproducing_sum(net_FW(:,:), isr, ier, jsr, jer) / CS%area_surf diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index 6fba8efdee..b057e06f9e 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -488,7 +488,7 @@ program MOM_main if (use_ice_shelf) then call shelf_calc_flux(sfc_state, fluxes, Time, dt_forcing, ice_shelf_CSp) - call add_shelf_forces(grid, Ice_shelf_CSp, forces) + call add_shelf_forces(grid, US, Ice_shelf_CSp, forces) endif fluxes%fluxes_used = .false. fluxes%dt_buoy_accum = dt_forcing diff --git a/config_src/solo_driver/MOM_surface_forcing.F90 b/config_src/solo_driver/MOM_surface_forcing.F90 index 4d9458a1c9..442047f03c 100644 --- a/config_src/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/solo_driver/MOM_surface_forcing.F90 @@ -909,12 +909,12 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, US, CS) call MOM_read_data(CS%runoff_file, CS%lrunoff_var, temp(:,:), & G%Domain, timelevel=time_lev) do j=js,je ; do i=is,ie - fluxes%lrunoff(i,j) = temp(i,j)*G%IareaT(i,j) + fluxes%lrunoff(i,j) = temp(i,j)*US%m_to_L**2*G%IareaT(i,j) enddo ; enddo call MOM_read_data(CS%runoff_file, CS%frunoff_var, temp(:,:), & G%Domain, timelevel=time_lev) do j=js,je ; do i=is,ie - fluxes%frunoff(i,j) = temp(i,j)*G%IareaT(i,j) + fluxes%frunoff(i,j) = temp(i,j)*US%m_to_L**2*G%IareaT(i,j) enddo ; enddo else call MOM_read_data(CS%runoff_file, CS%lrunoff_var, fluxes%lrunoff(:,:), & diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index b9aedb7a1c..33b498a60a 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -307,8 +307,8 @@ subroutine ALE_main( G, GV, US, h, u, v, tv, Reg, CS, dt, frac_shelf_h) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after the !! last time step [H ~> m or kg m-2] - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: u !< Zonal velocity field [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v !< Meridional velocity field [m s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: u !< Zonal velocity field [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v !< Meridional velocity field [L T-1 ~> m s-1] type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variable structure type(tracer_registry_type), pointer :: Reg !< Tracer registry structure type(ALE_CS), pointer :: CS !< Regridding parameters and options @@ -639,16 +639,16 @@ subroutine ALE_regrid_accelerated(CS, G, GV, h, tv, n, u, v, Reg, dt, dzRegrid, type(ocean_grid_type), intent(inout) :: G !< Ocean grid type(verticalGrid_type), intent(in) :: GV !< Vertical grid real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: h !< Original thicknesses + intent(inout) :: h !< Original thicknesses [H ~> m or kg-2] type(thermo_var_ptrs), intent(inout) :: tv !< Thermo vars (T/S/EOS) integer, intent(in) :: n !< Number of times to regrid real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: u !< Zonal velocity + intent(inout) :: u !< Zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(inout) :: v !< Meridional velocity + intent(inout) :: v !< Meridional velocity [L T-1 ~> m s-1] type(tracer_registry_type), & optional, pointer :: Reg !< Tracer registry to remap onto new grid - real, optional, intent(in) :: dt !< Model timestep to provide a timescale for regridding + real, optional, intent(in) :: dt !< Model timestep to provide a timescale for regridding [s] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & optional, intent(inout) :: dzRegrid !< Final change in interface positions logical, optional, intent(in) :: initial !< Whether we're being called from an initialization @@ -732,11 +732,11 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, optional, intent(in) :: dxInterface !< Change in interface position !! [H ~> m or kg-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - optional, intent(inout) :: u !< Zonal velocity component [m s-1] + optional, intent(inout) :: u !< Zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - optional, intent(inout) :: v !< Meridional velocity component [m s-1] - logical, optional, intent(in) :: debug !< If true, show the call tree - real, optional, intent(in) :: dt !< time step for diagnostics + optional, intent(inout) :: v !< Meridional velocity [L T-1 ~> m s-1] + logical, optional, intent(in) :: debug !< If true, show the call tree + real, optional, intent(in) :: dt !< time step for diagnostics ! Local variables integer :: i, j, k, m integer :: nz, ntr @@ -900,7 +900,7 @@ subroutine ALE_remap_scalar(CS, G, GV, nk_src, h_src, s_src, h_dst, s_dst, all_c real, dimension(SZI_(G),SZJ_(G),nk_src), intent(in) :: h_src !< Level thickness of source grid !! [H ~> m or kg-2] real, dimension(SZI_(G),SZJ_(G),nk_src), intent(in) :: s_src !< Scalar on source grid - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)),intent(in) :: h_dst !< Level thickness of destination grid + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)),intent(in) :: h_dst !< Level thickness of destination grid !! [H ~> m or kg-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)),intent(inout) :: s_dst !< Scalar on destination grid logical, optional, intent(in) :: all_cells !< If false, only reconstruct for diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 901b15fd4a..3e41e075c1 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -155,13 +155,13 @@ module MOM T, & !< potential temperature [degC] S !< salinity [ppt] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & - u, & !< zonal velocity component [m s-1] - uh, & !< uh = u * h * dy at u grid points [H m2 s-1 ~> m3 s-1 or kg s-1] - uhtr !< accumulated zonal thickness fluxes to advect tracers [H m2 ~> m3 or kg] + u, & !< zonal velocity component [L T-1 ~> m s-1] + uh, & !< uh = u * h * dy at u grid points [H L2 T-1 ~> m3 s-1 or kg s-1] + uhtr !< accumulated zonal thickness fluxes to advect tracers [H L2 ~> m3 or kg] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & - v, & !< meridional velocity [m s-1] - vh, & !< vh = v * h * dx at v grid points [H m2 s-1 ~> m3 s-1 or kg s-1] - vhtr !< accumulated meridional thickness fluxes to advect tracers [H m2 ~> m3 or kg] + v, & !< meridional velocity [L T-1 ~> m s-1] + vh, & !< vh = v * h * dx at v grid points [H L2 T-1 ~> m3 s-1 or kg s-1] + vhtr !< accumulated meridional thickness fluxes to advect tracers [H L2 ~> m3 or kg] real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: ssh_rint !< A running time integral of the sea surface height [s m]. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: ave_ssh_ibc @@ -251,8 +251,8 @@ module MOM type(cont_diag_ptrs) :: CDp !< structure containing pointers to continuity equation !! terms, for derived diagnostics (e.g., energy budgets) real, dimension(:,:,:), pointer :: & - u_prev => NULL(), & !< previous value of u stored for diagnostics [m s-1] - v_prev => NULL() !< previous value of v stored for diagnostics [m s-1] + u_prev => NULL(), & !< previous value of u stored for diagnostics [L T-1 ~> m s-1] + v_prev => NULL() !< previous value of v stored for diagnostics [L T-1 ~> m s-1] logical :: interp_p_surf !< If true, linearly interpolate surface pressure !! over the coupling time step, using specified value @@ -461,8 +461,8 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & ssh ! sea surface height, which may be based on eta_av [m] real, dimension(:,:,:), pointer :: & - u => NULL(), & ! u : zonal velocity component [m s-1] - v => NULL(), & ! v : meridional velocity component [m s-1] + u => NULL(), & ! u : zonal velocity component [L T-1 ~> m s-1] + v => NULL(), & ! v : meridional velocity component [L T-1 ~> m s-1] h => NULL() ! h : layer thickness [H ~> m or kg m-2] real, dimension(:,:), pointer :: & p_surf => NULL() ! A pointer to the ocean surface pressure [Pa]. @@ -492,7 +492,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & call cpu_clock_begin(id_clock_other) if (CS%debug) then - call MOM_state_chksum("Beginning of step_MOM ", u, v, h, CS%uh, CS%vh, G, GV) + call MOM_state_chksum("Beginning of step_MOM ", u, v, h, CS%uh, CS%vh, G, GV, US) endif showCallTree = callTree_showQuery() @@ -598,7 +598,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (CS%debug) then if (cycle_start) & - call MOM_state_chksum("Before steps ", u, v, h, CS%uh, CS%vh, G, GV) + call MOM_state_chksum("Before steps ", u, v, h, CS%uh, CS%vh, G, GV, US) if (cycle_start) call check_redundant("Before steps ", u, v, G) if (do_dyn) call MOM_mech_forcing_chksum("Before steps", forces, G, US, haloshift=0) if (do_dyn) call check_redundant("Before steps ", forces%taux, forces%tauy, G) @@ -716,7 +716,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & endif if (do_advection) then ! Do advective transport and lateral tracer mixing. - call step_MOM_tracer_dyn(CS, G, GV, h, Time_local) + call step_MOM_tracer_dyn(CS, G, GV, US, h, Time_local) CS%ndyn_per_adv = 0 if (CS%diabatic_first .and. abs(CS%t_dyn_rel_thermo) > 1e-6*dt) call MOM_error(FATAL, & "step_MOM: Mismatch between the dynamics and diabatic times "//& @@ -821,12 +821,12 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & enddo ; enddo ; endif if (CS%ensemble_ocean) then - ! update the time for the next analysis step if needed - call set_analysis_time(CS%Time,CS%odaCS) - ! store ensemble vector in odaCS - call set_prior_tracer(CS%Time, G, GV, CS%h, CS%tv, CS%odaCS) - ! call DA interface - call oda(CS%Time,CS%odaCS) + ! update the time for the next analysis step if needed + call set_analysis_time(CS%Time,CS%odaCS) + ! store ensemble vector in odaCS + call set_prior_tracer(CS%Time, G, GV, CS%h, CS%tv, CS%odaCS) + ! call DA interface + call oda(CS%Time,CS%odaCS) endif if (showCallTree) call callTree_waypoint("calling extract_surface_state (step_MOM)") @@ -940,13 +940,14 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & Time_local + real_to_time(bbl_time_int-dt), CS%diag) ! Calculate the BBL properties and store them inside visc (u,h). call cpu_clock_begin(id_clock_BBL_visc) - call set_viscous_BBL(CS%u, CS%v, CS%h, CS%tv, CS%visc, G, GV, US, & + call set_viscous_BBL(CS%u(:,:,:), CS%v(:,:,:), CS%h, CS%tv, CS%visc, G, GV, US, & CS%set_visc_CSp, symmetrize=.true.) call cpu_clock_end(id_clock_BBL_visc) if (showCallTree) call callTree_wayPoint("done with set_viscous_BBL (step_MOM)") call disable_averaging(CS%diag) endif + if (CS%do_dynamics .and. CS%split) then !--------------------------- start SPLIT ! This section uses a split time stepping scheme for the dynamic equations, ! basically the stacked shallow water equations with viscosity. @@ -1008,7 +1009,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & if (CS%debug) then call hchksum(h,"Pre-mixedlayer_restrat h", G%HI, haloshift=1, scale=GV%H_to_m) call uvchksum("Pre-mixedlayer_restrat uhtr", & - CS%uhtr, CS%vhtr, G%HI, haloshift=0, scale=GV%H_to_m) + CS%uhtr, CS%vhtr, G%HI, haloshift=0, scale=GV%H_to_m*US%L_to_m**2) endif call cpu_clock_begin(id_clock_ml_restrat) call mixedlayer_restrat(h, CS%uhtr, CS%vhtr, CS%tv, forces, dt, CS%visc%MLD, & @@ -1018,7 +1019,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & if (CS%debug) then call hchksum(h,"Post-mixedlayer_restrat h", G%HI, haloshift=1, scale=GV%H_to_m) call uvchksum("Post-mixedlayer_restrat [uv]htr", & - CS%uhtr, CS%vhtr, G%HI, haloshift=0, scale=GV%H_to_m) + CS%uhtr, CS%vhtr, G%HI, haloshift=0, scale=GV%H_to_m*US%L_to_m**2) endif endif @@ -1052,10 +1053,11 @@ end subroutine step_MOM_dynamics !> step_MOM_tracer_dyn does tracer advection and lateral diffusion, bringing the !! tracers up to date with the changes in state due to the dynamics. Surface !! sources and sinks and remapping are handled via step_MOM_thermo. -subroutine step_MOM_tracer_dyn(CS, G, GV, h, Time_local) +subroutine step_MOM_tracer_dyn(CS, G, GV, US, h, Time_local) type(MOM_control_struct), intent(inout) :: CS !< control structure type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< layer thicknesses after the transports [H ~> m or kg m-2] type(time_type), intent(in) :: Time_local !< The model time at the end @@ -1068,7 +1070,7 @@ subroutine step_MOM_tracer_dyn(CS, G, GV, h, Time_local) call cpu_clock_begin(id_clock_other) call hchksum(h,"Pre-advection h", G%HI, haloshift=1, scale=GV%H_to_m) call uvchksum("Pre-advection uhtr", CS%uhtr, CS%vhtr, G%HI, & - haloshift=0, scale=GV%H_to_m) + haloshift=0, scale=GV%H_to_m*US%L_to_m**2) if (associated(CS%tv%T)) call hchksum(CS%tv%T, "Pre-advection T", G%HI, haloshift=1) if (associated(CS%tv%S)) call hchksum(CS%tv%S, "Pre-advection S", G%HI, haloshift=1) if (associated(CS%tv%frazil)) call hchksum(CS%tv%frazil, & @@ -1082,15 +1084,15 @@ subroutine step_MOM_tracer_dyn(CS, G, GV, h, Time_local) call cpu_clock_begin(id_clock_thermo) ; call cpu_clock_begin(id_clock_tracer) call enable_averaging(CS%t_dyn_rel_adv, Time_local, CS%diag) - call advect_tracer(h, CS%uhtr, CS%vhtr, CS%OBC, CS%t_dyn_rel_adv, G, GV, & + call advect_tracer(h, CS%uhtr, CS%vhtr, CS%OBC, CS%t_dyn_rel_adv, G, GV, US, & CS%tracer_adv_CSp, CS%tracer_Reg) - call tracer_hordiff(h, CS%t_dyn_rel_adv, CS%MEKE, CS%VarMix, G, GV, & + call tracer_hordiff(h, CS%t_dyn_rel_adv, CS%MEKE, CS%VarMix, G, GV, US, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) if (showCallTree) call callTree_waypoint("finished tracer advection/diffusion (step_MOM)") call cpu_clock_end(id_clock_tracer) ; call cpu_clock_end(id_clock_thermo) call cpu_clock_begin(id_clock_other) ; call cpu_clock_begin(id_clock_diagnostics) - call post_transport_diagnostics(G, GV, CS%uhtr, CS%vhtr, h, CS%transport_IDs, & + call post_transport_diagnostics(G, GV, US, CS%uhtr, CS%vhtr, h, CS%transport_IDs, & CS%diag_pre_dyn, CS%diag, CS%t_dyn_rel_adv, CS%tracer_reg) ! Rebuild the remap grids now that we've posted the fields which rely on thicknesses ! from before the dynamics calls @@ -1126,9 +1128,9 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & type(verticalGrid_type), intent(inout) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: u !< zonal velocity [m s-1] + intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(inout) :: v !< meridional velocity [m s-1] + intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic variables @@ -1177,18 +1179,18 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call uvchksum("Pre-diabatic [uv]", u, v, G%HI, haloshift=2) call hchksum(h,"Pre-diabatic h", G%HI, haloshift=1, scale=GV%H_to_m) call uvchksum("Pre-diabatic [uv]h", CS%uhtr, CS%vhtr, G%HI, & - haloshift=0, scale=GV%H_to_m) - ! call MOM_state_chksum("Pre-diabatic ",u, v, h, CS%uhtr, CS%vhtr, G, GV) + haloshift=0, scale=GV%H_to_m*US%L_to_m**2) + ! call MOM_state_chksum("Pre-diabatic ", u, v, h, CS%uhtr, CS%vhtr, G, GV, vel_scale=1.0) call MOM_thermo_chksum("Pre-diabatic ", tv, G,haloshift=0) call check_redundant("Pre-diabatic ", u, v, G) call MOM_forcing_chksum("Pre-diabatic", fluxes, G, US, haloshift=0) endif call cpu_clock_begin(id_clock_diabatic) + call diabatic(u, v, h, tv, CS%Hml, fluxes, CS%visc, CS%ADp, CS%CDp, & dtdia, Time_end_thermo, G, GV, US, CS%diabatic_CSp, Waves=Waves) fluxes%fluxes_used = .true. - call cpu_clock_end(id_clock_diabatic) if (showCallTree) call callTree_waypoint("finished diabatic (step_MOM_thermo)") @@ -1208,7 +1210,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call preAle_tracer_diagnostics(CS%tracer_Reg, G, GV) if (CS%debug) then - call MOM_state_chksum("Pre-ALE ", u, v, h, CS%uh, CS%vh, G, GV) + call MOM_state_chksum("Pre-ALE ", u, v, h, CS%uh, CS%vh, G, GV, US) call hchksum(tv%T,"Pre-ALE T", G%HI, haloshift=1) call hchksum(tv%S,"Pre-ALE S", G%HI, haloshift=1) call check_redundant("Pre-ALE ", u, v, G) @@ -1235,7 +1237,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call do_group_pass(pass_uv_T_S_h, G%Domain, clock=id_clock_pass) if (CS%debug .and. CS%use_ALE_algorithm) then - call MOM_state_chksum("Post-ALE ", u, v, h, CS%uh, CS%vh, G, GV) + call MOM_state_chksum("Post-ALE ", u, v, h, CS%uh, CS%vh, G, GV, US) call hchksum(tv%T, "Post-ALE T", G%HI, haloshift=1) call hchksum(tv%S, "Post-ALE S", G%HI, haloshift=1) call check_redundant("Post-ALE ", u, v, G) @@ -1250,10 +1252,10 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call postALE_tracer_diagnostics(CS%tracer_Reg, G, GV, CS%diag, dtdia) if (CS%debug) then - call uvchksum("Post-diabatic u", u, v, G%HI, haloshift=2) + call uvchksum("Post-diabatic u", u, v, G%HI, haloshift=2, scale=US%L_T_to_m_s) call hchksum(h, "Post-diabatic h", G%HI, haloshift=1, scale=GV%H_to_m) call uvchksum("Post-diabatic [uv]h", CS%uhtr, CS%vhtr, G%HI, & - haloshift=0, scale=GV%H_to_m) + haloshift=0, scale=GV%H_to_m*US%L_to_m**2) ! call MOM_state_chksum("Post-diabatic ", u, v, & ! h, CS%uhtr, CS%vhtr, G, GV, haloshift=1) if (associated(tv%T)) call hchksum(tv%T, "Post-diabatic T", G%HI, haloshift=1) @@ -1266,6 +1268,8 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call check_redundant("Post-diabatic ", u, v, G) endif call disable_averaging(CS%diag) + + call cpu_clock_end(id_clock_diabatic) else ! complement of "if (.not.CS%adiabatic)" call cpu_clock_begin(id_clock_diabatic) @@ -1398,7 +1402,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS call calc_resoln_function(CS%h, CS%tv, G, GV, US, CS%VarMix) call calc_slope_functions(CS%h, CS%tv, REAL(dt_offline), G, GV, US, CS%VarMix) endif - call tracer_hordiff(CS%h, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, & + call tracer_hordiff(CS%h, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, US, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) endif endif @@ -1423,7 +1427,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS call calc_resoln_function(CS%h, CS%tv, G, GV, US, CS%VarMix) call calc_slope_functions(CS%h, CS%tv, REAL(dt_offline), G, GV, US, CS%VarMix) endif - call tracer_hordiff(CS%h, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, & + call tracer_hordiff(CS%h, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, US, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) endif endif @@ -1458,7 +1462,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS CS%h, eatr, ebtr, uhtr, vhtr) ! Perform offline diffusion if requested if (.not. skip_diffusion) then - call tracer_hordiff(h_end, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, & + call tracer_hordiff(h_end, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, US, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) endif @@ -2048,6 +2052,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (debug_truncations) then allocate(CS%u_prev(IsdB:IedB,jsd:jed,nz)) ; CS%u_prev(:,:,:) = 0.0 allocate(CS%v_prev(isd:ied,JsdB:JedB,nz)) ; CS%v_prev(:,:,:) = 0.0 + MOM_internal_state%u_prev => CS%u_prev + MOM_internal_state%v_prev => CS%v_prev call safe_alloc_ptr(CS%ADp%du_dt_visc,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(CS%ADp%dv_dt_visc,isd,ied,JsdB,JedB,nz) if (.not.CS%adiabatic) then @@ -2133,8 +2139,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! (potentially static) ocean-specific grid type. ! The next line would be needed if G%Domain had not already been init'd above: ! call clone_MOM_domain(dG%Domain, G%Domain) - call MOM_grid_init(G, param_file, HI, bathymetry_at_vel=bathy_at_vel) - call copy_dyngrid_to_MOM_grid(dG, G) + call MOM_grid_init(G, param_file, US, HI, bathymetry_at_vel=bathy_at_vel) + call copy_dyngrid_to_MOM_grid(dG, G, US) call destroy_dyn_horgrid(dG) ! Set a few remaining fields that are specific to the ocean grid type. @@ -2162,10 +2168,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call clone_MOM_domain(G%Domain, dG%Domain) call clone_MOM_domain(G%Domain, CS%G%Domain) - call MOM_grid_init(CS%G, param_file) + call MOM_grid_init(CS%G, param_file, US) - call copy_MOM_grid_to_dyngrid(G, dg) - call copy_dyngrid_to_MOM_grid(dg, CS%G) + call copy_MOM_grid_to_dyngrid(G, dg, US) + call copy_dyngrid_to_MOM_grid(dg, CS%G, US) call destroy_dyn_horgrid(dG) call MOM_grid_end(G) ; deallocate(G) @@ -2177,7 +2183,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & G%ke = GV%ke ; G%g_Earth = GV%mks_g_Earth endif - ! At this point, all user-modified initialization code has been called. The ! remainder of this subroutine is controlled by the parameters that have ! have already been set. @@ -2207,7 +2212,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! compute fractional ice shelf coverage of h do j=jsd,jed ; do i=isd,ied if (G%areaT(i,j) > 0.0) & - frac_shelf_h(i,j) = area_shelf_h(i,j) / G%areaT(i,j) + frac_shelf_h(i,j) = area_shelf_h(i,j) / (US%L_to_m**2*G%areaT(i,j)) enddo ; enddo ! pass to the pointer shelf_area => frac_shelf_h @@ -2286,6 +2291,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call VarMix_init(Time, G, GV, US, param_file, diag, CS%VarMix) call set_visc_init(Time, G, GV, US, param_file, diag, CS%visc, CS%set_visc_CSp, restart_CSp, CS%OBC) call thickness_diffuse_init(Time, G, GV, US, param_file, diag, CS%CDp, CS%thickness_diffuse_CSp) + if (CS%split) then allocate(eta(SZI_(G),SZJ_(G))) ; eta(:,:) = 0.0 call initialize_dyn_split_RK2(CS%u, CS%v, CS%h, CS%uh, CS%vh, eta, Time, & @@ -2319,6 +2325,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & CS%update_OBC_CSp, CS%ALE_CSp, CS%set_visc_CSp, CS%visc, dirs, & CS%ntrunc) endif + call callTree_waypoint("dynamics initialized (initialize_MOM)") CS%mixedlayer_restrat = mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, & @@ -2351,7 +2358,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & endif call tracer_advect_init(Time, G, param_file, diag, CS%tracer_adv_CSp) - call tracer_hor_diff_init(Time, G, param_file, diag, CS%tv%eqn_of_state, & + call tracer_hor_diff_init(Time, G, US, param_file, diag, CS%tv%eqn_of_state, & CS%tracer_diff_CSp) call lock_tracer_registry(CS%tracer_Reg) @@ -2359,8 +2366,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! now register some diagnostics since the tracer registry is now locked call register_surface_diags(Time, G, CS%sfc_IDs, CS%diag, CS%tv) - call register_diags(Time, G, GV, CS%IDs, CS%diag) - call register_transport_diags(Time, G, GV, CS%transport_IDs, CS%diag) + call register_diags(Time, G, GV, US, CS%IDs, CS%diag) + call register_transport_diags(Time, G, GV, US, CS%transport_IDs, CS%diag) call register_tracer_diagnostics(CS%tracer_Reg, CS%h, Time, diag, G, GV, & CS%use_ALE_algorithm) if (CS%use_ALE_algorithm) then @@ -2380,7 +2387,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (CS%offline_tracer_mode) then ! Setup some initial parameterizations and also assign some of the subtypes - call offline_transport_init(param_file, CS%offline_CSp, CS%diabatic_CSp, G, GV) + call offline_transport_init(param_file, CS%offline_CSp, CS%diabatic_CSp, G, GV, US) call insert_offline_main( CS=CS%offline_CSp, ALE_CSp=CS%ALE_CSp, diabatic_CSp=CS%diabatic_CSp, & diag=CS%diag, OBC=CS%OBC, tracer_adv_CSp=CS%tracer_adv_CSp, & tracer_flow_CSp=CS%tracer_flow_CSp, tracer_Reg=CS%tracer_Reg, & @@ -2505,10 +2512,11 @@ subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) end subroutine finish_MOM_initialization !> Register certain diagnostics -subroutine register_diags(Time, G, GV, IDs, diag) +subroutine register_diags(Time, G, GV, US, IDs, diag) type(time_type), intent(in) :: Time !< current model time type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(inout) :: US !< A dimensional unit scaling type type(MOM_diag_IDs), intent(inout) :: IDs !< A structure with the diagnostic IDs. type(diag_ctrl), intent(inout) :: diag !< regulates diagnostic output @@ -2524,9 +2532,9 @@ subroutine register_diags(Time, G, GV, IDs, diag) ! Diagnostics of the rapidly varying dynamic state IDs%id_u = register_diag_field('ocean_model', 'u_dyn', diag%axesCuL, Time, & - 'Zonal velocity after the dynamics update', 'm s-1') + 'Zonal velocity after the dynamics update', 'm s-1', conversion=US%L_T_to_m_s) IDs%id_v = register_diag_field('ocean_model', 'v_dyn', diag%axesCvL, Time, & - 'Meridional velocity after the dynamics update', 'm s-1') + 'Meridional velocity after the dynamics update', 'm s-1', conversion=US%L_T_to_m_s) IDs%id_h = register_diag_field('ocean_model', 'h_dyn', diag%axesTL, Time, & 'Layer Thickness after the dynamics update', thickness_units, & v_extensive=.true., conversion=H_convert) @@ -2685,12 +2693,13 @@ subroutine extract_surface_state(CS, sfc_state) ! local real :: hu, hv ! Thicknesses interpolated to velocity points [H ~> m or kg m-2] - type(ocean_grid_type), pointer :: G => NULL() !< pointer to a structure containing + type(ocean_grid_type), pointer :: G => NULL() !< pointer to a structure containing !! metrics and related information - type(verticalGrid_type), pointer :: GV => NULL() - real, dimension(:,:,:), pointer :: & - u => NULL(), & !< u : zonal velocity component [m s-1] - v => NULL(), & !< v : meridional velocity component [m s-1] + type(verticalGrid_type), pointer :: GV => NULL() !< structure containing vertical grid info + type(unit_scale_type), pointer :: US => NULL() !< structure containing various unit conversion factors + real, dimension(:,:,:), pointer :: & +! u => NULL(), & !< u : zonal velocity component [m s-1] +! v => NULL(), & !< v : meridional velocity component [m s-1] h => NULL() !< h : layer thickness [H ~> m or kg m-2] real :: depth(SZI_(CS%G)) !< Distance from the surface in depth units [Z ~> m] real :: depth_ml !< Depth over which to average to determine mixed @@ -2708,12 +2717,12 @@ subroutine extract_surface_state(CS, sfc_state) character(240) :: msg call callTree_enter("extract_surface_state(), MOM.F90") - G => CS%G ; GV => CS%GV + G => CS%G ; GV => CS%GV ; US => CS%US is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed iscB = G%iscB ; iecB = G%iecB; jscB = G%jscB ; jecB = G%jecB isdB = G%isdB ; iedB = G%iedB; jsdB = G%jsdB ; jedB = G%jedB - u => CS%u ; v => CS%v ; h => CS%h + h => CS%h use_temperature = associated(CS%tv%T) @@ -2747,10 +2756,10 @@ subroutine extract_surface_state(CS, sfc_state) sfc_state%SSS(i,j) = CS%tv%S(i,j,1) enddo ; enddo ; endif do j=js,je ; do I=is-1,ie - sfc_state%u(I,j) = u(I,j,1) + sfc_state%u(I,j) = US%L_T_to_m_s * CS%u(I,j,1) enddo ; enddo do J=js-1,je ; do i=is,ie - sfc_state%v(i,J) = v(i,J,1) + sfc_state%v(i,J) = US%L_T_to_m_s * CS%v(i,J,1) enddo ; enddo else ! (CS%Hmix >= 0.0) @@ -2823,7 +2832,7 @@ subroutine extract_surface_state(CS, sfc_state) else dh = 0.0 endif - sfc_state%v(i,J) = sfc_state%v(i,J) + dh * v(i,J,k) + sfc_state%v(i,J) = sfc_state%v(i,J) + dh * US%L_T_to_m_s * CS%v(i,J,k) depth(i) = depth(i) + dh enddo ; enddo ! Calculate the average properties of the mixed layer depth. @@ -2849,7 +2858,7 @@ subroutine extract_surface_state(CS, sfc_state) else dh = 0.0 endif - sfc_state%u(I,j) = sfc_state%u(I,j) + dh * u(I,j,k) + sfc_state%u(I,j) = sfc_state%u(I,j) + dh * US%L_T_to_m_s * CS%u(I,j,k) depth(I) = depth(I) + dh enddo ; enddo ! Calculate the average properties of the mixed layer depth. @@ -2861,10 +2870,10 @@ subroutine extract_surface_state(CS, sfc_state) enddo ! end of j loop else ! Hmix_UV<=0. do j=js,je ; do I=is-1,ie - sfc_state%u(I,j) = u(I,j,1) + sfc_state%u(I,j) = US%L_T_to_m_s * CS%u(I,j,1) enddo ; enddo do J=js-1,je ; do i=is,ie - sfc_state%v(i,J) = v(i,J,1) + sfc_state%v(i,J) = US%L_T_to_m_s * CS%v(i,J,1) enddo ; enddo endif endif ! (CS%Hmix >= 0.0) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index a897e2af13..e044ea5f6d 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -111,17 +111,17 @@ module MOM_CoriolisAdv subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) type(ocean_grid_type), intent(in) :: G !< Ocen grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [m s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uh !< Zonal transport u*h*dy - !! [H m2 s-1 ~> m3 s-1 or kg s-1] + !! [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vh !< Meridional transport v*h*dx - !! [H m2 s-1 ~> m3 s-1 or kg s-1] + !! [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: CAu !< Zonal acceleration due to Coriolis - !! and momentum advection [m s-2]. + !! and momentum advection [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: CAv !< Meridional acceleration due to Coriolis - !! and momentum advection [m s-2]. + !! and momentum advection [L T-2 ~> m s-2]. type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure type(accel_diag_ptrs), intent(inout) :: AD !< Storage for acceleration diagnostics type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -129,68 +129,68 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) ! Local variables real, dimension(SZIB_(G),SZJB_(G)) :: & - q, & ! Layer potential vorticity [m-1 s-1]. + q, & ! Layer potential vorticity [H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1]. Ih_q, & ! The inverse of thickness interpolated to q points [H-1 ~> m-1 or m2 kg-1]. - Area_q ! The sum of the ocean areas at the 4 adjacent thickness points [m2]. + Area_q ! The sum of the ocean areas at the 4 adjacent thickness points [L2 ~> m2]. real, dimension(SZIB_(G),SZJ_(G)) :: & a, b, c, d ! a, b, c, & d are combinations of the potential vorticities ! surrounding an h grid point. At small scales, a = q/4, - ! b = q/4, etc. All are in [H-1 s-1 ~> m-1 s-1 or m2 kg-1 s-1], + ! b = q/4, etc. All are in [H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1], ! and use the indexing of the corresponding u point. real, dimension(SZI_(G),SZJ_(G)) :: & - Area_h, & ! The ocean area at h points [m2]. Area_h is used to find the + Area_h, & ! The ocean area at h points [L2 ~> m2]. Area_h is used to find the ! average thickness in the denominator of q. 0 for land points. - KE ! Kinetic energy per unit mass [m2 s-2], KE = (u^2 + v^2)/2. + KE ! Kinetic energy per unit mass [L2 T-2 ~> m2 s-2], KE = (u^2 + v^2)/2. real, dimension(SZIB_(G),SZJ_(G)) :: & hArea_u, & ! The cell area weighted thickness interpolated to u points - ! times the effective areas [H m2 ~> m3 or kg]. - KEx, & ! The zonal gradient of Kinetic energy per unit mass [m s-2], + ! times the effective areas [H L2 ~> m3 or kg]. + KEx, & ! The zonal gradient of Kinetic energy per unit mass [L T-2 ~> m s-2], ! KEx = d/dx KE. - uh_center ! Transport based on arithmetic mean h at u-points [H m2 s-1 ~> m3 s-1 or kg s-1] + uh_center ! Transport based on arithmetic mean h at u-points [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJB_(G)) :: & hArea_v, & ! The cell area weighted thickness interpolated to v points - ! times the effective areas [H m2 ~> m3 or kg]. - KEy, & ! The meridonal gradient of Kinetic energy per unit mass [m s-2], + ! times the effective areas [H L2 ~> m3 or kg]. + KEy, & ! The meridonal gradient of Kinetic energy per unit mass [L T-2 ~> m s-2], ! KEy = d/dy KE. - vh_center ! Transport based on arithmetic mean h at v-points [H m2 s-1 ~> m3 s-1 or kg s-1] + vh_center ! Transport based on arithmetic mean h at v-points [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJ_(G)) :: & uh_min, uh_max, & ! The smallest and largest estimates of the volume vh_min, vh_max, & ! fluxes through the faces (i.e. u*h*dy & v*h*dx) - ! [H m2 s-1 ~> m3 s-1 or kg s-1]. + ! [H L2 T-1 ~> m3 s-1 or kg s-1]. ep_u, ep_v ! Additional pseudo-Coriolis terms in the Arakawa and Lamb ! discretization [H-1 s-1 ~> m-1 s-1 or m2 kg-1 s-1]. real, dimension(SZIB_(G),SZJB_(G)) :: & - dvdx,dudy, &! Contributions to the circulation around q-points [m2 s-1] - abs_vort, & ! Absolute vorticity at q-points [s-1]. - q2, & ! Relative vorticity over thickness [H-1 s-1 ~> m-1 s-1 or m2 kg-1 s-1]. - max_fvq, & ! The maximum or minimum of the - min_fvq, & ! adjacent values of (-u) or v times - max_fuq, & ! the absolute vorticity [m s-2]. - min_fuq ! All are defined at q points. + dvdx, dudy, & ! Contributions to the circulation around q-points [L2 T-1 ~> m2 s-1] + abs_vort, & ! Absolute vorticity at q-points [T-1 ~> s-1]. + q2, & ! Relative vorticity over thickness [H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1]. + max_fvq, & ! The maximum of the adjacent values of (-u) times absolute vorticity [L T-2 ~> m s-2]. + min_fvq, & ! The minimum of the adjacent values of (-u) times absolute vorticity [L T-2 ~> m s-2]. + max_fuq, & ! The maximum of the adjacent values of u times absolute vorticity [L T-2 ~> m s-2]. + min_fuq ! The minimum of the adjacent values of u times absolute vorticity [L T-2 ~> m s-2]. real, dimension(SZIB_(G),SZJB_(G),SZK_(G)) :: & - PV, & ! A diagnostic array of the potential vorticities [m-1 s-1]. - RV ! A diagnostic array of the relative vorticities [s-1]. - real :: fv1, fv2, fu1, fu2 ! (f+rv)*v or (f+rv)*u [m s-2]. + PV, & ! A diagnostic array of the potential vorticities [H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1]. + RV ! A diagnostic array of the relative vorticities [T-1 ~> s-1]. + real :: fv1, fv2, fu1, fu2 ! (f+rv)*v or (f+rv)*u [L T-2 ~> m s-2]. real :: max_fv, max_fu ! The maximum or minimum of the neighboring Coriolis - real :: min_fv, min_fu ! accelerations [m s-2], i.e. max(min)_fu(v)q. + real :: min_fv, min_fu ! accelerations [L T-2 ~> m s-2], i.e. max(min)_fu(v)q. real, parameter :: C1_12=1.0/12.0 ! C1_12 = 1/12 real, parameter :: C1_24=1.0/24.0 ! C1_24 = 1/24 - real :: absolute_vorticity ! Absolute vorticity [s-1]. - real :: relative_vorticity ! Relative vorticity [s-1]. + real :: absolute_vorticity ! Absolute vorticity [T-1 ~> s-1]. + real :: relative_vorticity ! Relative vorticity [T-1 ~> s-1]. real :: Ih ! Inverse of thickness [H-1 ~> m-1 or m2 kg-1]. real :: max_Ihq, min_Ihq ! The maximum and minimum of the nearby Ihq [H-1 ~> m-1 or m2 kg-1]. real :: hArea_q ! The sum of area times thickness of the cells - ! surrounding a q point [H m2 ~> m3 or kg]. + ! surrounding a q point [H L2 ~> m3 or kg]. real :: h_neglect ! A thickness that is so small it is usually ! lost in roundoff and can be neglected [H ~> m or kg m-2]. - real :: temp1, temp2 ! Temporary variables [m2 s-2]. - real, parameter :: eps_vel=1.0e-10 ! A tiny, positive velocity [m s-1]. + real :: temp1, temp2 ! Temporary variables [L2 T-2 ~> m2 s-2]. + real :: eps_vel ! A tiny, positive velocity [L T-1 ~> m s-1]. - real :: uhc, vhc ! Centered estimates of uh and vh [H m2 s-1 ~> m3 s-1 or kg s-1]. - real :: uhm, vhm ! The input estimates of uh and vh [H m2 s-1 ~> m3 s-1 or kg s-1]. + real :: uhc, vhc ! Centered estimates of uh and vh [H L2 T-1 ~> m3 s-1 or kg s-1]. + real :: uhm, vhm ! The input estimates of uh and vh [H L2 T-1 ~> m3 s-1 or kg s-1]. real :: c1, c2, c3, slope ! Nondimensional parameters for the Coriolis limiter scheme. real :: Fe_m2 ! Nondimensional temporary variables asssociated with @@ -206,8 +206,8 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) real :: Heff1, Heff2 ! Temporary effective H at U or V points [H ~> m or kg m-2]. real :: Heff3, Heff4 ! Temporary effective H at U or V points [H ~> m or kg m-2]. real :: h_tiny ! A very small thickness [H ~> m or kg m-2]. - real :: UHeff, VHeff ! More temporary variables [H m2 s-1 ~> m3 s-1 or kg s-1]. - real :: QUHeff,QVHeff ! More temporary variables [H m2 s-1 ~> m3 s-1 or kg s-1]. + real :: UHeff, VHeff ! More temporary variables [H L2 T-1 ~> m3 s-1 or kg s-1]. + real :: QUHeff,QVHeff ! More temporary variables [H L2 T-1 s-1 ~> m3 s-2 or kg s-2]. integer :: i, j, k, n, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz ! To work, the following fields must be set outside of the usual @@ -220,6 +220,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = G%ke h_neglect = GV%H_subroundoff + eps_vel = 1.0e-10*US%m_s_to_L_T h_tiny = GV%Angstrom_H ! Perhaps this should be set to h_neglect instead. !$OMP parallel do default(private) shared(Isq,Ieq,Jsq,Jeq,G,Area_h) @@ -256,14 +257,15 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) !$OMP parallel do default(private) shared(u,v,h,uh,vh,CAu,CAv,G,CS,AD,Area_h,Area_q,& !$OMP RV,PV,is,ie,js,je,Isq,Ieq,Jsq,Jeq,nz,h_neglect,h_tiny,OBC) do k=1,nz + ! Here the second order accurate layer potential vorticities, q, ! are calculated. hq is second order accurate in space. Relative ! vorticity is second order accurate everywhere with free slip b.c.s, ! but only first order accurate at boundaries with no slip b.c.s. ! First calculate the contributions to the circulation around the q-point. do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 - dvdx(I,J) = v(i+1,J,k)*G%dyCv(i+1,J) - v(i,J,k)*G%dyCv(i,J) - dudy(I,J) = u(I,j+1,k)*G%dxCu(I,j+1) - u(I,j,k)*G%dxCu(I,j) + dvdx(I,J) = (v(i+1,J,k)*G%dyCv(i+1,J) - v(i,J,k)*G%dyCv(i,J)) + dudy(I,J) = (u(I,j+1,k)*G%dxCu(I,j+1) - u(I,j,k)*G%dxCu(I,j)) enddo ; enddo do J=Jsq-1,Jeq+1 ; do i=Isq-1,Ieq+2 hArea_v(i,J) = 0.5*(Area_h(i,j) * h(i,j,k) + Area_h(i,j+1) * h(i,j+1,k)) @@ -406,13 +408,11 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 if (CS%no_slip ) then - relative_vorticity = (2.0-G%mask2dBu(I,J)) * (dvdx(I,J) - dudy(I,J)) * & - G%IareaBu(I,J) + relative_vorticity = (2.0-G%mask2dBu(I,J)) * (dvdx(I,J) - dudy(I,J)) * G%IareaBu(I,J) else - relative_vorticity = G%mask2dBu(I,J) * (dvdx(I,J) - dudy(I,J)) * & - G%IareaBu(I,J) + relative_vorticity = G%mask2dBu(I,J) * (dvdx(I,J) - dudy(I,J)) * G%IareaBu(I,J) endif - absolute_vorticity = US%s_to_T*G%CoriolisBu(I,J) + relative_vorticity + absolute_vorticity = G%CoriolisBu(I,J) + relative_vorticity Ih = 0.0 if (Area_q(i,j) > 0.0) then hArea_q = (hArea_u(I,j) + hArea_u(I,j+1)) + (hArea_v(i,J) + hArea_v(i+1,J)) @@ -423,10 +423,10 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) Ih_q(I,J) = Ih if (CS%bound_Coriolis) then - fv1 = absolute_vorticity*v(i+1,J,k) - fv2 = absolute_vorticity*v(i,J,k) - fu1 = -absolute_vorticity*u(I,j+1,k) - fu2 = -absolute_vorticity*u(I,j,k) + fv1 = absolute_vorticity * v(i+1,J,k) + fv2 = absolute_vorticity * v(i,J,k) + fu1 = -absolute_vorticity * u(I,j+1,k) + fu2 = -absolute_vorticity * u(I,j,k) if (fv1 > fv2) then max_fvq(I,J) = fv1 ; min_fvq(I,J) = fv2 else @@ -565,7 +565,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) endif ! Calculate KE and the gradient of KE - call gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, CS) + call gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, US, CS) ! Calculate the tendencies of zonal velocity due to the Coriolis ! force and momentum advection. On a Cartesian grid, this is @@ -610,40 +610,35 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) (CS%Coriolis_Scheme == AL_BLEND)) then ! (Global) Energy and (Local) Enstrophy conserving, Arakawa & Hsu 1990 do j=js,je ; do I=Isq,Ieq - CAu(I,j,k) = ((a(I,j) * vh(i+1,J,k) + & - c(I,j) * vh(i,J-1,k)) & - + (b(I,j) * vh(i,J,k) + & - d(I,j) * vh(i+1,J-1,k))) * G%IdxCu(I,j) + CAu(I,j,k) = ((a(I,j) * vh(i+1,J,k) + c(I,j) * vh(i,J-1,k)) + & + (b(I,j) * vh(i,J,k) + d(I,j) * vh(i+1,J-1,k))) * G%IdxCu(I,j) enddo ; enddo elseif (CS%Coriolis_Scheme == ROBUST_ENSTRO) then ! An enstrophy conserving scheme robust to vanishing layers ! Note: Heffs are in lieu of h_at_v that should be returned by the ! continuity solver. AJA do j=js,je ; do I=Isq,Ieq - Heff1 = abs(vh(i,J,k)*G%IdxCv(i,J))/(eps_vel+abs(v(i,J,k))) - Heff1 = max(Heff1,min(h(i,j,k),h(i,j+1,k))) - Heff1 = min(Heff1,max(h(i,j,k),h(i,j+1,k))) - Heff2 = abs(vh(i,J-1,k)*G%IdxCv(i,J-1))/(eps_vel+abs(v(i,J-1,k))) - Heff2 = max(Heff2,min(h(i,j-1,k),h(i,j,k))) - Heff2 = min(Heff2,max(h(i,j-1,k),h(i,j,k))) - Heff3 = abs(vh(i+1,J,k)*G%IdxCv(i+1,J))/(eps_vel+abs(v(i+1,J,k))) - Heff3 = max(Heff3,min(h(i+1,j,k),h(i+1,j+1,k))) - Heff3 = min(Heff3,max(h(i+1,j,k),h(i+1,j+1,k))) - Heff4 = abs(vh(i+1,J-1,k)*G%IdxCv(i+1,J-1))/(eps_vel+abs(v(i+1,J-1,k))) - Heff4 = max(Heff4,min(h(i+1,j-1,k),h(i+1,j,k))) - Heff4 = min(Heff4,max(h(i+1,j-1,k),h(i+1,j,k))) + Heff1 = abs(vh(i,J,k) * G%IdxCv(i,J)) / (eps_vel+abs(v(i,J,k))) + Heff1 = max(Heff1, min(h(i,j,k),h(i,j+1,k))) + Heff1 = min(Heff1, max(h(i,j,k),h(i,j+1,k))) + Heff2 = abs(vh(i,J-1,k) * G%IdxCv(i,J-1)) / (eps_vel+abs(v(i,J-1,k))) + Heff2 = max(Heff2, min(h(i,j-1,k),h(i,j,k))) + Heff2 = min(Heff2, max(h(i,j-1,k),h(i,j,k))) + Heff3 = abs(vh(i+1,J,k) * G%IdxCv(i+1,J)) / (eps_vel+abs(v(i+1,J,k))) + Heff3 = max(Heff3, min(h(i+1,j,k),h(i+1,j+1,k))) + Heff3 = min(Heff3, max(h(i+1,j,k),h(i+1,j+1,k))) + Heff4 = abs(vh(i+1,J-1,k) * G%IdxCv(i+1,J-1)) / (eps_vel+abs(v(i+1,J-1,k))) + Heff4 = max(Heff4, min(h(i+1,j-1,k),h(i+1,j,k))) + Heff4 = min(Heff4, max(h(i+1,j-1,k),h(i+1,j,k))) if (CS%PV_Adv_Scheme == PV_ADV_CENTERED) then CAu(I,j,k) = 0.5*(abs_vort(I,J)+abs_vort(I,J-1)) * & - ((vh(i ,J ,k)+vh(i+1,J-1,k)) + & - (vh(i ,J-1,k)+vh(i+1,J ,k)) ) / & - (h_tiny +((Heff1+Heff4) +(Heff2+Heff3)) ) * G%IdxCu(I,j) + ((vh(i,J,k) + vh(i+1,J-1,k)) + (vh(i,J-1,k) + vh(i+1,J,k)) ) / & + (h_tiny + ((Heff1+Heff4) + (Heff2+Heff3)) ) * G%IdxCu(I,j) elseif (CS%PV_Adv_Scheme == PV_ADV_UPWIND1) then - VHeff = ((vh(i ,J ,k)+vh(i+1,J-1,k)) + & - (vh(i ,J-1,k)+vh(i+1,J ,k)) ) + VHeff = ((vh(i,J,k) + vh(i+1,J-1,k)) + (vh(i,J-1,k) + vh(i+1,J,k)) ) QVHeff = 0.5*( (abs_vort(I,J)+abs_vort(I,J-1))*VHeff & -(abs_vort(I,J)-abs_vort(I,J-1))*abs(VHeff) ) - CAu(I,j,k) = QVHeff / & - (h_tiny +((Heff1+Heff4) +(Heff2+Heff3)) ) * G%IdxCu(I,j) + CAu(I,j,k) = (QVHeff / ( h_tiny + ((Heff1+Heff4) + (Heff2+Heff3)) ) ) * G%IdxCu(I,j) endif enddo ; enddo endif @@ -657,8 +652,8 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) if (CS%bound_Coriolis) then do j=js,je ; do I=Isq,Ieq - max_fv = MAX(max_fvq(I,J),max_fvq(I,J-1)) - min_fv = MIN(min_fvq(I,J),min_fvq(I,J-1)) + max_fv = MAX(max_fvq(I,J), max_fvq(I,J-1)) + min_fv = MIN(min_fvq(I,J), min_fvq(I,J-1)) ! CAu(I,j,k) = min( CAu(I,j,k), max_fv ) ! CAu(I,j,k) = max( CAu(I,j,k), min_fv ) if (CAu(I,j,k) > max_fv) then @@ -699,7 +694,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) else temp2 = q(I,J) * (uh_min(i,j)+uh_min(i,j+1)) endif - CAv(i,J,k) = - 0.25 * G%IdyCv(i,J) * (temp1 + temp2) + CAv(i,J,k) = -0.25 * G%IdyCv(i,J) * (temp1 + temp2) enddo ; enddo else ! Energy conserving scheme, Sadourny 1975 @@ -729,18 +724,18 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) ! Note: Heffs are in lieu of h_at_u that should be returned by the ! continuity solver. AJA do J=Jsq,Jeq ; do i=is,ie - Heff1 = abs(uh(I,j,k)*G%IdyCu(I,j))/(eps_vel+abs(u(I,j,k))) - Heff1 = max(Heff1,min(h(i,j,k),h(i+1,j,k))) - Heff1 = min(Heff1,max(h(i,j,k),h(i+1,j,k))) - Heff2 = abs(uh(I-1,j,k)*G%IdyCu(I-1,j))/(eps_vel+abs(u(I-1,j,k))) - Heff2 = max(Heff2,min(h(i-1,j,k),h(i,j,k))) - Heff2 = min(Heff2,max(h(i-1,j,k),h(i,j,k))) - Heff3 = abs(uh(I,j+1,k)*G%IdyCu(I,j+1))/(eps_vel+abs(u(I,j+1,k))) - Heff3 = max(Heff3,min(h(i,j+1,k),h(i+1,j+1,k))) - Heff3 = min(Heff3,max(h(i,j+1,k),h(i+1,j+1,k))) - Heff4 = abs(uh(I-1,j+1,k)*G%IdyCu(I-1,j+1))/(eps_vel+abs(u(I-1,j+1,k))) - Heff4 = max(Heff4,min(h(i-1,j+1,k),h(i,j+1,k))) - Heff4 = min(Heff4,max(h(i-1,j+1,k),h(i,j+1,k))) + Heff1 = abs(uh(I,j,k) * G%IdyCu(I,j)) / (eps_vel+abs(u(I,j,k))) + Heff1 = max(Heff1, min(h(i,j,k),h(i+1,j,k))) + Heff1 = min(Heff1, max(h(i,j,k),h(i+1,j,k))) + Heff2 = abs(uh(I-1,j,k) * G%IdyCu(I-1,j)) / (eps_vel+abs(u(I-1,j,k))) + Heff2 = max(Heff2, min(h(i-1,j,k),h(i,j,k))) + Heff2 = min(Heff2, max(h(i-1,j,k),h(i,j,k))) + Heff3 = abs(uh(I,j+1,k) * G%IdyCu(I,j+1)) / (eps_vel+abs(u(I,j+1,k))) + Heff3 = max(Heff3, min(h(i,j+1,k),h(i+1,j+1,k))) + Heff3 = min(Heff3, max(h(i,j+1,k),h(i+1,j+1,k))) + Heff4 = abs(uh(I-1,j+1,k) * G%IdyCu(I-1,j+1)) / (eps_vel+abs(u(I-1,j+1,k))) + Heff4 = max(Heff4, min(h(i-1,j+1,k),h(i,j+1,k))) + Heff4 = min(Heff4, max(h(i-1,j+1,k),h(i,j+1,k))) if (CS%PV_Adv_Scheme == PV_ADV_CENTERED) then CAv(i,J,k) = - 0.5*(abs_vort(I,J)+abs_vort(I-1,J)) * & ((uh(I ,j ,k)+uh(I-1,j+1,k)) + & @@ -838,23 +833,24 @@ end subroutine CorAdCalc !> Calculates the acceleration due to the gradient of kinetic energy. -subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, CS) +subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, US, CS) type(ocean_grid_type), intent(in) :: G !< Ocen grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [m s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] - real, dimension(SZI_(G) ,SZJ_(G) ), intent(out) :: KE !< Kinetic energy [m2 s-2] + real, dimension(SZI_(G) ,SZJ_(G) ), intent(out) :: KE !< Kinetic energy per unit mass [L2 T-2 ~> m2 s-2] real, dimension(SZIB_(G),SZJ_(G) ), intent(out) :: KEx !< Zonal acceleration due to kinetic - !! energy gradient [m s-2] + !! energy gradient [L T-2 ~> m s-2] real, dimension(SZI_(G) ,SZJB_(G)), intent(out) :: KEy !< Meridional acceleration due to kinetic - !! energy gradient [m s-2] + !! energy gradient [L T-2 ~> m s-2] integer, intent(in) :: k !< Layer number to calculate for type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(CoriolisAdv_CS), pointer :: CS !< Control structure for MOM_CoriolisAdv ! Local variables - real :: um, up, vm, vp ! Temporary variables [m s-1]. - real :: um2, up2, vm2, vp2 ! Temporary variables [m2 s-2]. - real :: um2a, up2a, vm2a, vp2a ! Temporary variables [m4 s-2]. + real :: um, up, vm, vp ! Temporary variables [L T-1 ~> m s-1]. + real :: um2, up2, vm2, vp2 ! Temporary variables [L2 T-2 ~> m2 s-2]. + real :: um2a, up2a, vm2a, vp2a ! Temporary variables [L4 T-2 ~> m4 s-2]. integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, n is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -867,11 +863,10 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, CS) ! identified in Arakawa & Lamb 1982 as important for KE conservation. It ! also includes the possibility of partially-blocked tracer cell faces. do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - KE(i,j) = ( ( G%areaCu( I ,j)*(u( I ,j,k)*u( I ,j,k)) & - +G%areaCu(I-1,j)*(u(I-1,j,k)*u(I-1,j,k)) ) & - +( G%areaCv(i, J )*(v(i, J ,k)*v(i, J ,k)) & - +G%areaCv(i,J-1)*(v(i,J-1,k)*v(i,J-1,k)) ) & - )*0.25*G%IareaT(i,j) + KE(i,j) = ( ( G%areaCu( I ,j)*(u( I ,j,k)*u( I ,j,k)) + & + G%areaCu(I-1,j)*(u(I-1,j,k)*u(I-1,j,k)) ) + & + ( G%areaCv(i, J )*(v(i, J ,k)*v(i, J ,k)) + & + G%areaCv(i,J-1)*(v(i,J-1,k)*v(i,J-1,k)) ) )*0.25*G%IareaT(i,j) enddo ; enddo elseif (CS%KE_Scheme == KE_SIMPLE_GUDONOV) then ! The following discretization of KE is based on the one-dimensinal Gudonov @@ -922,9 +917,11 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, CS) end subroutine gradKE !> Initializes the control structure for coriolisadv_cs -subroutine CoriolisAdv_init(Time, G, param_file, diag, AD, CS) +subroutine CoriolisAdv_init(Time, G, GV, US, param_file, diag, AD, CS) type(time_type), target, intent(in) :: Time !< Current model time - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Runtime parameter handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(accel_diag_ptrs), target, intent(inout) :: AD !< Strorage for acceleration diagnostics @@ -937,7 +934,7 @@ subroutine CoriolisAdv_init(Time, G, param_file, diag, AD, CS) character(len=400) :: mesg integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB if (associated(CS)) then @@ -1068,25 +1065,25 @@ subroutine CoriolisAdv_init(Time, G, param_file, diag, AD, CS) end select CS%id_rv = register_diag_field('ocean_model', 'RV', diag%axesBL, Time, & - 'Relative Vorticity', 's-1') + 'Relative Vorticity', 's-1', conversion=US%s_to_T) CS%id_PV = register_diag_field('ocean_model', 'PV', diag%axesBL, Time, & - 'Potential Vorticity', 'm-1 s-1') + 'Potential Vorticity', 'm-1 s-1', conversion=GV%m_to_H*US%s_to_T) CS%id_gKEu = register_diag_field('ocean_model', 'gKEu', diag%axesCuL, Time, & - 'Zonal Acceleration from Grad. Kinetic Energy', 'm-1 s-2') + 'Zonal Acceleration from Grad. Kinetic Energy', 'm-1 s-2', conversion=US%L_T2_to_m_s2) if (CS%id_gKEu > 0) call safe_alloc_ptr(AD%gradKEu,IsdB,IedB,jsd,jed,nz) CS%id_gKEv = register_diag_field('ocean_model', 'gKEv', diag%axesCvL, Time, & - 'Meridional Acceleration from Grad. Kinetic Energy', 'm-1 s-2') + 'Meridional Acceleration from Grad. Kinetic Energy', 'm-1 s-2', conversion=US%L_T2_to_m_s2) if (CS%id_gKEv > 0) call safe_alloc_ptr(AD%gradKEv,isd,ied,JsdB,JedB,nz) CS%id_rvxu = register_diag_field('ocean_model', 'rvxu', diag%axesCvL, Time, & - 'Meridional Acceleration from Relative Vorticity', 'm-1 s-2') + 'Meridional Acceleration from Relative Vorticity', 'm-1 s-2', conversion=US%L_T2_to_m_s2) if (CS%id_rvxu > 0) call safe_alloc_ptr(AD%rv_x_u,isd,ied,JsdB,JedB,nz) CS%id_rvxv = register_diag_field('ocean_model', 'rvxv', diag%axesCuL, Time, & - 'Zonal Acceleration from Relative Vorticity', 'm-1 s-2') + 'Zonal Acceleration from Relative Vorticity', 'm-1 s-2', conversion=US%L_T2_to_m_s2) if (CS%id_rvxv > 0) call safe_alloc_ptr(AD%rv_x_v,IsdB,IedB,jsd,jed,nz) end subroutine CoriolisAdv_init diff --git a/src/core/MOM_PressureForce.F90 b/src/core/MOM_PressureForce.F90 index 183817bf42..5579b2311f 100644 --- a/src/core/MOM_PressureForce.F90 +++ b/src/core/MOM_PressureForce.F90 @@ -52,9 +52,9 @@ subroutine PressureForce(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, e intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: PFu !< Zonal pressure force acceleration [m s-2] + intent(out) :: PFu !< Zonal pressure force acceleration [L T-2 ~> m s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: PFv !< Meridional pressure force acceleration [m s-2] + intent(out) :: PFv !< Meridional pressure force acceleration [L T-2 ~> m s-2] type(PressureForce_CS), pointer :: CS !< Pressure force control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), & diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 2c143baab1..9bb0a02606 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -40,9 +40,10 @@ module MOM_PressureForce_Mont type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate !! the timing of diagnostic output. - real, pointer :: PFu_bc(:,:,:) => NULL() !< Accelerations due to pressure - real, pointer :: PFv_bc(:,:,:) => NULL() !< gradients deriving from density - !! gradients within layers [m s-2]. + real, pointer :: PFu_bc(:,:,:) => NULL() !< Zonal accelerations due to pressure gradients + !! deriving from density gradients within layers [L T-2 ~> m s-2]. + real, pointer :: PFv_bc(:,:,:) => NULL() !< Meridional accelerations due to pressure gradients + !! deriving from density gradients within layers [L T-2 ~> m s-2]. !>@{ Diagnostic IDs integer :: id_PFu_bc = -1, id_PFv_bc = -1, id_e_tidal = -1 !!@} @@ -67,9 +68,9 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, [H ~> kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration due to pressure gradients - !! (equal to -dM/dx) [m s-2]. + !! (equal to -dM/dx) [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration due to pressure gradients - !! (equal to -dM/dy) [m s-2]. + !! (equal to -dM/dy) [L T-2 ~> m s-2]. type(PressureForce_Mont_CS), pointer :: CS !< Control structure for Montgomery potential PGF real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean or !! atmosphere-ocean [Pa]. @@ -81,7 +82,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - M, & ! The Montgomery potential, M = (p/rho + gz) [m2 s-2]. + M, & ! The Montgomery potential, M = (p/rho + gz) [L2 T-2 ~> m2 s-2]. alpha_star, & ! Compression adjusted specific volume [m3 kg-1]. dz_geo ! The change in geopotential across a layer [m2 s-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: p ! Interface pressure [Pa]. @@ -106,12 +107,12 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb e_tidal, & ! Bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading [Z ~> m]. geopot_bot ! Bottom geopotential relative to time-mean sea level, - ! including any tidal contributions [m2 s-2]. + ! including any tidal contributions [L2 T-2 ~> m2 s-2]. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density [Pa] (usually 2e7 Pa = 2000 dbar). real :: rho_in_situ(SZI_(G)) !In-situ density of a layer [kg m-3]. real :: PFu_bc, PFv_bc ! The pressure gradient force due to along-layer - ! compensated density gradients [m s-2] + ! compensated density gradients [L T-2 ~> m s-2] real :: dp_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [Pa]. logical :: use_p_atm ! If true, use the atmospheric pressure. @@ -206,12 +207,12 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=US%m_to_Z) !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - geopot_bot(i,j) = -US%L_T_to_m_s**2 * GV%g_Earth*(e_tidal(i,j) + G%bathyT(i,j)) + geopot_bot(i,j) = -GV%g_Earth*(e_tidal(i,j) + G%bathyT(i,j)) enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - geopot_bot(i,j) = -US%L_T_to_m_s**2 * GV%g_Earth*G%bathyT(i,j) + geopot_bot(i,j) = -GV%g_Earth*G%bathyT(i,j) enddo ; enddo endif @@ -258,20 +259,20 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - M(i,j,nz) = geopot_bot(i,j) + p(i,j,nz+1) * alpha_star(i,j,nz) + M(i,j,nz) = geopot_bot(i,j) + US%m_s_to_L_T**2*p(i,j,nz+1) * alpha_star(i,j,nz) enddo do k=nz-1,1,-1 ; do i=Isq,Ieq+1 - M(i,j,k) = M(i,j,k+1) + p(i,j,K+1) * (alpha_star(i,j,k) - alpha_star(i,j,k+1)) + M(i,j,k) = M(i,j,k+1) + US%m_s_to_L_T**2*p(i,j,K+1) * (alpha_star(i,j,k) - alpha_star(i,j,k+1)) enddo ; enddo enddo else ! not use_EOS !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - M(i,j,nz) = geopot_bot(i,j) + p(i,j,nz+1) * alpha_Lay(nz) + M(i,j,nz) = geopot_bot(i,j) + US%m_s_to_L_T**2*p(i,j,nz+1) * alpha_Lay(nz) enddo do k=nz-1,1,-1 ; do i=Isq,Ieq+1 - M(i,j,k) = M(i,j,k+1) + p(i,j,K+1) * dalpha_int(K+1) + M(i,j,k) = M(i,j,k+1) + US%m_s_to_L_T**2*p(i,j,K+1) * dalpha_int(K+1) enddo ; enddo enddo endif ! use_EOS @@ -294,11 +295,11 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb ! enddo ; enddo ! if (use_EOS) then ! do k=2,nz ; do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 -! M(i,j,k) = M(i,j,k-1) - p(i,j,K) * (alpha_star(i,j,k-1) - alpha_star(i,j,k)) +! M(i,j,k) = M(i,j,k-1) - US%m_s_to_L_T**2*p(i,j,K) * (alpha_star(i,j,k-1) - alpha_star(i,j,k)) ! enddo ; enddo ; enddo ! else ! not use_EOS ! do k=2,nz ; do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 -! M(i,j,k) = M(i,j,k-1) - p(i,j,K) * dalpha_int(K) +! M(i,j,k) = M(i,j,k-1) - US%m_s_to_L_T**2*p(i,j,K) * dalpha_int(K) ! enddo ; enddo ; enddo ! endif ! use_EOS @@ -319,14 +320,14 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb enddo ; enddo do j=js,je ; do I=Isq,Ieq ! PFu_bc = p* grad alpha* - PFu_bc = (alpha_star(i+1,j,k) - alpha_star(i,j,k)) * (G%IdxCu(I,j) * & + PFu_bc = US%m_s_to_L_T**2*(alpha_star(i+1,j,k) - alpha_star(i,j,k)) * (G%IdxCu(I,j) * & ((dp_star(i,j) * dp_star(i+1,j) + (p(i,j,K) * dp_star(i+1,j) + & p(i+1,j,K) * dp_star(i,j))) / (dp_star(i,j) + dp_star(i+1,j)))) PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * G%IdxCu(I,j) + PFu_bc if (associated(CS%PFu_bc)) CS%PFu_bc(i,j,k) = PFu_bc enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - PFv_bc = (alpha_star(i,j+1,k) - alpha_star(i,j,k)) * (G%IdyCv(i,J) * & + PFv_bc = US%m_s_to_L_T**2*(alpha_star(i,j+1,k) - alpha_star(i,j,k)) * (G%IdyCv(i,J) * & ((dp_star(i,j) * dp_star(i,j+1) + (p(i,j,K) * dp_star(i,j+1) + & p(i,j+1,K) * dp_star(i,j))) / (dp_star(i,j) + dp_star(i,j+1)))) PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * G%IdyCv(i,J) + PFv_bc @@ -365,9 +366,9 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration due to pressure gradients - !! (equal to -dM/dx) [m s-2]. + !! (equal to -dM/dx) [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration due to pressure gradients - !! (equal to -dM/dy) [m s2]. + !! (equal to -dM/dy) [L T-2 ~> m s2]. type(PressureForce_Mont_CS), pointer :: CS !< Control structure for Montgomery potential PGF real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean or !! atmosphere-ocean [Pa]. @@ -377,7 +378,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< Free surface height [H ~> m]. ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - M, & ! The Montgomery potential, M = (p/rho + gz) [m2 s-2]. + M, & ! The Montgomery potential, M = (p/rho + gz) [L2 T-2 ~> m2 s-2]. rho_star ! In-situ density divided by the derivative with depth of the ! corrected e times (G_Earth/Rho0) [m2 Z-1 s-2 ~> m s-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: e ! Interface height in m. @@ -400,10 +401,9 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density [Pa] (usually 2e7 Pa = 2000 dbar). real :: I_Rho0 ! 1/Rho0 [m3 kg-1]. - real :: G_Rho0 ! G_Earth / Rho0 [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1]. + real :: G_Rho0 ! G_Earth / Rho0 [L2 m3 Z-1 T-2 kg-1 ~> m4 s-2 kg-1]. real :: PFu_bc, PFv_bc ! The pressure gradient force due to along-layer - ! compensated density gradients [m s-2] -! real :: dr ! Temporary variables. + ! compensated density gradients [L T-2 ~> m s-2] real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [Z ~> m]. logical :: use_p_atm ! If true, use the atmospheric pressure. @@ -435,7 +435,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, h_neglect = GV%H_subroundoff * GV%H_to_Z I_Rho0 = 1.0/CS%Rho0 - G_Rho0 = US%L_T_to_m_s**2 * GV%g_Earth/GV%Rho0 + G_Rho0 = GV%g_Earth/GV%Rho0 if (CS%tides) then ! Determine the surface height anomaly for calculating self attraction @@ -520,7 +520,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, do j=Jsq,Jeq+1 do i=Isq,Ieq+1 M(i,j,1) = CS%GFS_scale * (rho_star(i,j,1) * e(i,j,1)) - if (use_p_atm) M(i,j,1) = M(i,j,1) + p_atm(i,j) * I_Rho0 + if (use_p_atm) M(i,j,1) = M(i,j,1) + US%m_s_to_L_T**2*p_atm(i,j) * I_Rho0 enddo do k=2,nz ; do i=Isq,Ieq+1 M(i,j,k) = M(i,j,k-1) + (rho_star(i,j,k) - rho_star(i,j,k-1)) * e(i,j,K) @@ -530,11 +530,11 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - M(i,j,1) = US%L_to_m**2*US%s_to_T**2*GV%g_prime(1) * e(i,j,1) - if (use_p_atm) M(i,j,1) = M(i,j,1) + p_atm(i,j) * I_Rho0 + M(i,j,1) = GV%g_prime(1) * e(i,j,1) + if (use_p_atm) M(i,j,1) = M(i,j,1) + US%m_s_to_L_T**2*p_atm(i,j) * I_Rho0 enddo do k=2,nz ; do i=Isq,Ieq+1 - M(i,j,k) = M(i,j,k-1) + US%L_to_m**2*US%s_to_T**2*GV%g_prime(K) * e(i,j,K) + M(i,j,k) = M(i,j,k-1) + GV%g_prime(K) * e(i,j,K) enddo ; enddo enddo endif ! use_EOS @@ -619,7 +619,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) !! [m2 H-1 s-2 ~> m4 kg-2 s-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: rho_star !< The layer densities (maybe compressibility - !! compensated), times g/rho_0 [m2 Z-1 s-2 ~> m s-2]. + !! compensated), times g/rho_0 [L2 Z-1 T-2 ~> m s-2]. ! Local variables real :: Ihtot(SZI_(G)) ! The inverse of the sum of the layer thicknesses [H-1 ~> m-1 or m2 kg-1]. @@ -650,10 +650,10 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 Ihtot(i) = GV%H_to_Z / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect) - pbce(i,j,1) = GFS_scale * US%m_s_to_L_T**2*rho_star(i,j,1) * GV%H_to_Z + pbce(i,j,1) = GFS_scale * rho_star(i,j,1) * GV%H_to_Z enddo do k=2,nz ; do i=Isq,Ieq+1 - pbce(i,j,k) = pbce(i,j,k-1) + US%m_s_to_L_T**2*(rho_star(i,j,k)-rho_star(i,j,k-1)) * & + pbce(i,j,k) = pbce(i,j,k-1) + (rho_star(i,j,k)-rho_star(i,j,k-1)) * & ((e(i,j,K) - e(i,j,nz+1)) * Ihtot(i)) enddo ; enddo enddo ! end of j loop @@ -825,10 +825,11 @@ subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_ type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(PressureForce_Mont_CS), pointer :: CS !< Montgomery PGF control structure type(tidal_forcing_CS), optional, pointer :: tides_CSp !< Tides control structure + ! Local variables logical :: use_temperature, use_EOS -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl ! This module's name. if (associated(CS)) then @@ -857,9 +858,9 @@ subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_ if (use_EOS) then CS%id_PFu_bc = register_diag_field('ocean_model', 'PFu_bc', diag%axesCuL, Time, & - 'Density Gradient Zonal Pressure Force Accel.', "meter second-2") + 'Density Gradient Zonal Pressure Force Accel.', "meter second-2", conversion=US%L_T2_to_m_s2) CS%id_PFv_bc = register_diag_field('ocean_model', 'PFv_bc', diag%axesCvL, Time, & - 'Density Gradient Meridional Pressure Force Accel.', "meter second-2") + 'Density Gradient Meridional Pressure Force Accel.', "meter second-2", conversion=US%L_T2_to_m_s2) if (CS%id_PFu_bc > 0) then call safe_alloc_ptr(CS%PFu_bc,G%IsdB,G%IedB,G%jsd,G%jed,G%ke) CS%PFu_bc(:,:,:) = 0.0 diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index d23b343cf4..f84b8e780e 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -69,8 +69,8 @@ subroutine PressureForce_AFV(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbc type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [m s-2] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [m s-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [L T-2 ~> m s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [L T-2 ~> m s-2] type(PressureForce_AFV_CS), pointer :: CS !< Finite volume PGF control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean @@ -105,8 +105,8 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> kg/m2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [m s-2] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [m s-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [L T-2 ~> m s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [L T-2 ~> m s-2] type(PressureForce_AFV_CS), pointer :: CS !< Finite volume PGF control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean @@ -140,7 +140,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p e_tidal, & ! The bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading [Z ~> m]. dM, & ! The barotropic adjustment to the Montgomery potential to - ! account for a reduced gravity model [m2 s-2]. + ! account for a reduced gravity model [L2 T-2 ~> m2 s-2]. za ! The geopotential anomaly (i.e. g*e + alpha_0*pressure) at the ! interface atop a layer [m2 s-2]. @@ -341,14 +341,14 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p rho_in_situ, Isq, Ieq-Isq+2, tv%eqn_of_state) do i=Isq,Ieq+1 - dM(i,j) = (CS%GFS_scale - 1.0) * & + dM(i,j) = (CS%GFS_scale - 1.0) * US%m_s_to_L_T**2 * & (p(i,j,1)*(1.0/rho_in_situ(i) - alpha_ref) + za(i,j)) enddo enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - dM(i,j) = (CS%GFS_scale - 1.0) * & + dM(i,j) = (CS%GFS_scale - 1.0) * US%m_s_to_L_T**2 * & (p(i,j,1)*(1.0/GV%Rlay(1) - alpha_ref) + za(i,j)) enddo ; enddo endif @@ -384,8 +384,8 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p (za(i+1,j)*dp(i+1,j) + intp_dza(i+1,j,k))) + & ((dp(i+1,j) - dp(i,j)) * intx_za(I,j) - & (p(i+1,j,K) - p(i,j,K)) * intx_dza(I,j,k))) * & - (2.0*G%IdxCu(I,j) / ((dp(i,j) + dp(i+1,j)) + & - dp_neglect)) + (US%m_s_to_L_T**2 * 2.0*G%IdxCu(I,j) / & + ((dp(i,j) + dp(i+1,j)) + dp_neglect)) enddo ; enddo !$OMP parallel do default(shared) do J=Jsq,Jeq ; do i=is,ie @@ -394,8 +394,8 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p (za(i,j+1)*dp(i,j+1) + intp_dza(i,j+1,k))) + & ((dp(i,j+1) - dp(i,j)) * inty_za(i,J) - & (p(i,j+1,K) - p(i,j,K)) * inty_dza(i,J,k))) * & - (2.0*G%IdyCv(i,J) / ((dp(i,j) + dp(i,j+1)) + & - dp_neglect)) + (US%m_s_to_L_T**2 * 2.0*G%IdyCv(i,J) / & + ((dp(i,j) + dp(i,j+1)) + dp_neglect)) enddo ; enddo if (CS%GFS_scale < 1.0) then @@ -448,8 +448,8 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [m s-2] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [m s-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [L T-2 ~> m s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [L T-2 ~> m s-2] type(PressureForce_AFV_CS), pointer :: CS !< Finite volume PGF control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean @@ -466,7 +466,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at e_tidal, & ! The bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading [Z ~> m]. dM ! The barotropic adjustment to the Montgomery potential to - ! account for a reduced gravity model [m2 s-2]. + ! account for a reduced gravity model [L2 T-2 ~> m2 s-2]. real, dimension(SZI_(G)) :: & Rho_cv_BL ! The coordinate potential density in the deepest variable ! density near-surface layer [kg m-3]. @@ -502,8 +502,8 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m]. real :: g_Earth_z ! A scaled version of g_Earth [m2 Z-1 s-2 ~> m s-2]. - real :: I_Rho0 ! 1/Rho0 [m3 kg-1]. - real :: G_Rho0 ! G_Earth / Rho0 in [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1]. + real :: I_Rho0 ! 1/Rho0 times unit scaling factors [L2 m kg-1 s2 T-2 ~> m3 kg-1]. + real :: G_Rho0 ! G_Earth / Rho0 in [L2 m5 Z-1 T-2 kg-1 ~> m4 s-2 kg-1]. real :: Rho_ref ! The reference density [kg m-3]. real :: dz_neglect ! A minimal thickness [Z ~> m], like e. logical :: use_p_atm ! If true, use the atmospheric pressure. @@ -531,9 +531,9 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff * GV%H_to_Z - I_Rho0 = 1.0/GV%Rho0 + I_Rho0 = US%m_s_to_L_T**2 / GV%Rho0 g_Earth_z = US%L_T_to_m_s**2 * GV%g_Earth - G_Rho0 = g_Earth_z/GV%Rho0 + G_Rho0 = GV%g_Earth/GV%Rho0 rho_ref = CS%Rho0 if (CS%tides) then @@ -791,8 +791,8 @@ subroutine PressureForce_AFV_init(Time, G, GV, US, param_file, diag, CS, tides_C type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(PressureForce_AFV_CS), pointer :: CS !< Finite volume PGF control structure type(tidal_forcing_CS), optional, pointer :: tides_CSp !< Tides control structure -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl ! This module's name. logical :: use_ALE diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index c9e1b2707c..773bcefc1d 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -69,8 +69,8 @@ subroutine PressureForce_blk_AFV(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [m s-2] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [m s-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [L T-2 ~> m s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [L T-2 ~> m s-2] type(PressureForce_blk_AFV_CS), pointer :: CS !< Finite volume PGF control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean @@ -105,8 +105,8 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [m s-2] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [m s-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [L T-2 ~> m s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [L T-2 ~> m s-2] type(PressureForce_blk_AFV_CS), pointer :: CS !< Finite volume PGF control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean !! or atmosphere-ocean interface [Pa]. @@ -307,14 +307,14 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, do i=Isq,Ieq+1 dM(i,j) = (CS%GFS_scale - 1.0) * & - (p(i,j,1)*(1.0/rho_in_situ(i) - alpha_ref) + za(i,j)) + US%m_s_to_L_T**2*(p(i,j,1)*(1.0/rho_in_situ(i) - alpha_ref) + za(i,j)) enddo enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 dM(i,j) = (CS%GFS_scale - 1.0) * & - (p(i,j,1)*(1.0/GV%Rlay(1) - alpha_ref) + za(i,j)) + US%m_s_to_L_T**2*(p(i,j,1)*(1.0/GV%Rlay(1) - alpha_ref) + za(i,j)) enddo ; enddo endif ! else @@ -365,8 +365,8 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, (za_bk(ib+1,jb)*dp_bk(ib+1,jb) + intp_dza(i+1,j,k))) + & ((dp_bk(ib+1,jb) - dp_bk(ib,jb)) * intx_za_bk(Ib,jb) - & (p(i+1,j,K) - p(i,j,K)) * intx_dza(I,j,k))) * & - (2.0*G%IdxCu(I,j) / ((dp_bk(ib,jb) + dp_bk(ib+1,jb)) + & - dp_neglect)) + (US%m_s_to_L_T**2 * 2.0*G%IdxCu(I,j) / & + ((dp_bk(ib,jb) + dp_bk(ib+1,jb)) + dp_neglect)) enddo ; enddo do Jb=Jsq_bk,Jeq_bk ; do ib=is_bk,ie_bk i = ib+ioff_bk ; J = Jb+joff_bk @@ -375,8 +375,8 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, (za_bk(ib,jb+1)*dp_bk(ib,jb+1) + intp_dza(i,j+1,k))) + & ((dp_bk(ib,jb+1) - dp_bk(ib,jb)) * inty_za_bk(ib,Jb) - & (p(i,j+1,K) - p(i,j,K)) * inty_dza(i,J,k))) * & - (2.0*G%IdyCv(i,J) / ((dp_bk(ib,jb) + dp_bk(ib,jb+1)) + & - dp_neglect)) + (US%m_s_to_L_T**2 * 2.0*G%IdyCv(i,J) / & + ((dp_bk(ib,jb) + dp_bk(ib,jb+1)) + dp_neglect)) enddo ; enddo if (CS%GFS_scale < 1.0) then @@ -429,8 +429,8 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [m s-2] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [m s-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [L T-2 ~> m s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [L T-2 ~> m s-2] type(PressureForce_blk_AFV_CS), pointer :: CS !< Finite volume PGF control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean @@ -447,7 +447,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, e_tidal, & ! The bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading, in depth units [Z ~> m]. dM ! The barotropic adjustment to the Montgomery potential to - ! account for a reduced gravity model [m2 s-2]. + ! account for a reduced gravity model [L2 T-2 ~> m2 s-2]. real, dimension(SZI_(G)) :: & Rho_cv_BL ! The coordinate potential density in the deepest variable ! density near-surface layer [kg m-3]. @@ -482,7 +482,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, real :: p0(SZI_(G)) ! An array of zeros to use for pressure [Pa]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. - real :: I_Rho0 ! 1/Rho0 [m3 kg-1]. + real :: I_Rho0 ! 1/Rho0 times unit scaling factors [L2 m kg-1 s2 T-2 ~> m3 kg-1]. real :: g_Earth_z ! A scaled version of g_Earth [m2 Z-1 s-2 ~> m s-2]. real :: G_Rho0 ! G_Earth / Rho0 [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1]. real :: Rho_ref ! The reference density [kg m-3]. @@ -515,9 +515,9 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff * GV%H_to_Z - I_Rho0 = 1.0/GV%Rho0 + I_Rho0 = US%m_s_to_L_T**2 / GV%Rho0 g_Earth_z = US%L_T_to_m_s**2 * GV%g_Earth - G_Rho0 = g_Earth_z / GV%Rho0 + G_Rho0 = GV%g_Earth / GV%Rho0 rho_ref = CS%Rho0 if (CS%tides) then diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 6377dd2d1f..8d48ebbb0b 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -241,7 +241,7 @@ module MOM_barotropic real :: vel_underflow !< Velocity components smaller than vel_underflow !! are set to 0 [L T-1 ~> m s-1]. real :: maxvel !< Velocity components greater than maxvel are - !! truncated to maxvel [m s-1]. + !! truncated to maxvel [L T-1 ~> m s-1]. real :: CFL_trunc !< If clip_velocity is true, velocity components will !! be truncated when they are large enough that the !! corresponding CFL number exceeds this value, nondim. @@ -331,13 +331,13 @@ module MOM_barotropic !> A desciption of the functional dependence of transport at a v-point type, private :: local_BT_cont_v_type real :: FA_v_NN !< The effective open face area for meridional barotropic transport - !! drawing from locations far to the north [H m ~> m2 or kg m-1]. + !! drawing from locations far to the north [H L ~> m2 or kg m-1]. real :: FA_v_N0 !< The effective open face area for meridional barotropic transport - !! drawing from nearby to the north [H m ~> m2 or kg m-1]. + !! drawing from nearby to the north [H L ~> m2 or kg m-1]. real :: FA_v_S0 !< The effective open face area for meridional barotropic transport - !! drawing from nearby to the south [H m ~> m2 or kg m-1]. + !! drawing from nearby to the south [H L ~> m2 or kg m-1]. real :: FA_v_SS !< The effective open face area for meridional barotropic transport - !! drawing from locations far to the south [H m ~> m2 or kg m-1]. + !! drawing from locations far to the south [H L ~> m2 or kg m-1]. real :: vBT_SS !< vBT_SS is the barotropic velocity [L T-1 ~> m s-1], beyond which the marginal !! open face area is FA_v_SS. vBT_SS must be non-negative. real :: vBT_NN !< vBT_NN is the barotropic velocity [L T-1 ~> m s-1], beyond which the marginal @@ -384,20 +384,21 @@ module MOM_barotropic subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, & eta_PF_in, U_Cor, V_Cor, accel_layer_u, accel_layer_v, & eta_out, uhbtav, vhbtav, G, GV, US, CS, & - visc_rem_u, visc_rem_v, etaav, OBC, & - BT_cont, eta_PF_start, & + visc_rem_u, visc_rem_v, etaav, OBC, BT_cont, eta_PF_start, & taux_bot, tauy_bot, uh0, vh0, u_uh0, v_vh0) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: U_in !< The initial (3-D) zonal velocity [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: V_in !< The initial (3-D) meridional velocity [m s-1]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: U_in !< The initial (3-D) zonal + !! velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: V_in !< The initial (3-D) meridional + !! velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta_in !< The initial barotropic free surface height !! anomaly or column mass anomaly [H ~> m or kg m-2]. real, intent(in) :: dt !< The time increment to integrate over. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: bc_accel_u !< The zonal baroclinic accelerations [m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: bc_accel_v !< The meridional baroclinic accelerations, - !! [m s-2]. + !! [L T-2 ~> m s-2]. type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: pbce !< The baroclinic pressure anomaly in each layer !! due to free surface height anomalies @@ -408,21 +409,22 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, !! eta_PF_start is provided [H ~> m or kg m-2]. !! Note: eta_in, pbce, and eta_PF_in must have up-to-date !! values in the first point of their halos. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: U_Cor !< The (3-D) zonal-velocities used to - !! calculate the Coriolis terms in bc_accel_u [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: V_Cor !< Ditto for meridonal bc_accel_v. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: U_Cor !< The (3-D) zonal velocities used to + !! calculate the Coriolis terms in bc_accel_u [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: V_Cor !< The (3-D) meridional velocities used to + !! calculate the Coriolis terms in bc_accel_u [L T-1 ~> m s-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: accel_layer_u !< The zonal acceleration of each layer due - !! to the barotropic calculation [m s-2]. + !! to the barotropic calculation [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: accel_layer_v !< The meridional acceleration of each layer - !! due to the barotropic calculation [m s-2]. + !! due to the barotropic calculation [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_out !< The final barotropic free surface !! height anomaly or column mass anomaly [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G)), intent(out) :: uhbtav !< the barotropic zonal volume or mass !! fluxes averaged through the barotropic steps - !! [H m2 s-1 ~> m3 or kg s-1]. + !! [H L2 T-1 ~> m3 or kg s-1]. real, dimension(SZI_(G),SZJB_(G)), intent(out) :: vhbtav !< the barotropic meridional volume or mass !! fluxes averaged through the barotropic steps - !! [H m2 s-1 ~> m3 or kg s-1]. + !! [H L2 T-1 ~> m3 or kg s-1]. type(barotropic_CS), pointer :: CS !< The control structure returned by a !! previous call to barotropic_init. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: visc_rem_u !< Both the fraction of the momentum @@ -442,15 +444,17 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, !! gradient at the start of the barotropic stepping !! [H ~> m or kg m-2]. real, dimension(:,:), optional, pointer :: taux_bot !< The zonal bottom frictional stress from - !! ocean to the seafloor [Pa]. + !! ocean to the seafloor [kg L Z T-2 m-3 ~> Pa]. real, dimension(:,:), optional, pointer :: tauy_bot !< The meridional bottom frictional stress - !! from ocean to the seafloor [Pa]. + !! from ocean to the seafloor [kg L Z T-2 m-3 ~> Pa]. real, dimension(:,:,:), optional, pointer :: uh0 !< The zonal layer transports at reference - !! velocities [H m s-1 ~> m2 s-1 or kg m-1 s-1]. - real, dimension(:,:,:), optional, pointer :: u_uh0 !< The velocities used to calculate uh0 [m s-1] + !! velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. + real, dimension(:,:,:), optional, pointer :: u_uh0 !< The velocities used to calculate + !! uh0 [L T-1 ~> m s-1] real, dimension(:,:,:), optional, pointer :: vh0 !< The zonal layer transports at reference - !! velocities [H m s-1 ~> m2 s-1 or kg m-1 s-1]. - real, dimension(:,:,:), optional, pointer :: v_vh0 !< The velocities used to calculate vh0 [m s-1] + !! velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. + real, dimension(:,:,:), optional, pointer :: v_vh0 !< The velocities used to calculate + !! vh0 [L T-1 ~> m s-1] ! Local variables real :: ubt_Cor(SZIB_(G),SZJ_(G)) ! The barotropic velocities that had been @@ -482,7 +486,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! not explicitly included in the barotropic equation [L T-2 ~> m s-2]. u_accel_bt, & ! The difference between the zonal acceleration from the ! barotropic calculation and BT_force_u [L T-2 ~> m s-2]. - uhbt, & ! The zonal barotropic thickness fluxes [H m2 s-1 ~> m3 s-1 or kg s-1]. + uhbt, & ! The zonal barotropic thickness fluxes [H L2 T-1 ~> m3 s-1 or kg s-1]. uhbt0, & ! The difference between the sum of the layer zonal thickness ! fluxes and the barotropic thickness flux using the same ! velocity [H L2 T-1 ~> m3 s-1 or kg s-1]. @@ -515,7 +519,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! not explicitly included in the barotropic equation [L T-2 ~> m s-2]. v_accel_bt, & ! The difference between the meridional acceleration from the ! barotropic calculation and BT_force_v [L T-2 ~> m s-2]. - vhbt, & ! The meridional barotropic thickness fluxes [H m2 s-1 ~> m3 s-1 or kg s-1]. + vhbt, & ! The meridional barotropic thickness fluxes [H L2 T-1 ~> m3 s-1 or kg s-1]. vhbt0, & ! The difference between the sum of the layer meridional ! thickness fluxes and the barotropic thickness flux using ! the same velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. @@ -577,6 +581,8 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, vbt_prev, vhbt_prev, vbt_sum_prev, vhbt_sum_prev, vbt_wtd_prev ! for OBC real :: mass_to_Z ! The depth unit converison divided by the mean density (Rho0) [Z m2 kg-1 ~> m3 kg-1]. + real :: mass_accel_to_Z ! The depth unit converison times an acceleration conversion divided by + ! the mean density (Rho0) [Z L m s2 T-2 kg-1 ~> m3 kg-1]. real :: visc_rem ! A work variable that may equal visc_rem_[uv]. Nondim. real :: vel_prev ! The previous velocity [L T-1 ~> m s-1]. real :: dtbt ! The barotropic time step [T ~> s]. @@ -616,11 +622,10 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! dynamic surface pressure for stability [H ~> m or kg m-2]. real :: H_eff_dx2 ! The effective total thickness divided by the grid spacing ! squared [H L-2 ~> m-1 or kg m-4]. - real :: vel_tmp ! A temporary velocity [m s-1]. real :: u_max_cor, v_max_cor ! The maximum corrective velocities [L T-1 ~> m s-1]. real :: Htot ! The total thickness [H ~> m or kg m-2]. real :: eta_cor_max ! The maximum fluid that can be added as a correction to eta [H ~> m or kg m-2]. - real :: accel_underflow ! An acceleration that is so small it should be zeroed out. + real :: accel_underflow ! An acceleration that is so small it should be zeroed out [L T-2 ~> m s-2]. real, allocatable, dimension(:) :: wt_vel, wt_eta, wt_accel, wt_trans, wt_accel2 real :: sum_wt_vel, sum_wt_eta, sum_wt_accel, sum_wt_trans @@ -650,7 +655,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, MS%isdw = CS%isdw ; MS%iedw = CS%iedw ; MS%jsdw = CS%jsdw ; MS%jedw = CS%jedw dt_in_T = US%s_to_T*dt Idt = 1.0 / dt_in_T - accel_underflow = US%L_T_to_m_s*CS%vel_underflow * US%s_to_T*Idt + accel_underflow = CS%vel_underflow * Idt use_BT_cont = .false. if (present(BT_cont)) use_BT_cont = (associated(BT_cont)) @@ -719,7 +724,8 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, dtbt = dt_in_T * Instep bebt = CS%bebt be_proj = CS%bebt - mass_to_Z = US%m_to_L*US%T_to_s**2 * US%m_to_Z / GV%Rho0 + mass_accel_to_Z = US%m_to_L*US%T_to_s**2 * US%m_to_Z / GV%Rho0 + mass_to_Z = US%m_to_Z / GV%Rho0 !--- setup the weight when computing vbt_trans and ubt_trans if (project_velocity) then @@ -915,11 +921,11 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, do J=js-1,je ; do i=is-1,ie+1 ; vbt_Cor(i,J) = 0.0 ; enddo ; enddo !$OMP parallel do default(shared) do j=js,je ; do k=1,nz ; do I=is-1,ie - ubt_Cor(I,j) = ubt_Cor(I,j) + wt_u(I,j,k) * US%m_s_to_L_T*U_Cor(I,j,k) + ubt_Cor(I,j) = ubt_Cor(I,j) + wt_u(I,j,k) * U_Cor(I,j,k) enddo ; enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do k=1,nz ; do i=is,ie - vbt_Cor(i,J) = vbt_Cor(i,J) + wt_v(i,J,k) * US%m_s_to_L_T*V_Cor(i,J,k) + vbt_Cor(i,J) = vbt_Cor(i,J) + wt_v(i,J,k) * V_Cor(i,J,k) enddo ; enddo ; enddo ! The gtot arrays are the effective layer-weighted reduced gravities for @@ -983,14 +989,14 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! ### IDatu here should be replaced with 1/D+eta(Bous) or 1/eta(non-Bous). ! ### although with BT_cont_types IDatu should be replaced by ! ### CS%dy_Cu(I,j) / (d(uhbt)/du) (with appropriate bounds). - BT_force_u(I,j) = forces%taux(I,j) * mass_to_Z * CS%IDatu(I,j)*visc_rem_u(I,j,1) + BT_force_u(I,j) = forces%taux(I,j) * mass_accel_to_Z * CS%IDatu(I,j)*visc_rem_u(I,j,1) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie ! ### IDatv here should be replaced with 1/D+eta(Bous) or 1/eta(non-Bous). ! ### although with BT_cont_types IDatv should be replaced by ! ### CS%dx_Cv(I,j) / (d(vhbt)/dv) (with appropriate bounds). - BT_force_v(i,J) = forces%tauy(i,J) * mass_to_Z * CS%IDatv(i,J)*visc_rem_v(i,J,1) + BT_force_v(i,J) = forces%tauy(i,J) * mass_accel_to_Z * CS%IDatv(i,J)*visc_rem_v(i,J,1) enddo ; enddo if (present(taux_bot) .and. present(tauy_bot)) then if (associated(taux_bot) .and. associated(tauy_bot)) then @@ -1009,11 +1015,11 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! non-symmetric computational domain. !$OMP parallel do default(shared) do j=js,je ; do k=1,nz ; do I=Isq,Ieq - BT_force_u(I,j) = BT_force_u(I,j) + wt_u(I,j,k) * US%m_to_L*US%T_to_s**2*bc_accel_u(I,j,k) + BT_force_u(I,j) = BT_force_u(I,j) + wt_u(I,j,k) * bc_accel_u(I,j,k) enddo ; enddo ; enddo !$OMP parallel do default(shared) do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - BT_force_v(i,J) = BT_force_v(i,J) + wt_v(i,J,k) * US%m_to_L*US%T_to_s**2*bc_accel_v(i,J,k) + BT_force_v(i,J) = BT_force_v(i,J) + wt_v(i,J,k) * bc_accel_v(i,J,k) enddo ; enddo ; enddo ! Determine the difference between the sum of the layer fluxes and the @@ -1026,24 +1032,24 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (CS%visc_rem_u_uh0) then !$OMP parallel do default(shared) do j=js,je ; do k=1,nz ; do I=is-1,ie - uhbt(I,j) = uhbt(I,j) + US%T_to_s*US%m_to_L**2*uh0(I,j,k) - ubt(I,j) = ubt(I,j) + wt_u(I,j,k) * US%m_s_to_L_T*u_uh0(I,j,k) + uhbt(I,j) = uhbt(I,j) + uh0(I,j,k) + ubt(I,j) = ubt(I,j) + wt_u(I,j,k) * u_uh0(I,j,k) enddo ; enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do k=1,nz ; do i=is,ie - vhbt(i,J) = vhbt(i,J) + US%T_to_s*US%m_to_L**2*vh0(i,J,k) - vbt(i,J) = vbt(i,J) + wt_v(i,J,k) * US%m_s_to_L_T*v_vh0(i,J,k) + vhbt(i,J) = vhbt(i,J) + vh0(i,J,k) + vbt(i,J) = vbt(i,J) + wt_v(i,J,k) * v_vh0(i,J,k) enddo ; enddo ; enddo else !$OMP parallel do default(shared) do j=js,je ; do k=1,nz ; do I=is-1,ie - uhbt(I,j) = uhbt(I,j) + US%T_to_s*US%m_to_L**2*uh0(I,j,k) - ubt(I,j) = ubt(I,j) + CS%frhatu(I,j,k) * US%m_s_to_L_T*u_uh0(I,j,k) + uhbt(I,j) = uhbt(I,j) + uh0(I,j,k) + ubt(I,j) = ubt(I,j) + CS%frhatu(I,j,k) * u_uh0(I,j,k) enddo ; enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do k=1,nz ; do i=is,ie - vhbt(i,J) = vhbt(i,J) + US%T_to_s*US%m_to_L**2*vh0(i,J,k) - vbt(i,J) = vbt(i,J) + CS%frhatv(i,J,k) * US%m_s_to_L_T*v_vh0(i,J,k) + vhbt(i,J) = vhbt(i,J) + vh0(i,J,k) + vbt(i,J) = vbt(i,J) + CS%frhatv(i,J,k) * v_vh0(i,J,k) enddo ; enddo ; enddo endif if (use_BT_cont) then @@ -1105,11 +1111,11 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, enddo ; enddo !$OMP parallel do default(shared) do j=js,je ; do k=1,nz ; do I=is-1,ie - ubt(I,j) = ubt(I,j) + wt_u(I,j,k) * US%m_s_to_L_T*U_in(I,j,k) + ubt(I,j) = ubt(I,j) + wt_u(I,j,k) * U_in(I,j,k) enddo ; enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do k=1,nz ; do i=is,ie - vbt(i,J) = vbt(i,J) + wt_v(i,J,k) * US%m_s_to_L_T*V_in(i,J,k) + vbt(i,J) = vbt(i,J) + wt_v(i,J,k) * V_in(i,J,k) enddo ; enddo ; enddo !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie @@ -1352,8 +1358,8 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! Limit the source (outward) correction to be a fraction the mass that ! can be transported out of the cell by velocities with a CFL number of ! CFL_cor. - u_max_cor = US%m_to_L*G%dxT(i,j) * (CS%maxCFL_BT_cont*Idt) - v_max_cor = US%m_to_L*G%dyT(i,j) * (CS%maxCFL_BT_cont*Idt) + u_max_cor = G%dxT(i,j) * (CS%maxCFL_BT_cont*Idt) + v_max_cor = G%dyT(i,j) * (CS%maxCFL_BT_cont*Idt) eta_cor_max = dt_in_T * (CS%IareaT(i,j) * & (((find_uhbt(u_max_cor, BTCL_u(I,j), US) + uhbt0(I,j)) - & (find_uhbt(-u_max_cor, BTCL_u(I-1,j), US) + uhbt0(I-1,j))) + & @@ -1393,17 +1399,17 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! This estimate of the maximum stable time step is pretty accurate for ! gravity waves, but it is a conservative estimate since it ignores the ! stabilizing effect of the bottom drag. - Idt_max2 = 0.5 * (dgeo_de * (1.0 + 2.0*bebt)) * (US%L_to_m**2*G%IareaT(i,j) * & - ((gtot_E(i,j) * (Datu(I,j)*US%L_to_m*G%IdxCu(I,j)) + & - gtot_W(i,j) * (Datu(I-1,j)*US%L_to_m*G%IdxCu(I-1,j))) + & - (gtot_N(i,j) * (Datv(i,J)*US%L_to_m*G%IdyCv(i,J)) + & - gtot_S(i,j) * (Datv(i,J-1)*US%L_to_m*G%IdyCv(i,J-1)))) + & + Idt_max2 = 0.5 * (dgeo_de * (1.0 + 2.0*bebt)) * (G%IareaT(i,j) * & + ((gtot_E(i,j) * (Datu(I,j)*G%IdxCu(I,j)) + & + gtot_W(i,j) * (Datu(I-1,j)*G%IdxCu(I-1,j))) + & + (gtot_N(i,j) * (Datv(i,J)*G%IdyCv(i,J)) + & + gtot_S(i,j) * (Datv(i,J-1)*G%IdyCv(i,J-1)))) + & ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2))) - H_eff_dx2 = max(H_min_dyn * ((US%L_to_m*G%IdxT(i,j))**2 + (US%L_to_m*G%IdyT(i,j))**2), & - US%L_to_m**2*G%IareaT(i,j) * & - ((Datu(I,j)*US%L_to_m*G%IdxCu(I,j) + Datu(I-1,j)*US%L_to_m*G%IdxCu(I-1,j)) + & - (Datv(i,J)*US%L_to_m*G%IdyCv(i,J) + Datv(i,J-1)*US%L_to_m*G%IdyCv(i,J-1)) ) ) + H_eff_dx2 = max(H_min_dyn * ((G%IdxT(i,j))**2 + (G%IdyT(i,j))**2), & + G%IareaT(i,j) * & + ((Datu(I,j)*G%IdxCu(I,j) + Datu(I-1,j)*G%IdxCu(I-1,j)) + & + (Datv(i,J)*G%IdyCv(i,J) + Datv(i,J-1)*G%IdyCv(i,J-1)) ) ) dyn_coef_max = CS%const_dyn_psurf * max(0.0, 1.0 - dtbt**2 * Idt_max2) / & (dtbt**2 * H_eff_dx2) @@ -1468,7 +1474,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, endif call uvchksum("BT wt_[uv]", wt_u, wt_v, G%HI, 0, .true., .true.) call uvchksum("BT frhat[uv]", CS%frhatu, CS%frhatv, G%HI, 0, .true., .true.) - call uvchksum("BT bc_accel_[uv]", bc_accel_u, bc_accel_v, G%HI, haloshift=0) + call uvchksum("BT bc_accel_[uv]", bc_accel_u, bc_accel_v, G%HI, haloshift=0, scale=US%L_T2_to_m_s2) call uvchksum("BT IDat[uv]", CS%IDatu, CS%IDatv, G%HI, haloshift=0, scale=US%m_to_Z) call uvchksum("BT visc_rem_[uv]", visc_rem_u, visc_rem_v, G%HI, haloshift=1) endif @@ -1545,21 +1551,21 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (CS%clip_velocity) then do j=jsv,jev ; do I=isv-1,iev - if ((ubt(I,j) * (dt_in_T * US%m_to_L*G%dy_Cu(I,j))) * US%L_to_m**2*G%IareaT(i+1,j) < -CS%CFL_trunc) then + if ((ubt(I,j) * (dt_in_T * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then ! Add some error reporting later. - ubt(I,j) = (-0.95*CS%CFL_trunc) * (US%m_to_L**2*G%areaT(i+1,j) / (dt_in_T * US%m_to_L*G%dy_Cu(I,j))) - elseif ((ubt(I,j) * (dt_in_T * US%m_to_L*G%dy_Cu(I,j))) * US%L_to_m**2*G%IareaT(i,j) > CS%CFL_trunc) then + ubt(I,j) = (-0.95*CS%CFL_trunc) * (G%areaT(i+1,j) / (dt_in_T * G%dy_Cu(I,j))) + elseif ((ubt(I,j) * (dt_in_T * G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then ! Add some error reporting later. - ubt(I,j) = (0.95*CS%CFL_trunc) * (US%m_to_L**2*G%areaT(i,j) / (dt_in_T * US%m_to_L*G%dy_Cu(I,j))) + ubt(I,j) = (0.95*CS%CFL_trunc) * (G%areaT(i,j) / (dt_in_T * G%dy_Cu(I,j))) endif enddo ; enddo do J=jsv-1,jev ; do i=isv,iev - if ((vbt(i,J) * (dt_in_T * US%m_to_L*G%dx_Cv(i,J))) * US%L_to_m**2*G%IareaT(i,j+1) < -CS%CFL_trunc) then + if ((vbt(i,J) * (dt_in_T * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then ! Add some error reporting later. - vbt(i,J) = (-0.9*CS%CFL_trunc) * (US%m_to_L**2*G%areaT(i,j+1) / (dt_in_T * US%m_to_L*G%dx_Cv(i,J))) - elseif ((vbt(i,J) * (dt_in_T * US%m_to_L*G%dx_Cv(i,J))) * US%L_to_m**2*G%IareaT(i,j) > CS%CFL_trunc) then + vbt(i,J) = (-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (dt_in_T * G%dx_Cv(i,J))) + elseif ((vbt(i,J) * (dt_in_T * G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then ! Add some error reporting later. - vbt(i,J) = (0.9*CS%CFL_trunc) * (US%m_to_L**2*G%areaT(i,j) / (dt_in_T * US%m_to_L*G%dx_Cv(i,J))) + vbt(i,J) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt_in_T * G%dx_Cv(i,J))) endif enddo ; enddo endif @@ -2087,7 +2093,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, do j=js,je ; do I=is-1,ie CS%ubtav(I,j) = ubt_sum(I,j) * I_sum_wt_trans - uhbtav(I,j) = US%s_to_T*US%L_to_m**2*uhbt_sum(I,j) * I_sum_wt_trans + uhbtav(I,j) = uhbt_sum(I,j) * I_sum_wt_trans ! The following line would do approximately nothing, as I_sum_wt_accel ~= 1. !### u_accel_bt(I,j) = u_accel_bt(I,j) * I_sum_wt_accel ubt_wtd(I,j) = ubt_wtd(I,j) * I_sum_wt_vel @@ -2095,7 +2101,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, do J=js-1,je ; do i=is,ie CS%vbtav(i,J) = vbt_sum(i,J) * I_sum_wt_trans - vhbtav(i,J) = US%s_to_T*US%L_to_m**2*vhbt_sum(i,J) * I_sum_wt_trans + vhbtav(i,J) = vhbt_sum(i,J) * I_sum_wt_trans ! The following line would do approximately nothing, as I_sum_wt_accel ~= 1. !### v_accel_bt(i,J) = v_accel_bt(i,J) * I_sum_wt_accel vbt_wtd(i,J) = vbt_wtd(i,J) * I_sum_wt_vel @@ -2117,13 +2123,13 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=is-1,ie - accel_layer_u(I,j,k) = US%L_T2_to_m_s2 * (u_accel_bt(I,j) - & + accel_layer_u(I,j,k) = (u_accel_bt(I,j) - & ((pbce(i+1,j,k) - gtot_W(i+1,j)) * e_anom(i+1,j) - & (pbce(i,j,k) - gtot_E(i,j)) * e_anom(i,j)) * CS%IdxCu(I,j) ) if (abs(accel_layer_u(I,j,k)) < accel_underflow) accel_layer_u(I,j,k) = 0.0 enddo ; enddo do J=js-1,je ; do i=is,ie - accel_layer_v(i,J,k) = US%L_T2_to_m_s2 * (v_accel_bt(i,J) - & + accel_layer_v(i,J,k) = (v_accel_bt(i,J) - & ((pbce(i,j+1,k) - gtot_S(i,j+1)) * e_anom(i,j+1) - & (pbce(i,j,k) - gtot_N(i,j)) * e_anom(i,j)) * CS%IdyCv(i,J) ) if (abs(accel_layer_v(i,J,k)) < accel_underflow) accel_layer_v(i,J,k) = 0.0 @@ -2136,13 +2142,13 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (CS%BT_OBC%apply_u_OBCs) then ; do j=js,je ; do I=is-1,ie if (OBC%segnum_u(I,j) /= OBC_NONE) then u_accel_bt(I,j) = (ubt_wtd(I,j) - ubt_first(I,j)) / dt_in_T - do k=1,nz ; accel_layer_u(I,j,k) = US%L_T2_to_m_s2*u_accel_bt(I,j) ; enddo + do k=1,nz ; accel_layer_u(I,j,k) = u_accel_bt(I,j) ; enddo endif enddo ; enddo ; endif if (CS%BT_OBC%apply_v_OBCs) then ; do J=js-1,je ; do i=is,ie if (OBC%segnum_v(i,J) /= OBC_NONE) then v_accel_bt(i,J) = (vbt_wtd(i,J) - vbt_first(i,J)) / dt_in_T - do k=1,nz ; accel_layer_v(i,J,k) = US%L_T2_to_m_s2*v_accel_bt(i,J) ; enddo + do k=1,nz ; accel_layer_v(i,J,k) = v_accel_bt(i,J) ; enddo endif enddo ; enddo ; endif endif @@ -2351,9 +2357,9 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) do j=js,je ; do i=is,ie ! This is pretty accurate for gravity waves, but it is a conservative ! estimate since it ignores the stabilizing effect of the bottom drag. - Idt_max2 = 0.5 * (1.0 + 2.0*CS%bebt) * (US%L_to_m**2*G%IareaT(i,j) * & - ((gtot_E(i,j)*Datu(I,j)*US%L_to_m*G%IdxCu(I,j) + gtot_W(i,j)*Datu(I-1,j)*US%L_to_m*G%IdxCu(I-1,j)) + & - (gtot_N(i,j)*Datv(i,J)*US%L_to_m*G%IdyCv(i,J) + gtot_S(i,j)*Datv(i,J-1)*US%L_to_m*G%IdyCv(i,J-1))) + & + Idt_max2 = 0.5 * (1.0 + 2.0*CS%bebt) * (G%IareaT(i,j) * & + ((gtot_E(i,j)*Datu(I,j)*G%IdxCu(I,j) + gtot_W(i,j)*Datu(I-1,j)*G%IdxCu(I-1,j)) + & + (gtot_N(i,j)*Datv(i,J)*G%IdyCv(i,J) + gtot_S(i,j)*Datv(i,J-1)*G%IdyCv(i,J-1))) + & ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2))) if (Idt_max2 * min_max_dt2 > 1.0) min_max_dt2 = 1.0 / Idt_max2 @@ -2378,16 +2384,17 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of !! the argument arrays. - real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt !< the zonal barotropic velocity [m s-1]. + real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt !< the zonal barotropic velocity [L T-1 ~> m s-1]. real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: uhbt !< the zonal barotropic transport - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt_trans !< the zonal barotropic velocity used in + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. + real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt_trans !< The zonal barotropic velocity used in !! transport [L T-1 ~> m s-1]. - real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt !< the meridional barotropic velocity [m s-1]. + real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt !< The meridional barotropic velocity + !! [L T-1 ~> m s-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vhbt !< the meridional barotropic transport - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt_trans !< the meridional BT velocity used in - !! transports [m s-1]. + !! transports [L T-1 ~> m s-1]. real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: eta !< The barotropic free surface height anomaly or !! column mass anomaly [H ~> m or kg m-2]. real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: ubt_old !< The starting value of ubt in a barotropic @@ -2450,7 +2457,7 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, vel_trans = ubt(I,j) elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then if (OBC%segment(OBC%segnum_u(I,j))%Flather) then - cfl = dtbt * BT_OBC%Cg_u(I,j) * US%L_to_m*G%IdxCu(I,j) ! CFL + cfl = dtbt * BT_OBC%Cg_u(I,j) * G%IdxCu(I,j) ! CFL u_inlet = cfl*ubt_old(I-1,j) + (1.0-cfl)*ubt_old(I,j) ! Valid for cfl<1 h_in = eta(i,j) + (0.5-cfl)*(eta(i,j)-eta(i-1,j)) ! internal H_u = BT_OBC%H_u(I,j) @@ -2464,7 +2471,7 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, endif elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then if (OBC%segment(OBC%segnum_u(I,j))%Flather) then - cfl = dtbt * BT_OBC%Cg_u(I,j) * US%L_to_m*G%IdxCu(I,j) ! CFL + cfl = dtbt * BT_OBC%Cg_u(I,j) * G%IdxCu(I,j) ! CFL u_inlet = cfl*ubt_old(I+1,j) + (1.0-cfl)*ubt_old(I,j) ! Valid for cfl<1 h_in = eta(i+1,j) + (0.5-cfl)*(eta(i+1,j)-eta(i+2,j)) ! external @@ -2500,7 +2507,7 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, vel_trans = vbt(i,J) elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then if (OBC%segment(OBC%segnum_v(i,J))%Flather) then - cfl = dtbt * BT_OBC%Cg_v(i,J) * US%L_to_m*G%IdyCv(I,j) ! CFL + cfl = dtbt * BT_OBC%Cg_v(i,J) * G%IdyCv(I,j) ! CFL v_inlet = cfl*vbt_old(i,J-1) + (1.0-cfl)*vbt_old(i,J) ! Valid for cfl<1 h_in = eta(i,j) + (0.5-cfl)*(eta(i,j)-eta(i,j-1)) ! internal @@ -2516,7 +2523,7 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, endif elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then if (OBC%segment(OBC%segnum_v(i,J))%Flather) then - cfl = dtbt * BT_OBC%Cg_v(i,J) * US%L_to_m*G%IdyCv(I,j) ! CFL + cfl = dtbt * BT_OBC%Cg_v(i,J) * G%IdyCv(I,j) ! CFL v_inlet = cfl*vbt_old(i,J+1) + (1.0-cfl)*vbt_old(i,J) ! Valid for cfl <1 h_in = eta(i,j+1) + (0.5-cfl)*(eta(i,j+1)-eta(i,j+2)) ! internal @@ -2565,9 +2572,9 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B logical, intent(in) :: use_BT_cont !< If true, use the BT_cont_types to calculate !! transports. real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face areas at u points - !! [L m ~> m2 or kg m-1]. + !! [H L ~> m2 or kg m-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face areas at v points - !! [L m ~> m2 or kg m-1]. + !! [H L ~> m2 or kg m-1]. type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: BTCL_u !< Structure of information used !! for a dynamic estimate of the face areas at !! u-points. @@ -2623,7 +2630,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B BT_OBC%uhbt(I,j) = 0. enddo ; enddo do k=1,nz ; do j=segment%HI%jsd,segment%HI%jed ; do I=segment%HI%IsdB,segment%HI%IedB - BT_OBC%uhbt(I,j) = BT_OBC%uhbt(I,j) + US%T_to_s*US%m_to_L**2*segment%normal_trans(I,j,k) + BT_OBC%uhbt(I,j) = BT_OBC%uhbt(I,j) + segment%normal_trans(I,j,k) enddo ; enddo ; enddo endif enddo @@ -2658,7 +2665,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B segment => OBC%segment(n) if (segment%is_E_or_W .and. segment%Flather) then do j=segment%HI%jsd,segment%HI%jed ; do I=segment%HI%IsdB,segment%HI%IedB - BT_OBC%ubt_outer(I,j) = US%m_s_to_L_T*segment%normal_vel_bt(I,j) + BT_OBC%ubt_outer(I,j) = segment%normal_vel_bt(I,j) BT_OBC%eta_outer_u(I,j) = segment%eta(I,j) enddo ; enddo endif @@ -2675,7 +2682,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B BT_OBC%vhbt(i,J) = 0. enddo ; enddo do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB ; do i=segment%HI%isd,segment%HI%ied - BT_OBC%vhbt(i,J) = BT_OBC%vhbt(i,J) + US%T_to_s*US%m_to_L**2*segment%normal_trans(i,J,k) + BT_OBC%vhbt(i,J) = BT_OBC%vhbt(i,J) + segment%normal_trans(i,J,k) enddo ; enddo ; enddo endif enddo @@ -2710,7 +2717,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B segment => OBC%segment(n) if (segment%is_N_or_S .and. segment%Flather) then do J=segment%HI%JsdB,segment%HI%JedB ; do i=segment%HI%isd,segment%HI%ied - BT_OBC%vbt_outer(i,J) = US%m_s_to_L_T*segment%normal_vel_bt(i,J) + BT_OBC%vbt_outer(i,J) = segment%normal_vel_bt(i,J) BT_OBC%eta_outer_v(i,J) = segment%eta(i,J) enddo ; enddo endif @@ -3056,7 +3063,7 @@ function uhbt_to_ubt(uhbt, BTC, US, guess) result(ubt) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, optional, intent(in) :: guess !< A guess at what ubt will be [L T-1 ~> m s-1]. The result !! is not allowed to be dramatically larger than guess. - real :: ubt !< The result - The velocity that gives uhbt transport [m s-1]. + real :: ubt !< The result - The velocity that gives uhbt transport [L T-1 ~> m s-1]. ! Local variables real :: ubt_min, ubt_max, uhbt_err, derr_du @@ -3392,15 +3399,15 @@ subroutine adjust_local_BT_cont_types(ubt, uhbt, vbt, vhbt, BTCL_u, BTCL_v, & G, US, MS, halo) type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of the argument arrays. real, dimension(SZIBW_(MS),SZJW_(MS)), & - intent(in) :: ubt !< The linearization zonal barotropic velocity [m s-1]. + intent(in) :: ubt !< The linearization zonal barotropic velocity [L T-1 ~> m s-1]. real, dimension(SZIBW_(MS),SZJW_(MS)), & intent(in) :: uhbt !< The linearization zonal barotropic transport - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), & - intent(in) :: vbt !< The linearization meridional barotropic velocity [m s-1]. + intent(in) :: vbt !< The linearization meridional barotropic velocity [L T-1 ~> m s-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), & intent(in) :: vhbt !< The linearization meridional barotropic transport - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), & intent(out) :: BTCL_u !< A structure with the u information from BT_cont. type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), & @@ -3702,9 +3709,9 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), & @@ -4079,17 +4086,17 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, ALLOC_(CS%dy_Cu(CS%isdw-1:CS%iedw,CS%jsdw:CS%jedw)) ; CS%dy_Cu(:,:) = 0.0 ALLOC_(CS%dx_Cv(CS%isdw:CS%iedw,CS%jsdw-1:CS%jedw)) ; CS%dx_Cv(:,:) = 0.0 do j=G%jsd,G%jed ; do i=G%isd,G%ied - CS%IareaT(i,j) = US%L_to_m**2*G%IareaT(i,j) + CS%IareaT(i,j) = G%IareaT(i,j) CS%bathyT(i,j) = G%bathyT(i,j) enddo ; enddo ! Note: G%IdxCu & G%IdyCv may be valid for a smaller extent than CS%IdxCu & CS%IdyCv, even without ! wide halos. do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - CS%IdxCu(I,j) = US%L_to_m*G%IdxCu(I,j) ; CS%dy_Cu(I,j) = US%m_to_L*G%dy_Cu(I,j) + CS%IdxCu(I,j) = G%IdxCu(I,j) ; CS%dy_Cu(I,j) = G%dy_Cu(I,j) enddo ; enddo do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - CS%IdyCv(I,j) = US%L_to_m*G%IdyCv(I,j) ; CS%dx_Cv(i,J) = US%m_to_L*G%dx_Cv(i,J) + CS%IdyCv(I,j) = G%IdyCv(I,j) ; CS%dx_Cv(i,J) = G%dx_Cv(i,J) enddo ; enddo call create_group_pass(pass_static_data, CS%IareaT, CS%BT_domain, To_All) call create_group_pass(pass_static_data, CS%bathyT, CS%BT_domain, To_All) @@ -4291,10 +4298,10 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, call btcalc(h, G, GV, CS, may_use_default=.true.) CS%ubtav(:,:) = 0.0 ; CS%vbtav(:,:) = 0.0 do k=1,nz ; do j=js,je ; do I=is-1,ie - CS%ubtav(I,j) = CS%ubtav(I,j) + CS%frhatu(I,j,k) * US%m_s_to_L_T*u(I,j,k) + CS%ubtav(I,j) = CS%ubtav(I,j) + CS%frhatu(I,j,k) * u(I,j,k) enddo ; enddo ; enddo do k=1,nz ; do J=js-1,je ; do i=is,ie - CS%vbtav(i,J) = CS%vbtav(i,J) + CS%frhatv(i,J,k) * US%m_s_to_L_T*v(i,J,k) + CS%vbtav(i,J) = CS%vbtav(i,J) + CS%frhatv(i,J,k) * v(i,J,k) enddo ; enddo ; enddo elseif ((US%s_to_T_restart*US%m_to_L_restart /= 0.0) .and. & (US%m_to_L*US%s_to_T_restart) /= (US%m_to_L_restart*US%s_to_T)) then @@ -4345,7 +4352,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, ! ### Consider replacing maxvel with G%dxT(i,j) * (CS%maxCFL_BT_cont*Idt) ! ### and G%dyT(i,j) * (CS%maxCFL_BT_cont*Idt) do j=js,je ; do i=is,ie - CS%eta_cor_bound(i,j) = GV%m_to_H * US%L_to_m**2*G%IareaT(i,j) * 0.1 * CS%maxvel * & + CS%eta_cor_bound(i,j) = GV%m_to_H * G%IareaT(i,j) * 0.1 * CS%maxvel * & ((Datu(I-1,j) + Datu(I,j)) + (Datv(i,J) + Datv(i,J-1))) enddo ; enddo endif @@ -4385,19 +4392,19 @@ subroutine barotropic_get_tav(CS, ubtav, vbtav, G, US) type(barotropic_CS), pointer :: CS !< Control structure for this module type(ocean_grid_type), intent(in) :: G !< Grid structure real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: ubtav !< Zonal barotropic velocity averaged - !! over a baroclinic timestep [m s-1] + !! over a baroclinic timestep [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vbtav !< Meridional barotropic velocity averaged - !! over a baroclinic timestep [m s-1] + !! over a baroclinic timestep [L T-1 ~> m s-1] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables integer :: i,j do j=G%jsc,G%jec ; do I=G%isc-1,G%iec - ubtav(I,j) = US%L_T_to_m_s*CS%ubtav(I,j) + ubtav(I,j) = CS%ubtav(I,j) enddo ; enddo do J=G%jsc-1,G%jec ; do i=G%isc,G%iec - vbtav(i,J) = US%L_T_to_m_s*CS%vbtav(i,J) + vbtav(i,J) = CS%vbtav(i,J) enddo ; enddo end subroutine barotropic_get_tav diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index 755cdac2b9..e8347881f7 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -39,69 +39,78 @@ module MOM_checksum_packages ! ============================================================================= !> Write out chksums for the model's basic state variables, including transports. -subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, haloshift, symmetric) +subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, US, haloshift, symmetric, vel_scale) character(len=*), & intent(in) :: mesg !< A message that appears on the chksum lines. 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(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1] or other units. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1] or other units. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: uh !< Volume flux through zonal faces = u*h*dy - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: vh !< Volume flux through meridional faces = v*h*dx - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric - !! computationoal domain. + !! computational domain. + real, optional, intent(in) :: vel_scale !< The scaling factor to convert velocities to [m s-1] - integer :: is, ie, js, je, nz, hs + real :: scale_vel ! The scaling factor to convert velocities to [m s-1] logical :: sym + integer :: is, ie, js, je, nz, hs is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke ! Note that for the chksum calls to be useful for reproducing across PE ! counts, there must be no redundant points, so all variables use is..ie ! and js...je as their extent. - hs=1; if (present(haloshift)) hs=haloshift - sym=.false.; if (present(symmetric)) sym=symmetric - call uvchksum(mesg//" [uv]", u, v, G%HI, haloshift=hs, symmetric=sym) + hs = 1 ; if (present(haloshift)) hs=haloshift + sym = .false. ; if (present(symmetric)) sym=symmetric + scale_vel = US%L_T_to_m_s ; if (present(vel_scale)) scale_vel = vel_scale + + call uvchksum(mesg//" [uv]", u, v, G%HI, haloshift=hs, symmetric=sym, scale=scale_vel) call hchksum(h, mesg//" h", G%HI, haloshift=hs, scale=GV%H_to_m) call uvchksum(mesg//" [uv]h", uh, vh, G%HI, haloshift=hs, & - symmetric=sym, scale=GV%H_to_m) + symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) end subroutine MOM_state_chksum_5arg ! ============================================================================= !> Write out chksums for the model's basic state variables. -subroutine MOM_state_chksum_3arg(mesg, u, v, h, G, GV, haloshift, symmetric) - character(len=*), intent(in) :: mesg !< A message that appears on the chksum lines. - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. +subroutine MOM_state_chksum_3arg(mesg, u, v, h, G, GV, US, haloshift, symmetric) + character(len=*), intent(in) :: mesg !< A message that appears on the chksum lines. + 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(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< Zonal velocity [m s-1]. + intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1] or [m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< Meridional velocity [m s-1]. + intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1] or [m s-1].. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). - logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric - !! computationoal domain. - + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type, which is + !! used to rescale u and v if present. + integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). + logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully + !! symmetric computational domain. + real :: L_T_to_m_s ! A rescaling factor for velocities [m T s-1 L-1 ~> nondim] or [nondim] integer :: is, ie, js, je, nz, hs logical :: sym + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + L_T_to_m_s = 1.0 ; if (present(US)) L_T_to_m_s = US%L_T_to_m_s ! Note that for the chksum calls to be useful for reproducing across PE ! counts, there must be no redundant points, so all variables use is..ie ! and js...je as their extent. hs=1; if (present(haloshift)) hs=haloshift sym=.false.; if (present(symmetric)) sym=symmetric - call uvchksum(mesg//" u", u, v, G%HI,haloshift=hs, symmetric=sym) + call uvchksum(mesg//" u", u, v, G%HI, haloshift=hs, symmetric=sym, scale=L_T_to_m_s) call hchksum(h, mesg//" h",G%HI, haloshift=hs, scale=GV%H_to_m) end subroutine MOM_state_chksum_3arg @@ -137,7 +146,7 @@ subroutine MOM_surface_chksum(mesg, sfc, G, haloshift, symmetric) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric - !! computationoal domain. + !! computational domain. integer :: hs logical :: sym @@ -166,35 +175,35 @@ subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, US, p type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: CAu !< Zonal acceleration due to Coriolis - !! and momentum advection terms [m s-2]. + !! and momentum advection terms [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: CAv !< Meridional acceleration due to Coriolis - !! and momentum advection terms [m s-2]. + !! and momentum advection terms [L T-2 ~> m s-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: PFu !< Zonal acceleration due to pressure gradients - !! (equal to -dM/dx) [m s-2]. + !! (equal to -dM/dx) [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: PFv !< Meridional acceleration due to pressure gradients - !! (equal to -dM/dy) [m s-2]. + !! (equal to -dM/dy) [L T-2 ~> m s-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: diffu !< Zonal acceleration due to convergence of the - !! along-isopycnal stress tensor [m s-1 T-1 ~> m s-2]. + !! along-isopycnal stress tensor [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: diffv !< Meridional acceleration due to convergence of - !! the along-isopycnal stress tensor [m s-1 T-1 ~> m s-2]. + !! the along-isopycnal stress tensor [L T-2 ~> m s-2]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: pbce !< The baroclinic pressure anomaly in each layer !! due to free surface height anomalies - !! [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1]. + !! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: u_accel_bt !< The zonal acceleration from terms in the - !! barotropic solver [m s-2]. + !! barotropic solver [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(in) :: v_accel_bt !< The meridional acceleration from terms in - !! the barotropic solver [m s-2]. + !! the barotropic solver [L T-2 ~> m s-2]. logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric - !! computationoal domain. + !! computational domain. integer :: is, ie, js, je, nz logical :: sym @@ -205,59 +214,69 @@ subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, US, p ! Note that for the chksum calls to be useful for reproducing across PE ! counts, there must be no redundant points, so all variables use is..ie ! and js...je as their extent. - call uvchksum(mesg//" CA[uv]", CAu, CAv, G%HI, haloshift=0, symmetric=sym) - call uvchksum(mesg//" PF[uv]", PFu, PFv, G%HI, haloshift=0, symmetric=sym) - call uvchksum(mesg//" diffu", diffu, diffv, G%HI,haloshift=0, symmetric=sym, scale=US%s_to_T) + call uvchksum(mesg//" CA[uv]", CAu, CAv, G%HI, haloshift=0, symmetric=sym, scale=US%L_T2_to_m_s2) + call uvchksum(mesg//" PF[uv]", PFu, PFv, G%HI, haloshift=0, symmetric=sym, scale=US%L_T2_to_m_s2) + call uvchksum(mesg//" diffu", diffu, diffv, G%HI,haloshift=0, symmetric=sym, scale=US%L_T2_to_m_s2) if (present(pbce)) & call hchksum(pbce, mesg//" pbce",G%HI,haloshift=0, scale=GV%m_to_H*US%L_T_to_m_s**2) if (present(u_accel_bt) .and. present(v_accel_bt)) & - call uvchksum(mesg//" [uv]_accel_bt", u_accel_bt, v_accel_bt, G%HI,haloshift=0, symmetric=sym) + call uvchksum(mesg//" [uv]_accel_bt", u_accel_bt, v_accel_bt, G%HI,haloshift=0, symmetric=sym, & + scale=US%L_T2_to_m_s2) end subroutine MOM_accel_chksum ! ============================================================================= !> Monitor and write out statistics for the model's state variables. -subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, allowChange, permitDiminishing) +subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, GV, US, allowChange, permitDiminishing) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. character(len=*), intent(in) :: mesg !< A message that appears on the chksum lines. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, pointer, dimension(:,:,:), & intent(in) :: Temp !< Temperature [degC]. real, pointer, dimension(:,:,:), & intent(in) :: Salt !< Salinity [ppt]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type logical, optional, intent(in) :: allowChange !< do not flag an error !! if the statistics change. - logical, optional, intent(in) :: permitDiminishing !< do not flag error - !!if the extrema are diminishing. + logical, optional, intent(in) :: permitDiminishing !< do not flag error if the + !! extrema are diminishing. + ! Local variables - integer :: is, ie, js, je, nz, i, j, k - real :: Vol, dV, Area, h_minimum + real :: Vol, dV ! The total ocean volume and its change [m3] (unscaled to permit reproducing sum). + real :: Area ! The total ocean surface area [m2] (unscaled to permit reproducing sum). + real :: h_minimum ! The minimum layer thicknesses [H ~> m or kg m-2] + logical :: do_TS ! If true, evaluate statistics for temperature and salinity type(stats) :: T, S, delT, delS - type(stats), save :: oldT, oldS ! NOTE: save data is not normally allowed but - logical, save :: firstCall = .true. ! we use it for debugging purposes here on the - logical :: do_TS - real, save :: oldVol ! assumption we will not turn this on with threads + + ! NOTE: save data is not normally allowed but we use it for debugging purposes here on the + ! assumption we will not turn this on with threads + type(stats), save :: oldT, oldS + logical, save :: firstCall = .true. + real, save :: oldVol ! The previous total ocean volume [m3] + character(len=80) :: lMsg - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + integer :: is, ie, js, je, nz, i, j, k + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke do_TS = associated(Temp) .and. associated(Salt) ! First collect local stats Area = 0. ; Vol = 0. do j = js, je ; do i = is, ie - Area = Area + G%areaT(i,j) + Area = Area + US%L_to_m**2*G%areaT(i,j) enddo ; enddo T%minimum = 1.E34 ; T%maximum = -1.E34 ; T%average = 0. S%minimum = 1.E34 ; S%maximum = -1.E34 ; S%average = 0. - h_minimum = 1.E34 + h_minimum = 1.E34*GV%m_to_H do k = 1, nz ; do j = js, je ; do i = is, ie if (G%mask2dT(i,j)>0.) then - dV = G%areaT(i,j)*h(i,j,k) ; Vol = Vol + dV + dV = US%L_to_m**2*G%areaT(i,j)*GV%H_to_m*h(i,j,k) ; Vol = Vol + dV if (do_TS .and. h(i,j,k)>0.) then T%minimum = min( T%minimum, Temp(i,j,k) ) ; T%maximum = max( T%maximum, Temp(i,j,k) ) T%average = T%average + dV*Temp(i,j,k) @@ -280,7 +299,7 @@ subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, allowChange, permitDimi delT%average = T%average - oldT%average delS%minimum = S%minimum - oldS%minimum ; delS%maximum = S%maximum - oldS%maximum delS%average = S%average - oldS%average - write(lMsg(1:80),'(2(a,es12.4))') 'Mean thickness =',Vol/Area,' frac. delta=',dV/Vol + write(lMsg(1:80),'(2(a,es12.4))') 'Mean thickness =', Vol/Area,' frac. delta=',dV/Vol call MOM_mesg(lMsg//trim(mesg)) if (do_TS) then write(lMsg(1:80),'(a,3es12.4)') 'Temp min/mean/max =',T%minimum,T%average,T%maximum @@ -293,12 +312,12 @@ subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, allowChange, permitDimi call MOM_mesg(lMsg//trim(mesg)) endif else - write(lMsg(1:80),'(a,es12.4)') 'Mean thickness =',Vol/Area + write(lMsg(1:80),'(a,es12.4)') 'Mean thickness =', Vol/Area call MOM_mesg(lMsg//trim(mesg)) if (do_TS) then - write(lMsg(1:80),'(a,3es12.4)') 'Temp min/mean/max =',T%minimum,T%average,T%maximum + write(lMsg(1:80),'(a,3es12.4)') 'Temp min/mean/max =', T%minimum, T%average, T%maximum call MOM_mesg(lMsg//trim(mesg)) - write(lMsg(1:80),'(a,3es12.4)') 'Salt min/mean/max =',S%minimum,S%average,S%maximum + write(lMsg(1:80),'(a,3es12.4)') 'Salt min/mean/max =', S%minimum, S%average, S%maximum call MOM_mesg(lMsg//trim(mesg)) endif endif @@ -310,10 +329,10 @@ subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, allowChange, permitDimi if (do_TS .and. T%minimum<-5.0) then do j = js, je ; do i = is, ie if (minval(Temp(i,j,:)) == T%minimum) then - write(0,'(a,2f12.5)') 'x,y=',G%geoLonT(i,j),G%geoLatT(i,j) + write(0,'(a,2f12.5)') 'x,y=', G%geoLonT(i,j), G%geoLatT(i,j) write(0,'(a3,3a12)') 'k','h','Temp','Salt' do k = 1, nz - write(0,'(i3,3es12.4)') k,h(i,j,k),Temp(i,j,k),Salt(i,j,k) + write(0,'(i3,3es12.4)') k, h(i,j,k), Temp(i,j,k), Salt(i,j,k) enddo stop 'Extremum detected' endif @@ -326,7 +345,7 @@ subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, allowChange, permitDimi write(0,'(a,2f12.5)') 'x,y=',G%geoLonT(i,j),G%geoLatT(i,j) write(0,'(a3,3a12)') 'k','h','Temp','Salt' do k = 1, nz - write(0,'(i3,3es12.4)') k,h(i,j,k),Temp(i,j,k),Salt(i,j,k) + write(0,'(i3,3es12.4)') k, h(i,j,k), Temp(i,j,k), Salt(i,j,k) enddo stop 'Negative thickness detected' endif diff --git a/src/core/MOM_continuity.F90 b/src/core/MOM_continuity.F90 index 5bca916ab5..9aaa6f92fc 100644 --- a/src/core/MOM_continuity.F90 +++ b/src/core/MOM_continuity.F90 @@ -40,33 +40,32 @@ module MOM_continuity !> Time steps the layer thicknesses, using a monotonically limited, directionally split PPM scheme, !! based on Lin (1994). subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, & - visc_rem_u, visc_rem_v, u_cor, v_cor, & - uhbt_aux, vhbt_aux, u_cor_aux, v_cor_aux, BT_cont) + visc_rem_u, visc_rem_v, u_cor, v_cor, BT_cont) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< Zonal velocity [m s-1]. + intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< Meridional velocity [m s-1]. + intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: hin !< Initial layer thickness [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< Final layer thickness [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: uh !< Volume flux through zonal faces = - !! u*h*dy [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! u*h*dy [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(out) :: vh !< Volume flux through meridional faces = - !! v*h*dx [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, intent(in) :: dt !< Time increment [s]. + !! v*h*dx [H L2 T-1 ~> m3 s-1 or kg s-1]. + real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_CS), pointer :: CS !< Control structure for mom_continuity. real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(in) :: uhbt !< The vertically summed volume - !! flux through zonal faces [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! flux through zonal faces [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G)), & optional, intent(in) :: vhbt !< The vertically summed volume - !! flux through meridional faces [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! flux through meridional faces [H L2 T-1 ~> m3 s-1 or kg s-1]. type(ocean_OBC_type), & optional, pointer :: OBC !< Open boundaries control structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -81,22 +80,10 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: u_cor !< The zonal velocities that - !! give uhbt as the depth-integrated transport [m s-1]. + !! give uhbt as the depth-integrated transport [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(out) :: v_cor !< The meridional velocities that - !! give vhbt as the depth-integrated transport [m s-1]. - real, dimension(SZIB_(G),SZJ_(G)), & - optional, intent(in) :: uhbt_aux !< A second summed zonal - !! volume flux [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZI_(G),SZJB_(G)), & - optional, intent(in) :: vhbt_aux !< A second summed meridional - !! volume flux [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - optional, intent(inout) :: u_cor_aux !< The zonal velocities - !! that give uhbt_aux as the depth-integrated transport [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - optional, intent(inout) :: v_cor_aux !< The meridional velocities - !! that give vhbt_aux as the depth-integrated transport [m s-1]. + !! give vhbt as the depth-integrated transport [L T-1 ~> m s-1]. type(BT_cont_type), & optional, pointer :: BT_cont !< A structure with elements !! that describe the effective open face areas as a function of barotropic flow. @@ -107,21 +94,10 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, if (present(u_cor) .neqv. present(v_cor)) call MOM_error(FATAL, & "MOM_continuity: Either both u_cor and v_cor or neither"// & " one must be present in call to continuity.") - if (present(uhbt_aux) .neqv. present(vhbt_aux)) call MOM_error(FATAL, & - "MOM_continuity: Either both uhbt_aux and uhbt_aux or neither"// & - " one must be present in call to continuity.") - if (present(u_cor_aux) .neqv. present(v_cor_aux)) call MOM_error(FATAL, & - "MOM_continuity: Either both u_cor_aux and v_cor_aux or neither"// & - " one must be present in call to continuity.") - if (present(u_cor_aux) .neqv. present(uhbt_aux)) call MOM_error(FATAL, & - "MOM_continuity: u_cor_aux can only be calculated if uhbt_aux is"// & - " provided, and uhbt_aux has no other purpose. Include both arguments"//& - " or neither.") if (CS%continuity_scheme == PPM_SCHEME) then call continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS%PPM_CSp, uhbt, vhbt, OBC, & - visc_rem_u, visc_rem_v, u_cor, v_cor, & - uhbt_aux, vhbt_aux, u_cor_aux, v_cor_aux, BT_cont) + visc_rem_u, visc_rem_v, u_cor, v_cor, BT_cont=BT_cont) else call MOM_error(FATAL, "continuity: Unrecognized value of continuity_scheme") endif @@ -129,10 +105,11 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, end subroutine continuity !> Initializes continuity_cs -subroutine continuity_init(Time, G, GV, param_file, diag, CS) +subroutine continuity_init(Time, G, GV, US, param_file, diag, CS) type(time_type), target, intent(in) :: Time !< Current model time. type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handles. type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. type(continuity_CS), pointer :: CS !< Control structure for mom_continuity. @@ -168,7 +145,7 @@ subroutine continuity_init(Time, G, GV, param_file, diag, CS) end select if (CS%continuity_scheme == PPM_SCHEME) then - call continuity_PPM_init(Time, G, GV, param_file, diag, CS%PPM_CSp) + call continuity_PPM_init(Time, G, GV, US, param_file, diag, CS%PPM_CSp) endif end subroutine continuity_init diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index a55166e7ff..8a8ecf9da5 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -39,7 +39,7 @@ module MOM_continuity_PPM !! the sum of the layer thicknesses [H ~> m or kg m-2]. real :: tol_vel !< The tolerance for barotropic velocity !! discrepancies between the barotropic solution and - !! the sum of the layer thicknesses [m s-1]. + !! the sum of the layer thicknesses [L T-1 ~> m s-1]. real :: tol_eta_aux !< The tolerance for free-surface height !! discrepancies between the barotropic solution and !! the sum of the layer thicknesses when calculating @@ -73,32 +73,31 @@ module MOM_continuity_PPM !> Time steps the layer thicknesses, using a monotonically limit, directionally split PPM scheme, !! based on Lin (1994). -subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, & - visc_rem_u, visc_rem_v, u_cor, v_cor, & - uhbt_aux, vhbt_aux, u_cor_aux, v_cor_aux, BT_cont) +subroutine continuity_PPM(u, v, hin, h, uh, vh, dt_in_T, G, GV, US, CS, uhbt, vhbt, OBC, & + visc_rem_u, visc_rem_v, u_cor, v_cor, BT_cont) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(continuity_PPM_CS), pointer :: CS !< Module's control structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< Zonal velocity [m s-1]. + intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< Meridional velocity [m s-1]. + intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: hin !< Initial layer thickness [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< Final layer thickness [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: uh !< Zonal volume flux, u*h*dy [H m2 s-1 ~> m3 s-1 or kg s-1]. + intent(out) :: uh !< Zonal volume flux, u*h*dy [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: vh !< Meridional volume flux, v*h*dx [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, intent(in) :: dt !< Time increment [s]. + intent(out) :: vh !< Meridional volume flux, v*h*dx [H L2 T-1 ~> m3 s-1 or kg s-1]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(in) :: uhbt !< The summed volume flux through zonal faces - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G)), & optional, intent(in) :: vhbt !< The summed volume flux through meridional faces - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. type(ocean_OBC_type), & optional, pointer :: OBC !< Open boundaries control structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -117,26 +116,11 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: u_cor - !< The zonal velocities that give uhbt as the depth-integrated transport [m s-1]. + !< The zonal velocities that give uhbt as the depth-integrated transport [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(out) :: v_cor - !< The meridional velocities that give vhbt as the depth-integrated transport [m s-1]. - real, dimension(SZIB_(G),SZJ_(G)), & - optional, intent(in) :: uhbt_aux - !< A second set of summed volume fluxes through zonal faces - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZI_(G),SZJB_(G)), & - optional, intent(in) :: vhbt_aux - !< A second set of summed volume fluxes through meridional faces - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - optional, intent(out) :: u_cor_aux - !< The zonal velocities that give uhbt_aux as the depth-integrated - !! transports [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - optional, intent(out) :: v_cor_aux - !< The meridional velocities that give vhbt_aux as the depth-integrated - !! transports [m s-1]. + !< The meridional velocities that give vhbt as the depth-integrated + !! transport [L T-1 ~> m s-1]. type(BT_cont_type), optional, pointer :: BT_cont !< A structure with elements that describe !! the effective open face areas as a function of barotropic flow. @@ -165,13 +149,12 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O ! First, advect zonally. LB%ish = G%isc ; LB%ieh = G%iec LB%jsh = G%jsc-stencil ; LB%jeh = G%jec+stencil - call zonal_mass_flux(u, hin, uh, dt, G, GV, US, CS, LB, uhbt, OBC, visc_rem_u, & - u_cor, uhbt_aux, u_cor_aux, BT_cont) + call zonal_mass_flux(u, hin, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, visc_rem_u, u_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = hin(i,j,k) - dt* G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) + h(i,j,k) = hin(i,j,k) - dt_in_T * G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) ! Uncomment this line to prevent underflow. ! if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo @@ -181,13 +164,12 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O ! Now advect meridionally, using the updated thicknesses to determine ! the fluxes. - call meridional_mass_flux(v, h, vh, dt, G, GV, US, CS, LB, vhbt, OBC, visc_rem_v, & - v_cor, vhbt_aux, v_cor_aux, BT_cont) + call meridional_mass_flux(v, h, vh, dt_in_T, G, GV, US, CS, LB, vhbt, OBC, visc_rem_v, v_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = h(i,j,k) - dt*G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) + h(i,j,k) = h(i,j,k) - dt_in_T * G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) ! This line prevents underflow. if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo @@ -198,26 +180,24 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O LB%ish = G%isc-stencil ; LB%ieh = G%iec+stencil LB%jsh = G%jsc ; LB%jeh = G%jec - call meridional_mass_flux(v, hin, vh, dt, G, GV, US, CS, LB, vhbt, OBC, visc_rem_v, & - v_cor, vhbt_aux, v_cor_aux, BT_cont) + call meridional_mass_flux(v, hin, vh, dt_in_T, G, GV, US, CS, LB, vhbt, OBC, visc_rem_v, v_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = hin(i,j,k) - dt*G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) + h(i,j,k) = hin(i,j,k) - dt_in_T * G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) enddo ; enddo ; enddo call cpu_clock_end(id_clock_update) ! Now advect zonally, using the updated thicknesses to determine ! the fluxes. LB%ish = G%isc ; LB%ieh = G%iec ; LB%jsh = G%jsc ; LB%jeh = G%jec - call zonal_mass_flux(u, h, uh, dt, G, GV, US, CS, LB, uhbt, OBC, visc_rem_u, & - u_cor, uhbt_aux, u_cor_aux, BT_cont) + call zonal_mass_flux(u, h, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, visc_rem_u, u_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = h(i,j,k) - dt* G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) + h(i,j,k) = h(i,j,k) - dt_in_T * G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) ! This line prevents underflow. if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo @@ -228,18 +208,18 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O end subroutine continuity_PPM !> Calculates the mass or volume fluxes through the zonal faces, and other related quantities. -subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & - visc_rem_u, u_cor, uhbt_aux, u_cor_aux, BT_cont) +subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & + visc_rem_u, u_cor, BT_cont) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< Zonal velocity [m s-1]. + intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h_in !< Layer thickness used to calculate fluxes [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: uh !< Volume flux through zonal faces = u*h*dy - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, intent(in) :: dt !< Time increment [s]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_PPM_CS), pointer :: CS !< This module's control structure. type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. @@ -253,48 +233,40 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(in) :: uhbt !< The summed volume flux through zonal faces - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZIB_(G),SZJ_(G)), & - optional, intent(in) :: uhbt_aux - !< A second set of summed volume fluxes through zonal faces [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: u_cor !< The zonal velocitiess (u with a barotropic correction) !! that give uhbt as the depth-integrated transport, m s-1. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - optional, intent(out) :: u_cor_aux - !< The zonal velocities (u with a barotropic correction) - !! that give uhbt_aux as the depth-integrated transports [m s-1]. type(BT_cont_type), optional, pointer :: BT_cont !< A structure with elements that describe the !! effective open face areas as a function of barotropic flow. ! Local variables - real, dimension(SZIB_(G),SZK_(G)) :: duhdu ! Partial derivative of uh with u [H m ~> m2 or kg m-1]. + real, dimension(SZIB_(G),SZK_(G)) :: duhdu ! Partial derivative of uh with u [H L ~> m2 or kg m-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_L, h_R ! Left and right face thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G)) :: & - du, & ! Corrective barotropic change in the velocity [m s-1]. + du, & ! Corrective barotropic change in the velocity [L T-1 ~> m s-1]. du_min_CFL, & ! Min/max limits on du correction du_max_CFL, & ! to avoid CFL violations - duhdu_tot_0, & ! Summed partial derivative of uh with u [H m ~> m2 or kg m-1]. - uh_tot_0, & ! Summed transport with no barotropic correction [H m2 s-1 ~> m3 s-1 or kg s-1]. + duhdu_tot_0, & ! Summed partial derivative of uh with u [H L ~> m2 or kg m-1]. + uh_tot_0, & ! Summed transport with no barotropic correction [H L2 T-1 ~> m3 s-1 or kg s-1]. visc_rem_max ! The column maximum of visc_rem. logical, dimension(SZIB_(G)) :: do_I real, dimension(SZIB_(G),SZK_(G)) :: & visc_rem ! A 2-D copy of visc_rem_u or an array of 1's. - real, dimension(SZIB_(G)) :: FAuI ! A list of sums of zonal face areas [H m ~> m2 or kg m-1]. + real, dimension(SZIB_(G)) :: FAuI ! A list of sums of zonal face areas [H L ~> m2 or kg m-1]. real :: FA_u ! A sum of zonal face areas [H m ~> m2 or kg m-1]. real :: I_vrm ! 1.0 / visc_rem_max, nondim. real :: CFL_dt ! The maximum CFL ratio of the adjusted velocities divided by - ! the time step [s-1]. - real :: I_dt ! 1.0 / dt [s-1]. - real :: du_lim ! The velocity change that give a relative CFL of 1 [m s-1]. - real :: dx_E, dx_W ! Effective x-grid spacings to the east and west [m]. + ! the time step [T-1 ~> s-1]. + real :: I_dt ! 1.0 / dt [T-1 ~> s-1]. + real :: du_lim ! The velocity change that give a relative CFL of 1 [L T-1 ~> m s-1]. + real :: dx_E, dx_W ! Effective x-grid spacings to the east and west [L ~> m]. integer :: i, j, k, ish, ieh, jsh, jeh, n, nz - logical :: do_aux, local_specified_BC, use_visc_rem, set_BT_cont, any_simple_OBC + logical :: local_specified_BC, use_visc_rem, set_BT_cont, any_simple_OBC logical :: local_Flather_OBC, local_open_BC, is_simple type(OBC_segment_type), pointer :: segment => NULL() - do_aux = (present(uhbt_aux) .and. present(u_cor_aux)) use_visc_rem = present(visc_rem_u) local_specified_BC = .false. ; set_BT_cont = .false. ; local_Flather_OBC = .false. local_open_BC = .false. @@ -306,8 +278,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & endif ; endif ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh ; nz = G%ke - CFL_dt = CS%CFL_limit_adjust / dt - I_dt = 1.0 / dt + CFL_dt = CS%CFL_limit_adjust / (dt_in_T) + I_dt = 1.0 / (dt_in_T) if (CS%aggress_adjust) CFL_dt = I_dt call cpu_clock_begin(id_clock_update) @@ -328,8 +300,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & call cpu_clock_begin(id_clock_correct) !$OMP parallel do default(none) shared(ish,ieh,jsh,jeh,nz,u,h_in,h_L,h_R,use_visc_rem,visc_rem_u, & -!$OMP uh,dt,G,GV,CS,local_specified_BC,OBC,uhbt,do_aux,set_BT_cont, & -!$OMP CFL_dt,I_dt,u_cor,uhbt_aux,u_cor_aux,BT_cont, local_Flather_OBC) & +!$OMP uh,dt,G,GV,CS,local_specified_BC,OBC,uhbt,set_BT_cont, & +!$OMP CFL_dt,I_dt,u_cor,BT_cont, local_Flather_OBC) & !$OMP private(do_I,duhdu,du,du_max_CFL,du_min_CFL,uh_tot_0,duhdu_tot_0, & !$OMP is_simple,FAuI,visc_rem_max,I_vrm,du_lim,dx_E,dx_W,any_simple_OBC ) & !$OMP firstprivate(visc_rem) @@ -343,7 +315,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & enddo ; endif call zonal_flux_layer(u(:,j,k), h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), & uh(:,j,k), duhdu(:,k), visc_rem(:,k), & - dt, G, j, ish, ieh, do_I, CS%vol_CFL, OBC) + dt_in_T, G, US, j, ish, ieh, do_I, CS%vol_CFL, OBC) if (local_specified_BC) then do I=ish-1,ieh if (OBC%segment(OBC%segnum_u(I,j))%specified) & @@ -356,7 +328,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & visc_rem_max(I) = 1.0 enddo ; endif - if (present(uhbt) .or. do_aux .or. set_BT_cont) then + if (present(uhbt) .or. set_BT_cont) then ! Set limits on du that will keep the CFL number between -1 and 1. ! This should be adequate to keep the root bracketed in all cases. do I=ish-1,ieh @@ -433,10 +405,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & du_min_CFL(I) = min(du_min_CFL(I),0.0) enddo - ! Up to this point, everything is shared between uhbt and uhbt_aux. - any_simple_OBC = .false. - if (present(uhbt) .or. do_aux .or. set_BT_cont) then + if (present(uhbt) .or. set_BT_cont) then if (local_specified_BC .or. local_Flather_OBC) then ; do I=ish-1,ieh ! Avoid reconciling barotropic/baroclinic transports if transport is specified is_simple = OBC%segment(OBC%segnum_u(I,j))%specified @@ -448,9 +418,9 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & endif if (present(uhbt)) then - call zonal_flux_adjust(u, h_in, h_L, h_R, uhbt(:,j), uh_tot_0, & - duhdu_tot_0, du, du_max_CFL, du_min_CFL, dt, G, & - CS, visc_rem, j, ish, ieh, do_I, .true., uh, OBC=OBC) + call zonal_flux_adjust(u, h_in, h_L, h_R, uhbt(:,j), uh_tot_0, duhdu_tot_0, du, & + du_max_CFL, du_min_CFL, dt_in_T, G, US, CS, visc_rem, & + j, ish, ieh, do_I, .true., uh, OBC=OBC) if (present(u_cor)) then ; do k=1,nz do I=ish-1,ieh ; u_cor(I,j,k) = u(I,j,k) + du(I) * visc_rem(I,k) ; enddo @@ -462,23 +432,9 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & endif - if (do_aux) then - call zonal_flux_adjust(u, h_in, h_L, h_R, uhbt_aux(:,j), uh_tot_0, & - duhdu_tot_0, du, du_max_CFL, du_min_CFL, dt, G, & - CS, visc_rem, j, ish, ieh, do_I, .false., OBC=OBC) - - do k=1,nz - do I=ish-1,ieh ; u_cor_aux(I,j,k) = u(I,j,k) + du(I) * visc_rem(I,k) ; enddo - if (local_specified_BC) then ; do I=ish-1,ieh - if (OBC%segment(OBC%segnum_u(I,j))%specified) & - u_cor_aux(I,j,k) = OBC%segment(OBC%segnum_u(I,j))%normal_vel(I,j,k) - enddo ; endif - enddo - endif ! do_aux - if (set_BT_cont) then call set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0,& - du_max_CFL, du_min_CFL, dt, G, US, CS, visc_rem, & + du_max_CFL, du_min_CFL, dt_in_T, G, US, CS, visc_rem, & visc_rem_max, j, ish, ieh, do_I) if (any_simple_OBC) then do I=ish-1,ieh @@ -492,15 +448,17 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & OBC%segment(OBC%segnum_u(I,j))%normal_vel(I,j,k) endif ; enddo ; enddo do I=ish-1,ieh ; if (do_I(I)) then - BT_cont%FA_u_W0(I,j) = US%m_to_L*FAuI(I) ; BT_cont%FA_u_E0(I,j) = US%m_to_L*FAuI(I) - BT_cont%FA_u_WW(I,j) = US%m_to_L*FAuI(I) ; BT_cont%FA_u_EE(I,j) = US%m_to_L*FAuI(I) + BT_cont%FA_u_W0(I,j) = FAuI(I) ; BT_cont%FA_u_E0(I,j) = FAuI(I) + BT_cont%FA_u_WW(I,j) = FAuI(I) ; BT_cont%FA_u_EE(I,j) = FAuI(I) BT_cont%uBT_WW(I,j) = 0.0 ; BT_cont%uBT_EE(I,j) = 0.0 endif ; enddo endif endif ! set_BT_cont - endif ! present(uhbt) or do_aux or set_BT_cont + endif ! present(uhbt) or set_BT_cont + enddo ! j-loop + if (local_open_BC .and. set_BT_cont) then do n = 1, OBC%number_of_segments if (OBC%segment(n)%open .and. OBC%segment(n)%is_E_or_W) then @@ -508,7 +466,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & if (OBC%segment(n)%direction == OBC_DIRECTION_E) then do J = OBC%segment(n)%HI%Jsd, OBC%segment(n)%HI%Jed FA_u = 0.0 - do k=1,nz ; FA_u = FA_u + h_in(i,j,k)*US%m_to_L*G%dy_Cu(I,j) ; enddo + do k=1,nz ; FA_u = FA_u + h_in(i,j,k)*G%dy_Cu(I,j) ; enddo BT_cont%FA_u_W0(I,j) = FA_u ; BT_cont%FA_u_E0(I,j) = FA_u BT_cont%FA_u_WW(I,j) = FA_u ; BT_cont%FA_u_EE(I,j) = FA_u BT_cont%uBT_WW(I,j) = 0.0 ; BT_cont%uBT_EE(I,j) = 0.0 @@ -516,7 +474,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & else do J = OBC%segment(n)%HI%Jsd, OBC%segment(n)%HI%Jed FA_u = 0.0 - do k=1,nz ; FA_u = FA_u + h_in(i+1,j,k)*US%m_to_L*G%dy_Cu(I,j) ; enddo + do k=1,nz ; FA_u = FA_u + h_in(i+1,j,k)*G%dy_Cu(I,j) ; enddo BT_cont%FA_u_W0(I,j) = FA_u ; BT_cont%FA_u_E0(I,j) = FA_u BT_cont%FA_u_WW(I,j) = FA_u ; BT_cont%FA_u_EE(I,j) = FA_u BT_cont%uBT_WW(I,j) = 0.0 ; BT_cont%uBT_EE(I,j) = 0.0 @@ -529,10 +487,10 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & if (set_BT_cont) then ; if (allocated(BT_cont%h_u)) then if (present(u_cor)) then - call zonal_face_thickness(u_cor, h_in, h_L, h_R, BT_cont%h_u, dt, G, LB, & + call zonal_face_thickness(u_cor, h_in, h_L, h_R, BT_cont%h_u, dt_in_T, G, US, LB, & CS%vol_CFL, CS%marginal_faces, visc_rem_u, OBC) else - call zonal_face_thickness(u, h_in, h_L, h_R, BT_cont%h_u, dt, G, LB, & + call zonal_face_thickness(u, h_in, h_L, h_R, BT_cont%h_u, dt_in_T, G, US, LB, & CS%vol_CFL, CS%marginal_faces, visc_rem_u, OBC) endif endif ; endif @@ -540,10 +498,10 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & end subroutine zonal_mass_flux !> Evaluates the zonal mass or volume fluxes in a layer. -subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, j, & +subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt_in_T, G, US, j, & ish, ieh, do_I, vol_CFL, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. - real, dimension(SZIB_(G)), intent(in) :: u !< Zonal velocity [m s-1]. + real, dimension(SZIB_(G)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. real, dimension(SZIB_(G)), intent(in) :: visc_rem !< Both the fraction of the !! momentum originally in a layer that remains after a time-step !! of viscosity, and the fraction of a time-step's worth of a barotropic @@ -553,10 +511,11 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, j, & real, dimension(SZI_(G)), intent(in) :: h_L !< Left thickness [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(in) :: h_R !< Right thickness [H ~> m or kg m-2]. real, dimension(SZIB_(G)), intent(inout) :: uh !< Zonal mass or volume - !! transport [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! transport [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)), intent(inout) :: duhdu !< Partial derivative of uh - !! with u [H m ~> m2 or kg m-1]. - real, intent(in) :: dt !< Time increment [s]. + !! with u [H L ~> m2 or kg m-1]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. integer, intent(in) :: ieh !< End of index range. @@ -580,15 +539,15 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, j, & do I=ish-1,ieh ; if (do_I(I)) then ! Set new values of uh and duhdu. if (u(I) > 0.0) then - if (vol_CFL) then ; CFL = (u(I) * dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) - else ; CFL = u(I) * dt * G%IdxT(i,j) ; endif + if (vol_CFL) then ; CFL = (u(I) * dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i,j)) + else ; CFL = u(I) * dt_in_T * G%IdxT(i,j) ; endif curv_3 = h_L(i) + h_R(i) - 2.0*h(i) uh(I) = G%dy_Cu(I,j) * u(I) * & (h_R(i) + CFL * (0.5*(h_L(i) - h_R(i)) + curv_3*(CFL - 1.5))) h_marg = h_R(i) + CFL * ((h_L(i) - h_R(i)) + 3.0*curv_3*(CFL - 1.0)) elseif (u(I) < 0.0) then - if (vol_CFL) then ; CFL = (-u(I) * dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) - else ; CFL = -u(I) * dt * G%IdxT(i+1,j) ; endif + if (vol_CFL) then ; CFL = (-u(I) * dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) + else ; CFL = -u(I) * dt_in_T * G%IdxT(i+1,j) ; endif curv_3 = h_L(i+1) + h_R(i+1) - 2.0*h(i+1) uh(I) = G%dy_Cu(I,j) * u(I) * & (h_L(i+1) + CFL * (0.5*(h_R(i+1)-h_L(i+1)) + curv_3*(CFL - 1.5))) @@ -616,10 +575,10 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, j, & end subroutine zonal_flux_layer !> Sets the effective interface thickness at each zonal velocity point. -subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, LB, vol_CFL, & +subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt_in_T, G, US, LB, vol_CFL, & marginal, visc_rem_u, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [m s-1]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness used to !! calculate fluxes [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the @@ -627,7 +586,8 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, LB, vol_CFL, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_R !< Right thickness in the !! reconstruction [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: h_u !< Thickness at zonal faces [H ~> m or kg m-2]. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. logical, intent(in) :: vol_CFL !< If true, rescale the ratio !! of face areas to the cell areas when estimating the CFL number. @@ -654,14 +614,14 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, LB, vol_CFL, & !$OMP parallel do default(shared) private(CFL,curv_3,h_marg,h_avg) do k=1,nz ; do j=jsh,jeh ; do I=ish-1,ieh if (u(I,j,k) > 0.0) then - if (vol_CFL) then ; CFL = (u(I,j,k) * dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) - else ; CFL = u(I,j,k) * dt * G%IdxT(i,j) ; endif + if (vol_CFL) then ; CFL = (u(I,j,k) * dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i,j)) + else ; CFL = u(I,j,k) * dt_in_T * G%IdxT(i,j) ; endif curv_3 = h_L(i,j,k) + h_R(i,j,k) - 2.0*h(i,j,k) h_avg = h_R(i,j,k) + CFL * (0.5*(h_L(i,j,k) - h_R(i,j,k)) + curv_3*(CFL - 1.5)) h_marg = h_R(i,j,k) + CFL * ((h_L(i,j,k) - h_R(i,j,k)) + 3.0*curv_3*(CFL - 1.0)) elseif (u(I,j,k) < 0.0) then - if (vol_CFL) then ; CFL = (-u(I,j,k)*dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) - else ; CFL = -u(I,j,k) * dt * G%IdxT(i+1,j) ; endif + if (vol_CFL) then ; CFL = (-u(I,j,k)*dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) + else ; CFL = -u(I,j,k) * dt_in_T * G%IdxT(i+1,j) ; endif curv_3 = h_L(i+1,j,k) + h_R(i+1,j,k) - 2.0*h(i+1,j,k) h_avg = h_L(i+1,j,k) + CFL * (0.5*(h_R(i+1,j,k)-h_L(i+1,j,k)) + curv_3*(CFL - 1.5)) h_marg = h_L(i+1,j,k) + CFL * ((h_R(i+1,j,k)-h_L(i+1,j,k)) + & @@ -723,10 +683,10 @@ end subroutine zonal_face_thickness !> Returns the barotropic velocity adjustment that gives the !! desired barotropic (layer-summed) transport. subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & - du, du_max_CFL, du_min_CFL, dt, G, CS, visc_rem, & + du, du_max_CFL, du_min_CFL, dt_in_T, G, US, CS, visc_rem, & j, ish, ieh, do_I_in, full_precision, uh_3d, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [m s-1]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to !! calculate fluxes [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the @@ -739,19 +699,20 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & !! experiences after viscosity is applied. !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZIB_(G)), optional, intent(in) :: uhbt !< The summed volume flux - !! through zonal faces [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! through zonal faces [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)), intent(in) :: du_max_CFL !< Maximum acceptable - !! value of du [m s-1]. + !! value of du [L T-1 ~> m s-1]. real, dimension(SZIB_(G)), intent(in) :: du_min_CFL !< Minimum acceptable - !! value of du [m s-1]. + !! value of du [L T-1 ~> m s-1]. real, dimension(SZIB_(G)), intent(in) :: uh_tot_0 !< The summed transport - !! with 0 adjustment [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! with 0 adjustment [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)), intent(in) :: duhdu_tot_0 !< The partial derivative - !! of du_err with du at 0 adjustment [H m ~> m2 or kg m-1]. + !! of du_err with du at 0 adjustment [H L ~> m2 or kg m-1]. real, dimension(SZIB_(G)), intent(out) :: du !< - !! The barotropic velocity adjustment [m s-1]. - real, intent(in) :: dt !< Time increment [s]. + !! The barotropic velocity adjustment [L T-1 ~> m s-1]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_PPM_CS), pointer :: CS !< This module's control structure. integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. @@ -762,23 +723,23 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & !! A flag indicating how carefully to iterate. The !! default is .true. (more accurate). real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), optional, intent(inout) :: uh_3d !< - !! Volume flux through zonal faces = u*h*dy [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! Volume flux through zonal faces = u*h*dy [H L2 T-1 ~> m3 s-1 or kg s-1]. type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables real, dimension(SZIB_(G),SZK_(G)) :: & - uh_aux, & ! An auxiliary zonal volume flux [H m s-1 ~> m2 s-1 or kg m-1 s-1]. - duhdu ! Partial derivative of uh with u [H m ~> m2 or kg m-1]. + uh_aux, & ! An auxiliary zonal volume flux [H L2 s-1 ~> m3 s-1 or kg s-1]. + duhdu ! Partial derivative of uh with u [H L ~> m2 or kg m-1]. real, dimension(SZIB_(G)) :: & - uh_err, & ! Difference between uhbt and the summed uh [H m2 s-1 ~> m3 s-1 or kg s-1]. - uh_err_best, & ! The smallest value of uh_err found so far [H m2 s-1 ~> m3 s-1 or kg s-1]. - u_new, & ! The velocity with the correction added [m s-1]. - duhdu_tot,&! Summed partial derivative of uh with u [H m ~> m2 or kg m-1]. + uh_err, & ! Difference between uhbt and the summed uh [H L2 T-1 ~> m3 s-1 or kg s-1]. + uh_err_best, & ! The smallest value of uh_err found so far [H L2 T-1 ~> m3 s-1 or kg s-1]. + u_new, & ! The velocity with the correction added [L T-1 ~> m s-1]. + duhdu_tot,&! Summed partial derivative of uh with u [H L ~> m2 or kg m-1]. du_min, & ! Min/max limits on du correction based on CFL limits - du_max ! and previous iterations [m s-1]. - real :: du_prev ! The previous value of du [m s-1]. - real :: ddu ! The change in du from the previous iteration [m s-1]. + du_max ! and previous iterations [L T-1 ~> m s-1]. + real :: du_prev ! The previous value of du [L T-1 ~> m s-1]. + real :: ddu ! The change in du from the previous iteration [L T-1 ~> m s-1]. real :: tol_eta ! The tolerance for the current iteration [H ~> m or kg m-2]. - real :: tol_vel ! The tolerance for velocity in the current iteration [m s-1]. + real :: tol_vel ! The tolerance for velocity in the current iteration [L T-1 ~> m s-1]. integer :: i, k, nz, itt, max_itts = 20 logical :: full_prec, domore, do_I(SZIB_(G)) @@ -818,8 +779,8 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & enddo domore = .false. do I=ish-1,ieh ; if (do_I(I)) then - if ((dt*min(G%IareaT(i,j),G%IareaT(i+1,j))*abs(uh_err(I)) > tol_eta) .or.& - (CS%better_iter .and. ((abs(uh_err(I)) > tol_vel * duhdu_tot(I)) .or.& + if ((dt_in_T * min(G%IareaT(i,j),G%IareaT(i+1,j))*abs(uh_err(I)) > tol_eta) .or. & + (CS%better_iter .and. ((abs(uh_err(I)) > tol_vel * duhdu_tot(I)) .or. & (abs(uh_err(I)) > uh_err_best(I))) )) then ! Use Newton's method, provided it stays bounded. Otherwise bisect ! the value with the appropriate bound. @@ -857,7 +818,7 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & do I=ish-1,ieh ; u_new(I) = u(I,j,k) + du(I) * visc_rem(I,k) ; enddo call zonal_flux_layer(u_new, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), & uh_aux(:,k), duhdu(:,k), visc_rem(:,k), & - dt, G, j, ish, ieh, do_I, CS%vol_CFL, OBC) + dt_in_T, G, US, j, ish, ieh, do_I, CS%vol_CFL, OBC) enddo ; endif if (itt < max_itts) then @@ -886,10 +847,10 @@ end subroutine zonal_flux_adjust !> Sets a structure that describes the zonal barotropic volume or mass fluxes as a !! function of barotropic flow to agree closely with the sum of the layer's transports. subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, & - du_max_CFL, du_min_CFL, dt, G, US, CS, visc_rem, & + du_max_CFL, du_min_CFL, dt_in_T, G, US, CS, visc_rem, & visc_rem_max, j, ish, ieh, do_I) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [m s-1]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to !! calculate fluxes [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the @@ -899,14 +860,14 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, type(BT_cont_type), intent(inout) :: BT_cont !< A structure with elements !! that describe the effective open face areas as a function of barotropic flow. real, dimension(SZIB_(G)), intent(in) :: uh_tot_0 !< The summed transport - !! with 0 adjustment [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! with 0 adjustment [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)), intent(in) :: duhdu_tot_0 !< The partial derivative - !! of du_err with du at 0 adjustment [H m ~> m2 or kg m-1]. + !! of du_err with du at 0 adjustment [H L ~> m2 or kg m-1]. real, dimension(SZIB_(G)), intent(in) :: du_max_CFL !< Maximum acceptable - !! value of du [m s-1]. + !! value of du [L T-1 ~> m s-1]. real, dimension(SZIB_(G)), intent(in) :: du_min_CFL !< Minimum acceptable - !! value of du [m s-1]. - real, intent(in) :: dt !< Time increment [s]. + !! value of du [L T-1 ~> m s-1]. + real, intent(in) :: dt_in_T !< Time increment [s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_PPM_CS), pointer :: CS !< This module's control structure. real, dimension(SZIB_(G),SZK_(G)), intent(in) :: visc_rem !< Both the fraction of the @@ -922,24 +883,24 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, !! which I values to work on. ! Local variables real, dimension(SZIB_(G)) :: & - du0, & ! The barotropic velocity increment that gives 0 transport [m s-1]. + du0, & ! The barotropic velocity increment that gives 0 transport [L T-1 ~> m s-1]. duL, duR, & ! The barotropic velocity increments that give the westerly - ! (duL) and easterly (duR) test velocities. + ! (duL) and easterly (duR) test velocities [L T-1 ~> m s-1]. zeros, & ! An array of full of 0's. - du_CFL, & ! The velocity increment that corresponds to CFL_min [m s-1]. + du_CFL, & ! The velocity increment that corresponds to CFL_min [L T-1 ~> m s-1]. u_L, u_R, & ! The westerly (u_L), easterly (u_R), and zero-barotropic - u_0, & ! transport (u_0) layer test velocities [m s-1]. - FA_marg_L, & ! The effective layer marginal face areas with the westerly - FA_marg_R, & ! (_L), easterly (_R), and zero-barotropic (_0) test - FA_marg_0, & ! velocities [H m ~> m2 or kg m-1]. + u_0, & ! transport (u_0) layer test velocities [L T-1 ~> m s-1]. + duhdu_L, & ! The effective layer marginal face areas with the westerly + duhdu_R, & ! (_L), easterly (_R), and zero-barotropic (_0) test + duhdu_0, & ! velocities [H L ~> m2 or kg m-1]. uh_L, uh_R, & ! The layer transports with the westerly (_L), easterly (_R), - uh_0, & ! and zero-barotropic (_0) test velocities [H m2 s-1 ~> m3 s-1 or kg s-1]. + uh_0, & ! and zero-barotropic (_0) test velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. FAmt_L, FAmt_R, & ! The summed effective marginal face areas for the 3 - FAmt_0, & ! test velocities [H m ~> m2 or kg m-1]. + FAmt_0, & ! test velocities [H L ~> m2 or kg m-1]. uhtot_L, & ! The summed transport with the westerly (uhtot_L) and - uhtot_R ! and easterly (uhtot_R) test velocities [H m2 s-1 ~> m3 s-1 or kg s-1]. - real :: FA_0 ! The effective face area with 0 barotropic transport [m H ~> m2 or kg m]. - real :: FA_avg ! The average effective face area [m H ~> m2 or kg m], nominally given by + uhtot_R ! and easterly (uhtot_R) test velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. + real :: FA_0 ! The effective face area with 0 barotropic transport [L H ~> m2 or kg m]. + real :: FA_avg ! The average effective face area [L H ~> m2 or kg m], nominally given by ! the realized transport divided by the barotropic velocity. real :: visc_rem_lim ! The larger of visc_rem and min_visc_rem [nondim] This ! limiting is necessary to keep the inverse of visc_rem @@ -950,18 +911,18 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, ! of visc_rem from leading to large CFL numbers. real :: CFL_min ! A minimal increment in the CFL to try to ensure that the ! flow is truly upwind [nondim] - real :: Idt ! The inverse of the time step [s-1]. + real :: Idt ! The inverse of the time step [T-1 ~> s-1]. logical :: domore integer :: i, k, nz - nz = G%ke ; Idt = 1.0/dt + nz = G%ke ; Idt = 1.0 / (dt_in_T) min_visc_rem = 0.1 ; CFL_min = 1e-6 ! Diagnose the zero-transport correction, du0. do I=ish-1,ieh ; zeros(I) = 0.0 ; enddo - call zonal_flux_adjust(u, h_in, h_L, h_R, zeros, uh_tot_0, & - duhdu_tot_0, du0, du_max_CFL, du_min_CFL, dt, G, & - CS, visc_rem, j, ish, ieh, do_I, .true.) + call zonal_flux_adjust(u, h_in, h_L, h_R, zeros, uh_tot_0, duhdu_tot_0, du0, & + du_max_CFL, du_min_CFL, dt_in_T, G, US, CS, visc_rem, & + j, ish, ieh, do_I, .true.) ! Determine the westerly- and easterly- fluxes. Choose a sufficiently ! negative velocity correction for the easterly-flux, and a sufficiently @@ -1001,19 +962,16 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, u_R(I) = u(I,j,k) + duR(I) * visc_rem(I,k) u_0(I) = u(I,j,k) + du0(I) * visc_rem(I,k) endif ; enddo - call zonal_flux_layer(u_0, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), uh_0, & - FA_marg_0, visc_rem(:,k), dt, G, j, ish, ieh, do_I, & - CS%vol_CFL) - call zonal_flux_layer(u_L, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), uh_L, & - FA_marg_L, visc_rem(:,k), dt, G, j, ish, ieh, do_I, & - CS%vol_CFL) - call zonal_flux_layer(u_R, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), uh_R, & - FA_marg_R, visc_rem(:,k), dt, G, j, ish, ieh, do_I, & - CS%vol_CFL) + call zonal_flux_layer(u_0, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), uh_0, duhdu_0, & + visc_rem(:,k), dt_in_T, G, US, j, ish, ieh, do_I, CS%vol_CFL) + call zonal_flux_layer(u_L, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), uh_L, duhdu_L, & + visc_rem(:,k), dt_in_T, G, US, j, ish, ieh, do_I, CS%vol_CFL) + call zonal_flux_layer(u_R, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), uh_R, duhdu_R, & + visc_rem(:,k), dt_in_T, G, US, j, ish, ieh, do_I, CS%vol_CFL) do I=ish-1,ieh ; if (do_I(I)) then - FAmt_0(I) = FAmt_0(I) + FA_marg_0(I) - FAmt_L(I) = FAmt_L(I) + FA_marg_L(I) - FAmt_R(I) = FAmt_R(I) + FA_marg_R(I) + FAmt_0(I) = FAmt_0(I) + duhdu_0(I) + FAmt_L(I) = FAmt_L(I) + duhdu_L(I) + FAmt_R(I) = FAmt_R(I) + duhdu_R(I) uhtot_L(I) = uhtot_L(I) + uh_L(I) uhtot_R(I) = uhtot_R(I) + uh_R(I) endif ; enddo @@ -1025,9 +983,9 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, if (FA_avg > max(FA_0, FAmt_L(I))) then ; FA_avg = max(FA_0, FAmt_L(I)) elseif (FA_avg < min(FA_0, FAmt_L(I))) then ; FA_0 = FA_avg ; endif - BT_cont%FA_u_W0(I,j) = US%m_to_L*FA_0 ; BT_cont%FA_u_WW(I,j) = US%m_to_L*FAmt_L(I) + BT_cont%FA_u_W0(I,j) = FA_0 ; BT_cont%FA_u_WW(I,j) = FAmt_L(I) if (abs(FA_0-FAmt_L(I)) <= 1e-12*FA_0) then ; BT_cont%uBT_WW(I,j) = 0.0 ; else - BT_cont%uBT_WW(I,j) = US%m_s_to_L_T*(1.5 * (duL(I) - du0(I))) * & + BT_cont%uBT_WW(I,j) = (1.5 * (duL(I) - du0(I))) * & ((FAmt_L(I) - FA_avg) / (FAmt_L(I) - FA_0)) endif @@ -1037,9 +995,9 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, if (FA_avg > max(FA_0, FAmt_R(I))) then ; FA_avg = max(FA_0, FAmt_R(I)) elseif (FA_avg < min(FA_0, FAmt_R(I))) then ; FA_0 = FA_avg ; endif - BT_cont%FA_u_E0(I,j) = US%m_to_L*FA_0 ; BT_cont%FA_u_EE(I,j) = US%m_to_L*FAmt_R(I) + BT_cont%FA_u_E0(I,j) = FA_0 ; BT_cont%FA_u_EE(I,j) = FAmt_R(I) if (abs(FAmt_R(I) - FA_0) <= 1e-12*FA_0) then ; BT_cont%uBT_EE(I,j) = 0.0 ; else - BT_cont%uBT_EE(I,j) = US%m_s_to_L_T*(1.5 * (duR(I) - du0(I))) * & + BT_cont%uBT_EE(I,j) = (1.5 * (duR(I) - du0(I))) * & ((FAmt_R(I) - FA_avg) / (FAmt_R(I) - FA_0)) endif else @@ -1051,18 +1009,18 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, end subroutine set_zonal_BT_cont !> Calculates the mass or volume fluxes through the meridional faces, and other related quantities. -subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & - visc_rem_v, v_cor, vhbt_aux, v_cor_aux, BT_cont) +subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, OBC, & + visc_rem_v, v_cor, BT_cont) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to !! calculate fluxes [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: vh !< Volume flux through meridional !! faces = v*h*dx [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(continuity_PPM_CS), pointer :: CS !< This module's control structure. + type(continuity_PPM_CS), pointer :: CS !< This module's control structure.G type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. type(ocean_OBC_type), optional, pointer :: OBC !< Open boundary condition type !! specifies whether, where, and what open boundary conditions are used. @@ -1073,48 +1031,41 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & !! that a layer experiences after viscosity is applied. Nondimensional between !! 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZI_(G),SZJB_(G)), optional, intent(in) :: vhbt !< The summed volume flux through - !< meridional faces [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZI_(G),SZJB_(G)), optional, intent(in) :: vhbt_aux !< A second set of summed volume fluxes - !! through meridional faces [H m2 s-1 ~> m3 s-1 or kg s-1]. + !< meridional faces [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(out) :: v_cor !< The meridional velocitiess (v with a barotropic correction) - !! that give vhbt as the depth-integrated transport [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - optional, intent(out) :: v_cor_aux - !< The meridional velocities (v with a barotropic correction) - !! that give vhbt_aux as the depth-integrated transports [m s-1]. + !! that give vhbt as the depth-integrated transport [L T-1 ~> m s-1]. type(BT_cont_type), optional, pointer :: BT_cont !< A structure with elements that describe !! the effective open face areas as a function of barotropic flow. ! Local variables real, dimension(SZI_(G),SZK_(G)) :: & - dvhdv ! Partial derivative of vh with v [H m ~> m2 or kg m-1]. + dvhdv ! Partial derivative of vh with v [H L ~> m2 or kg m-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & h_L, h_R ! Left and right face thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G)) :: & - dv, & ! Corrective barotropic change in the velocity [m s-1]. + dv, & ! Corrective barotropic change in the velocity [L T-1 ~> m s-1]. dv_min_CFL, & ! Min/max limits on dv correction dv_max_CFL, & ! to avoid CFL violations - dvhdv_tot_0, & ! Summed partial derivative of vh with v [H m ~> m2 or kg m-1]. - vh_tot_0, & ! Summed transport with no barotropic correction [H m2 s-1 ~> m3 s-1 or kg s-1]. + dvhdv_tot_0, & ! Summed partial derivative of vh with v [H L ~> m2 or kg m-1]. + vh_tot_0, & ! Summed transport with no barotropic correction [H L2 T-1 ~> m3 s-1 or kg s-1]. visc_rem_max ! The column maximum of visc_rem. logical, dimension(SZI_(G)) :: do_I - real, dimension(SZI_(G)) :: FAvi ! A list of sums of meridional face areas [H m ~> m2 or kg m-1]. + real, dimension(SZI_(G)) :: FAvi ! A list of sums of meridional face areas [H L ~> m2 or kg m-1]. real :: FA_v ! A sum of meridional face areas [H m ~> m2 or kg m-1]. real, dimension(SZI_(G),SZK_(G)) :: & visc_rem ! A 2-D copy of visc_rem_v or an array of 1's. real :: I_vrm ! 1.0 / visc_rem_max, nondim. real :: CFL_dt ! The maximum CFL ratio of the adjusted velocities divided by - ! the time step [s-1]. - real :: I_dt ! 1.0 / dt [s-1]. - real :: dv_lim ! The velocity change that give a relative CFL of 1 [m s-1]. - real :: dy_N, dy_S ! Effective y-grid spacings to the north and south [m]. + ! the time step [T-1 ~> s-1]. + real :: I_dt ! 1.0 / dt [T-1 ~> s-1]. + real :: dv_lim ! The velocity change that give a relative CFL of 1 [L T-1 ~> m s-1]. + real :: dy_N, dy_S ! Effective y-grid spacings to the north and south [L ~> m]. integer :: i, j, k, ish, ieh, jsh, jeh, n, nz - logical :: do_aux, local_specified_BC, use_visc_rem, set_BT_cont, any_simple_OBC + logical :: local_specified_BC, use_visc_rem, set_BT_cont, any_simple_OBC logical :: local_Flather_OBC, is_simple, local_open_BC type(OBC_segment_type), pointer :: segment => NULL() - do_aux = (present(vhbt_aux) .and. present(v_cor_aux)) use_visc_rem = present(visc_rem_v) local_specified_BC = .false. ; set_BT_cont = .false. ; local_Flather_OBC = .false. local_open_BC = .false. @@ -1126,8 +1077,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & endif ; endif ; endif ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh ; nz = G%ke - CFL_dt = CS%CFL_limit_adjust / dt - I_dt = 1.0 / dt + CFL_dt = CS%CFL_limit_adjust / (dt_in_T) + I_dt = 1.0 / (dt_in_T) if (CS%aggress_adjust) CFL_dt = I_dt call cpu_clock_begin(id_clock_update) @@ -1148,9 +1099,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & call cpu_clock_begin(id_clock_correct) !$OMP parallel do default(none) shared(ish,ieh,jsh,jeh,nz,v,h_in,h_L,h_R,vh,use_visc_rem, & -!$OMP visc_rem_v,dt,G,GV,CS,local_specified_BC,OBC,vhbt,do_aux, & -!$OMP set_BT_cont,CFL_dt,I_dt,v_cor,vhbt_aux, & -!$OMP v_cor_aux,BT_cont, local_Flather_OBC ) & +!$OMP visc_rem_v,dt,G,GV,CS,local_specified_BC,OBC,vhbt, & +!$OMP set_BT_cont,CFL_dt,I_dt,v_cor,BT_cont, local_Flather_OBC ) & !$OMP private(do_I,dvhdv,dv,dv_max_CFL,dv_min_CFL,vh_tot_0, & !$OMP dvhdv_tot_0,visc_rem_max,I_vrm,dv_lim,dy_N, & !$OMP is_simple,FAvi,dy_S,any_simple_OBC ) & @@ -1165,7 +1115,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & enddo ; endif call merid_flux_layer(v(:,J,k), h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), & vh(:,J,k), dvhdv(:,k), visc_rem(:,k), & - dt, G, J, ish, ieh, do_I, CS%vol_CFL, OBC) + dt_in_T, G, US, J, ish, ieh, do_I, CS%vol_CFL, OBC) if (local_specified_BC) then do i=ish,ieh if (OBC%segment(OBC%segnum_v(i,J))%specified) & @@ -1177,7 +1127,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & visc_rem_max(i) = 1.0 enddo ; endif - if (present(vhbt) .or. do_aux .or. set_BT_cont) then + if (present(vhbt) .or. set_BT_cont) then ! Set limits on dv that will keep the CFL number between -1 and 1. ! This should be adequate to keep the root bracketed in all cases. do i=ish,ieh @@ -1251,10 +1201,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & dv_min_CFL(i) = min(dv_min_CFL(i),0.0) enddo - ! Up to this point, everything is shared between vhbt and vhbt_aux. - any_simple_OBC = .false. - if (present(vhbt) .or. do_aux .or. set_BT_cont) then + if (present(vhbt) .or. set_BT_cont) then if (local_specified_BC .or. local_Flather_OBC) then ; do i=ish,ieh ! Avoid reconciling barotropic/baroclinic transports if transport is specified is_simple = OBC%segment(OBC%segnum_v(i,J))%specified @@ -1266,9 +1214,9 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & endif if (present(vhbt)) then - call meridional_flux_adjust(v, h_in, h_L, h_R, vhbt(:,J), vh_tot_0, & - dvhdv_tot_0, dv, dv_max_CFL, dv_min_CFL, dt, G, & - CS, visc_rem, j, ish, ieh, do_I, .true., vh, OBC=OBC) + call meridional_flux_adjust(v, h_in, h_L, h_R, vhbt(:,J), vh_tot_0, dvhdv_tot_0, dv, & + dv_max_CFL, dv_min_CFL, dt_in_T, G, US, CS, visc_rem, & + j, ish, ieh, do_I, .true., vh, OBC=OBC) if (present(v_cor)) then ; do k=1,nz do i=ish,ieh ; v_cor(i,J,k) = v(i,J,k) + dv(i) * visc_rem(i,k) ; enddo @@ -1279,23 +1227,9 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & enddo ; endif ! v-corrected endif - if (do_aux) then - call meridional_flux_adjust(v, h_in, h_L, h_R, vhbt_aux(:,J), vh_tot_0, & - dvhdv_tot_0, dv, dv_max_CFL, dv_min_CFL, dt, G, & - CS, visc_rem, j, ish, ieh, do_I, .false., OBC=OBC) - - do k=1,nz - do i=ish,ieh ; v_cor_aux(i,J,k) = v(i,J,k) + dv(i) * visc_rem(i,k) ; enddo - if (local_specified_BC) then ; do i=ish,ieh - if (OBC%segment(OBC%segnum_v(i,J))%specified) & - v_cor_aux(i,J,k) = OBC%segment(OBC%segnum_v(i,J))%normal_vel(i,J,k) - enddo ; endif - enddo - endif ! do_aux - if (set_BT_cont) then call set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0,& - dv_max_CFL, dv_min_CFL, dt, G, US, CS, visc_rem, & + dv_max_CFL, dv_min_CFL, dt_in_T, G, US, CS, visc_rem, & visc_rem_max, J, ish, ieh, do_I) if (any_simple_OBC) then do i=ish,ieh @@ -1305,19 +1239,19 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & do k=1,nz ; do i=ish,ieh ; if (do_I(i)) then if ((abs(OBC%segment(OBC%segnum_v(i,J))%normal_vel(i,J,k)) > 0.0) .and. & (OBC%segment(OBC%segnum_v(i,J))%specified)) & - FAvi(i) = FAvi(i) + & - OBC%segment(OBC%segnum_v(i,J))%normal_trans(i,J,k) / & - OBC%segment(OBC%segnum_v(i,J))%normal_vel(i,J,k) + FAvi(i) = FAvi(i) + OBC%segment(OBC%segnum_v(i,J))%normal_trans(i,J,k) / & + OBC%segment(OBC%segnum_v(i,J))%normal_vel(i,J,k) endif ; enddo ; enddo do i=ish,ieh ; if (do_I(i)) then - BT_cont%FA_v_S0(i,J) = US%m_to_L*FAvi(i) ; BT_cont%FA_v_N0(i,J) = US%m_to_L*FAvi(i) - BT_cont%FA_v_SS(i,J) = US%m_to_L*FAvi(i) ; BT_cont%FA_v_NN(i,J) = US%m_to_L*FAvi(i) + BT_cont%FA_v_S0(i,J) = FAvi(i) ; BT_cont%FA_v_N0(i,J) = FAvi(i) + BT_cont%FA_v_SS(i,J) = FAvi(i) ; BT_cont%FA_v_NN(i,J) = FAvi(i) BT_cont%vBT_SS(i,J) = 0.0 ; BT_cont%vBT_NN(i,J) = 0.0 endif ; enddo endif endif ! set_BT_cont - endif ! present(vhbt) or do_aux or set_BT_cont + endif ! present(vhbt) or set_BT_cont + enddo ! j-loop if (local_open_BC .and. set_BT_cont) then @@ -1327,7 +1261,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & if (OBC%segment(n)%direction == OBC_DIRECTION_N) then do i = OBC%segment(n)%HI%Isd, OBC%segment(n)%HI%Ied FA_v = 0.0 - do k=1,nz ; FA_v = FA_v + h_in(i,j,k)*US%m_to_L*G%dx_Cv(i,J) ; enddo + do k=1,nz ; FA_v = FA_v + h_in(i,j,k)*G%dx_Cv(i,J) ; enddo BT_cont%FA_v_S0(i,J) = FA_v ; BT_cont%FA_v_N0(i,J) = FA_v BT_cont%FA_v_SS(i,J) = FA_v ; BT_cont%FA_v_NN(i,J) = FA_v BT_cont%vBT_SS(i,J) = 0.0 ; BT_cont%vBT_NN(i,J) = 0.0 @@ -1335,7 +1269,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & else do i = OBC%segment(n)%HI%Isd, OBC%segment(n)%HI%Ied FA_v = 0.0 - do k=1,nz ; FA_v = FA_v + h_in(i,j+1,k)*US%m_to_L*G%dx_Cv(i,J) ; enddo + do k=1,nz ; FA_v = FA_v + h_in(i,j+1,k)*G%dx_Cv(i,J) ; enddo BT_cont%FA_v_S0(i,J) = FA_v ; BT_cont%FA_v_N0(i,J) = FA_v BT_cont%FA_v_SS(i,J) = FA_v ; BT_cont%FA_v_NN(i,J) = FA_v BT_cont%vBT_SS(i,J) = 0.0 ; BT_cont%vBT_NN(i,J) = 0.0 @@ -1348,10 +1282,10 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & if (set_BT_cont) then ; if (allocated(BT_cont%h_v)) then if (present(v_cor)) then - call merid_face_thickness(v_cor, h_in, h_L, h_R, BT_cont%h_v, dt, G, LB, & + call merid_face_thickness(v_cor, h_in, h_L, h_R, BT_cont%h_v, dt_in_T, G, US, LB, & CS%vol_CFL, CS%marginal_faces, visc_rem_v, OBC) else - call merid_face_thickness(v, h_in, h_L, h_R, BT_cont%h_v, dt, G, LB, & + call merid_face_thickness(v, h_in, h_L, h_R, BT_cont%h_v, dt_in_T, G, US, LB, & CS%vol_CFL, CS%marginal_faces, visc_rem_v, OBC) endif endif ; endif @@ -1359,10 +1293,10 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & end subroutine meridional_mass_flux !> Evaluates the meridional mass or volume fluxes in a layer. -subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, J, & +subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt_in_T, G, US, J, & ish, ieh, do_I, vol_CFL, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. - real, dimension(SZI_(G)), intent(in) :: v !< Meridional velocity [m s-1]. + real, dimension(SZI_(G)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G)), intent(in) :: visc_rem !< Both the fraction of the !! momentum originally in a layer that remains after a time-step !! of viscosity, and the fraction of a time-step's worth of a barotropic @@ -1375,10 +1309,11 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, J, & real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_R !< Right thickness in the reconstruction !! [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(inout) :: vh !< Meridional mass or volume transport - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G)), intent(inout) :: dvhdv !< Partial derivative of vh with v - !! [H m ~> m2 or kg m-1]. - real, intent(in) :: dt !< Time increment [s]. + !! [H L ~> m2 or kg m-1]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. integer, intent(in) :: ieh !< End of index range. @@ -1401,16 +1336,16 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, J, & do i=ish,ieh ; if (do_I(i)) then if (v(i) > 0.0) then - if (vol_CFL) then ; CFL = (v(i) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) - else ; CFL = v(i) * dt * G%IdyT(i,j) ; endif + if (vol_CFL) then ; CFL = (v(i) * dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j)) + else ; CFL = v(i) * dt_in_T * G%IdyT(i,j) ; endif curv_3 = h_L(i,j) + h_R(i,j) - 2.0*h(i,j) vh(i) = G%dx_Cv(i,J) * v(i) * ( h_R(i,j) + CFL * & (0.5*(h_L(i,j) - h_R(i,j)) + curv_3*(CFL - 1.5)) ) h_marg = h_R(i,j) + CFL * ((h_L(i,j) - h_R(i,j)) + & 3.0*curv_3*(CFL - 1.0)) elseif (v(i) < 0.0) then - if (vol_CFL) then ; CFL = (-v(i) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) - else ; CFL = -v(i) * dt * G%IdyT(i,j+1) ; endif + if (vol_CFL) then ; CFL = (-v(i) * dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) + else ; CFL = -v(i) * dt_in_T * G%IdyT(i,j+1) ; endif curv_3 = h_L(i,j+1) + h_R(i,j+1) - 2.0*h(i,j+1) vh(i) = G%dx_Cv(i,J) * v(i) * ( h_L(i,j+1) + CFL * & (0.5*(h_R(i,j+1)-h_L(i,j+1)) + curv_3*(CFL - 1.5)) ) @@ -1439,10 +1374,10 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, J, & end subroutine merid_flux_layer !> Sets the effective interface thickness at each meridional velocity point. -subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, LB, vol_CFL, & +subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt_in_T, G, US, LB, vol_CFL, & marginal, visc_rem_v, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness used to calculate fluxes, !! [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the reconstruction, @@ -1451,8 +1386,9 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, LB, vol_CFL, & !! [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: h_v !< Thickness at meridional faces, !! [H ~> m or kg m-2]. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type logical, intent(in) :: vol_CFL !< If true, rescale the ratio !! of face areas to the cell areas when estimating the CFL number. logical, intent(in) :: marginal !< If true, report the marginal @@ -1467,7 +1403,7 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, LB, vol_CFL, & ! Local variables real :: CFL ! The CFL number based on the local velocity and grid spacing [nondim] real :: curv_3 ! A measure of the thickness curvature over a grid length, - ! with the same units as h_in. + ! with the same units as h [H ~> m or kg m-2] . real :: h_avg ! The average thickness of a flux [H ~> m or kg m-2]. real :: h_marg ! The marginal thickness of a flux [H ~> m or kg m-2]. logical :: local_open_BC @@ -1477,15 +1413,15 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, LB, vol_CFL, & !$OMP parallel do default(shared) private(CFL,curv_3,h_marg,h_avg) do k=1,nz ; do J=jsh-1,jeh ; do i=ish,ieh if (v(i,J,k) > 0.0) then - if (vol_CFL) then ; CFL = (v(i,J,k) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) - else ; CFL = v(i,J,k) * dt * G%IdyT(i,j) ; endif + if (vol_CFL) then ; CFL = (v(i,J,k) * dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j)) + else ; CFL = v(i,J,k) * dt_in_T * G%IdyT(i,j) ; endif curv_3 = h_L(i,j,k) + h_R(i,j,k) - 2.0*h(i,j,k) h_avg = h_R(i,j,k) + CFL * (0.5*(h_L(i,j,k) - h_R(i,j,k)) + curv_3*(CFL - 1.5)) h_marg = h_R(i,j,k) + CFL * ((h_L(i,j,k) - h_R(i,j,k)) + & 3.0*curv_3*(CFL - 1.0)) elseif (v(i,J,k) < 0.0) then - if (vol_CFL) then ; CFL = (-v(i,J,k)*dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) - else ; CFL = -v(i,J,k) * dt * G%IdyT(i,j+1) ; endif + if (vol_CFL) then ; CFL = (-v(i,J,k)*dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) + else ; CFL = -v(i,J,k) * dt_in_T * G%IdyT(i,j+1) ; endif curv_3 = h_L(i,j+1,k) + h_R(i,j+1,k) - 2.0*h(i,j+1,k) h_avg = h_L(i,j+1,k) + CFL * (0.5*(h_R(i,j+1,k)-h_L(i,j+1,k)) + curv_3*(CFL - 1.5)) h_marg = h_L(i,j+1,k) + CFL * ((h_R(i,j+1,k)-h_L(i,j+1,k)) + & @@ -1547,11 +1483,11 @@ end subroutine merid_face_thickness !> Returns the barotropic velocity adjustment that gives the desired barotropic (layer-summed) transport. subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0, & - dv, dv_max_CFL, dv_min_CFL, dt, G, CS, visc_rem, & + dv, dv_max_CFL, dv_min_CFL, dt_in_T, G, US, CS, visc_rem, & j, ish, ieh, do_I_in, full_precision, vh_3d, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< Meridional velocity [m s-1]. + intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h_in !< Layer thickness used to calculate fluxes [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)),& @@ -1566,15 +1502,16 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 !! between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZI_(G)), & optional, intent(in) :: vhbt !< The summed volume flux through meridional faces - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZI_(G)), intent(in) :: dv_max_CFL !< Maximum acceptable value of dv [m s-1]. - real, dimension(SZI_(G)), intent(in) :: dv_min_CFL !< Minimum acceptable value of dv [m s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. + real, dimension(SZI_(G)), intent(in) :: dv_max_CFL !< Maximum acceptable value of dv [L T-1 ~> m s-1]. + real, dimension(SZI_(G)), intent(in) :: dv_min_CFL !< Minimum acceptable value of dv [L T-1 ~> m s-1]. real, dimension(SZI_(G)), intent(in) :: vh_tot_0 !< The summed transport with 0 adjustment - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G)), intent(in) :: dvhdv_tot_0 !< The partial derivative of dv_err with - !! dv at 0 adjustment [H m ~> m2 or kg m-1]. - real, dimension(SZI_(G)), intent(out) :: dv !< The barotropic velocity adjustment [m s-1]. - real, intent(in) :: dt !< Time increment [s]. + !! dv at 0 adjustment [H L ~> m2 or kg m-1]. + real, dimension(SZI_(G)), intent(out) :: dv !< The barotropic velocity adjustment [L T-1 ~> m s-1]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_PPM_CS), pointer :: CS !< This module's control structure. integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. @@ -1585,23 +1522,23 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 !! iterate. The default is .true. (more accurate). real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(inout) :: vh_3d !< Volume flux through meridional - !! faces = v*h*dx [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! faces = v*h*dx [H L2 T-1 ~> m3 s-1 or kg s-1]. type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables real, dimension(SZI_(G),SZK_(G)) :: & - vh_aux, & ! An auxiliary meridional volume flux [H m s-1 ~> m2 s-1 or kg m-1 s-1]. + vh_aux, & ! An auxiliary meridional volume flux [H L2 s-1 ~> m3 s-1 or kg s-1]. dvhdv ! Partial derivative of vh with v [H m ~> m2 or kg m-1]. real, dimension(SZI_(G)) :: & - vh_err, & ! Difference between vhbt and the summed vh [H m2 s-1 ~> m3 s-1 or kg s-1]. - vh_err_best, & ! The smallest value of vh_err found so far [H m2 s-1 ~> m3 s-1 or kg s-1]. - v_new, & ! The velocity with the correction added [m s-1]. - dvhdv_tot,&! Summed partial derivative of vh with u [H m ~> m2 or kg m-1]. + vh_err, & ! Difference between vhbt and the summed vh [H L2 T-1 ~> m3 s-1 or kg s-1]. + vh_err_best, & ! The smallest value of vh_err found so far [H L2 T-1 ~> m3 s-1 or kg s-1]. + v_new, & ! The velocity with the correction added [L T-1 ~> m s-1]. + dvhdv_tot,&! Summed partial derivative of vh with u [H L ~> m2 or kg m-1]. dv_min, & ! Min/max limits on dv correction based on CFL limits - dv_max ! and previous iterations [m s-1]. - real :: dv_prev ! The previous value of dv [m s-1]. - real :: ddv ! The change in dv from the previous iteration [m s-1]. + dv_max ! and previous iterations [L T-1 ~> m s-1]. + real :: dv_prev ! The previous value of dv [L T-1 ~> m s-1]. + real :: ddv ! The change in dv from the previous iteration [L T-1 ~> m s-1]. real :: tol_eta ! The tolerance for the current iteration [H ~> m or kg m-2]. - real :: tol_vel ! The tolerance for velocity in the current iteration [m s-1]. + real :: tol_vel ! The tolerance for velocity in the current iteration [L T-1 ~> m s-1]. integer :: i, k, nz, itt, max_itts = 20 logical :: full_prec, domore, do_I(SZI_(G)) @@ -1641,8 +1578,8 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 enddo domore = .false. do i=ish,ieh ; if (do_I(i)) then - if ((dt*min(G%IareaT(i,j),G%IareaT(i,j+1))*abs(vh_err(i)) > tol_eta) .or.& - (CS%better_iter .and. ((abs(vh_err(i)) > tol_vel * dvhdv_tot(i)) .or.& + if ((dt_in_T * min(G%IareaT(i,j),G%IareaT(i,j+1))*abs(vh_err(i)) > tol_eta) .or. & + (CS%better_iter .and. ((abs(vh_err(i)) > tol_vel * dvhdv_tot(i)) .or. & (abs(vh_err(i)) > vh_err_best(i))) )) then ! Use Newton's method, provided it stays bounded. Otherwise bisect ! the value with the appropriate bound. @@ -1680,7 +1617,7 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 do i=ish,ieh ; v_new(i) = v(i,J,k) + dv(i) * visc_rem(i,k) ; enddo call merid_flux_layer(v_new, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), & vh_aux(:,k), dvhdv(:,k), visc_rem(:,k), & - dt, G, J, ish, ieh, do_I, CS%vol_CFL, OBC) + dt_in_T, G, US, J, ish, ieh, do_I, CS%vol_CFL, OBC) enddo ; endif if (itt < max_itts) then @@ -1709,10 +1646,10 @@ end subroutine meridional_flux_adjust !> Sets of a structure that describes the meridional barotropic volume or mass fluxes as a !! function of barotropic flow to agree closely with the sum of the layer's transports. subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, & - dv_max_CFL, dv_min_CFL, dt, G, US, CS, visc_rem, & + dv_max_CFL, dv_min_CFL, dt_in_T, G, US, CS, visc_rem, & visc_rem_max, j, ish, ieh, do_I) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to calculate fluxes, !! [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the reconstruction, @@ -1722,12 +1659,14 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, type(BT_cont_type), intent(inout) :: BT_cont !< A structure with elements !! that describe the effective open face areas as a function of barotropic flow. real, dimension(SZI_(G)), intent(in) :: vh_tot_0 !< The summed transport - !! with 0 adjustment [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! with 0 adjustment [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G)), intent(in) :: dvhdv_tot_0 !< The partial derivative - !! of du_err with dv at 0 adjustment [H m ~> m2 or kg m-1]. - real, dimension(SZI_(G)), intent(in) :: dv_max_CFL !< Maximum acceptable value of dv [m s-1]. - real, dimension(SZI_(G)), intent(in) :: dv_min_CFL !< Minimum acceptable value of dv [m s-1]. - real, intent(in) :: dt !< Time increment [s]. + !! of du_err with dv at 0 adjustment [H L ~> m2 or kg m-1]. + real, dimension(SZI_(G)), intent(in) :: dv_max_CFL !< Maximum acceptable value + !! of dv [L T-1 ~> m s-1]. + real, dimension(SZI_(G)), intent(in) :: dv_min_CFL !< Minimum acceptable value + !! of dv [L T-1 ~> m s-1]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_PPM_CS), pointer :: CS !< This module's control structure. real, dimension(SZI_(G),SZK_(G)), intent(in) :: visc_rem !< Both the fraction of the @@ -1743,24 +1682,24 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, !! which I values to work on. ! Local variables real, dimension(SZI_(G)) :: & - dv0, & ! The barotropic velocity increment that gives 0 transport [m s-1]. + dv0, & ! The barotropic velocity increment that gives 0 transport [L T-1 ~> m s-1]. dvL, dvR, & ! The barotropic velocity increments that give the southerly - ! (dvL) and northerly (dvR) test velocities. + ! (dvL) and northerly (dvR) test velocities [L T-1 ~> m s-1]. zeros, & ! An array of full of 0's. - dv_CFL, & ! The velocity increment that corresponds to CFL_min [m s-1]. + dv_CFL, & ! The velocity increment that corresponds to CFL_min [L T-1 ~> m s-1]. v_L, v_R, & ! The southerly (v_L), northerly (v_R), and zero-barotropic - v_0, & ! transport (v_0) layer test velocities [m s-1]. - FA_marg_L, & ! The effective layer marginal face areas with the southerly - FA_marg_R, & ! (_L), northerly (_R), and zero-barotropic (_0) test - FA_marg_0, & ! velocities [H m ~> m2 or kg m-1]. + v_0, & ! transport (v_0) layer test velocities [L T-1 ~> m s-1]. + dvhdv_L, & ! The effective layer marginal face areas with the southerly + dvhdv_R, & ! (_L), northerly (_R), and zero-barotropic (_0) test + dvhdv_0, & ! velocities [H L ~> m2 or kg m-1]. vh_L, vh_R, & ! The layer transports with the southerly (_L), northerly (_R) - vh_0, & ! and zero-barotropic (_0) test velocities [H m2 s-1 ~> m3 s-1 or kg s-1]. + vh_0, & ! and zero-barotropic (_0) test velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. FAmt_L, FAmt_R, & ! The summed effective marginal face areas for the 3 FAmt_0, & ! test velocities [H m ~> m2 or kg m-1]. vhtot_L, & ! The summed transport with the southerly (vhtot_L) and - vhtot_R ! and northerly (vhtot_R) test velocities [H m2 s-1 ~> m3 s-1 or kg s-1]. - real :: FA_0 ! The effective face area with 0 barotropic transport [H m ~> m2 or kg m-1]. - real :: FA_avg ! The average effective face area [H m ~> m2 or kg m-1], nominally given by + vhtot_R ! and northerly (vhtot_R) test velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. + real :: FA_0 ! The effective face area with 0 barotropic transport [H L ~> m2 or kg m-1]. + real :: FA_avg ! The average effective face area [H L ~> m2 or kg m-1], nominally given by ! the realized transport divided by the barotropic velocity. real :: visc_rem_lim ! The larger of visc_rem and min_visc_rem [nondim] This ! limiting is necessary to keep the inverse of visc_rem @@ -1771,18 +1710,18 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, ! of visc_rem from leading to large CFL numbers. real :: CFL_min ! A minimal increment in the CFL to try to ensure that the ! flow is truly upwind [nondim] - real :: Idt ! The inverse of the time step [s-1]. + real :: Idt ! The inverse of the time step [T-1 ~> s-1]. logical :: domore integer :: i, k, nz - nz = G%ke ; Idt = 1.0/dt + nz = G%ke ; Idt = 1.0/(dt_in_T) min_visc_rem = 0.1 ; CFL_min = 1e-6 ! Diagnose the zero-transport correction, dv0. do i=ish,ieh ; zeros(i) = 0.0 ; enddo - call meridional_flux_adjust(v, h_in, h_L, h_R, zeros, vh_tot_0, & - dvhdv_tot_0, dv0, dv_max_CFL, dv_min_CFL, dt, G, & - CS, visc_rem, j, ish, ieh, do_I, .true.) + call meridional_flux_adjust(v, h_in, h_L, h_R, zeros, vh_tot_0, dvhdv_tot_0, dv0, & + dv_max_CFL, dv_min_CFL, dt_in_T, G, US, CS, visc_rem, & + j, ish, ieh, do_I, .true.) ! Determine the southerly- and northerly- fluxes. Choose a sufficiently ! negative velocity correction for the northerly-flux, and a sufficiently @@ -1822,19 +1761,16 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, v_R(i) = v(I,j,k) + dvR(i) * visc_rem(i,k) v_0(i) = v(I,j,k) + dv0(i) * visc_rem(i,k) endif ; enddo - call merid_flux_layer(v_0, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), vh_0, & - FA_marg_0, visc_rem(:,k), dt, G, J, ish, ieh, do_I, & - CS%vol_CFL) - call merid_flux_layer(v_L, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), vh_L, & - FA_marg_L, visc_rem(:,k), dt, G, J, ish, ieh, do_I, & - CS%vol_CFL) - call merid_flux_layer(v_R, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), vh_R, & - FA_marg_R, visc_rem(:,k), dt, G, J, ish, ieh, do_I, & - CS%vol_CFL) + call merid_flux_layer(v_0, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), vh_0, dvhdv_0, & + visc_rem(:,k), dt_in_T, G, US, J, ish, ieh, do_I, CS%vol_CFL) + call merid_flux_layer(v_L, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), vh_L, dvhdv_L, & + visc_rem(:,k), dt_in_T, G, US, J, ish, ieh, do_I, CS%vol_CFL) + call merid_flux_layer(v_R, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), vh_R, dvhdv_R, & + visc_rem(:,k), dt_in_T, G, US, J, ish, ieh, do_I, CS%vol_CFL) do i=ish,ieh ; if (do_I(i)) then - FAmt_0(i) = FAmt_0(i) + FA_marg_0(i) - FAmt_L(i) = FAmt_L(i) + FA_marg_L(i) - FAmt_R(i) = FAmt_R(i) + FA_marg_R(i) + FAmt_0(i) = FAmt_0(i) + dvhdv_0(i) + FAmt_L(i) = FAmt_L(i) + dvhdv_L(i) + FAmt_R(i) = FAmt_R(i) + dvhdv_R(i) vhtot_L(i) = vhtot_L(i) + vh_L(i) vhtot_R(i) = vhtot_R(i) + vh_R(i) endif ; enddo @@ -1845,9 +1781,9 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, FA_avg = vhtot_L(i) / (dvL(i) - dv0(i)) if (FA_avg > max(FA_0, FAmt_L(i))) then ; FA_avg = max(FA_0, FAmt_L(i)) elseif (FA_avg < min(FA_0, FAmt_L(i))) then ; FA_0 = FA_avg ; endif - BT_cont%FA_v_S0(i,J) = US%m_to_L*FA_0 ; BT_cont%FA_v_SS(i,J) = US%m_to_L*FAmt_L(i) + BT_cont%FA_v_S0(i,J) = FA_0 ; BT_cont%FA_v_SS(i,J) = FAmt_L(i) if (abs(FA_0-FAmt_L(i)) <= 1e-12*FA_0) then ; BT_cont%vBT_SS(i,J) = 0.0 ; else - BT_cont%vBT_SS(i,J) = US%m_s_to_L_T*(1.5 * (dvL(i) - dv0(i))) * & + BT_cont%vBT_SS(i,J) = (1.5 * (dvL(i) - dv0(i))) * & ((FAmt_L(i) - FA_avg) / (FAmt_L(i) - FA_0)) endif @@ -1856,9 +1792,9 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, FA_avg = vhtot_R(i) / (dvR(i) - dv0(i)) if (FA_avg > max(FA_0, FAmt_R(i))) then ; FA_avg = max(FA_0, FAmt_R(i)) elseif (FA_avg < min(FA_0, FAmt_R(i))) then ; FA_0 = FA_avg ; endif - BT_cont%FA_v_N0(i,J) = US%m_to_L*FA_0 ; BT_cont%FA_v_NN(i,J) = US%m_to_L*FAmt_R(i) + BT_cont%FA_v_N0(i,J) = FA_0 ; BT_cont%FA_v_NN(i,J) = FAmt_R(i) if (abs(FAmt_R(i) - FA_0) <= 1e-12*FA_0) then ; BT_cont%vBT_NN(i,J) = 0.0 ; else - BT_cont%vBT_NN(i,J) = US%m_s_to_L_T*(1.5 * (dvR(i) - dv0(i))) * & + BT_cont%vBT_NN(i,J) = (1.5 * (dvR(i) - dv0(i))) * & ((FAmt_R(i) - FA_avg) / (FAmt_R(i) - FA_0)) endif else @@ -2241,10 +2177,11 @@ function ratio_max(a, b, maxrat) result(ratio) end function ratio_max !> Initializes continuity_ppm_cs -subroutine continuity_PPM_init(Time, G, GV, param_file, diag, CS) - type(time_type), target, intent(in) :: Time !< Time increment [s]. +subroutine continuity_PPM_init(Time, G, GV, US, param_file, diag, CS) + type(time_type), target, intent(in) :: Time !< The current model time. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure indicating !! the open file to parse for model parameter values. type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to @@ -2289,6 +2226,7 @@ subroutine continuity_PPM_init(Time, G, GV, param_file, diag, CS) "than about 10^-15*MAXIMUM_DEPTH.", units="m", scale=GV%m_to_H, & default=0.5*G%ke*GV%Angstrom_m, unscaled=tol_eta_m) + !### ETA_TOLERANCE_AUX can be obsoleted. call get_param(param_file, mdl, "ETA_TOLERANCE_AUX", CS%tol_eta_aux, & "The tolerance for free-surface height discrepancies "//& "between the barotropic solution and the sum of the "//& @@ -2299,7 +2237,8 @@ subroutine continuity_PPM_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, "VELOCITY_TOLERANCE", CS%tol_vel, & "The tolerance for barotropic velocity discrepancies "//& "between the barotropic solution and the sum of the "//& - "layer thicknesses.", units="m s-1", default=3.0e8) ! The speed of light is the default. + "layer thicknesses.", units="m s-1", default=3.0e8, scale=US%m_s_to_L_T) + ! The speed of light is the default. call get_param(param_file, mdl, "CONT_PPM_AGGRESS_ADJUST", CS%aggress_adjust,& "If true, allow the adjusted velocities to have a "//& diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index f256df6508..1f43a699a1 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -69,14 +69,14 @@ module MOM_dynamics_split_RK2 !> MOM_dynamics_split_RK2 module control structure type, public :: MOM_dyn_split_RK2_CS ; private real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & - CAu, & !< CAu = f*v - u.grad(u) [m s-2] - PFu, & !< PFu = -dM/dx [m s-2] - diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [m s-1 T-1 ~> m s-2] + CAu, & !< CAu = f*v - u.grad(u) [L T-2 ~> m s-2] + PFu, & !< PFu = -dM/dx [L T-2 ~> m s-2] + diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> m s-2] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & - CAv, & !< CAv = -f*u - u.grad(v) [m s-2] - PFv, & !< PFv = -dM/dy [m s-2] - diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [m s-1 T-1 ~> m s-2] + CAv, & !< CAv = -f*u - u.grad(v) [L T-2 ~> m s-2] + PFv, & !< PFv = -dM/dy [L T-2 ~> m s-2] + diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> m s-2] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: visc_rem_u !< Both the fraction of the zonal momentum originally in a @@ -87,7 +87,7 @@ module MOM_dynamics_split_RK2 real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: u_accel_bt !< The zonal layer accelerations due to the difference between !! the barotropic accelerations and the baroclinic accelerations - !! that were fed into the barotopic calculation [m s-2] + !! that were fed into the barotopic calculation [L T-2 ~> m s-2] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: visc_rem_v !< Both the fraction of the meridional momentum originally in !! a layer that remains after a time-step of viscosity, and the @@ -97,7 +97,7 @@ module MOM_dynamics_split_RK2 real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: v_accel_bt !< The meridional layer accelerations due to the difference between !! the barotropic accelerations and the baroclinic accelerations - !! that were fed into the barotopic calculation [m s-2] + !! that were fed into the barotopic calculation [L T-2 ~> m s-2] ! The following variables are only used with the split time stepping scheme. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta !< Instantaneous free surface height (in Boussinesq @@ -105,26 +105,28 @@ module MOM_dynamics_split_RK2 !! mode) [H ~> m or kg m-2] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: u_av !< layer x-velocity with vertical mean replaced by !! time-mean barotropic velocity over a baroclinic - !! timestep [m s-1] + !! timestep [L T-1 ~> m s-1] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: v_av !< layer y-velocity with vertical mean replaced by !! time-mean barotropic velocity over a baroclinic - !! timestep [m s-1] + !! timestep [L T-1 ~> m s-1] real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: h_av !< arithmetic mean of two successive layer !! thicknesses [H ~> m or kg m-2] real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_PF !< instantaneous SSH used in calculating PFu and !! PFv [H ~> m or kg m-2] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: uhbt !< average x-volume or mass flux determined by the - !! barotropic solver [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! barotropic solver [H L2 T-1 ~> m3 s-1 or kg s-1]. !! uhbt is roughly equal to the vertical sum of uh. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vhbt !< average y-volume or mass flux determined by the - !! barotropic solver [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! barotropic solver [H L2 T-1 ~> m3 s-1 or kg s-1]. !! vhbt is roughly equal to vertical sum of vh. real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: pbce !< pbce times eta gives the baroclinic pressure !! anomaly in each layer due to free surface height !! anomalies [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2]. - real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean to the seafloor [Pa] - real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean to the seafloor [Pa] + real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean + !! to the seafloor [kg L Z T-2 m-3 ~> Pa] + real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean + !! to the seafloor [kg L Z T-2 m-3 ~> Pa] type(BT_cont_type), pointer :: BT_cont => NULL() !< A structure with elements that describe the !! effective summed open face areas as a function !! of barotropic flow. @@ -238,9 +240,9 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - target, intent(inout) :: u !< zonal velocity [m s-1] + target, intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - target, intent(inout) :: v !< merid velocity [m s-1] + target, intent(inout) :: v !< merid velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< thermodynamic type @@ -254,16 +256,16 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !! time step [Pa] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & target, intent(inout) :: uh !< zonal volume/mass transport - !! [H m2 s-1 ~> m3 s-1 or kg s-1] + !! [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & target, intent(inout) :: vh !< merid volume/mass transport - !! [H m2 s-1 ~> m3 s-1 or kg s-1] + !! [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(inout) :: uhtr !< accumulatated zonal volume/mass transport - !! since last tracer advection [H m2 ~> m3 or kg] + !! since last tracer advection [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(inout) :: vhtr !< accumulatated merid volume/mass transport - !! since last tracer advection [H m2 ~> m3 or kg] + !! since last tracer advection [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< free surface height or column mass time !! averaged over time step [H ~> m or kg m-2] type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure @@ -276,21 +278,19 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !! fields related to the surface wave conditions ! local variables - real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping. - - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up ! Predicted zonal velocity [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp ! Predicted meridional velocity [m s-1]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up ! Predicted zonal velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp ! Predicted meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: hp ! Predicted thickness [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u_bc_accel real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v_bc_accel ! u_bc_accel and v_bc_accel are the summed baroclinic accelerations of each - ! layer calculated by the non-barotropic part of the model [m s-2]. + ! layer calculated by the non-barotropic part of the model [L T-2 ~> m s-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target :: uh_in real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target :: vh_in ! uh_in and vh_in are the zonal or meridional mass transports that would be - ! obtained using the initial velocities [H m2 s-1 ~> m3 s-1 or kg s-1]. + ! obtained using the initial velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G),SZJ_(G)) :: uhbt_out real, dimension(SZI_(G),SZJB_(G)) :: vhbt_out @@ -301,16 +301,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! eta_pred is the predictor value of the free surface height or column mass, ! [H ~> m or kg m-2]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target :: u_adj - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target :: v_adj - ! u_adj and v_adj are the zonal or meridional velocities after u and v - ! have been barotropically adjusted so the resulting transports match - ! uhbt_out and vhbt_out [m s-1]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u_old_rad_OBC real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v_old_rad_OBC ! u_old_rad_OBC and v_old_rad_OBC are the starting velocities, which are - ! saved for use in the Flather open boundary condition code [m s-1]. + ! saved for use in the Flather open boundary condition code [L T-1 ~> m s-1]. real :: Pa_to_eta ! A factor that converts pressures to the units of eta. real, pointer, dimension(:,:) :: & @@ -320,11 +314,13 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & real, pointer, dimension(:,:,:) :: & uh_ptr => NULL(), u_ptr => NULL(), vh_ptr => NULL(), v_ptr => NULL(), & - u_init => NULL(), v_init => NULL(), & ! Pointers to u and v or u_adj and v_adj. - u_av, & ! The zonal velocity time-averaged over a time step [m s-1]. - v_av, & ! The meridional velocity time-averaged over a time step [m s-1]. + u_av, & ! The zonal velocity time-averaged over a time step [L T-1 ~> m s-1]. + v_av, & ! The meridional velocity time-averaged over a time step [L T-1 ~> m s-1]. h_av ! The layer thickness time-averaged over a time step [H ~> m or kg m-2]. - real :: Idt + real :: dt_in_T ! The dynamics time step [T ~> s] + real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping [T ~> s]. + + real :: Idt ! The inverse of the timestep [s-1] logical :: dyn_p_surf logical :: BT_cont_BT_thick ! If true, use the BT_cont_type to estimate the ! relative weightings of the layers in calculating @@ -337,6 +333,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB u_av => CS%u_av ; v_av => CS%v_av ; h_av => CS%h_av ; eta => CS%eta + + dt_in_T = US%s_to_T*dt Idt = 1.0 / dt sym=.false.;if (G%Domain%symmetric) sym=.true. ! switch to include symmetric domain in checksums @@ -345,7 +343,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (showCallTree) call callTree_enter("step_MOM_dyn_split_RK2(), MOM_dynamics_split_RK2.F90") !$OMP parallel do default(shared) - do k = 1, nz + do k=1,nz do j=G%jsd,G%jed ; do i=G%isdB,G%iedB ; up(i,j,k) = 0.0 ; enddo ; enddo do j=G%jsdB,G%jedB ; do i=G%isd,G%ied ; vp(i,j,k) = 0.0 ; enddo ; enddo do j=G%jsd,G%jed ; do i=G%isd,G%ied ; hp(i,j,k) = h(i,j,k) ; enddo ; enddo @@ -355,7 +353,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call updateCFLtruncationValue(Time_local, CS%vertvisc_CSp) if (CS%debug) then - call MOM_state_chksum("Start predictor ", u, v, h, uh, vh, G, GV, symmetric=sym) + call MOM_state_chksum("Start predictor ", u, v, h, uh, vh, G, GV, US, symmetric=sym) call check_redundant("Start predictor u ", u, v, G) call check_redundant("Start predictor uh ", uh, vh, G) endif @@ -449,10 +447,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq - u_bc_accel(I,j,k) = (CS%Cau(I,j,k) + CS%PFu(I,j,k)) + US%s_to_T*CS%diffu(I,j,k) + u_bc_accel(I,j,k) = (CS%CAu(I,j,k) + CS%PFu(I,j,k)) + CS%diffu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - v_bc_accel(i,J,k) = (CS%Cav(i,J,k) + CS%PFv(i,J,k)) + US%s_to_T*CS%diffv(i,J,k) + v_bc_accel(i,J,k) = (CS%CAv(i,J,k) + CS%PFv(i,J,k)) + CS%diffv(i,J,k) enddo ; enddo enddo if (associated(CS%OBC)) then @@ -474,10 +472,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq - up(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt * u_bc_accel(I,j,k)) + up(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt_in_T * u_bc_accel(I,j,k)) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - vp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt * v_bc_accel(i,J,k)) + vp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt_in_T * v_bc_accel(i,J,k)) enddo ; enddo enddo @@ -518,9 +516,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! u_accel_bt = layer accelerations due to barotropic solver if (associated(CS%BT_cont) .or. CS%BT_use_layer_fluxes) then call cpu_clock_begin(id_clock_continuity) - call continuity(u, v, h, hp, uh_in, vh_in, dt, G, GV, US, & - CS%continuity_CSp, OBC=CS%OBC, visc_rem_u=CS%visc_rem_u, & - visc_rem_v=CS%visc_rem_v, BT_cont=CS%BT_cont) + call continuity(u, v, h, hp, uh_in, vh_in, dt_in_T, G, GV, US, CS%continuity_CSp, & + OBC=CS%OBC, visc_rem_u=CS%visc_rem_u, visc_rem_v=CS%visc_rem_v, BT_cont=CS%BT_cont) call cpu_clock_end(id_clock_continuity) if (BT_cont_BT_thick) then call btcalc(h, G, GV, CS%barotropic_CSp, CS%BT_cont%h_u, CS%BT_cont%h_v, & @@ -530,10 +527,9 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & endif if (CS%BT_use_layer_fluxes) then - uh_ptr => uh_in; vh_ptr => vh_in; u_ptr => u; v_ptr => v + uh_ptr => uh_in ; vh_ptr => vh_in; u_ptr => u ; v_ptr => v endif - u_init => u ; v_init => v call cpu_clock_begin(id_clock_btstep) if (calc_dtbt) call set_dtbt(G, GV, US, CS%barotropic_CSp, eta, CS%pbce) if (showCallTree) call callTree_enter("btstep(), MOM_barotropic.F90") @@ -548,31 +544,31 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call cpu_clock_end(id_clock_btstep) ! up = u + dt_pred*( u_bc_accel + u_accel_bt ) - dt_pred = dt * CS%be + dt_pred = dt_in_T * CS%be call cpu_clock_begin(id_clock_mom_update) !$OMP parallel do default(shared) do k=1,nz do J=Jsq,Jeq ; do i=is,ie - vp(i,J,k) = G%mask2dCv(i,J) * (v_init(i,J,k) + dt_pred * & + vp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt_pred * & (v_bc_accel(i,J,k) + CS%v_accel_bt(i,J,k))) enddo ; enddo do j=js,je ; do I=Isq,Ieq - up(I,j,k) = G%mask2dCu(I,j) * (u_init(I,j,k) + dt_pred * & + up(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt_pred * & (u_bc_accel(I,j,k) + CS%u_accel_bt(I,j,k))) enddo ; enddo enddo call cpu_clock_end(id_clock_mom_update) if (CS%debug) then - call uvchksum("Predictor 1 [uv]", up, vp, G%HI, haloshift=0, symmetric=sym) + call uvchksum("Predictor 1 [uv]", up, vp, G%HI, haloshift=0, symmetric=sym, scale=US%L_T_to_m_s) call hchksum(h, "Predictor 1 h", G%HI, haloshift=1, scale=GV%H_to_m) call uvchksum("Predictor 1 [uv]h", uh, vh, G%HI,haloshift=2, & - symmetric=sym, scale=GV%H_to_m) -! call MOM_state_chksum("Predictor 1", up, vp, h, uh, vh, G, GV, haloshift=1) + symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) +! call MOM_state_chksum("Predictor 1", up, vp, h, uh, vh, G, GV, US, haloshift=1) call MOM_accel_chksum("Predictor accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US, CS%pbce, CS%u_accel_bt, CS%v_accel_bt, symmetric=sym) - call MOM_state_chksum("Predictor 1 init", u_init, v_init, h, uh, vh, G, GV, haloshift=2, & + call MOM_state_chksum("Predictor 1 init", u, v, h, uh, vh, G, GV, US, haloshift=2, & symmetric=sym) call check_redundant("Predictor 1 up", up, vp, G) call check_redundant("Predictor 1 uh", uh, vh, G) @@ -582,11 +578,11 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! u_av <- u_av + dt_pred d/dz visc d/dz u_av call cpu_clock_begin(id_clock_vertvisc) if (CS%debug) then - call uvchksum("0 before vertvisc: [uv]p", up, vp, G%HI,haloshift=0, symmetric=sym) + call uvchksum("0 before vertvisc: [uv]p", up, vp, G%HI,haloshift=0, symmetric=sym, scale=US%L_T_to_m_s) endif - call vertvisc_coef(up, vp, h, forces, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, & + call vertvisc_coef(up, vp, h, forces, visc, US%T_to_s*dt_pred, G, GV, US, CS%vertvisc_CSp, & CS%OBC) - call vertvisc(up, vp, h, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, G, & + call vertvisc(up, vp, h, forces, visc, US%T_to_s*dt_pred, CS%OBC, CS%ADp, CS%CDp, G, & GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, waves=waves) if (showCallTree) call callTree_wayPoint("done with vertvisc (step_MOM_dyn_split_RK2)") if (G%nonblocking_updates) then @@ -594,7 +590,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call start_group_pass(CS%pass_uvp, G%Domain, clock=id_clock_pass) call cpu_clock_begin(id_clock_vertvisc) endif - call vertvisc_remnant(visc, CS%visc_rem_u, CS%visc_rem_v, dt_pred, G, GV, US, CS%vertvisc_CSp) + call vertvisc_remnant(visc, CS%visc_rem_u, CS%visc_rem_v, US%T_to_s*dt_pred, G, GV, US, CS%vertvisc_CSp) call cpu_clock_end(id_clock_vertvisc) call do_group_pass(CS%pass_visc_rem, G%Domain, clock=id_clock_pass) @@ -607,7 +603,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! uh = u_av * h ! hp = h + dt * div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(up, vp, h, hp, uh, vh, dt, G, GV, US, CS%continuity_CSp, & + call continuity(up, vp, h, hp, uh, vh, dt_in_T, G, GV, US, CS%continuity_CSp, & CS%uhbt, CS%vhbt, CS%OBC, CS%visc_rem_u, CS%visc_rem_v, & u_av, v_av, BT_cont=CS%BT_cont) call cpu_clock_end(id_clock_continuity) @@ -618,12 +614,12 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (associated(CS%OBC)) then if (CS%debug) & - call uvchksum("Pre OBC avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym) + call uvchksum("Pre OBC avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) - call radiation_open_bdry_conds(CS%OBC, u_av, u_old_rad_OBC, v_av, v_old_rad_OBC, G, dt_pred) + call radiation_open_bdry_conds(CS%OBC, u_av, u_old_rad_OBC, v_av, v_old_rad_OBC, G, US, US%T_to_s*dt_pred) if (CS%debug) & - call uvchksum("Post OBC avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym) + call uvchksum("Post OBC avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) ! These should be done with a pass that excludes uh & vh. ! call do_group_pass(CS%pass_hp_uv, G%Domain, clock=id_clock_pass) @@ -678,10 +674,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & endif if (CS%debug) then - call MOM_state_chksum("Predictor ", up, vp, hp, uh, vh, G, GV, symmetric=sym) + call MOM_state_chksum("Predictor ", up, vp, hp, uh, vh, G, GV, US, symmetric=sym) call uvchksum("Predictor avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym) call hchksum(h_av, "Predictor avg h", G%HI, haloshift=0, scale=GV%H_to_m) - ! call MOM_state_chksum("Predictor avg ", u_av, v_av, h_av, uh, vh, G, GV) + ! call MOM_state_chksum("Predictor avg ", u_av, v_av, h_av, uh, vh, G, GV, US) call check_redundant("Predictor up ", up, vp, G) call check_redundant("Predictor uh ", uh, vh, G) endif @@ -708,10 +704,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq - u_bc_accel(I,j,k) = (CS%Cau(I,j,k) + CS%PFu(I,j,k)) + US%s_to_T*CS%diffu(I,j,k) + u_bc_accel(I,j,k) = (CS%Cau(I,j,k) + CS%PFu(I,j,k)) + CS%diffu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - v_bc_accel(i,J,k) = (CS%Cav(i,J,k) + CS%PFv(i,J,k)) + US%s_to_T*CS%diffv(i,J,k) + v_bc_accel(i,J,k) = (CS%Cav(i,J,k) + CS%PFv(i,J,k)) + CS%diffv(i,J,k) enddo ; enddo enddo if (associated(CS%OBC)) then @@ -746,6 +742,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & taux_bot=taux_bot, tauy_bot=tauy_bot, & uh0=uh_ptr, vh0=vh_ptr, u_uh0=u_ptr, v_vh0=v_ptr) do j=js,je ; do i=is,ie ; eta(i,j) = eta_pred(i,j) ; enddo ; enddo + call cpu_clock_end(id_clock_btstep) if (showCallTree) call callTree_leave("btstep()") @@ -758,22 +755,22 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq - u(I,j,k) = G%mask2dCu(I,j) * (u_init(I,j,k) + dt * & + u(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt_in_T * & (u_bc_accel(I,j,k) + CS%u_accel_bt(I,j,k))) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - v(i,J,k) = G%mask2dCv(i,J) * (v_init(i,J,k) + dt * & + v(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt_in_T * & (v_bc_accel(i,J,k) + CS%v_accel_bt(i,J,k))) enddo ; enddo enddo call cpu_clock_end(id_clock_mom_update) if (CS%debug) then - call uvchksum("Corrector 1 [uv]", u, v, G%HI,haloshift=0, symmetric=sym) + call uvchksum("Corrector 1 [uv]", u, v, G%HI,haloshift=0, symmetric=sym, scale=US%L_T_to_m_s) call hchksum(h, "Corrector 1 h", G%HI, haloshift=2, scale=GV%H_to_m) call uvchksum("Corrector 1 [uv]h", uh, vh, G%HI, haloshift=2, & - symmetric=sym, scale=GV%H_to_m) - ! call MOM_state_chksum("Corrector 1", u, v, h, uh, vh, G, GV, haloshift=1) + symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) + ! call MOM_state_chksum("Corrector 1", u, v, h, uh, vh, G, GV, US, haloshift=1) call MOM_accel_chksum("Corrector accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US, CS%pbce, CS%u_accel_bt, CS%v_accel_bt, & symmetric=sym) @@ -811,9 +808,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! h = h + dt * div . uh ! u_av and v_av adjusted so their mass transports match uhbt and vhbt. call cpu_clock_begin(id_clock_continuity) - call continuity(u, v, h, h, uh, vh, dt, G, GV, US, & - CS%continuity_CSp, CS%uhbt, CS%vhbt, CS%OBC, & - CS%visc_rem_u, CS%visc_rem_v, u_av, v_av) + call continuity(u, v, h, h, uh, vh, dt_in_T, G, GV, US, CS%continuity_CSp, & + CS%uhbt, CS%vhbt, CS%OBC, CS%visc_rem_u, CS%visc_rem_v, u_av, v_av) call cpu_clock_end(id_clock_continuity) call do_group_pass(CS%pass_h, G%Domain, clock=id_clock_pass) ! Whenever thickness changes let the diag manager know, target grids @@ -828,7 +824,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & endif if (associated(CS%OBC)) then - call radiation_open_bdry_conds(CS%OBC, u, u_old_rad_OBC, v, v_old_rad_OBC, G, dt) + call radiation_open_bdry_conds(CS%OBC, u, u_old_rad_OBC, v, v_old_rad_OBC, G, US, dt) endif ! h_av = (h_in + h_out)/2 . Going in to this line, h_av = h_in. @@ -843,10 +839,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do j=js-2,je+2 ; do I=Isq-2,Ieq+2 - uhtr(I,j,k) = uhtr(I,j,k) + uh(I,j,k)*dt + uhtr(I,j,k) = uhtr(I,j,k) + uh(I,j,k)*dt_in_T enddo ; enddo do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 - vhtr(i,J,k) = vhtr(i,J,k) + vh(i,J,k)*dt + vhtr(i,J,k) = vhtr(i,J,k) + vh(i,J,k)*dt_in_T enddo ; enddo enddo @@ -869,10 +865,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (CS%id_v_BT_accel > 0) call post_data(CS%id_v_BT_accel, CS%v_accel_bt, CS%diag) if (CS%debug) then - call MOM_state_chksum("Corrector ", u, v, h, uh, vh, G, GV, symmetric=sym) - call uvchksum("Corrector avg [uv]", u_av, v_av, G%HI,haloshift=1, symmetric=sym) + call MOM_state_chksum("Corrector ", u, v, h, uh, vh, G, GV, US, symmetric=sym, vel_scale=1.0) + call uvchksum("Corrector avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) call hchksum(h_av, "Corrector avg h", G%HI, haloshift=1, scale=GV%H_to_m) - ! call MOM_state_chksum("Corrector avg ", u_av, v_av, h_av, uh, vh, G, GV) + ! call MOM_state_chksum("Corrector avg ", u_av, v_av, h_av, uh, vh, G, GV, US) endif if (showCallTree) call callTree_leave("step_MOM_dyn_split_RK2()") @@ -889,9 +885,9 @@ subroutine register_restarts_dyn_split_RK2(HI, GV, param_file, CS, restart_CS, u type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure type(MOM_restart_CS), pointer :: restart_CS !< restart control structure real, dimension(SZIB_(HI),SZJ_(HI),SZK_(GV)), & - target, intent(inout) :: uh !< zonal volume/mass transport [H m2 s-1 ~> m3 s-1 or kg s-1] + target, intent(inout) :: uh !< zonal volume/mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(HI),SZJB_(HI),SZK_(GV)), & - target, intent(inout) :: vh !< merid volume/mass transport [H m2 s-1 ~> m3 s-1 or kg s-1] + target, intent(inout) :: vh !< merid volume/mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] type(vardesc) :: vd character(len=40) :: mdl = "MOM_dynamics_split_RK2" ! This module's name. @@ -968,14 +964,14 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: u !< zonal velocity [m s-1] + intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(inout) :: v !< merid velocity [m s-1] + intent(inout) :: v !< merid velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - target, intent(inout) :: uh !< zonal volume/mass transport [H m2 s-1 ~> m3 s-1 or kg s-1] + target, intent(inout) :: uh !< zonal volume/mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - target, intent(inout) :: vh !< merid volume/mass transport [H m2 s-1 ~> m3 s-1 or kg s-1] + target, intent(inout) :: vh !< merid volume/mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: eta !< free surface height or column mass [H ~> m or kg m-2] type(time_type), target, intent(in) :: Time !< current model time type(param_file_type), intent(in) :: param_file !< parameter file for parsing @@ -1011,8 +1007,12 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param character(len=48) :: thickness_units, flux_units, eta_rest_name real :: H_rescale ! A rescaling factor for thicknesses from the representation in ! a restart file to the internal representation in this run. + real :: vel_rescale ! A rescaling factor for velocities from the representation in + ! a restart file to the internal representation in this run. real :: uH_rescale ! A rescaling factor for thickness transports from the representation in ! a restart file to the internal representation in this run. + real :: accel_rescale ! A rescaling factor for accelerations from the representation in + ! a restart file to the internal representation in this run. real :: H_convert type(group_pass_type) :: pass_av_h_uvh logical :: use_tides, debug_truncations @@ -1105,8 +1105,8 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param ! Accel_diag%u_accel_bt => CS%u_accel_bt ; Accel_diag%v_accel_bt => CS%v_accel_bt ! Accel_diag%u_av => CS%u_av ; Accel_diag%v_av => CS%v_av - call continuity_init(Time, G, GV, param_file, diag, CS%continuity_CSp) - call CoriolisAdv_init(Time, G, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) + call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp) + call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) @@ -1148,23 +1148,43 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param CS%tides_CSp) if (.not. query_initialized(CS%diffu,"diffu",restart_CS) .or. & - .not. query_initialized(CS%diffv,"diffv",restart_CS)) & + .not. query_initialized(CS%diffv,"diffv",restart_CS)) then call horizontal_viscosity(u, v, h, CS%diffu, CS%diffv, MEKE, VarMix, & G, GV, US, CS%hor_visc_CSp, & OBC=CS%OBC, BT=CS%barotropic_CSp) + else + if ( (US%s_to_T_restart * US%m_to_L_restart /= 0.0) .and. & + (US%m_to_L * US%s_to_T_restart**2 /= US%m_to_L_restart * US%s_to_T**2) ) then + accel_rescale = (US%m_to_L * US%s_to_T_restart**2) / (US%m_to_L_restart * US%s_to_T**2) + do k=1,nz ; do j=js,je ; do I=G%IscB,G%IecB + CS%diffu(I,j,k) = accel_rescale * CS%diffu(I,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do J=G%JscB,G%JecB ; do i=is,ie + CS%diffv(i,J,k) = accel_rescale * CS%diffv(i,J,k) + enddo ; enddo ; enddo + endif + endif + if (.not. query_initialized(CS%u_av,"u2", restart_CS) .or. & .not. query_initialized(CS%u_av,"v2", restart_CS)) then - CS%u_av(:,:,:) = u(:,:,:) - CS%v_av(:,:,:) = v(:,:,:) + do k=1,nz ; do j=jsd,jed ; do I=IsdB,IedB ; CS%u_av(I,j,k) = u(I,j,k) ; enddo ; enddo ; enddo + do k=1,nz ; do J=JsdB,JedB ; do i=isd,ied ; CS%v_av(i,J,k) = v(i,J,k) ; enddo ; enddo ; enddo + elseif ( (US%s_to_T_restart * US%m_to_L_restart /= 0.0) .and. & + ((US%m_to_L * US%s_to_T_restart) /= (US%m_to_L_restart * US%s_to_T)) ) then + vel_rescale = (US%m_to_L * US%s_to_T_restart) / (US%m_to_L_restart * US%s_to_T) + do k=1,nz ; do j=jsd,jed ; do I=IsdB,IeDB ; CS%u_av(I,j,k) = vel_rescale * CS%u_av(I,j,k) ; enddo ; enddo ; enddo + do k=1,nz ; do J=JsdB,JedB ; do i=isd,ied ; CS%v_av(i,J,k) = vel_rescale * CS%v_av(i,J,k) ; enddo ; enddo ; enddo endif ! This call is just here to initialize uh and vh. if (.not. query_initialized(uh,"uh",restart_CS) .or. & .not. query_initialized(vh,"vh",restart_CS)) then - h_tmp(:,:,:) = h(:,:,:) - call continuity(u, v, h, h_tmp, uh, vh, dt, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) + do k=1,nz ; do j=jsd,jed ; do i=isd,ied ; h_tmp(i,j,k) = h(i,j,k) ; enddo ; enddo ; enddo + call continuity(u, v, h, h_tmp, uh, vh, US%s_to_T*dt, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) call pass_var(h_tmp, G%Domain, clock=id_clock_pass_init) - CS%h_av(:,:,:) = 0.5*(h(:,:,:) + h_tmp(:,:,:)) + do k=1,nz ; do j=jsd,jed ; do i=isd,ied + CS%h_av(i,j,k) = 0.5*(h(i,j,k) + h_tmp(i,j,k)) + enddo ; enddo ; enddo else if (.not. query_initialized(CS%h_av,"h2",restart_CS)) then CS%h_av(:,:,:) = h(:,:,:) @@ -1172,8 +1192,11 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param H_rescale = GV%m_to_H / GV%m_to_H_restart do k=1,nz ; do j=js,je ; do i=is,ie ; CS%h_av(i,j,k) = H_rescale * CS%h_av(i,j,k) ; enddo ; enddo ; enddo endif - if ((GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= GV%m_to_H)) then - uH_rescale = GV%m_to_H / GV%m_to_H_restart + if ( (GV%m_to_H_restart * US%s_to_T_restart * US%m_to_L_restart /= 0.0) .and. & + ((GV%m_to_H * US%m_to_L**2 * US%s_to_T_restart) /= & + (GV%m_to_H_restart * US%m_to_L_restart**2 * US%s_to_T)) ) then + uH_rescale = (GV%m_to_H * US%m_to_L**2 * US%s_to_T_restart) / & + (GV%m_to_H_restart * US%m_to_L_restart**2 * US%s_to_T) do k=1,nz ; do j=js,je ; do I=G%IscB,G%IecB ; uh(I,j,k) = uH_rescale * uh(I,j,k) ; enddo ; enddo ; enddo do k=1,nz ; do J=G%JscB,G%JecB ; do i=is,ie ; vh(i,J,k) = uH_rescale * vh(i,J,k) ; enddo ; enddo ; enddo endif @@ -1190,29 +1213,29 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param H_convert = GV%H_to_m ; if (.not.GV%Boussinesq) H_convert = GV%H_to_kg_m2 CS%id_uh = register_diag_field('ocean_model', 'uh', diag%axesCuL, Time, & 'Zonal Thickness Flux', flux_units, y_cell_method='sum', v_extensive=.true., & - conversion=H_convert) + conversion=H_convert*US%L_to_m**2*US%s_to_T) CS%id_vh = register_diag_field('ocean_model', 'vh', diag%axesCvL, Time, & 'Meridional Thickness Flux', flux_units, x_cell_method='sum', v_extensive=.true., & - conversion=H_convert) + conversion=H_convert*US%L_to_m**2*US%s_to_T) CS%id_CAu = register_diag_field('ocean_model', 'CAu', diag%axesCuL, Time, & - 'Zonal Coriolis and Advective Acceleration', 'm s-2') + 'Zonal Coriolis and Advective Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_CAv = register_diag_field('ocean_model', 'CAv', diag%axesCvL, Time, & - 'Meridional Coriolis and Advective Acceleration', 'm s-2') + 'Meridional Coriolis and Advective Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_PFu = register_diag_field('ocean_model', 'PFu', diag%axesCuL, Time, & - 'Zonal Pressure Force Acceleration', 'm s-2') + 'Zonal Pressure Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_PFv = register_diag_field('ocean_model', 'PFv', diag%axesCvL, Time, & - 'Meridional Pressure Force Acceleration', 'm s-2') + 'Meridional Pressure Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_uav = register_diag_field('ocean_model', 'uav', diag%axesCuL, Time, & - 'Barotropic-step Averaged Zonal Velocity', 'm s-1') + 'Barotropic-step Averaged Zonal Velocity', 'm s-1', conversion=US%L_T_to_m_s) CS%id_vav = register_diag_field('ocean_model', 'vav', diag%axesCvL, Time, & - 'Barotropic-step Averaged Meridional Velocity', 'm s-1') + 'Barotropic-step Averaged Meridional Velocity', 'm s-1', conversion=US%L_T_to_m_s) CS%id_u_BT_accel = register_diag_field('ocean_model', 'u_BT_accel', diag%axesCuL, Time, & - 'Barotropic Anomaly Zonal Acceleration', 'm s-1') + 'Barotropic Anomaly Zonal Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_v_BT_accel = register_diag_field('ocean_model', 'v_BT_accel', diag%axesCvL, Time, & - 'Barotropic Anomaly Meridional Acceleration', 'm s-1') + 'Barotropic Anomaly Meridional Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) id_clock_Cor = cpu_clock_id('(Ocean Coriolis & mom advection)', grain=CLOCK_MODULE) id_clock_continuity = cpu_clock_id('(Ocean continuity equation)', grain=CLOCK_MODULE) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 07c4648b87..108f4c8943 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -107,17 +107,19 @@ module MOM_dynamics_unsplit !> MOM_dynamics_unsplit module control structure type, public :: MOM_dyn_unsplit_CS ; private real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & - CAu, & !< CAu = f*v - u.grad(u) [m s-2]. - PFu, & !< PFu = -dM/dx [m s-2]. - diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [m s-1 T-1 ~> mm s-2]. + CAu, & !< CAu = f*v - u.grad(u) [L T-2 ~> m s-2]. + PFu, & !< PFu = -dM/dx [L T-2 ~> m s-2]. + diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> m s-2]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & - CAv, & !< CAv = -f*u - u.grad(v) [m s-2]. - PFv, & !< PFv = -dM/dy [m s-2]. - diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [m s-1 T-1 ~> m s-2]. + CAv, & !< CAv = -f*u - u.grad(v) [L T-2 ~> m s-2]. + PFv, & !< PFv = -dM/dy [L T-2 ~> m s-2]. + diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> m s-2]. - real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean to the seafloor (Pa) - real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean to the seafloor (Pa) + real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean + !! to the seafloor [kg L Z T-2 m-3 ~> Pa] + real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean + !! to the seafloor [kg L Z T-2 m-3 ~> Pa] logical :: debug !< If true, write verbose checksums for debugging purposes. @@ -187,8 +189,8 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< The meridional velocity [m s-1]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. @@ -203,13 +205,13 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & real, dimension(:,:), pointer :: p_surf_end !< A pointer (perhaps NULL) to the surface !! pressure at the end of this dynamic step [Pa]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh !< The zonal volume or mass transport - !! [H m2 s-1 ~> m3 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh !< The meridional volume or mass - !! transport [H m2 s-1 ~> m3 or kg s-1]. + !! transport [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< The accumulated zonal volume or mass - !! transport since the last tracer advection [H m2 ~> m3 or kg]. + !! transport since the last tracer advection [H L2 ~> m3 or kg]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< The accumulated meridional volume or mass - !! transport since the last tracer advection [H m2 ~> m3 or kg]. + !! transport since the last tracer advection [H L2 ~> m3 or kg]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< The time-mean free surface height or !! column mass [H ~> m or kg m-2]. type(MOM_dyn_unsplit_CS), pointer :: CS !< The control structure set up by @@ -222,17 +224,18 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & !! fields related to the surface wave conditions ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_av, hp - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up, upp - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp, vpp + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_av, hp ! Prediced or averaged layer thicknesses [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up, upp ! Predicted zonal velocities [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp, vpp ! Predicted meridional velocities [L T-1 ~> m s-1] real, dimension(:,:), pointer :: p_surf => NULL() - real :: dt_pred ! The time step for the predictor part of the baroclinic - ! time stepping. + real :: dt_in_T ! The dynamics time step [T ~> s] + real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping [T ~> s]. logical :: dyn_p_surf integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - dt_pred = dt / 3.0 + dt_in_T = US%s_to_T*dt + dt_pred = dt_in_T / 3.0 h_av(:,:,:) = 0; hp(:,:,:) = 0 up(:,:,:) = 0; upp(:,:,:) = 0 @@ -249,7 +252,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! all of the fields except h. h is stepped separately. if (CS%debug) then - call MOM_state_chksum("Start First Predictor ", u, v, h, uh, vh, G, GV) + call MOM_state_chksum("Start First Predictor ", u, v, h, uh, vh, G, GV, US) endif ! diffu = horizontal viscosity terms (u,h) @@ -263,8 +266,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! uh = u*h ! hp = h + dt/2 div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(u, v, h, hp, uh, vh, dt*0.5, G, GV, US, CS%continuity_CSp, & - OBC=CS%OBC) + call continuity(u, v, h, hp, uh, vh, dt_in_T*0.5, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(hp, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -283,16 +285,16 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & h_av(i,j,k) = (h(i,j,k) + hp(i,j,k)) * 0.5 enddo ; enddo do j=js,je ; do I=Isq,Ieq - u(I,j,k) = u(I,j,k) + dt * US%s_to_T*CS%diffu(I,j,k) * G%mask2dCu(I,j) + u(I,j,k) = u(I,j,k) + dt_in_T * CS%diffu(I,j,k) * G%mask2dCu(I,j) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - v(i,J,k) = v(i,J,k) + dt * US%s_to_T*CS%diffv(i,J,k) * G%mask2dCv(i,J) + v(i,J,k) = v(i,J,k) + dt_in_T * CS%diffv(i,J,k) * G%mask2dCv(i,J) enddo ; enddo do j=js-2,je+2 ; do I=Isq-2,Ieq+2 - uhtr(i,j,k) = uhtr(i,j,k) + 0.5*dt*uh(i,j,k) + uhtr(i,j,k) = uhtr(i,j,k) + 0.5*dt_in_T*uh(i,j,k) enddo ; enddo do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 - vhtr(i,j,k) = vhtr(i,j,k) + 0.5*dt*vh(i,j,k) + vhtr(i,j,k) = vhtr(i,j,k) + 0.5*dt_in_T*vh(i,j,k) enddo ; enddo enddo call cpu_clock_end(id_clock_mom_update) @@ -334,7 +336,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call cpu_clock_end(id_clock_mom_update) if (CS%debug) then - call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV) + call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV, US) call MOM_accel_chksum("Predictor 1 accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv,& CS%diffu, CS%diffv, G, GV, US) endif @@ -345,6 +347,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call set_viscous_ML(u, v, h_av, tv, forces, visc, dt*0.5, G, GV, US, & CS%set_visc_CSp) call disable_averaging(CS%diag) + !### I think that the time steps in the next two calls should be dt_pred. call vertvisc_coef(up, vp, h_av, forces, visc, dt*0.5, G, GV, US, & CS%vertvisc_CSp, CS%OBC) call vertvisc(up, vp, h_av, forces, visc, dt*0.5, CS%OBC, CS%ADp, CS%CDp, & @@ -355,8 +358,8 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! uh = up * hp ! h_av = hp + dt/2 div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(up, vp, hp, h_av, uh, vh, & - (0.5*dt), G, GV, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(up, vp, hp, h_av, uh, vh, (0.5*dt_in_T), G, GV, US, & + CS%continuity_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(h_av, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -392,17 +395,17 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! upp = u + dt/2 * ( PFu + CAu ) call cpu_clock_begin(id_clock_mom_update) do k=1,nz ; do j=js,je ; do I=Isq,Ieq - upp(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt * 0.5 * & - (CS%PFu(I,j,k) + CS%CAu(I,j,k))) + upp(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt_in_T * 0.5 * & + (CS%PFu(I,j,k) + CS%CAu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - vpp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt * 0.5 * & - (CS%PFv(i,J,k) + CS%CAv(i,J,k))) + vpp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt_in_T * 0.5 * & + (CS%PFv(i,J,k) + CS%CAv(i,J,k))) enddo ; enddo ; enddo call cpu_clock_end(id_clock_mom_update) if (CS%debug) then - call MOM_state_chksum("Predictor 2", upp, vpp, h_av, uh, vh, G, GV) + call MOM_state_chksum("Predictor 2", upp, vpp, h_av, uh, vh, G, GV, US) call MOM_accel_chksum("Predictor 2 accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv,& CS%diffu, CS%diffv, G, GV, US) endif @@ -419,8 +422,8 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! uh = upp * hp ! h = hp + dt/2 div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(upp, vpp, hp, h, uh, vh, & - (dt*0.5), G, GV, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(upp, vpp, hp, h, uh, vh, (dt_in_T*0.5), G, GV, US, & + CS%continuity_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(h, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -441,10 +444,10 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & h_av(i,j,k) = 0.5*(h(i,j,k) + hp(i,j,k)) enddo ; enddo do j=js-2,je+2 ; do I=Isq-2,Ieq+2 - uhtr(i,j,k) = uhtr(i,j,k) + 0.5*dt*uh(i,j,k) + uhtr(i,j,k) = uhtr(i,j,k) + 0.5*dt_in_T*uh(i,j,k) enddo ; enddo do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 - vhtr(i,j,k) = vhtr(i,j,k) + 0.5*dt*vh(i,j,k) + vhtr(i,j,k) = vhtr(i,j,k) + 0.5*dt_in_T*vh(i,j,k) enddo ; enddo enddo @@ -470,12 +473,12 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call open_boundary_zero_normal_flow(CS%OBC, G, CS%CAu, CS%CAv) endif do k=1,nz ; do j=js,je ; do I=Isq,Ieq - u(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt * & - (CS%PFu(I,j,k) + CS%CAu(I,j,k))) + u(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt_in_T * & + (CS%PFu(I,j,k) + CS%CAu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - v(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt * & - (CS%PFv(i,J,k) + CS%CAv(i,J,k))) + v(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt_in_T * & + (CS%PFv(i,J,k) + CS%CAv(i,J,k))) enddo ; enddo ; enddo ! u <- u + dt d/dz visc d/dz u @@ -487,7 +490,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call pass_vector(u, v, G%Domain, clock=id_clock_pass) if (CS%debug) then - call MOM_state_chksum("Corrector", u, v, h, uh, vh, G, GV) + call MOM_state_chksum("Corrector", u, v, h, uh, vh, G, GV, US) call MOM_accel_chksum("Corrector accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US) endif @@ -566,9 +569,9 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: u !< The zonal velocity [m s-1]. + intent(inout) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(inout) :: v !< The meridional velocity [m s-1]. + intent(inout) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , & intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] type(time_type), target, intent(in) :: Time !< The current model time. @@ -650,8 +653,8 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS Accel_diag%PFu => CS%PFu ; Accel_diag%PFv => CS%PFv Accel_diag%CAu => CS%CAu ; Accel_diag%CAv => CS%CAv - call continuity_init(Time, G, GV, param_file, diag, CS%continuity_CSp) - call CoriolisAdv_init(Time, G, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) + call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp) + call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) @@ -670,18 +673,18 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS H_convert = GV%H_to_m ; if (.not.GV%Boussinesq) H_convert = GV%H_to_kg_m2 CS%id_uh = register_diag_field('ocean_model', 'uh', diag%axesCuL, Time, & 'Zonal Thickness Flux', flux_units, y_cell_method='sum', v_extensive=.true., & - conversion=H_convert) + conversion=H_convert*US%L_to_m**2*US%s_to_T) CS%id_vh = register_diag_field('ocean_model', 'vh', diag%axesCvL, Time, & 'Meridional Thickness Flux', flux_units, x_cell_method='sum', v_extensive=.true., & - conversion=H_convert) + conversion=H_convert*US%L_to_m**2*US%s_to_T) CS%id_CAu = register_diag_field('ocean_model', 'CAu', diag%axesCuL, Time, & - 'Zonal Coriolis and Advective Acceleration', 'meter second-2') + 'Zonal Coriolis and Advective Acceleration', 'meter second-2, conversion=US%L_T2_to_m_s2') CS%id_CAv = register_diag_field('ocean_model', 'CAv', diag%axesCvL, Time, & - 'Meridional Coriolis and Advective Acceleration', 'meter second-2') + 'Meridional Coriolis and Advective Acceleration', 'meter second-2', conversion=US%L_T2_to_m_s2) CS%id_PFu = register_diag_field('ocean_model', 'PFu', diag%axesCuL, Time, & - 'Zonal Pressure Force Acceleration', 'meter second-2') + 'Zonal Pressure Force Acceleration', 'meter second-2', conversion=US%L_T2_to_m_s2) CS%id_PFv = register_diag_field('ocean_model', 'PFv', diag%axesCvL, Time, & - 'Meridional Pressure Force Acceleration', 'meter second-2') + 'Meridional Pressure Force Acceleration', 'meter second-2', conversion=US%L_T2_to_m_s2) id_clock_Cor = cpu_clock_id('(Ocean Coriolis & mom advection)', grain=CLOCK_MODULE) id_clock_continuity = cpu_clock_id('(Ocean continuity equation)', grain=CLOCK_MODULE) diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 2ad0c50624..af33db8011 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -26,7 +26,7 @@ module MOM_dynamics_unsplit_RK2 !* The subroutine step_MOM_dyn_unsplit_RK2 actually does the time * !* stepping, while register_restarts_dyn_unsplit_RK2 sets the fields * !* that are found in a full restart file with this scheme, and * -!* initialize_dyn_unsplit_RK2 initializes the cpu clocks that are * * +!* initialize_dyn_unsplit_RK2 initializes the cpu clocks that are * !* used in this module. For largely historical reasons, this module * !* does not have its own control structure, but shares the same * !* control structure with MOM.F90 and the other MOM_dynamics_... * @@ -104,17 +104,19 @@ module MOM_dynamics_unsplit_RK2 !> MOM_dynamics_unsplit_RK2 module control structure type, public :: MOM_dyn_unsplit_RK2_CS ; private real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & - CAu, & !< CAu = f*v - u.grad(u) [m s-2]. - PFu, & !< PFu = -dM/dx [m s-2]. - diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [m s-1 T-1 ~> m s-2]. + CAu, & !< CAu = f*v - u.grad(u) [L T-2 ~> m s-2]. + PFu, & !< PFu = -dM/dx [L T-2 ~> m s-2]. + diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> m s-2]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & - CAv, & !< CAv = -f*u - u.grad(v) [m s-2]. - PFv, & !< PFv = -dM/dy [m s-2]. - diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [m s-1 T-1 ~> m s-2]. + CAv, & !< CAv = -f*u - u.grad(v) [L T-2 ~> m s-2]. + PFv, & !< PFv = -dM/dy [L T-2 ~> m s-2]. + diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> m s-2]. - real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean to the seafloor (Pa) - real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean to the seafloor (Pa) + real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean + !! to the seafloor [kg L Z T-2 m-3 ~> Pa] + real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean + !! to the seafloor [kg L Z T-2 m-3 ~> Pa] real :: be !< A nondimensional number from 0.5 to 1 that controls !! the backward weighting of the time stepping scheme. @@ -191,9 +193,9 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u_in !< The input and output zonal - !! velocity [m s-1]. + !! velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v_in !< The input and output meridional - !! velocity [m s-1]. + !! velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h_in !< The input and output layer thicknesses, !! [H ~> m or kg m-2], depending on whether !! the Boussinesq approximation is made. @@ -213,15 +215,15 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, !! the surface pressure at the end of !! this dynamic step [Pa]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh !< The zonal volume or mass transport - !! [H m2 s-1 ~> m3 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh !< The meridional volume or mass - !! transport [H m2 s-1 ~> m3 or kg s-1]. + !! transport [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< The accumulated zonal volume or !! mass transport since the last - !! tracer advection [H m2 ~> m3 or kg]. + !! tracer advection [H L2 ~> m3 or kg]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< The accumulated meridional volume !! or mass transport since the last - !! tracer advection [H m2 ~> m3 or kg]. + !! tracer advection [H L2 ~> m3 or kg]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< The time-mean free surface height !! or column mass [H ~> m or kg m-2]. type(MOM_dyn_unsplit_RK2_CS), pointer :: CS !< The control structure set up by @@ -234,16 +236,18 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, !! Eddy Kinetic Energy. ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_av, hp - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up ! Predicted zonal velocities [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp ! Predicted meridional velocities [L T-1 ~> m s-1] real, dimension(:,:), pointer :: p_surf => NULL() + real :: dt_in_T ! The dynamics time step [T ~> s] real :: dt_pred ! The time step for the predictor part of the baroclinic - ! time stepping. + ! time stepping [T ~> s]. logical :: dyn_p_surf integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - dt_pred = dt * CS%BE + dt_in_T = US%s_to_T*dt + dt_pred = dt_in_T * CS%BE h_av(:,:,:) = 0; hp(:,:,:) = 0 up(:,:,:) = 0 @@ -260,7 +264,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! all of the fields except h. h is stepped separately. if (CS%debug) then - call MOM_state_chksum("Start Predictor ", u_in, v_in, h_in, uh, vh, G, GV) + call MOM_state_chksum("Start Predictor ", u_in, v_in, h_in, uh, vh, G, GV, US) endif ! diffu = horizontal viscosity terms (u,h) @@ -279,8 +283,8 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, call cpu_clock_begin(id_clock_continuity) ! This is a duplicate calculation of the last continuity from the previous step ! and could/should be optimized out. -AJA - call continuity(u_in, v_in, h_in, hp, uh, vh, dt_pred, G, GV, US, CS%continuity_CSp, & - OBC=CS%OBC) + call continuity(u_in, v_in, h_in, hp, uh, vh, dt_pred, G, GV, US, & + CS%continuity_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(hp, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -323,11 +327,11 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, call cpu_clock_begin(id_clock_mom_update) do k=1,nz ; do j=js,je ; do I=Isq,Ieq up(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + dt_pred * & - ((CS%PFu(I,j,k) + CS%CAu(I,j,k)) + US%s_to_T*CS%diffu(I,j,k))) + ((CS%PFu(I,j,k) + CS%CAu(I,j,k)) + CS%diffu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie vp(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + dt_pred * & - ((CS%PFv(i,J,k) + CS%CAv(i,J,k)) + US%s_to_T*CS%diffv(i,J,k))) + ((CS%PFv(i,J,k) + CS%CAv(i,J,k)) + CS%diffv(i,J,k))) enddo ; enddo ; enddo call cpu_clock_end(id_clock_mom_update) @@ -338,12 +342,12 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! up[n-1/2] <- up*[n-1/2] + dt/2 d/dz visc d/dz up[n-1/2] call cpu_clock_begin(id_clock_vertvisc) call enable_averaging(dt, Time_local, CS%diag) - call set_viscous_ML(up, vp, h_av, tv, forces, visc, dt_pred, G, GV, US, & + call set_viscous_ML(up, vp, h_av, tv, forces, visc, US%T_to_s*dt_pred, G, GV, US, & CS%set_visc_CSp) call disable_averaging(CS%diag) - call vertvisc_coef(up, vp, h_av, forces, visc, dt_pred, G, GV, US, & + call vertvisc_coef(up, vp, h_av, forces, visc, US%T_to_s*dt_pred, G, GV, US, & CS%vertvisc_CSp, CS%OBC) - call vertvisc(up, vp, h_av, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, & + call vertvisc(up, vp, h_av, forces, visc, US%T_to_s*dt_pred, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp) call cpu_clock_end(id_clock_vertvisc) call pass_vector(up, vp, G%Domain, clock=id_clock_pass) @@ -351,8 +355,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! uh = up[n-1/2] * h[n-1/2] ! h_av = h + dt div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(up, vp, h_in, hp, uh, vh, & - dt, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(up, vp, h_in, hp, uh, vh, dt_in_T, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(hp, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -363,7 +366,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, enddo ; enddo ; enddo if (CS%debug) & - call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV) + call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV, US) ! CAu = -(f+zeta(up))/h_av vh + d/dx KE(up) (function of up[n-1/2], h[n-1/2]) call cpu_clock_begin(id_clock_Cor) @@ -379,16 +382,16 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! up* = u[n] + (1+gamma) * dt * ( PFu + CAu ) Extrapolated for damping ! u*[n+1] = u[n] + dt * ( PFu + CAu ) do k=1,nz ; do j=js,je ; do I=Isq,Ieq - up(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + dt * (1.+CS%begw) * & - ((CS%PFu(I,j,k) + CS%CAu(I,j,k)) + US%s_to_T*CS%diffu(I,j,k))) - u_in(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + dt * & - ((CS%PFu(I,j,k) + CS%CAu(I,j,k)) + US%s_to_T*CS%diffu(I,j,k))) + up(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + dt_in_T * (1.+CS%begw) * & + ((CS%PFu(I,j,k) + CS%CAu(I,j,k)) + CS%diffu(I,j,k))) + u_in(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + dt_in_T * & + ((CS%PFu(I,j,k) + CS%CAu(I,j,k)) + CS%diffu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - vp(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + dt * (1.+CS%begw) * & - ((CS%PFv(i,J,k) + CS%CAv(i,J,k)) + US%s_to_T*CS%diffv(i,J,k))) - v_in(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + dt * & - ((CS%PFv(i,J,k) + CS%CAv(i,J,k)) + US%s_to_T*CS%diffv(i,J,k))) + vp(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + dt_in_T * (1.+CS%begw) * & + ((CS%PFv(i,J,k) + CS%CAv(i,J,k)) + CS%diffv(i,J,k))) + v_in(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + dt_in_T * & + ((CS%PFv(i,J,k) + CS%CAv(i,J,k)) + CS%diffv(i,J,k))) enddo ; enddo ; enddo ! up[n] <- up* + dt d/dz visc d/dz up @@ -409,8 +412,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! uh = up[n] * h[n] (up[n] might be extrapolated to damp GWs) ! h[n+1] = h[n] + dt div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(up, vp, h_in, h_in, uh, vh, & - dt, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(up, vp, h_in, h_in, uh, vh, dt_in_T, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(h_in, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -418,15 +420,15 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! Accumulate mass flux for tracer transport do k=1,nz do j=js-2,je+2 ; do I=Isq-2,Ieq+2 - uhtr(I,j,k) = uhtr(I,j,k) + dt*uh(I,j,k) + uhtr(I,j,k) = uhtr(I,j,k) + dt_in_T*uh(I,j,k) enddo ; enddo do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 - vhtr(i,J,k) = vhtr(i,J,k) + dt*vh(i,J,k) + vhtr(i,J,k) = vhtr(i,J,k) + dt_in_T*vh(i,J,k) enddo ; enddo enddo if (CS%debug) then - call MOM_state_chksum("Corrector", u_in, v_in, h_in, uh, vh, G, GV) + call MOM_state_chksum("Corrector", u_in, v_in, h_in, uh, vh, G, GV, US) call MOM_accel_chksum("Corrector accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US) endif @@ -511,8 +513,8 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< The meridional velocity [m s-1]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] type(time_type), target, intent(in) :: Time !< The current model time. type(param_file_type), intent(in) :: param_file !< A structure to parse @@ -610,8 +612,8 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag Accel_diag%PFu => CS%PFu ; Accel_diag%PFv => CS%PFv Accel_diag%CAu => CS%CAu ; Accel_diag%CAv => CS%CAv - call continuity_init(Time, G, GV, param_file, diag, CS%continuity_CSp) - call CoriolisAdv_init(Time, G, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) + call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp) + call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) @@ -629,18 +631,18 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag H_convert = GV%H_to_m ; if (.not.GV%Boussinesq) H_convert = GV%H_to_kg_m2 CS%id_uh = register_diag_field('ocean_model', 'uh', diag%axesCuL, Time, & 'Zonal Thickness Flux', flux_units, y_cell_method='sum', v_extensive=.true., & - conversion=H_convert) + conversion=H_convert*US%L_to_m**2*US%s_to_T) CS%id_vh = register_diag_field('ocean_model', 'vh', diag%axesCvL, Time, & 'Meridional Thickness Flux', flux_units, x_cell_method='sum', v_extensive=.true., & - conversion=H_convert) + conversion=H_convert*US%L_to_m**2*US%s_to_T) CS%id_CAu = register_diag_field('ocean_model', 'CAu', diag%axesCuL, Time, & - 'Zonal Coriolis and Advective Acceleration', 'meter second-2') + 'Zonal Coriolis and Advective Acceleration', 'meter second-2', conversion=US%L_T2_to_m_s2) CS%id_CAv = register_diag_field('ocean_model', 'CAv', diag%axesCvL, Time, & - 'Meridional Coriolis and Advective Acceleration', 'meter second-2') + 'Meridional Coriolis and Advective Acceleration', 'meter second-2', conversion=US%L_T2_to_m_s2) CS%id_PFu = register_diag_field('ocean_model', 'PFu', diag%axesCuL, Time, & - 'Zonal Pressure Force Acceleration', 'meter second-2') + 'Zonal Pressure Force Acceleration', 'meter second-2', conversion=US%L_T2_to_m_s2) CS%id_PFv = register_diag_field('ocean_model', 'PFv', diag%axesCvL, Time, & - 'Meridional Pressure Force Acceleration', 'meter second-2') + 'Meridional Pressure Force Acceleration', 'meter second-2', conversion=US%L_T2_to_m_s2) id_clock_Cor = cpu_clock_id('(Ocean Coriolis & mom advection)', grain=CLOCK_MODULE) id_clock_continuity = cpu_clock_id('(Ocean continuity equation)', grain=CLOCK_MODULE) diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index b66aecd261..1a2d03bd44 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -8,6 +8,7 @@ module MOM_grid use MOM_domains, only : get_global_shape, get_domain_extent_dsamp2 use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL use MOM_file_parser, only : get_param, log_param, log_version, param_file_type +use MOM_unit_scaling, only : unit_scale_type implicit none ; private @@ -73,54 +74,54 @@ module MOM_grid !! set_first_direction. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - mask2dT, & !< 0 for land points and 1 for ocean points on the h-grid. Nd. + mask2dT, & !< 0 for land points and 1 for ocean points on the h-grid [nondim]. geoLatT, & !< The geographic latitude at q points in degrees of latitude or m. geoLonT, & !< The geographic longitude at q points in degrees of longitude or m. - dxT, & !< dxT is delta x at h points [m]. - IdxT, & !< 1/dxT [m-1]. - dyT, & !< dyT is delta y at h points [m]. - IdyT, & !< IdyT is 1/dyT [m-1]. - areaT, & !< The area of an h-cell [m2]. - IareaT, & !< 1/areaT [m-2]. + dxT, & !< dxT is delta x at h points [L ~> m]. + IdxT, & !< 1/dxT [L-1 ~> m-1]. + dyT, & !< dyT is delta y at h points [L ~> m]. + IdyT, & !< IdyT is 1/dyT [L-1 ~> m-1]. + areaT, & !< The area of an h-cell [L2 ~> m2]. + IareaT, & !< 1/areaT [L-2 ~> m-2]. sin_rot, & !< The sine of the angular rotation between the local model grid's northward !! and the true northward directions. cos_rot !< The cosine of the angular rotation between the local model grid's northward !! and the true northward directions. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: & - mask2dCu, & !< 0 for boundary points and 1 for ocean points on the u grid. Nondim. + mask2dCu, & !< 0 for boundary points and 1 for ocean points on the u grid [nondim]. geoLatCu, & !< The geographic latitude at u points in degrees of latitude or m. geoLonCu, & !< The geographic longitude at u points in degrees of longitude or m. - dxCu, & !< dxCu is delta x at u points [m]. - IdxCu, & !< 1/dxCu [m-1]. - dyCu, & !< dyCu is delta y at u points [m]. - IdyCu, & !< 1/dyCu [m-1]. - dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [m]. - IareaCu, & !< The masked inverse areas of u-grid cells [m2]. - areaCu !< The areas of the u-grid cells [m2]. + dxCu, & !< dxCu is delta x at u points [L ~> m]. + IdxCu, & !< 1/dxCu [L-1 ~> m-1]. + dyCu, & !< dyCu is delta y at u points [L ~> m]. + IdyCu, & !< 1/dyCu [L-1 ~> m-1]. + dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [L ~> m]. + IareaCu, & !< The masked inverse areas of u-grid cells [L-2 ~> m-2]. + areaCu !< The areas of the u-grid cells [L2 ~> m2]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: & - mask2dCv, & !< 0 for boundary points and 1 for ocean points on the v grid. Nondim. + mask2dCv, & !< 0 for boundary points and 1 for ocean points on the v grid [nondim]. geoLatCv, & !< The geographic latitude at v points in degrees of latitude or m. geoLonCv, & !< The geographic longitude at v points in degrees of longitude or m. - dxCv, & !< dxCv is delta x at v points [m]. - IdxCv, & !< 1/dxCv [m-1]. - dyCv, & !< dyCv is delta y at v points [m]. - IdyCv, & !< 1/dyCv [m-1]. - dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [m]. - IareaCv, & !< The masked inverse areas of v-grid cells [m2]. - areaCv !< The areas of the v-grid cells [m2]. + dxCv, & !< dxCv is delta x at v points [L ~> m]. + IdxCv, & !< 1/dxCv [L-1 ~> m-1]. + dyCv, & !< dyCv is delta y at v points [L ~> m]. + IdyCv, & !< 1/dyCv [L-1 ~> m-1]. + dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [L ~> m]. + IareaCv, & !< The masked inverse areas of v-grid cells [L-2 ~> m-2]. + areaCv !< The areas of the v-grid cells [L2 ~> m2]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & - mask2dBu, & !< 0 for boundary points and 1 for ocean points on the q grid. Nondim. + mask2dBu, & !< 0 for boundary points and 1 for ocean points on the q grid [nondim]. geoLatBu, & !< The geographic latitude at q points in degrees of latitude or m. geoLonBu, & !< The geographic longitude at q points in degrees of longitude or m. - dxBu, & !< dxBu is delta x at q points [m]. - IdxBu, & !< 1/dxBu [m-1]. - dyBu, & !< dyBu is delta y at q points [m]. - IdyBu, & !< 1/dyBu [m-1]. - areaBu, & !< areaBu is the area of a q-cell [m2] - IareaBu !< IareaBu = 1/areaBu [m-2]. + dxBu, & !< dxBu is delta x at q points [L ~> m]. + IdxBu, & !< 1/dxBu [L-1 ~> m-1]. + dyBu, & !< dyBu is delta y at q points [L ~> m]. + IdyBu, & !< 1/dyBu [L-1 ~> m-1]. + areaBu, & !< areaBu is the area of a q-cell [L2 ~> m2] + IareaBu !< IareaBu = 1/areaBu [L-2 ~> m-2]. real, pointer, dimension(:) :: & gridLatT => NULL(), & !< The latitude of T points for the purpose of labeling the output axes. @@ -151,13 +152,16 @@ module MOM_grid real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & CoriolisBu !< The Coriolis parameter at corner points [T-1 ~> s-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points [T-1 m-1 ~> s-1 m-1]. - df_dy !< Derivative d/dy f (Coriolis parameter) at h-points [T-1 m-1 ~> s-1 m-1]. + df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points [T-1 L-1 ~> s-1 m-1]. + df_dy !< Derivative d/dy f (Coriolis parameter) at h-points [T-1 L-1 ~> s-1 m-1]. real :: g_Earth !< The gravitational acceleration [m2 Z-1 s-2 ~> m s-2]. - ! These variables are global sums that are useful for 1-d diagnostics + ! These variables are global sums that are useful for 1-d diagnostics and should not be rescaled. real :: areaT_global !< Global sum of h-cell area [m2] - real :: IareaT_global !< Global sum of inverse h-cell area (1/areaT_global) [m2]. + real :: IareaT_global !< Global sum of inverse h-cell area (1/areaT_global) [m-2]. + + type(unit_scale_type), pointer :: US => NULL() !< A dimensional unit scaling type + ! These variables are for block structures. integer :: nblocks !< The number of sub-PE blocks on this PE @@ -176,9 +180,10 @@ module MOM_grid contains !> MOM_grid_init initializes the ocean grid array sizes and grid memory. -subroutine MOM_grid_init(G, param_file, HI, global_indexing, bathymetry_at_vel) +subroutine MOM_grid_init(G, param_file, US, HI, global_indexing, bathymetry_at_vel) type(ocean_grid_type), intent(inout) :: G !< The horizontal grid type type(param_file_type), intent(in) :: param_file !< Parameter file handle + type(unit_scale_type), optional, pointer :: US !< A dimensional unit scaling type type(hor_index_type), & optional, intent(in) :: HI !< A hor_index_type for array extents logical, optional, intent(in) :: global_indexing !< If true use global index @@ -214,6 +219,8 @@ subroutine MOM_grid_init(G, param_file, HI, global_indexing, bathymetry_at_vel) "in the y-direction on each processor (for openmp).", default=1, & layoutParam=.true.) + if (present(US)) then ; if (associated(US)) G%US => US ; endif + if (present(HI)) then G%HI = HI @@ -402,8 +409,9 @@ subroutine rescale_grid_bathymetry(G, m_in_new_units) end subroutine rescale_grid_bathymetry !> set_derived_metrics calculates metric terms that are derived from other metrics. -subroutine set_derived_metrics(G) - type(ocean_grid_type), intent(inout) :: G !< The horizontal grid structure +subroutine set_derived_metrics(G, US) + type(ocean_grid_type), intent(inout) :: G !< The horizontal grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Various inverse grid spacings and derived areas are calculated within this ! subroutine. integer :: i, j, isd, ied, jsd, jed diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index ab5ce700a7..30a2a451a8 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -39,10 +39,10 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: slope_y !< Isopycnal slope in j-direction [nondim] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), & optional, intent(inout) :: N2_u !< Brunt-Vaisala frequency squared at - !! interfaces between u-points [s-2] + !! interfaces between u-points [T-2 ~> s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), & optional, intent(inout) :: N2_v !< Brunt-Vaisala frequency squared at - !! interfaces between u-points [s-2] + !! interfaces between u-points [[T-2 ~> s-2] integer, optional, intent(in) :: halo !< Halo width over which to compute ! real, optional, intent(in) :: eta_to_m !< The conversion factor from the units @@ -79,19 +79,18 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & real :: haA, haB, haL, haR ! Arithmetic mean thicknesses [H ~> m or kg m-2]. real :: dzaL, dzaR ! Temporary thicknesses in eta units [Z ~> m]. real :: wtA, wtB, wtL, wtR ! Unscaled weights, with various units. - real :: drdx, drdy ! Zonal and meridional density gradients [kg m-4]. + real :: drdx, drdy ! Zonal and meridional density gradients [kg m-3 L-1 ~> kg m-4]. real :: drdz ! Vertical density gradient [kg m-3 Z-1 ~> kg m-4]. real :: Slope ! The slope of density surfaces, calculated in a way ! that is always between -1 and 1. - real :: mag_grad2 ! The squared magnitude of the 3-d density gradient [kg2 m-8]. + real :: mag_grad2 ! The squared magnitude of the 3-d density gradient [kg2 m-6 L-2 ~> kg2 m-8]. real :: slope2_Ratio ! The ratio of the slope squared to slope_max squared. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: h_neglect2 ! h_neglect^2 [H2 ~> m2 or kg2 m-4]. real :: dz_neglect ! A change in interface heighs that is so small it is usually lost ! in roundoff and can be neglected [Z ~> m]. - logical :: use_EOS ! If true, density is calculated from T & S using an - ! equation of state. + logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. real :: G_Rho0, N2, dzN2, H_x(SZIB_(G)), H_y(SZI_(G)) real :: Z_to_L ! A conversion factor between from units for e to the ! units for lateral distances. @@ -111,9 +110,9 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & nz = G%ke ; IsdB = G%IsdB h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect**2 - Z_to_L = US%Z_to_m ; H_to_Z = GV%H_to_Z + Z_to_L = US%Z_to_L ; H_to_Z = GV%H_to_Z ! if (present(eta_to_m)) then - ! Z_to_L = eta_to_m ; H_to_Z = GV%H_to_m / eta_to_m + ! Z_to_L = eta_to_m*US%m_to_L ; H_to_Z = GV%H_to_m / eta_to_m ! endif L_to_Z = 1.0 / Z_to_L dz_neglect = GV%H_subroundoff * H_to_Z @@ -122,7 +121,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & present_N2_u = PRESENT(N2_u) present_N2_v = PRESENT(N2_v) - G_Rho0 = (US%L_to_Z*US%L_to_m*L_to_z*US%s_to_T**2*GV%g_Earth) / GV%Rho0 + G_Rho0 = (US%L_to_Z*L_to_Z*GV%g_Earth) / GV%Rho0 if (present_N2_u) then do j=js,je ; do I=is-1,ie N2_u(I,j,1) = 0. @@ -157,7 +156,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & enddo ; enddo enddo - !$OMP parallel do default(none) shared(nz,is,ie,js,je,IsdB,use_EOS,G,GV,pres,T,S,tv, & + !$OMP parallel do default(none) shared(nz,is,ie,js,je,IsdB,use_EOS,G,GV,US,pres,T,S,tv, & !$OMP h,h_neglect,e,dz_neglect,Z_to_L,L_to_Z,H_to_Z, & !$OMP h_neglect2,present_N2_u,G_Rho0,N2_u,slope_x) & !$OMP private(drdiA,drdiB,drdkL,drdkR,pres_u,T_u,S_u, & diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 481197f85a..cea51b1fd9 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -148,25 +148,25 @@ module MOM_open_boundary logical :: salt_segment_data_exists !< true if salinity data arrays are present real, pointer, dimension(:,:) :: Cg=>NULL() !< The external gravity wave speed [m s-1] !! at OBC-points. - real, pointer, dimension(:,:) :: Htot=>NULL() !< The total column thickness [m] at OBC-points. - real, pointer, dimension(:,:,:) :: h=>NULL() !< The cell thickness [m] at OBC-points. + real, pointer, dimension(:,:) :: Htot=>NULL() !< The total column thickness [H ~> m or kg m-2] at OBC-points. + real, pointer, dimension(:,:,:) :: h=>NULL() !< The cell thickness [H ~> m or kg m-2] at OBC-points. real, pointer, dimension(:,:,:) :: normal_vel=>NULL() !< The layer velocity normal to the OB - !! segment [m s-1]. + !! segment [L T-1 ~> m s-1]. real, pointer, dimension(:,:,:) :: tangential_vel=>NULL() !< The layer velocity tangential to the - !! OB segment [m s-1]. + !! OB segment [L T-1 ~> m s-1]. real, pointer, dimension(:,:,:) :: tangential_grad=>NULL() !< The gradient of the velocity tangential - !! to the OB segment [m s-1]. + !! to the OB segment [T-1 ~> s-1]. real, pointer, dimension(:,:,:) :: normal_trans=>NULL() !< The layer transport normal to the OB - !! segment [m3 s-1]. + !! segment [H L2 T-1 ~> m3 s-1]. real, pointer, dimension(:,:) :: normal_vel_bt=>NULL() !< The barotropic velocity normal to - !! the OB segment [m s-1]. + !! the OB segment [L T-1 ~> m s-1]. real, pointer, dimension(:,:) :: eta=>NULL() !< The sea-surface elevation along the segment [m]. real, pointer, dimension(:,:,:) :: grad_normal=>NULL() !< The gradient of the normal flow along the - !! segment [s-1] + !! segment [T-1 ~> s-1] real, pointer, dimension(:,:,:) :: grad_tan=>NULL() !< The gradient of the tangential flow along the - !! segment [s-1] + !! segment [T-1 ~> s-1] real, pointer, dimension(:,:,:) :: grad_gradient=>NULL() !< The gradient of the gradient of tangential flow along the - !! segment [m-1 s-1] + !! segment times a grid spacing [T-1 ~> s-1] real, pointer, dimension(:,:,:) :: rx_normal=>NULL() !< The rx_old_u value for radiation coeff !! for normal velocity real, pointer, dimension(:,:,:) :: ry_normal=>NULL() !< The tangential value for radiation coeff @@ -174,11 +174,11 @@ module MOM_open_boundary real, pointer, dimension(:,:,:) :: cff_normal=>NULL() !< The denominator for oblique radiation !! for normal velocity real, pointer, dimension(:,:,:) :: nudged_normal_vel=>NULL() !< The layer velocity normal to the OB segment - !! that values should be nudged towards [m s-1]. + !! that values should be nudged towards [L T-1 ~> m s-1]. real, pointer, dimension(:,:,:) :: nudged_tangential_vel=>NULL() !< The layer velocity tangential to the OB segment - !! that values should be nudged towards [m s-1]. + !! that values should be nudged towards [L T-1 ~> m s-1]. real, pointer, dimension(:,:,:) :: nudged_tangential_grad=>NULL() !< The layer dvdx or dudy towards which nudging - !! can occur [s-1]. + !! can occur [T-1 ~> s-1]. type(segment_tracer_registry_type), pointer :: tr_Reg=> NULL()!< A pointer to the tracer registry for the segment. type(hor_index_type) :: HI !< Horizontal index ranges real :: Tr_InvLscale3_out !< An effective inverse length scale cubed [m-3] @@ -1496,11 +1496,12 @@ end subroutine open_boundary_impose_normal_slope !> Reconcile masks and open boundaries, deallocate OBC on PEs where it is not needed. !! Also adjust u- and v-point cell area on specified open boundaries and mask all !! points outside open boundaries. -subroutine open_boundary_impose_land_mask(OBC, G, areaCu, areaCv) +subroutine open_boundary_impose_land_mask(OBC, G, areaCu, areaCv, US) type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure - type(dyn_horgrid_type), intent(inout) :: G !< Ocean grid structure - real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: areaCu !< Area of a u-cell [m2] - real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: areaCv !< Area of a u-cell [m2] + type(dyn_horgrid_type), intent(inout) :: G !< Ocean grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: areaCu !< Area of a u-cell [L2 ~> m2] + real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: areaCv !< Area of a u-cell [L2 ~> m2] ! Local variables integer :: i, j, n type(OBC_segment_type), pointer :: segment => NULL() @@ -1559,9 +1560,9 @@ subroutine open_boundary_impose_land_mask(OBC, G, areaCu, areaCv) I=segment%HI%IsdB do j=segment%HI%jsd,segment%HI%jed if (segment%direction == OBC_DIRECTION_E) then - areaCu(I,j) = G%areaT(i,j) + areaCu(I,j) = G%areaT(i,j) ! Both of these are in [L2] else ! West - areaCu(I,j) = G%areaT(i+1,j) + areaCu(I,j) = G%areaT(i+1,j) ! Both of these are in [L2] endif enddo else @@ -1569,9 +1570,9 @@ subroutine open_boundary_impose_land_mask(OBC, G, areaCu, areaCv) J=segment%HI%JsdB do i=segment%HI%isd,segment%HI%ied if (segment%direction == OBC_DIRECTION_S) then - areaCv(i,J) = G%areaT(i,j+1) + areaCv(i,J) = G%areaT(i,j+1) ! Both of these are in [L2] else ! North - areaCu(i,J) = G%areaT(i,j) + areaCu(i,J) = G%areaT(i,j) ! Both of these are in [L2] endif enddo endif @@ -1605,21 +1606,23 @@ subroutine open_boundary_impose_land_mask(OBC, G, areaCu, areaCv) end subroutine open_boundary_impose_land_mask !> Apply radiation conditions to 3D u,v at open boundaries -subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) +subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u_new !< On exit, new u values on open boundaries - !! On entry, the old time-level v but - !! including barotropic accelerations. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u_old !< Original unadjusted u + !! On entry, the old time-level v but including + !! barotropic accelerations [L T-1 ~> m s-1]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u_old !< Original unadjusted u [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v_new !< On exit, new v values on open boundaries. - !! On entry, the old time-level v but - !! including barotropic accelerations. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v_old !< Original unadjusted v - real, intent(in) :: dt !< Appropriate timestep + !! On entry, the old time-level v but including + !! barotropic accelerations [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v_old !< Original unadjusted v [L T-1 ~> m s-1] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: dt !< Appropriate timestep [s] ! Local variables - real :: dhdt, dhdx, dhdy, gamma_u, gamma_v, gamma_2 - real :: Cx, Cy, tau + real :: dhdt, dhdx, dhdy ! One-point differences in time or space [L T-1 ~> m s-1] + real :: gamma_u, gamma_v, gamma_2 + real :: cff, Cx, Cy, tau real :: rx_max, ry_max ! coefficients for radiation real :: rx_new, rx_avg ! coefficients for radiation real :: ry_new, ry_avg ! coefficients for radiation @@ -1627,7 +1630,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) real, pointer, dimension(:,:,:) :: rx_tangential=>NULL() real, pointer, dimension(:,:,:) :: ry_tangential=>NULL() real, pointer, dimension(:,:,:) :: cff_tangential=>NULL() - real, parameter :: eps = 1.0e-20 + real :: eps ! A small velocity squared [L2 T-2 ~> m2 s-2]? type(OBC_segment_type), pointer :: segment => NULL() integer :: i, j, k, is, ie, js, je, nz, n integer :: is_obc, ie_obc, js_obc, je_obc @@ -1639,6 +1642,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) if (.not.(OBC%open_u_BCs_exist_globally .or. OBC%open_v_BCs_exist_globally)) & return + eps = 1.0e-20*US%m_s_to_L_T**2 + !! Copy previously calculated phase velocity from global arrays into segments !! This is terribly inefficient and temporary solution for continuity across restarts !! and needs to be revisited in the future. @@ -1686,14 +1691,14 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) do n=1,OBC%number_of_segments segment=>OBC%segment(n) if (.not. segment%on_pe) cycle - if (segment%oblique) call gradient_at_q_points(G,segment,u_new,v_new) + if (segment%oblique) call gradient_at_q_points(G, segment, u_new(:,:,:), v_new(:,:,:)) if (segment%direction == OBC_DIRECTION_E) then I=segment%HI%IsdB if (I 0.0) rx_new = min( (dhdt/dhdx), rx_max) ! outward phase speed rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new @@ -1706,8 +1711,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) ! implemented as a work-around to limitations in restart capability OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) elseif (segment%oblique) then - dhdt = u_old(I-1,j,k)-u_new(I-1,j,k) !old-new - dhdx = u_new(I-1,j,k)-u_new(I-2,j,k) !in new time backward sasha for I-1 + dhdt = (u_old(I-1,j,k) - u_new(I-1,j,k)) !old-new + dhdx = (u_new(I-1,j,k) - u_new(I-2,j,k)) !in new time backward sasha for I-1 if (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) > 0.0) then dhdy = segment%grad_normal(J-1,1,k) elseif (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) == 0.0) then @@ -1716,9 +1721,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) dhdy = segment%grad_normal(J,1,k) endif if (dhdt*dhdx < 0.0) dhdt = 0.0 - rx_new = dhdt*dhdx - cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) - ry_new = min(cff_new,max(dhdt*dhdy,-cff_new)) + rx_new = US%L_T_to_m_s**2*dhdt*dhdx + cff_new = US%L_T_to_m_s**2*max(dhdx*dhdx + dhdy*dhdy, eps) + ry_new = min(cff_new,max(US%L_T_to_m_s**2*dhdt*dhdy,-cff_new)) rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new ry_avg = (1.0-gamma_u)*segment%ry_normal(i,J,k) + gamma_u*ry_new cff_avg = (1.0-gamma_u)*segment%cff_normal(i,J,k) + gamma_u*cff_new @@ -1726,7 +1731,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) segment%ry_normal(i,J,k) = ry_avg segment%cff_normal(i,J,k) = cff_avg segment%normal_vel(I,j,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I-1,j,k)) - & - (max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / & + (max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + & + min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / & (cff_avg + rx_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability @@ -1783,11 +1789,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) do k=1,nz ; do J=Js_obc,Je_obc rx_avg = rx_tangential(I,J,k) ! if (G%mask2dCu(I-1,j) > 0.0 .and. G%mask2dCu(I-1,j+1) > 0.0) then -! rx_avg = 0.5*(u_new(I-1,j,k) + u_new(I-1,j+1,k))*dt*G%IdxBu(I-1,J) +! rx_avg = 0.5*(u_new(I-1,j,k) + u_new(I-1,j+1,k)) * US%s_to_T*dt * G%IdxBu(I-1,J) ! elseif (G%mask2dCu(I-1,j) > 0.0) then -! rx_avg = u_new(I-1,j,k)*dt*G%IdxBu(I-1,J) +! rx_avg = u_new(I-1,j,k) * US%s_to_T*dt * G%IdxBu(I-1,J) ! elseif (G%mask2dCu(I-1,j+1) > 0.0) then -! rx_avg = u_new(I-1,j+1,k)*dt*G%IdxBu(I-1,J) +! rx_avg = u_new(I-1,j+1,k) * US%s_to_T*dt * G%IdxBu(I-1,J) ! else ! rx_avg = 0.0 ! endif @@ -1834,8 +1840,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) segment%tangential_vel(I,J,k) = ((cff_avg*v_new(i,J,k) + rx_avg*v_new(i-1,J,k)) - & - (max(ry_avg,0.0)*segment%grad_tan(j,2,k) + min(ry_avg,0.0)*segment%grad_tan(j+1,2,k))) / & - (cff_avg + rx_avg) + (max(ry_avg,0.0)*segment%grad_tan(j,2,k) + & + min(ry_avg,0.0)*segment%grad_tan(j+1,2,k))) / & + (cff_avg + rx_avg) enddo ; enddo endif if (segment%nudged_tan) then @@ -1858,10 +1865,12 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = ((cff_avg*(v_new(i,J,k) - v_new(i-1,J,k))*G%IdxBu(I-1,J) & - + rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*G%IdxBu(I-2,J)) - & - (max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / & - (cff_avg + rx_avg) + segment%tangential_grad(I,J,k) = & + ((cff_avg*(v_new(i,J,k) - v_new(i-1,J,k))*G%IdxBu(I-1,J) + & + rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*G%IdxBu(I-2,J)) - & + (max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + & + min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k)) ) / & + (cff_avg + rx_avg) enddo ; enddo endif if (segment%nudged_grad) then @@ -1888,8 +1897,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) if (I>G%HI%IecB) cycle do k=1,nz ; do j=segment%HI%jsd,segment%HI%jed if (segment%radiation) then - dhdt = u_old(I+1,j,k)-u_new(I+1,j,k) !old-new - dhdx = u_new(I+1,j,k)-u_new(I+2,j,k) !in new time forward sasha for I+1 + dhdt = (u_old(I+1,j,k) - u_new(I+1,j,k)) !old-new + dhdx = (u_new(I+1,j,k) - u_new(I+2,j,k)) !in new time forward sasha for I+1 rx_new = 0.0 if (dhdt*dhdx > 0.0) rx_new = min( (dhdt/dhdx), rx_max) rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new @@ -1902,8 +1911,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) ! implemented as a work-around to limitations in restart capability OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) elseif (segment%oblique) then - dhdt = u_old(I+1,j,k)-u_new(I+1,j,k) !old-new - dhdx = u_new(I+1,j,k)-u_new(I+2,j,k) !in new time forward sasha for I+1 + dhdt = (u_old(I+1,j,k) - u_new(I+1,j,k)) !old-new + dhdx = (u_new(I+1,j,k) - u_new(I+2,j,k)) !in new time forward sasha for I+1 if (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) > 0.0) then dhdy = segment%grad_normal(J-1,1,k) elseif (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) == 0.0) then @@ -1912,9 +1921,10 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) dhdy = segment%grad_normal(J,1,k) endif if (dhdt*dhdx < 0.0) dhdt = 0.0 - rx_new = dhdt*dhdx - cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) - ry_new = min(cff_new,max(dhdt*dhdy,-cff_new)) + + rx_new = US%L_T_to_m_s**2*dhdt*dhdx + cff_new = US%L_T_to_m_s**2*max(dhdx*dhdx + dhdy*dhdy, eps) + ry_new = min(cff_new,max(US%L_T_to_m_s**2*dhdt*dhdy,-cff_new)) rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new ry_avg = (1.0-gamma_u)*segment%ry_normal(i,J,k) + gamma_u*ry_new cff_avg = (1.0-gamma_u)*segment%cff_normal(I,j,k) + gamma_u*cff_new @@ -1922,8 +1932,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) segment%ry_normal(i,J,k) = ry_avg segment%cff_normal(i,J,k) = cff_avg segment%normal_vel(I,j,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I+1,j,k)) - & - (max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / & - (cff_avg + rx_avg) + (max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + & + min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / & + (cff_avg + rx_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) @@ -1979,11 +1990,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) do k=1,nz ; do J=Js_obc,Je_obc rx_avg = rx_tangential(I,J,k) ! if (G%mask2dCu(I+1,j) > 0.0 .and. G%mask2dCu(I+1,j+1) > 0.0) then -! rx_avg = 0.5*(u_new(I+1,j,k) + u_new(I+1,j+1,k))*dt*G%IdxBu(I+1,J) +! rx_avg = 0.5*(u_new(I+1,j,k) + u_new(I+1,j+1,k)) * US%s_to_T*dt * G%IdxBu(I+1,J) ! elseif (G%mask2dCu(I+1,j) > 0.0) then -! rx_avg = u_new(I+1,j,k)*dt*G%IdxBu(I+1,J) +! rx_avg = u_new(I+1,j,k) * US%s_to_T*dt * G%IdxBu(I+1,J) ! elseif (G%mask2dCu(I+1,j+1) > 0.0) then -! rx_avg = u_new(I+1,j+1,k)*dt*G%IdxBu(I+1,J) +! rx_avg = u_new(I+1,j+1,k) * US%s_to_T*dt * G%IdxBu(I+1,J) ! else ! rx_avg = 0.0 ! endif @@ -2030,8 +2041,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) segment%tangential_vel(I,J,k) = ((cff_avg*v_new(i+1,J,k) + rx_avg*v_new(i+2,J,k)) - & - (max(ry_avg,0.0)*segment%grad_tan(j,2,k) + min(ry_avg,0.0)*segment%grad_tan(j+1,2,k))) / & - (cff_avg + rx_avg) + (max(ry_avg,0.0)*segment%grad_tan(j,2,k) + & + min(ry_avg,0.0)*segment%grad_tan(j+1,2,k))) / & + (cff_avg + rx_avg) enddo ; enddo endif if (segment%nudged_tan) then @@ -2054,10 +2066,12 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = ((cff_avg*(v_new(i+2,J,k) - v_new(i+1,J,k))*G%IdxBu(I+1,J) & - + rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*G%IdxBu(I+2,J)) - & - (max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / & - (cff_avg + rx_avg) + segment%tangential_grad(I,J,k) = & + ((cff_avg*(v_new(i+2,J,k) - v_new(i+1,J,k))*G%IdxBu(I+1,J) + & + rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*G%IdxBu(I+2,J)) - & + (max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + & + min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / & + (cff_avg + rx_avg) enddo ; enddo endif if (segment%nudged_grad) then @@ -2084,8 +2098,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) if (J 0.0) ry_new = min( (dhdt/dhdy), ry_max) ry_avg = (1.0-gamma_v)*segment%ry_normal(I,j,k) + gamma_v*ry_new @@ -2098,8 +2112,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) ! implemented as a work-around to limitations in restart capability OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) elseif (segment%oblique) then - dhdt = v_old(i,J-1,k)-v_new(i,J-1,k) !old-new - dhdy = v_new(i,J-1,k)-v_new(i,J-2,k) !in new time backward sasha for J-1 + dhdt = (v_old(i,J-1,k) - v_new(i,J-1,k)) !old-new + dhdy = (v_new(i,J-1,k) - v_new(i,J-2,k)) !in new time backward sasha for J-1 + if (dhdt*(segment%grad_normal(I,1,k) + segment%grad_normal(I-1,1,k)) > 0.0) then dhdx = segment%grad_normal(I-1,1,k) elseif (dhdt*(segment%grad_normal(I,1,k) + segment%grad_normal(I-1,1,k)) == 0.0) then @@ -2108,9 +2123,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) dhdx = segment%grad_normal(I,1,k) endif if (dhdt*dhdy < 0.0) dhdt = 0.0 - ry_new = dhdt*dhdy - cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) - rx_new = min(cff_new,max(dhdt*dhdx,-cff_new)) + ry_new = US%L_T_to_m_s**2*dhdt*dhdy + cff_new = US%L_T_to_m_s**2*max(dhdx*dhdx + dhdy*dhdy, eps) + rx_new = min(cff_new,max(US%L_T_to_m_s**2*dhdt*dhdx,-cff_new)) rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new ry_avg = (1.0-gamma_u)*segment%ry_normal(i,J,k) + gamma_u*ry_new cff_avg = (1.0-gamma_u)*segment%cff_normal(i,J,k) + gamma_u*cff_new @@ -2118,8 +2133,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) segment%ry_normal(i,J,k) = ry_avg segment%cff_normal(i,J,k) = cff_avg segment%normal_vel(i,J,k) = ((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J-1,k)) - & - (max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) + min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & - (cff_avg + ry_avg) + (max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) +& + min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & + (cff_avg + ry_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) @@ -2175,15 +2191,16 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) do k=1,nz ; do I=Is_obc,Ie_obc rx_avg = rx_tangential(I,J,k) ! if (G%mask2dCv(i,J-1) > 0.0 .and. G%mask2dCv(i+1,J-1) > 0.0) then -! rx_avg = 0.5*(v_new(i,J-1,k) + v_new(i+1,J-1,k)*dt*G%IdyBu(I,J-1)) +! rx_avg = 0.5*(v_new(i,J-1,k) + v_new(i+1,J-1,k) * US%s_to_T*dt * G%IdyBu(I,J-1)) ! elseif (G%mask2dCv(i,J-1) > 0.0) then -! rx_avg = v_new(i,J-1,k)*dt*G%IdyBu(I,J-1) +! rx_avg = v_new(i,J-1,k) * US%s_to_T*dt *G%IdyBu(I,J-1) ! elseif (G%mask2dCv(i+1,J-1) > 0.0) then -! rx_avg = v_new(i+1,J-1,k)*dt*G%IdyBu(I,J-1) +! rx_avg = v_new(i+1,J-1,k) * US%s_to_T*dt *G%IdyBu(I,J-1) ! else ! rx_avg = 0.0 ! endif - segment%tangential_grad(I,J,k) = ((u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) + & + segment%tangential_grad(I,J,k) = & + ((u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) + & rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%IdyBu(I,J-2)) / (1.0+rx_avg) enddo ; enddo endif @@ -2226,8 +2243,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) segment%tangential_vel(I,J,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I,j-1,k)) - & - (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + min(ry_avg,0.0)*segment%grad_tan(i+1,2,k))) / & - (cff_avg + rx_avg) + (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + & + min(ry_avg,0.0)*segment%grad_tan(i+1,2,k))) / & + (cff_avg + rx_avg) enddo ; enddo endif if (segment%nudged_tan) then @@ -2250,10 +2268,12 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = ((cff_avg*(u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) & - + rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%IdyBu(I,J-2)) - & - (max(ry_avg,0.0)*segment%grad_gradient(I,2,k) + min(ry_avg,0.0)*segment%grad_gradient(I+1,2,k))) / & - (cff_avg + rx_avg) + segment%tangential_grad(I,J,k) = & + ((cff_avg*(u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) + & + rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%IdyBu(I,J-2)) - & + (max(ry_avg,0.0)*segment%grad_gradient(I,2,k) + & + min(ry_avg,0.0)*segment%grad_gradient(I+1,2,k))) / & + (cff_avg + rx_avg) enddo ; enddo endif if (segment%nudged_grad) then @@ -2280,8 +2300,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) if (J>G%HI%JecB) cycle do k=1,nz ; do i=segment%HI%isd,segment%HI%ied if (segment%radiation) then - dhdt = v_old(i,J+1,k)-v_new(i,J+1,k) !old-new - dhdy = v_new(i,J+1,k)-v_new(i,J+2,k) !in new time backward sasha for J-1 + dhdt = (v_old(i,J+1,k) - v_new(i,J+1,k)) !old-new + dhdy = (v_new(i,J+1,k) - v_new(i,J+2,k)) !in new time backward sasha for J-1 ry_new = 0.0 if (dhdt*dhdy > 0.0) ry_new = min( (dhdt/dhdy), ry_max) ry_avg = (1.0-gamma_v)*segment%ry_normal(I,j,k) + gamma_v*ry_new @@ -2294,8 +2314,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) ! implemented as a work-around to limitations in restart capability OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) elseif (segment%oblique) then - dhdt = v_old(i,J+1,k)-v_new(i,J+1,k) !old-new - dhdy = v_new(i,J+1,k)-v_new(i,J+2,k) !in new time backward sasha for J-1 + dhdt = (v_old(i,J+1,k) - v_new(i,J+1,k)) !old-new + dhdy = (v_new(i,J+1,k) - v_new(i,J+2,k)) !in new time backward sasha for J-1 if (dhdt*(segment%grad_normal(I,1,k) + segment%grad_normal(I-1,1,k)) > 0.0) then dhdx = segment%grad_normal(I-1,1,k) elseif (dhdt*(segment%grad_normal(I,1,k) + segment%grad_normal(I-1,1,k)) == 0.0) then @@ -2304,9 +2324,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) dhdx = segment%grad_normal(I,1,k) endif if (dhdt*dhdy < 0.0) dhdt = 0.0 - ry_new = dhdt*dhdy - cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) - rx_new = min(cff_new,max(dhdt*dhdx,-cff_new)) + ry_new = US%L_T_to_m_s**2*dhdt*dhdy + cff_new = US%L_T_to_m_s**2*max(dhdx*dhdx + dhdy*dhdy, eps) + rx_new = min(cff_new,max(US%L_T_to_m_s**2*dhdt*dhdx,-cff_new)) rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new ry_avg = (1.0-gamma_u)*segment%ry_normal(i,J,k) + gamma_u*ry_new cff_avg = (1.0-gamma_u)*segment%cff_normal(i,J,k) + gamma_u*cff_new @@ -2314,7 +2334,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) segment%ry_normal(i,J,k) = ry_avg segment%cff_normal(i,J,k) = cff_avg segment%normal_vel(i,J,k) = ((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J+1,k)) - & - (max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) + min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & + (max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) + & + min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & (cff_avg + ry_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability @@ -2371,11 +2392,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) do k=1,nz ; do I=Is_obc,Ie_obc rx_avg = rx_tangential(I,J,k) ! if (G%mask2dCv(i,J+1) > 0.0 .and. G%mask2dCv(i+1,J+1) > 0.0) then -! rx_avg = 0.5*(v_new(i,J+1,k) + v_new(i+1,J+1,k))*dt*G%IdyBu(I,J+1) +! rx_avg = 0.5*(v_new(i,J+1,k) + v_new(i+1,J+1,k)) * US%s_to_T*dt * G%IdyBu(I,J+1) ! elseif (G%mask2dCv(i,J+1) > 0.0) then -! rx_avg = v_new(i,J+1,k)*dt*G%IdyBu(I,J+1) +! rx_avg = v_new(i,J+1,k) * US%s_to_T*dt * G%IdyBu(I,J+1) ! elseif (G%mask2dCv(i+1,J+1) > 0.0) then -! rx_avg = v_new(i+1,J+1,k)*dt*G%IdyBu(I,J+1) +! rx_avg = v_new(i+1,J+1,k) * US%s_to_T*dt * G%IdyBu(I,J+1) ! else ! rx_avg = 0.0 ! endif @@ -2421,9 +2442,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_vel(I,J,k) = ((cff_avg*u_new(I,j+1,k) + rx_avg*u_new(I,j+2,k)) - & - (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + min(ry_avg,0.0)*segment%grad_tan(i+1,2,k))) / & - (cff_avg + rx_avg) + segment%tangential_vel(I,J,k) = & + ((cff_avg*u_new(I,j+1,k) + rx_avg*u_new(I,j+2,k)) - & + (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + & + min(ry_avg,0.0)*segment%grad_tan(i+1,2,k)) ) / & + (cff_avg + rx_avg) enddo ; enddo endif if (segment%nudged_tan) then @@ -2436,7 +2459,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) endif gamma_2 = dt / (tau + dt) segment%tangential_vel(I,J,k) = (1 - gamma_2) * segment%tangential_vel(I,J,k) + & - gamma_2 * segment%nudged_tangential_vel(I,J,k) + gamma_2 * segment%nudged_tangential_vel(I,J,k) enddo ; enddo endif if (segment%oblique_grad) then @@ -2446,10 +2469,12 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = ((cff_avg*(u_new(I,j+2,k) - u_new(I,j+1,k))*G%IdyBu(I,J+1) & - + rx_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%IdyBu(I,J+2)) - & - (max(ry_avg,0.0)*segment%grad_gradient(i,2,k) + min(ry_avg,0.0)*segment%grad_gradient(i+1,2,k))) / & - (cff_avg + rx_avg) + segment%tangential_grad(I,J,k) = & + ((cff_avg*(u_new(I,j+2,k) - u_new(I,j+1,k))*G%IdyBu(I,J+1) + & + rx_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%IdyBu(I,J+2)) - & + (max(ry_avg,0.0)*segment%grad_gradient(i,2,k) + & + min(ry_avg,0.0)*segment%grad_gradient(i+1,2,k))) / & + (cff_avg + rx_avg) enddo ; enddo endif if (segment%nudged_grad) then @@ -2484,8 +2509,10 @@ subroutine open_boundary_apply_normal_flow(OBC, G, u, v) ! Arguments type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< u field to update on open boundaries - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< v field to update on open boundaries + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< u field to update on open + !! boundaries [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< v field to update on open + !! boundaries [L T-1 ~> m s-1] ! Local variables integer :: i, j, k, n type(OBC_segment_type), pointer :: segment => NULL() @@ -2549,8 +2576,8 @@ end subroutine open_boundary_zero_normal_flow subroutine gradient_at_q_points(G, segment, uvel, vvel) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(OBC_segment_type), pointer :: segment !< OBC segment structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uvel !< zonal velocity - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vvel !< meridional velocity + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uvel !< zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vvel !< meridional velocity [L T-1 ~> m s-1] integer :: i,j,k if (.not. segment%on_pe) return @@ -2629,6 +2656,7 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) if (segment%oblique_grad) then do k=1,G%ke do I=max(segment%HI%isd, G%HI%isd+1),min(segment%HI%ied, G%HI%ied-1) + !### The combination of differences in j and Idx here do not make sense to me. All should be Idy? segment%grad_gradient(i,1,k) = (((uvel(I,j-1,k) - uvel(I,j-2,k))*G%IdxBu(I,J-2)) - & (uvel(I-1,j-1,k) - uvel(I-1,j-2,k))*G%IdxBu(I-1,J-2)) * G%mask2dCv(I,j-1) segment%grad_gradient(i,2,k) = (((uvel(I,j,k) - uvel(I,j-1,k))*G%IdyBu(I,J-1)) - & @@ -2655,6 +2683,7 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) if (segment%oblique_grad) then do k=1,G%ke do I=max(segment%HI%isd, G%HI%isd+1),min(segment%HI%ied, G%HI%ied-1) + !### The combination of differences in j and Idx here do not make sense to me. All should be Idy? segment%grad_gradient(i,1,k) = (((uvel(I,j+3,k) - uvel(I,j+2,k))*G%IdxBu(I,J+2)) - & (uvel(I-1,j+3,k) - uvel(I-1,j+2,k))*G%IdyBu(I-1,J+2)) * G%mask2dCv(i,J+2) segment%grad_gradient(i,2,k) = (((uvel(I,j+2,k) - uvel(I,j+1,k))*G%IdxBu(I,J+1)) - & @@ -3373,13 +3402,12 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) do j=js_obc+1,je_obc normal_trans_bt(I,j) = 0.0 do k=1,G%ke - segment%normal_vel(I,j,k) = segment%field(m)%buffer_dst(I,j,k) - segment%normal_trans(I,j,k) = segment%field(m)%buffer_dst(I,j,k)*segment%h(I,j,k) * & + segment%normal_vel(I,j,k) = US%m_s_to_L_T*segment%field(m)%buffer_dst(I,j,k) + segment%normal_trans(I,j,k) = US%m_s_to_L_T*segment%field(m)%buffer_dst(I,j,k)*segment%h(I,j,k) * & G%dyCu(I,j) - normal_trans_bt(I,j) = normal_trans_bt(I,j)+segment%normal_trans(I,j,k) + normal_trans_bt(I,j) = normal_trans_bt(I,j) + segment%normal_trans(I,j,k) enddo - segment%normal_vel_bt(I,j) = normal_trans_bt(I,j)/(max(segment%Htot(I,j),1.e-12) * & - G%dyCu(I,j)) + segment%normal_vel_bt(I,j) = normal_trans_bt(I,j) / (max(segment%Htot(I,j),1.e-12) * G%dyCu(I,j)) if (associated(segment%nudged_normal_vel)) segment%nudged_normal_vel(I,j,:) = segment%normal_vel(I,j,:) enddo elseif (trim(segment%field(m)%name) == 'V' .and. segment%is_N_or_S) then @@ -3387,13 +3415,12 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) do i=is_obc+1,ie_obc normal_trans_bt(i,J) = 0.0 do k=1,G%ke - segment%normal_vel(i,J,k) = segment%field(m)%buffer_dst(i,J,k) - segment%normal_trans(i,J,k) = segment%field(m)%buffer_dst(i,J,k)*segment%h(i,J,k) * & + segment%normal_vel(i,J,k) = US%m_s_to_L_T*segment%field(m)%buffer_dst(i,J,k) + segment%normal_trans(i,J,k) = US%m_s_to_L_T*segment%field(m)%buffer_dst(i,J,k)*segment%h(i,J,k) * & G%dxCv(i,J) - normal_trans_bt(i,J) = normal_trans_bt(i,J)+segment%normal_trans(i,J,k) + normal_trans_bt(i,J) = normal_trans_bt(i,J) + segment%normal_trans(i,J,k) enddo - segment%normal_vel_bt(i,J) = normal_trans_bt(i,J)/(max(segment%Htot(i,J),1.e-12) * & - G%dxCv(i,J)) + segment%normal_vel_bt(i,J) = normal_trans_bt(i,J) / (max(segment%Htot(i,J),1.e-12) * G%dxCv(i,J)) if (associated(segment%nudged_normal_vel)) segment%nudged_normal_vel(i,J,:) = segment%normal_vel(i,J,:) enddo elseif (trim(segment%field(m)%name) == 'V' .and. segment%is_E_or_W .and. & @@ -3401,7 +3428,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) I=is_obc do J=js_obc,je_obc do k=1,G%ke - segment%tangential_vel(I,J,k) = segment%field(m)%buffer_dst(I,J,k) + segment%tangential_vel(I,J,k) = US%m_s_to_L_T*segment%field(m)%buffer_dst(I,J,k) enddo if (associated(segment%nudged_tangential_vel)) & segment%nudged_tangential_vel(I,J,:) = segment%tangential_vel(I,J,:) @@ -3411,7 +3438,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) J=js_obc do I=is_obc,ie_obc do k=1,G%ke - segment%tangential_vel(I,J,k) = segment%field(m)%buffer_dst(I,J,k) + segment%tangential_vel(I,J,k) = US%m_s_to_L_T*segment%field(m)%buffer_dst(I,J,k) enddo if (associated(segment%nudged_tangential_vel)) & segment%nudged_tangential_vel(I,J,:) = segment%tangential_vel(I,J,:) @@ -3421,7 +3448,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) I=is_obc do J=js_obc,je_obc do k=1,G%ke - segment%tangential_grad(I,J,k) = segment%field(m)%buffer_dst(I,J,k) + segment%tangential_grad(I,J,k) = US%T_to_s*segment%field(m)%buffer_dst(I,J,k) enddo enddo elseif (trim(segment%field(m)%name) == 'DUDY' .and. segment%is_N_or_S .and. & @@ -3429,7 +3456,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) J=js_obc do I=is_obc,ie_obc do k=1,G%ke - segment%tangential_grad(I,J,k) = segment%field(m)%buffer_dst(I,J,k) + segment%tangential_grad(I,J,k) = US%T_to_s*segment%field(m)%buffer_dst(I,J,k) enddo enddo endif @@ -4065,8 +4092,8 @@ subroutine adjustSegmentEtaToFitBathymetry(G, GV, US, segment,fld) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(OBC_segment_type), intent(inout) :: segment !< pointer to segment type - integer, intent(in) :: fld + type(OBC_segment_type), intent(inout) :: segment !< pointer to segment type + integer, intent(in) :: fld !< field index to adjust thickness ! Local variables integer :: i, j, k, is, ie, js, je, nz, contractions, dilations integer :: n diff --git a/src/core/MOM_transcribe_grid.F90 b/src/core/MOM_transcribe_grid.F90 index 62ac6e1ea4..045fc9261c 100644 --- a/src/core/MOM_transcribe_grid.F90 +++ b/src/core/MOM_transcribe_grid.F90 @@ -9,6 +9,7 @@ module MOM_transcribe_grid use MOM_dyn_horgrid, only : dyn_horgrid_type, set_derived_dyn_horgrid use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING use MOM_grid, only : ocean_grid_type, set_derived_metrics +use MOM_unit_scaling, only : unit_scale_type implicit none ; private @@ -18,9 +19,10 @@ module MOM_transcribe_grid !> Copies information from a dynamic (shared) horizontal grid type into an !! ocean_grid_type. -subroutine copy_dyngrid_to_MOM_grid(dG, oG) +subroutine copy_dyngrid_to_MOM_grid(dG, oG, US) type(dyn_horgrid_type), intent(in) :: dG !< Common horizontal grid type type(ocean_grid_type), intent(inout) :: oG !< Ocean grid type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer :: isd, ied, jsd, jed ! Common data domains. integer :: IsdB, IedB, JsdB, JedB ! Common data domains. @@ -154,16 +156,17 @@ subroutine copy_dyngrid_to_MOM_grid(dG, oG) call pass_vector(oG%Dopen_u, oG%Dopen_v, oG%Domain, To_All+Scalar_Pair, CGRID_NE) endif - call set_derived_metrics(oG) + call set_derived_metrics(oG, US) end subroutine copy_dyngrid_to_MOM_grid !> Copies information from an ocean_grid_type into a dynamic (shared) !! horizontal grid type. -subroutine copy_MOM_grid_to_dyngrid(oG, dG) +subroutine copy_MOM_grid_to_dyngrid(oG, dG, US) type(ocean_grid_type), intent(in) :: oG !< Ocean grid type type(dyn_horgrid_type), intent(inout) :: dG !< Common horizontal grid type + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type integer :: isd, ied, jsd, jed ! Common data domains. integer :: IsdB, IedB, JsdB, JedB ! Common data domains. @@ -298,7 +301,7 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG) call pass_vector(dG%Dopen_u, dG%Dopen_v, dG%Domain, To_All+Scalar_Pair, CGRID_NE) endif - call set_derived_dyn_horgrid(dG) + call set_derived_dyn_horgrid(dG, US) end subroutine copy_MOM_grid_to_dyngrid diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 2dd459ba91..36148f69ba 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -131,24 +131,24 @@ module MOM_variables v => NULL(), & !< Pointer to the meridional velocity [m s-1] h => NULL() !< Pointer to the layer thicknesses [H ~> m or kg m-2] real, pointer, dimension(:,:,:) :: & - uh => NULL(), & !< Pointer to zonal transports [H m2 s-1 ~> m3 s-1 or kg s-1] - vh => NULL() !< Pointer to meridional transports [H m2 s-1 ~> m3 s-1 or kg s-1] + uh => NULL(), & !< Pointer to zonal transports [H L2 T-1 ~> m3 s-1 or kg s-1] + vh => NULL() !< Pointer to meridional transports [H L2 T-1 ~> m3 s-1 or kg s-1] real, pointer, dimension(:,:,:) :: & - CAu => NULL(), & !< Pointer to the zonal Coriolis and Advective acceleration [m s-2] - CAv => NULL(), & !< Pointer to the meridional Coriolis and Advective acceleration [m s-2] - PFu => NULL(), & !< Pointer to the zonal Pressure force acceleration [m s-2] - PFv => NULL(), & !< Pointer to the meridional Pressure force acceleration [m s-2] - diffu => NULL(), & !< Pointer to the zonal acceleration due to lateral viscosity [m s-1 T-1 ~> m s-2] - diffv => NULL(), & !< Pointer to the meridional acceleration due to lateral viscosity [m s-1 T-1 ~> m s-2] + CAu => NULL(), & !< Pointer to the zonal Coriolis and Advective acceleration [L T-2 ~> m s-2] + CAv => NULL(), & !< Pointer to the meridional Coriolis and Advective acceleration [L T-2 ~> m s-2] + PFu => NULL(), & !< Pointer to the zonal Pressure force acceleration [L T-2 ~> m s-2] + PFv => NULL(), & !< Pointer to the meridional Pressure force acceleration [L T-2 ~> m s-2] + diffu => NULL(), & !< Pointer to the zonal acceleration due to lateral viscosity [L T-2 ~> m s-2] + diffv => NULL(), & !< Pointer to the meridional acceleration due to lateral viscosity [L T-2 ~> m s-2] pbce => NULL(), & !< Pointer to the baroclinic pressure force dependency on free surface movement - !! [m2 s-2 H-1 ~> m s-2 or m4 kg-1 s-2] - u_accel_bt => NULL(), & !< Pointer to the zonal barotropic-solver acceleration [m s-2] - v_accel_bt => NULL() !< Pointer to the meridional barotropic-solver acceleration [m s-2] + !! [L2 T-2 H-1 ~> m s-2 or m4 kg-1 s-2] + u_accel_bt => NULL(), & !< Pointer to the zonal barotropic-solver acceleration [L T-2 ~> m s-2] + v_accel_bt => NULL() !< Pointer to the meridional barotropic-solver acceleration [L T-2 ~> m s-2] real, pointer, dimension(:,:,:) :: & - u_av => NULL(), & !< Pointer to zonal velocity averaged over the timestep [m s-1] - v_av => NULL(), & !< Pointer to meridional velocity averaged over the timestep [m s-1] - u_prev => NULL(), & !< Pointer to zonal velocity at the end of the last timestep [m s-1] - v_prev => NULL() !< Pointer to meridional velocity at the end of the last timestep [m s-1] + u_av => NULL(), & !< Pointer to zonal velocity averaged over the timestep [L T-1 ~> m s-1] + v_av => NULL(), & !< Pointer to meridional velocity averaged over the timestep [L T-1 ~> m s-1] + u_prev => NULL(), & !< Pointer to zonal velocity at the end of the last timestep [L T-1 ~> m s-1] + v_prev => NULL() !< Pointer to meridional velocity at the end of the last timestep [L T-1 ~> m s-1] end type ocean_internal_state !> Pointers to arrays with accelerations, which can later be used for derived diagnostics, like energy balances. @@ -156,16 +156,16 @@ module MOM_variables ! Each of the following fields has nz layers. real, pointer, dimension(:,:,:) :: & - diffu => NULL(), & !< Zonal acceleration due to along isopycnal viscosity [m s-1 T-1 ~> m s-2] - diffv => NULL(), & !< Meridional acceleration due to along isopycnal viscosity [m s-1 T-1 ~> m s-2] - CAu => NULL(), & !< Zonal Coriolis and momentum advection accelerations [m s-2] - CAv => NULL(), & !< Meridional Coriolis and momentum advection accelerations [m s-2] - PFu => NULL(), & !< Zonal acceleration due to pressure forces [m s-2] - PFv => NULL(), & !< Meridional acceleration due to pressure forces [m s-2] - du_dt_visc => NULL(), &!< Zonal acceleration due to vertical viscosity [m s-2] - dv_dt_visc => NULL(), &!< Meridional acceleration due to vertical viscosity [m s-2] - du_dt_dia => NULL(), & !< Zonal acceleration due to diapycnal mixing [m s-2] - dv_dt_dia => NULL() !< Meridional acceleration due to diapycnal mixing [m s-2] + diffu => NULL(), & !< Zonal acceleration due to along isopycnal viscosity [L T-2 ~> m s-2] + diffv => NULL(), & !< Meridional acceleration due to along isopycnal viscosity [L T-2 ~> m s-2] + CAu => NULL(), & !< Zonal Coriolis and momentum advection accelerations [L T-2 ~> m s-2] + CAv => NULL(), & !< Meridional Coriolis and momentum advection accelerations [L T-2 ~> m s-2] + PFu => NULL(), & !< Zonal acceleration due to pressure forces [L T-2 ~> m s-2] + PFv => NULL(), & !< Meridional acceleration due to pressure forces [L T-2 ~> m s-2] + du_dt_visc => NULL(), &!< Zonal acceleration due to vertical viscosity [L T-2 ~> m s-2] + dv_dt_visc => NULL(), &!< Meridional acceleration due to vertical viscosity [L T-2 ~> m s-2] + du_dt_dia => NULL(), & !< Zonal acceleration due to diapycnal mixing [L T-2 ~> m s-2] + dv_dt_dia => NULL() !< Meridional acceleration due to diapycnal mixing [L T-2 ~> m s-2] real, pointer, dimension(:,:,:) :: du_other => NULL() !< Zonal velocity changes due to any other processes that are !! not due to any explicit accelerations [m s-1]. @@ -174,10 +174,10 @@ module MOM_variables !! not due to any explicit accelerations [m s-1]. ! These accelerations are sub-terms included in the accelerations above. - real, pointer :: gradKEu(:,:,:) => NULL() !< gradKEu = - d/dx(u2) [m s-2] - real, pointer :: gradKEv(:,:,:) => NULL() !< gradKEv = - d/dy(u2) [m s-2] - real, pointer :: rv_x_v(:,:,:) => NULL() !< rv_x_v = rv * v at u [m s-2] - real, pointer :: rv_x_u(:,:,:) => NULL() !< rv_x_u = rv * u at v [m s-2] + real, pointer :: gradKEu(:,:,:) => NULL() !< gradKEu = - d/dx(u2) [L T-2 ~> m s-2] + real, pointer :: gradKEv(:,:,:) => NULL() !< gradKEv = - d/dy(u2) [L T-2 ~> m s-2] + real, pointer :: rv_x_v(:,:,:) => NULL() !< rv_x_v = rv * v at u [L T-2 ~> m s-2] + real, pointer :: rv_x_u(:,:,:) => NULL() !< rv_x_u = rv * u at v [L T-2 ~> m s-2] end type accel_diag_ptrs @@ -186,10 +186,10 @@ module MOM_variables ! Each of the following fields has nz layers. real, pointer, dimension(:,:,:) :: & - uh => NULL(), & !< Resolved zonal layer thickness fluxes, [H m2 s-1 ~> m3 s-1 or kg s-1] - vh => NULL(), & !< Resolved meridional layer thickness fluxes, [H m2 s-1 ~> m3 s-1 or kg s-1] - uhGM => NULL(), & !< Isopycnal height diffusion induced zonal volume fluxes [H m2 s-1 ~> m3 s-1 or kg s-1] - vhGM => NULL() !< Isopycnal height diffusion induced meridional volume fluxes [H m2 s-1 ~> m3 s-1 or kg s-1] + uh => NULL(), & !< Resolved zonal layer thickness fluxes, [H L2 T-1 ~> m3 s-1 or kg s-1] + vh => NULL(), & !< Resolved meridional layer thickness fluxes, [H L2 T-1 ~> m3 s-1 or kg s-1] + uhGM => NULL(), & !< Isopycnal height diffusion induced zonal volume fluxes [H L2 T-1 ~> m3 s-1 or kg s-1] + vhGM => NULL() !< Isopycnal height diffusion induced meridional volume fluxes [H L2 T-1 ~> m3 s-1 or kg s-1] ! Each of the following fields is found at nz+1 interfaces. real, pointer :: diapyc_vel(:,:,:) => NULL() !< The net diapycnal velocity [H s-1 ~> m s-1 or kg m-2 s-1] diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index d488171fc5..e0bbd832bb 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -47,18 +47,18 @@ module MOM_PointAccel ! that are used to step the physical model forward. They all use the same ! names as the variables they point to in MOM.F90 real, pointer, dimension(:,:,:) :: & - u_av => NULL(), & !< Time average u-velocity [m s-1]. - v_av => NULL(), & !< Time average velocity [m s-1]. - u_prev => NULL(), & !< Previous u-velocity [m s-1]. - v_prev => NULL(), & !< Previous v-velocity [m s-1]. + u_av => NULL(), & !< Time average u-velocity [L T-1 ~> m s-1]. + v_av => NULL(), & !< Time average velocity [L T-1 ~> m s-1]. + u_prev => NULL(), & !< Previous u-velocity [L T-1 ~> m s-1]. + v_prev => NULL(), & !< Previous v-velocity [L T-1 ~> m s-1]. T => NULL(), & !< Temperature [degC]. S => NULL(), & !< Salinity [ppt]. - u_accel_bt => NULL(), & !< Barotropic u-acclerations [m s-2] - v_accel_bt => NULL() !< Barotropic v-acclerations [m s-2] + u_accel_bt => NULL(), & !< Barotropic u-acclerations [L T-2 ~> m s-2] + v_accel_bt => NULL() !< Barotropic v-acclerations [L T-2 ~> m s-2] real, pointer, dimension(:,:,:) :: pbce => NULL() !< pbce times eta gives the baroclinic !! pressure anomaly in each layer due to free surface height anomalies !! [m2 s-2 H-1 ~> m s-2 or m4 kg-1 s-2]. - + real :: u_av_scale !< A scaling factor to convert u_av to m s-1. end type PointAccel_CS contains @@ -73,7 +73,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: um !< The new zonal velocity [m s-1]. + intent(in) :: um !< The new zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: hin !< The layer thickness [H ~> m or kg m-2]. type(accel_diag_ptrs), intent(in) :: ADp !< A structure pointing to the various @@ -83,7 +83,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st real, intent(in) :: dt !< The ocean dynamics time step [s]. type(PointAccel_CS), pointer :: CS !< The control structure returned by a previous !! call to PointAccel_init. - real, intent(in) :: vel_rpt !< The velocity magnitude that triggers a report [m s-1]. + real, intent(in) :: vel_rpt !< The velocity magnitude that triggers a report [L T-1 ~> m s-1]. real, optional, intent(in) :: str !< The surface wind stress integrated over a time !! step divided by the Boussinesq density [m2 s-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -132,14 +132,14 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st ! Determine which layers to write out accelerations for. do k=1,nz - if (((max(CS%u_av(I,j,k),um(I,j,k)) >= vel_rpt) .or. & - (min(CS%u_av(I,j,k),um(I,j,k)) <= -vel_rpt)) .and. & + if (((max(US%m_s_to_L_T*CS%u_av_scale*CS%u_av(I,j,k),um(I,j,k)) >= vel_rpt) .or. & + (min(US%m_s_to_L_T*CS%u_av_scale*CS%u_av(I,j,k),um(I,j,k)) <= -vel_rpt)) .and. & ((hin(i,j,k) + hin(i+1,j,k)) > 3.0*Angstrom)) exit enddo ks = k do k=nz,1,-1 - if (((max(CS%u_av(I,j,k), um(I,j,k)) >= vel_rpt) .or. & - (min(CS%u_av(I,j,k), um(I,j,k)) <= -vel_rpt)) .and. & + if (((max(US%m_s_to_L_T*CS%u_av_scale*CS%u_av(I,j,k), um(I,j,k)) >= vel_rpt) .or. & + (min(US%m_s_to_L_T*CS%u_av_scale*CS%u_av(I,j,k), um(I,j,k)) <= -vel_rpt)) .and. & ((hin(i,j,k) + hin(i+1,j,k)) > 3.0*Angstrom)) exit enddo ke = k @@ -163,54 +163,54 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"Layers:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(I10," ",$)') (k); enddo write(file,'(/,"u(m): ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (um(I,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (US%L_T_to_m_s*um(I,j,k)); enddo if (prev_avail) then write(file,'(/,"u(mp): ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (CS%u_prev(I,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (US%L_T_to_m_s*CS%u_prev(I,j,k)); enddo endif write(file,'(/,"u(3): ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (CS%u_av(I,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (CS%u_av_scale*CS%u_av(I,j,k)); enddo write(file,'(/,"CFL u: ",$)') do k=ks,ke ; if (do_k(k)) then - CFL = abs(um(I,j,k)) * dt * G%dy_Cu(I,j) + CFL = abs(um(I,j,k)) * US%s_to_T*dt * G%dy_Cu(I,j) if (um(I,j,k) < 0.0) then ; CFL = CFL * G%IareaT(i+1,j) else ; CFL = CFL * G%IareaT(i,j) ; endif write(file,'(ES10.3," ",$)') CFL endif ; enddo write(file,'(/,"CFL0 u:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - abs(um(I,j,k)) * dt * G%IdxCu(I,j) ; enddo + abs(um(I,j,k)) * US%s_to_T*dt * G%IdxCu(I,j) ; enddo if (prev_avail) then write(file,'(/,"du: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - ((um(I,j,k)-CS%u_prev(I,j,k))); enddo + (US%L_T_to_m_s*(um(I,j,k)-CS%u_prev(I,j,k))); enddo endif write(file,'(/,"CAu: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*ADp%CAu(I,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%L_T2_to_m_s2*ADp%CAu(I,j,k)); enddo write(file,'(/,"PFu: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*ADp%PFu(I,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%L_T2_to_m_s2*ADp%PFu(I,j,k)); enddo write(file,'(/,"diffu: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%s_to_T*ADp%diffu(I,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%L_T2_to_m_s2*ADp%diffu(I,j,k)); enddo if (associated(ADp%gradKEu)) then write(file,'(/,"KEu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (dt*ADp%gradKEu(I,j,k)); enddo + (dt*US%L_T2_to_m_s2*ADp%gradKEu(I,j,k)); enddo endif if (associated(ADp%rv_x_v)) then write(file,'(/,"Coru: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - dt*(ADp%CAu(I,j,k)-ADp%rv_x_v(I,j,k)); enddo + dt*US%L_T2_to_m_s2*(ADp%CAu(I,j,k)-ADp%rv_x_v(I,j,k)); enddo endif if (associated(ADp%du_dt_visc)) then write(file,'(/,"ubv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (um(I,j,k)-dt*ADp%du_dt_visc(I,j,k)); enddo + US%L_T_to_m_s*(um(I,j,k) - US%s_to_T*dt*ADp%du_dt_visc(I,j,k)); enddo write(file,'(/,"duv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (dt*ADp%du_dt_visc(I,j,k)); enddo + (dt*US%L_T2_to_m_s2*ADp%du_dt_visc(I,j,k)); enddo endif if (associated(ADp%du_other)) then write(file,'(/,"du_other: ",$)') @@ -230,7 +230,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (associated(CS%u_accel_bt)) then write(file,'("dubt: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (dt*CS%u_accel_bt(I,j,k)) ; enddo + (dt*US%L_T2_to_m_s2*CS%u_accel_bt(I,j,k)) ; enddo write(file,'(/)') endif @@ -285,10 +285,10 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"vh--: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%vh(i,J-1,k)*G%IdxCv(i,J-1)); enddo + (uh_scale*US%m_to_L*CDp%vh(i,J-1,k)*G%IdxCv(i,J-1)); enddo write(file,'(/," vhC--:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%v_av(i,j-1,k)*h_scale*(hin(i,j-1,k) + hin(i,j,k))); enddo + (0.5*CS%u_av_scale*CS%v_av(i,j-1,k)*h_scale*(hin(i,j-1,k) + hin(i,j,k))); enddo if (prev_avail) then write(file,'(/," vhCp--:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & @@ -297,10 +297,10 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"vh-+: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%vh(i,J,k)*G%IdxCv(i,J)); enddo + (uh_scale*US%m_to_L*CDp%vh(i,J,k)*G%IdxCv(i,J)); enddo write(file,'(/," vhC-+:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%v_av(i,J,k)*h_scale*(hin(i,j,k) + hin(i,j+1,k))); enddo + (0.5*CS%u_av_scale*CS%v_av(i,J,k)*h_scale*(hin(i,j,k) + hin(i,j+1,k))); enddo if (prev_avail) then write(file,'(/," vhCp-+:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & @@ -309,10 +309,10 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"vh+-: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%vh(i+1,J-1,k)*G%IdxCv(i+1,J-1)); enddo + (uh_scale*US%m_to_L*CDp%vh(i+1,J-1,k)*G%IdxCv(i+1,J-1)); enddo write(file,'(/," vhC+-:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%v_av(i+1,J-1,k)*h_scale*(hin(i+1,j-1,k) + hin(i+1,j,k))); enddo + (0.5*CS%u_av_scale*CS%v_av(i+1,J-1,k)*h_scale*(hin(i+1,j-1,k) + hin(i+1,j,k))); enddo if (prev_avail) then write(file,'(/," vhCp+-:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & @@ -321,14 +321,14 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"vh++: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%vh(i+1,J,k)*G%IdxCv(i+1,J)); enddo + (uh_scale*US%m_to_L*CDp%vh(i+1,J,k)*G%IdxCv(i+1,J)); enddo write(file,'(/," vhC++:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%v_av(i+1,J,k)*h_scale*(hin(i+1,j,k) + hin(i+1,j+1,k))); enddo + (0.5*CS%u_av_scale*CS%v_av(i+1,J,k)*h_scale*(hin(i+1,j,k) + hin(i+1,j+1,k))); enddo if (prev_avail) then write(file,'(/," vhCp++:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%v_av(i+1,J,k)*h_scale*(hin(i+1,j,k) + hin(i+1,j+1,k))); enddo + (0.5*CS%u_av_scale*CS%v_av(i+1,J,k)*h_scale*(hin(i+1,j,k) + hin(i+1,j+1,k))); enddo endif write(file,'(/,"D: ",2(ES10.3))') US%Z_to_m*G%bathyT(i,j),US%Z_to_m*G%bathyT(i+1,j) @@ -336,7 +336,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st ! From here on, the normalized accelerations are written. if (prev_avail) then do k=ks,ke - du = um(I,j,k)-CS%u_prev(I,j,k) + du = US%L_T_to_m_s*(um(I,j,k) - CS%u_prev(I,j,k)) if (abs(du) < 1.0e-6) du = 1.0e-6 Inorm(k) = 1.0 / du enddo @@ -346,34 +346,34 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"du: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - ((um(I,j,k)-CS%u_prev(I,j,k))*Inorm(k)); enddo + (US%L_T_to_m_s*(um(I,j,k)-CS%u_prev(I,j,k))*Inorm(k)); enddo write(file,'(/,"CAu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*ADp%CAu(I,j,k)*Inorm(k)); enddo + (dt*US%L_T2_to_m_s2*ADp%CAu(I,j,k)*Inorm(k)); enddo write(file,'(/,"PFu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*ADp%PFu(I,j,k)*Inorm(k)); enddo + (dt*US%L_T2_to_m_s2*ADp%PFu(I,j,k)*Inorm(k)); enddo write(file,'(/,"diffu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*US%s_to_T*ADp%diffu(I,j,k)*Inorm(k)); enddo + (dt*US%L_T2_to_m_s2*ADp%diffu(I,j,k)*Inorm(k)); enddo if (associated(ADp%gradKEu)) then write(file,'(/,"KEu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*ADp%gradKEu(I,j,k)*Inorm(k)); enddo + (dt*US%L_T2_to_m_s2*ADp%gradKEu(I,j,k)*Inorm(k)); enddo endif if (associated(ADp%rv_x_v)) then write(file,'(/,"Coru: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - dt*(ADp%CAu(I,j,k)-ADp%rv_x_v(I,j,k))*Inorm(k); enddo + dt*US%L_T2_to_m_s2*(ADp%CAu(I,j,k)-ADp%rv_x_v(I,j,k))*Inorm(k); enddo endif if (associated(ADp%du_dt_visc)) then write(file,'(/,"duv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*ADp%du_dt_visc(I,j,k))*Inorm(k); enddo + (dt*US%L_T2_to_m_s2*ADp%du_dt_visc(I,j,k))*Inorm(k); enddo endif if (associated(ADp%du_other)) then write(file,'(/,"du_other: ",$)') @@ -383,7 +383,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (associated(CS%u_accel_bt)) then write(file,'(/,"dubt: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*CS%u_accel_bt(I,j,k)*Inorm(k)) ; enddo + (dt*US%L_T2_to_m_s2*CS%u_accel_bt(I,j,k)*Inorm(k)) ; enddo endif endif @@ -404,7 +404,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: vm !< The new meridional velocity [m s-1]. + intent(in) :: vm !< The new meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: hin !< The layer thickness [H ~> m or kg m-2]. type(accel_diag_ptrs), intent(in) :: ADp !< A structure pointing to the various @@ -414,7 +414,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st real, intent(in) :: dt !< The ocean dynamics time step [s]. type(PointAccel_CS), pointer :: CS !< The control structure returned by a previous !! call to PointAccel_init. - real, intent(in) :: vel_rpt !< The velocity magnitude that triggers a report [m s-1]. + real, intent(in) :: vel_rpt !< The velocity magnitude that triggers a report [L T-1 ~> m s-1]. real, optional, intent(in) :: str !< The surface wind stress integrated over a time !! step divided by the Boussinesq density [m2 s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -462,14 +462,14 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st prev_avail = (associated(CS%u_prev) .and. associated(CS%v_prev)) do k=1,nz - if (((max(CS%v_av(i,J,k), vm(i,J,k)) >= vel_rpt) .or. & - (min(CS%v_av(i,J,k), vm(i,J,k)) <= -vel_rpt)) .and. & + if (((max(US%m_s_to_L_T*CS%u_av_scale*CS%v_av(i,J,k), US%L_T_to_m_s*vm(i,J,k)) >= vel_rpt) .or. & + (min(US%m_s_to_L_T*CS%u_av_scale*CS%v_av(i,J,k), US%L_T_to_m_s*vm(i,J,k)) <= -vel_rpt)) .and. & ((hin(i,j,k) + hin(i,j+1,k)) > 3.0*Angstrom)) exit enddo ks = k do k=nz,1,-1 - if (((max(CS%v_av(i,J,k), vm(i,J,k)) >= vel_rpt) .or. & - (min(CS%v_av(i,J,k), vm(i,J,k)) <= -vel_rpt)) .and. & + if (((max(US%m_s_to_L_T*CS%u_av_scale*CS%v_av(i,J,k), US%L_T_to_m_s*vm(i,J,k)) >= vel_rpt) .or. & + (min(US%m_s_to_L_T*CS%u_av_scale*CS%v_av(i,J,k), US%L_T_to_m_s*vm(i,J,k)) <= -vel_rpt)) .and. & ((hin(i,j,k) + hin(i,j+1,k)) > 3.0*Angstrom)) exit enddo ke = k @@ -493,59 +493,59 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"Layers:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(I10," ",$)') (k); enddo write(file,'(/,"v(m): ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vm(i,J,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (US%L_T_to_m_s*vm(i,J,k)); enddo if (prev_avail) then write(file,'(/,"v(mp): ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (CS%v_prev(i,J,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (US%L_T_to_m_s*CS%v_prev(i,J,k)); enddo endif write(file,'(/,"v(3): ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (CS%v_av(i,J,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (CS%u_av_scale*CS%v_av(i,J,k)); enddo write(file,'(/,"CFL v: ",$)') do k=ks,ke ; if (do_k(k)) then - CFL = abs(vm(i,J,k)) * dt * G%dx_Cv(i,J) + CFL = abs(vm(i,J,k)) * US%s_to_T*dt * G%dx_Cv(i,J) if (vm(i,J,k) < 0.0) then ; CFL = CFL * G%IareaT(i,j+1) else ; CFL = CFL * G%IareaT(i,j) ; endif write(file,'(ES10.3," ",$)') CFL endif ; enddo write(file,'(/,"CFL0 v:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - abs(vm(i,J,k)) * dt * G%IdyCv(i,J) ; enddo + abs(vm(i,J,k)) * US%s_to_T*dt * G%IdyCv(i,J) ; enddo if (prev_avail) then write(file,'(/,"dv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - ((vm(i,J,k)-CS%v_prev(i,J,k))); enddo + (US%L_T_to_m_s*(vm(i,J,k)-CS%v_prev(i,J,k))); enddo endif write(file,'(/,"CAv: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*ADp%CAv(i,J,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%L_T2_to_m_s2*ADp%CAv(i,J,k)); enddo write(file,'(/,"PFv: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*ADp%PFv(i,J,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%L_T2_to_m_s2*ADp%PFv(i,J,k)); enddo write(file,'(/,"diffv: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%s_to_T*ADp%diffv(i,J,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%L_T2_to_m_s2*ADp%diffv(i,J,k)); enddo if (associated(ADp%gradKEv)) then write(file,'(/,"KEv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (dt*ADp%gradKEv(i,J,k)); enddo + (dt*US%L_T2_to_m_s2*ADp%gradKEv(i,J,k)); enddo endif if (associated(ADp%rv_x_u)) then write(file,'(/,"Corv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - dt*(ADp%CAv(i,J,k)-ADp%rv_x_u(i,J,k)); enddo + dt*US%L_T2_to_m_s2*(ADp%CAv(i,J,k)-ADp%rv_x_u(i,J,k)); enddo endif if (associated(ADp%dv_dt_visc)) then write(file,'(/,"vbv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (vm(i,J,k)-dt*ADp%dv_dt_visc(i,J,k)); enddo + US%L_T_to_m_s*(vm(i,J,k) - US%s_to_T*dt*ADp%dv_dt_visc(i,J,k)); enddo write(file,'(/,"dvv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (dt*ADp%dv_dt_visc(i,J,k)); enddo + (dt*US%L_T2_to_m_s2*ADp%dv_dt_visc(i,J,k)); enddo endif if (associated(ADp%dv_other)) then write(file,'(/,"dv_other: ",$)') @@ -565,7 +565,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (associated(CS%v_accel_bt)) then write(file,'("dvbt: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (dt*CS%v_accel_bt(i,J,k)) ; enddo + (dt*US%L_T2_to_m_s2*CS%v_accel_bt(i,J,k)) ; enddo write(file,'(/)') endif @@ -619,10 +619,10 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"uh--: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%uh(I-1,j,k)*G%IdyCu(I-1,j)); enddo + (uh_scale*US%m_to_L*CDp%uh(I-1,j,k)*G%IdyCu(I-1,j)); enddo write(file,'(/," uhC--: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CS%u_av(I-1,j,k) * h_scale*0.5*(hin(i-1,j,k) + hin(i,j,k))); enddo + (CS%u_av_scale*CS%u_av(I-1,j,k) * h_scale*0.5*(hin(i-1,j,k) + hin(i,j,k))); enddo if (prev_avail) then write(file,'(/," uhCp--:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & @@ -631,10 +631,10 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"uh-+: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%uh(I-1,j+1,k)*G%IdyCu(I-1,j+1)); enddo + (uh_scale*US%m_to_L*CDp%uh(I-1,j+1,k)*G%IdyCu(I-1,j+1)); enddo write(file,'(/," uhC-+: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CS%u_av(I-1,j+1,k) * h_scale*0.5*(hin(i-1,j+1,k) + hin(i,j+1,k))); enddo + (CS%u_av_scale*CS%u_av(I-1,j+1,k) * h_scale*0.5*(hin(i-1,j+1,k) + hin(i,j+1,k))); enddo if (prev_avail) then write(file,'(/," uhCp-+:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & @@ -643,10 +643,10 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"uh+-: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%uh(I,j,k)*G%IdyCu(I,j)); enddo + (uh_scale*US%m_to_L*CDp%uh(I,j,k)*G%IdyCu(I,j)); enddo write(file,'(/," uhC+-: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CS%u_av(I,j,k) * h_scale*0.5*(hin(i,j,k) + hin(i+1,j,k))); enddo + (CS%u_av_scale*CS%u_av(I,j,k) * h_scale*0.5*(hin(i,j,k) + hin(i+1,j,k))); enddo if (prev_avail) then write(file,'(/," uhCp+-:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & @@ -655,10 +655,10 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"uh++: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%uh(I,j+1,k)*G%IdyCu(I,j+1)); enddo + (uh_scale*US%m_to_L*CDp%uh(I,j+1,k)*G%IdyCu(I,j+1)); enddo write(file,'(/," uhC++: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CS%u_av(I,j+1,k) * 0.5*h_scale*(hin(i,j+1,k) + hin(i+1,j+1,k))); enddo + (CS%u_av_scale*CS%u_av(I,j+1,k) * 0.5*h_scale*(hin(i,j+1,k) + hin(i+1,j+1,k))); enddo if (prev_avail) then write(file,'(/," uhCp++:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & @@ -670,7 +670,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st ! From here on, the normalized accelerations are written. if (prev_avail) then do k=ks,ke - dv = vm(i,J,k)-CS%v_prev(i,J,k) + dv = US%L_T_to_m_s*(vm(i,J,k)-CS%v_prev(i,J,k)) if (abs(dv) < 1.0e-6) dv = 1.0e-6 Inorm(k) = 1.0 / dv enddo @@ -679,31 +679,31 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') (1.0/Inorm(k)); enddo write(file,'(/,"dv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - ((vm(i,J,k)-CS%v_prev(i,J,k))*Inorm(k)); enddo + (US%L_T_to_m_s*(vm(i,J,k)-CS%v_prev(i,J,k))*Inorm(k)); enddo write(file,'(/,"CAv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*ADp%CAv(i,J,k)*Inorm(k)); enddo + (dt*US%L_T2_to_m_s2*ADp%CAv(i,J,k)*Inorm(k)); enddo write(file,'(/,"PFv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*ADp%PFv(i,J,k)*Inorm(k)); enddo + (dt*US%L_T2_to_m_s2*ADp%PFv(i,J,k)*Inorm(k)); enddo write(file,'(/,"diffv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*US%s_to_T*ADp%diffv(i,J,k)*Inorm(k)); enddo + (dt*US%L_T2_to_m_s2*ADp%diffv(i,J,k)*Inorm(k)); enddo if (associated(ADp%gradKEu)) then write(file,'(/,"KEv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*ADp%gradKEv(i,J,k)*Inorm(k)); enddo + (dt*US%L_T2_to_m_s2*ADp%gradKEv(i,J,k)*Inorm(k)); enddo endif if (associated(ADp%rv_x_u)) then write(file,'(/,"Corv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - dt*(ADp%CAv(i,J,k)-ADp%rv_x_u(i,J,k))*Inorm(k); enddo + dt*US%L_T2_to_m_s2*(ADp%CAv(i,J,k)-ADp%rv_x_u(i,J,k))*Inorm(k); enddo endif if (associated(ADp%dv_dt_visc)) then write(file,'(/,"dvv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*ADp%dv_dt_visc(i,J,k)*Inorm(k)); enddo + (dt*US%L_T2_to_m_s2*ADp%dv_dt_visc(i,J,k)*Inorm(k)); enddo endif if (associated(ADp%dv_other)) then write(file,'(/,"dv_other: ",$)') @@ -713,7 +713,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (associated(CS%v_accel_bt)) then write(file,'(/,"dvbt: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*CS%v_accel_bt(i,J,k)*Inorm(k)) ; enddo + (dt*US%L_T2_to_m_s2*CS%v_accel_bt(i,J,k)*Inorm(k)) ; enddo endif endif @@ -755,6 +755,9 @@ subroutine PointAccel_init(MIS, Time, G, param_file, diag, dirs, CS) CS%u_av => MIS%u_av; if (.not.associated(MIS%u_av)) CS%u_av => MIS%u(:,:,:) CS%v_av => MIS%v_av; if (.not.associated(MIS%v_av)) CS%v_av => MIS%v(:,:,:) +! CS%u_av_scale = G%US%L_T_to_m_s ; if (.not.associated(MIS%u_av)) CS%u_av_scale = 1.0 + CS%u_av_scale = 1.0 + ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "U_TRUNC_FILE", CS%u_trunc_file, & diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index a35d4edd7a..54025a0ac0 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -66,8 +66,8 @@ module MOM_diagnostics ! following fields have nz layers. real, pointer, dimension(:,:,:) :: & - du_dt => NULL(), & !< net i-acceleration [m s-2] - dv_dt => NULL(), & !< net j-acceleration [m s-2] + du_dt => NULL(), & !< net i-acceleration [L T-1 s-1 ~> m s-2] + dv_dt => NULL(), & !< net j-acceleration [L T-1 s-1 ~> m s-2] dh_dt => NULL(), & !< thickness rate of change [H s-1 ~> m s-1 or kg m-2 s-1] p_ebt => NULL() !< Equivalent barotropic modal structure [nondim] @@ -188,17 +188,17 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: uh !< Transport through zonal faces = u*h*dy, - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: vh !< Transport through meridional faces = v*h*dx, - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. type(accel_diag_ptrs), intent(in) :: ADp !< structure with pointers to @@ -251,6 +251,11 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB nz = G%ke ; nkmb = GV%nk_rho_varies + if (loc(CS)==0) call MOM_error(FATAL, & + "calculate_diagnostic_fields: Module must be initialized before used.") + + call calculate_derivs(dt, G, CS) + if (dt > 0.0) then call diag_save_grids(CS%diag) call diag_copy_storage_to_diag(CS%diag, diag_pre_sync) @@ -277,11 +282,6 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & ! one iteration that would break the following one-line workaround! if (nkmb==0 .and. nz > 1) nkmb = nz - if (loc(CS)==0) call MOM_error(FATAL, & - "calculate_diagnostic_fields: Module must be initialized before used.") - - call calculate_derivs(dt, G, CS) - if (CS%id_u > 0) call post_data(CS%id_u, u, CS%diag) if (CS%id_v > 0) call post_data(CS%id_v, v, CS%diag) @@ -320,7 +320,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_masso > 0) then work_2d(:,:) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie - work_2d(i,j) = work_2d(i,j) + (GV%H_to_kg_m2*h(i,j,k)) * G%areaT(i,j) + work_2d(i,j) = work_2d(i,j) + (GV%H_to_kg_m2*h(i,j,k)) * US%L_to_m**2*G%areaT(i,j) enddo ; enddo ; enddo masso = reproducing_sum(work_2d) call post_data(CS%id_masso, masso, CS%diag) @@ -339,7 +339,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & endif ; endif if (CS%id_volcello > 0) then ! volcello = h*area for Boussinesq do k=1,nz; do j=js,je ; do i=is,ie - work_3d(i,j,k) = ( GV%H_to_m*h(i,j,k) ) * G%areaT(i,j) + work_3d(i,j,k) = ( GV%H_to_m*h(i,j,k) ) * US%L_to_m**2*G%areaT(i,j) enddo ; enddo ; enddo call post_data(CS%id_volcello, work_3d, CS%diag) endif @@ -372,7 +372,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_thkcello > 0) call post_data(CS%id_thkcello, work_3d, CS%diag) if (CS%id_volcello > 0) then do k=1,nz; do j=js,je ; do i=is,ie ! volcello = dp/(rho*g)*area for non-Boussinesq - work_3d(i,j,k) = G%areaT(i,j) * work_3d(i,j,k) + work_3d(i,j,k) = US%L_to_m**2*G%areaT(i,j) * work_3d(i,j,k) enddo ; enddo ; enddo call post_data(CS%id_volcello, work_3d, CS%diag) endif @@ -558,7 +558,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & enddo ; enddo enddo - if (CS%id_uh_Rlay > 0) call post_data(CS%id_uhGM_Rlay, CS%uhGM_Rlay, CS%diag) + if (CS%id_uhGM_Rlay > 0) call post_data(CS%id_uhGM_Rlay, CS%uhGM_Rlay, CS%diag) endif if (associated(CS%vhGM_Rlay) .and. associated(CDp%vhGM)) then @@ -629,7 +629,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & f2_h = absurdly_small_freq2 + 0.25 * US%s_to_T**2 * & ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) - mag_beta = sqrt(0.5 * US%s_to_T**2 * ( & + mag_beta = US%s_to_T*US%m_to_L * sqrt(0.5 * ( & (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & ((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2) + & (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & @@ -641,19 +641,19 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & endif if (CS%id_cfl_cg1>0) then do j=js,je ; do i=is,ie - CS%cfl_cg1(i,j) = (dt*CS%cg1(i,j)) * (G%IdxT(i,j) + G%IdyT(i,j)) + CS%cfl_cg1(i,j) = (dt*US%m_to_L*CS%cg1(i,j)) * (G%IdxT(i,j) + G%IdyT(i,j)) enddo ; enddo call post_data(CS%id_cfl_cg1, CS%cfl_cg1, CS%diag) endif if (CS%id_cfl_cg1_x>0) then do j=js,je ; do i=is,ie - CS%cfl_cg1_x(i,j) = (dt*CS%cg1(i,j)) * G%IdxT(i,j) + CS%cfl_cg1_x(i,j) = (dt*US%m_to_L*CS%cg1(i,j)) * G%IdxT(i,j) enddo ; enddo call post_data(CS%id_cfl_cg1_x, CS%cfl_cg1_x, CS%diag) endif if (CS%id_cfl_cg1_y>0) then do j=js,je ; do i=is,ie - CS%cfl_cg1_y(i,j) = (dt*CS%cg1(i,j)) * G%IdyT(i,j) + CS%cfl_cg1_y(i,j) = (dt*US%m_to_L*CS%cg1(i,j)) * G%IdyT(i,j) enddo ; enddo call post_data(CS%id_cfl_cg1_y, CS%cfl_cg1_y, CS%diag) endif @@ -678,7 +678,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & f2_h = absurdly_small_freq2 + 0.25 * US%s_to_T**2 * & ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) - mag_beta = sqrt(0.5 * US%s_to_T**2 * ( & + mag_beta = US%s_to_T*US%m_to_L * sqrt(0.5 * ( & (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & ((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2) + & (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & @@ -882,17 +882,17 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: uh !< Transport through zonal faces=u*h*dy, - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: vh !< Transport through merid faces=v*h*dx, - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. type(accel_diag_ptrs), intent(in) :: ADp !< Structure pointing to accelerations in momentum equation. type(cont_diag_ptrs), intent(in) :: CDp !< Structure pointing to terms in continuity equations. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -916,7 +916,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%KE)) then do k=1,nz ; do j=js,je ; do i=is,ie - CS%KE(i,j,k) = ((u(I,j,k)*u(I,j,k) + u(I-1,j,k)*u(I-1,j,k)) + & + CS%KE(i,j,k) = US%L_T_to_m_s**2*((u(I,j,k)*u(I,j,k) + u(I-1,j,k)*u(I-1,j,k)) + & (v(i,J,k)*v(i,J,k) + v(i,J-1,k)*v(i,J-1,k)))*0.25 ! DELETE THE FOLLOWING... Make this 0 to test the momentum balance, ! or a huge number to test the continuity balance. @@ -936,13 +936,13 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%dKE_dt)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = uh(I,j,k)*G%dxCu(I,j)*CS%du_dt(I,j,k) + KE_u(I,j) = US%L_T_to_m_s**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*CS%du_dt(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = vh(i,J,k)*G%dyCv(i,J)*CS%dv_dt(i,J,k) + KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*CS%dv_dt(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie - KE_h(i,j) = CS%KE(i,j,k)*CS%dh_dt(i,j,k) + KE_h(i,j) = CS%KE(i,j,k)*US%s_to_T*CS%dh_dt(i,j,k) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) @@ -957,10 +957,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%PE_to_KE)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = uh(I,j,k)*G%dxCu(I,j)*ADp%PFu(I,j,k) + KE_u(I,j) = US%L_T_to_m_s**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%PFu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = vh(i,J,k)*G%dyCv(i,J)*ADp%PFv(i,J,k) + KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%PFv(i,J,k) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) @@ -975,14 +975,14 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%KE_CorAdv)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = uh(I,j,k)*G%dxCu(I,j)*ADp%CAu(I,j,k) + KE_u(I,j) = US%L_T_to_m_s**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%CAu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = vh(i,J,k)*G%dyCv(i,J)*ADp%CAv(i,J,k) + KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%CAv(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie KE_h(i,j) = -CS%KE(i,j,k) * G%IareaT(i,j) * & - (uh(I,j,k) - uh(I-1,j,k) + vh(i,J,k) - vh(i,J-1,k)) + US%s_to_T*(uh(I,j,k) - uh(I-1,j,k) + vh(i,J,k) - vh(i,J-1,k)) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) @@ -1002,15 +1002,15 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS do k=1,nz do j=js,je ; do I=Isq,Ieq if (G%mask2dCu(i,j) /= 0.) & - KE_u(I,j) = uh(I,j,k)*G%dxCu(I,j)*ADp%gradKEu(I,j,k) + KE_u(I,j) = US%L_T_to_m_s**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%gradKEu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie if (G%mask2dCv(i,j) /= 0.) & - KE_v(i,J) = vh(i,J,k)*G%dyCv(i,J)*ADp%gradKEv(i,J,k) + KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%gradKEv(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie KE_h(i,j) = -CS%KE(i,j,k) * G%IareaT(i,j) * & - (uh(I,j,k) - uh(I-1,j,k) + vh(i,J,k) - vh(i,J-1,k)) + US%s_to_T*(uh(I,j,k) - uh(I-1,j,k) + vh(i,J,k) - vh(i,J-1,k)) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) @@ -1025,10 +1025,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%KE_visc)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = uh(I,j,k)*G%dxCu(I,j)*ADp%du_dt_visc(I,j,k) + KE_u(I,j) = US%L_T_to_m_s**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%du_dt_visc(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = vh(i,J,k)*G%dyCv(i,J)*ADp%dv_dt_visc(i,J,k) + KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%dv_dt_visc(i,J,k) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) @@ -1043,10 +1043,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%KE_horvisc)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = uh(I,j,k)*G%dxCu(I,j)*US%s_to_T*ADp%diffu(I,j,k) + KE_u(I,j) = US%s_to_T*uh(I,j,k)*US%L_to_m*G%dxCu(I,j)*US%L_T2_to_m_s2*ADp%diffu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = vh(i,J,k)*G%dyCv(i,J)*US%s_to_T*ADp%diffv(i,J,k) + KE_v(i,J) = US%s_to_T*vh(i,J,k)*US%L_to_m*G%dyCv(i,J)*US%L_T2_to_m_s2*ADp%diffv(i,J,k) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) @@ -1061,10 +1061,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%KE_dia)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = uh(I,j,k)*G%dxCu(I,j)*ADp%du_dt_dia(I,j,k) + KE_u(I,j) = US%L_T_to_m_s**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%du_dt_dia(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = vh(i,J,k)*G%dyCv(i,J)*ADp%dv_dt_dia(i,J,k) + KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%dv_dt_dia(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie KE_h(i,j) = CS%KE(i,j,k) * & @@ -1123,14 +1123,14 @@ end subroutine register_time_deriv !> This subroutine calculates all registered time derivatives. subroutine calculate_derivs(dt, G, CS) - real, intent(in) :: dt !< The time interval over which differences occur [s]. + real, intent(in) :: dt !< The time interval over which differences occur [T ~> s]. type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(diagnostics_CS), intent(inout) :: CS !< Control structure returned by previous call to !! diagnostics_init. ! This subroutine calculates all registered time derivatives. - integer i, j, k, m - real Idt + real :: Idt ! The inverse timestep [T-1 ~> s-1] + integer :: i, j, k, m if (dt > 0.0) then ; Idt = 1.0/dt else ; return ; endif @@ -1335,14 +1335,15 @@ end subroutine post_surface_thermo_diags !> This routine posts diagnostics of the transports, including the subgridscale !! contributions. -subroutine post_transport_diagnostics(G, GV, uhtr, vhtr, h, IDs, diag_pre_dyn, & +subroutine post_transport_diagnostics(G, GV, US, uhtr, vhtr, h, IDs, diag_pre_dyn, & diag, dt_trans, Reg) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uhtr !< Accumulated zonal thickness fluxes - !! used to advect tracers [H m2 ~> m3 or kg] + !! used to advect tracers [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vhtr !< Accumulated meridional thickness fluxes - !! used to advect tracers [H m2 ~> m3 or kg] + !! used to advect tracers [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< The updated layer thicknesses [H ~> m or kg m-2] type(transport_diag_IDs), intent(in) :: IDs !< A structure with the diagnostic IDs. @@ -1360,12 +1361,12 @@ subroutine post_transport_diagnostics(G, GV, uhtr, vhtr, h, IDs, diag_pre_dyn, & ! [H s-1 ~> m s-1 or kg m-2 s-1]. real :: Idt ! The inverse of the time interval [s-1] real :: H_to_kg_m2_dt ! A conversion factor from accumulated transports to fluxes - ! [kg m-2 H-1 s-1 ~> kg m-3 s-1 or s-1]. + ! [kg L-2 H-1 s-1 ~> kg m-3 s-1 or s-1]. integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Idt = 1. / dt_trans - H_to_kg_m2_dt = GV%H_to_kg_m2 * Idt + H_to_kg_m2_dt = GV%H_to_kg_m2 * US%L_to_m**2 * Idt call diag_save_grids(diag) call diag_copy_storage_to_diag(diag, diag_pre_dyn) @@ -1543,10 +1544,10 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag endif CS%id_u = register_diag_field('ocean_model', 'u', diag%axesCuL, Time, & - 'Zonal velocity', 'm s-1', cmor_field_name='uo', & + 'Zonal velocity', 'm s-1', conversion=US%L_T_to_m_s, cmor_field_name='uo', & cmor_standard_name='sea_water_x_velocity', cmor_long_name='Sea Water X Velocity') CS%id_v = register_diag_field('ocean_model', 'v', diag%axesCvL, Time, & - 'Meridional velocity', 'm s-1', cmor_field_name='vo', & + 'Meridional velocity', 'm s-1', conversion=US%L_T_to_m_s, cmor_field_name='vo', & cmor_standard_name='sea_water_y_velocity', cmor_long_name='Sea Water Y Velocity') CS%id_h = register_diag_field('ocean_model', 'h', diag%axesTL, Time, & 'Layer Thickness', thickness_units, v_extensive=.true., conversion=convert_H) @@ -1573,21 +1574,21 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag 'In situ density', 'kg m-3') CS%id_du_dt = register_diag_field('ocean_model', 'dudt', diag%axesCuL, Time, & - 'Zonal Acceleration', 'm s-2') + 'Zonal Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) if ((CS%id_du_dt>0) .and. .not.associated(CS%du_dt)) then call safe_alloc_ptr(CS%du_dt,IsdB,IedB,jsd,jed,nz) call register_time_deriv(lbound(MIS%u), MIS%u, CS%du_dt, CS) endif CS%id_dv_dt = register_diag_field('ocean_model', 'dvdt', diag%axesCvL, Time, & - 'Meridional Acceleration', 'm s-2') + 'Meridional Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) if ((CS%id_dv_dt>0) .and. .not.associated(CS%dv_dt)) then call safe_alloc_ptr(CS%dv_dt,isd,ied,JsdB,JedB,nz) call register_time_deriv(lbound(MIS%v), MIS%v, CS%dv_dt, CS) endif CS%id_dh_dt = register_diag_field('ocean_model', 'dhdt', diag%axesTL, Time, & - 'Thickness tendency', trim(thickness_units)//" s-1", v_extensive = .true.) + 'Thickness tendency', trim(thickness_units)//" s-1", conversion=convert_H*US%s_to_T, v_extensive=.true.) if ((CS%id_dh_dt>0) .and. .not.associated(CS%dh_dt)) then call safe_alloc_ptr(CS%dh_dt,isd,ied,jsd,jed,nz) call register_time_deriv(lbound(MIS%h), MIS%h, CS%dh_dt, CS) @@ -1602,22 +1603,22 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag CS%id_uh_Rlay = register_diag_field('ocean_model', 'uh_rho', diag%axesCuL, Time, & 'Zonal volume transport in pure potential density coordinates', flux_units, & - conversion=convert_H) + conversion=US%L_to_m**2*US%s_to_T*convert_H) if (CS%id_uh_Rlay>0) call safe_alloc_ptr(CS%uh_Rlay,IsdB,IedB,jsd,jed,nz) CS%id_vh_Rlay = register_diag_field('ocean_model', 'vh_rho', diag%axesCvL, Time, & 'Meridional volume transport in pure potential density coordinates', flux_units, & - conversion=convert_H) + conversion=US%L_to_m**2*US%s_to_T*convert_H) if (CS%id_vh_Rlay>0) call safe_alloc_ptr(CS%vh_Rlay,isd,ied,JsdB,JedB,nz) CS%id_uhGM_Rlay = register_diag_field('ocean_model', 'uhGM_rho', diag%axesCuL, Time, & - 'Zonal volume transport due to interface height diffusion in pure potential & - &density coordinates', flux_units, conversion=convert_H) + 'Zonal volume transport due to interface height diffusion in pure potential '//& + 'density coordinates', flux_units, conversion=US%L_to_m**2*US%s_to_T*convert_H) if (CS%id_uhGM_Rlay>0) call safe_alloc_ptr(CS%uhGM_Rlay,IsdB,IedB,jsd,jed,nz) CS%id_vhGM_Rlay = register_diag_field('ocean_model', 'vhGM_rho', diag%axesCvL, Time, & - 'Meridional volume transport due to interface height diffusion in pure & - &potential density coordinates', flux_units, conversion=convert_H) + 'Meridional volume transport due to interface height diffusion in pure potential '//& + 'density coordinates', flux_units, conversion=US%L_to_m**2*US%s_to_T*convert_H) if (CS%id_vhGM_Rlay>0) call safe_alloc_ptr(CS%vhGM_Rlay,isd,ied,JsdB,JedB,nz) !endif @@ -1792,10 +1793,11 @@ subroutine register_surface_diags(Time, G, IDs, diag, tv) end subroutine register_surface_diags !> Register certain diagnostics related to transports -subroutine register_transport_diags(Time, G, GV, IDs, diag) +subroutine register_transport_diags(Time, G, GV, US, IDs, diag) type(time_type), intent(in) :: Time !< current model time type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(transport_diag_IDs), intent(inout) :: IDs !< A structure with the diagnostic IDs. type(diag_ctrl), intent(inout) :: diag !< regulates diagnostic output @@ -1812,10 +1814,10 @@ subroutine register_transport_diags(Time, G, GV, IDs, diag) ! Diagnostics related to tracer and mass transport IDs%id_uhtr = register_diag_field('ocean_model', 'uhtr', diag%axesCuL, Time, & 'Accumulated zonal thickness fluxes to advect tracers', 'kg', & - y_cell_method='sum', v_extensive=.true., conversion=H_convert) + y_cell_method='sum', v_extensive=.true., conversion=H_convert*US%L_to_m**2) IDs%id_vhtr = register_diag_field('ocean_model', 'vhtr', diag%axesCvL, Time, & 'Accumulated meridional thickness fluxes to advect tracers', 'kg', & - x_cell_method='sum', v_extensive=.true., conversion=H_convert) + x_cell_method='sum', v_extensive=.true., conversion=H_convert*US%L_to_m**2) IDs%id_umo = register_diag_field('ocean_model', 'umo', & diag%axesCuL, Time, 'Ocean Mass X Transport', 'kg s-1', & standard_name='ocean_mass_x_transport', y_cell_method='sum', v_extensive=.true.) @@ -1881,7 +1883,7 @@ subroutine write_static_fields(G, GV, US, tv, diag) if (id > 0) call post_data(id, G%geoLonCu, diag, .true.) id = register_static_field('ocean_model', 'area_t', diag%axesT1, & - 'Surface area of tracer (T) cells', 'm2', & + 'Surface area of tracer (T) cells', 'm2', conversion=US%m_to_L**2, & cmor_field_name='areacello', cmor_standard_name='cell_area', & cmor_long_name='Ocean Grid-Cell Area', & x_cell_method='sum', y_cell_method='sum', area_cell_method='sum') @@ -1891,21 +1893,21 @@ subroutine write_static_fields(G, GV, US, tv, diag) endif id = register_static_field('ocean_model', 'area_u', diag%axesCu1, & - 'Surface area of x-direction flow (U) cells', 'm2', & + 'Surface area of x-direction flow (U) cells', 'm2', conversion=US%m_to_L**2, & cmor_field_name='areacello_cu', cmor_standard_name='cell_area', & cmor_long_name='Ocean Grid-Cell Area', & x_cell_method='sum', y_cell_method='sum', area_cell_method='sum') if (id > 0) call post_data(id, G%areaCu, diag, .true.) id = register_static_field('ocean_model', 'area_v', diag%axesCv1, & - 'Surface area of y-direction flow (V) cells', 'm2', & + 'Surface area of y-direction flow (V) cells', 'm2', conversion=US%m_to_L**2, & cmor_field_name='areacello_cv', cmor_standard_name='cell_area', & cmor_long_name='Ocean Grid-Cell Area', & x_cell_method='sum', y_cell_method='sum', area_cell_method='sum') if (id > 0) call post_data(id, G%areaCv, diag, .true.) id = register_static_field('ocean_model', 'area_q', diag%axesB1, & - 'Surface area of B-grid flow (Q) cells', 'm2', & + 'Surface area of B-grid flow (Q) cells', 'm2', conversion=US%m_to_L**2, & cmor_field_name='areacello_bu', cmor_standard_name='cell_area', & cmor_long_name='Ocean Grid-Cell Area', & x_cell_method='sum', y_cell_method='sum', area_cell_method='sum') @@ -1941,35 +1943,35 @@ subroutine write_static_fields(G, GV, US, tv, diag) if (id > 0) call post_data(id, G%CoriolisBu, diag, .true.) id = register_static_field('ocean_model', 'dxt', diag%axesT1, & - 'Delta(x) at thickness/tracer points (meter)', 'm', interp_method='none') - if (id > 0) call post_data(id, G%dxt, diag, .true.) + 'Delta(x) at thickness/tracer points (meter)', 'm', interp_method='none', conversion=US%L_to_m) + if (id > 0) call post_data(id, G%dxT, diag, .true.) id = register_static_field('ocean_model', 'dyt', diag%axesT1, & - 'Delta(y) at thickness/tracer points (meter)', 'm', interp_method='none') - if (id > 0) call post_data(id, G%dyt, diag, .true.) + 'Delta(y) at thickness/tracer points (meter)', 'm', interp_method='none', conversion=US%L_to_m) + if (id > 0) call post_data(id, G%dyT, diag, .true.) id = register_static_field('ocean_model', 'dxCu', diag%axesCu1, & - 'Delta(x) at u points (meter)', 'm', interp_method='none') + 'Delta(x) at u points (meter)', 'm', interp_method='none', conversion=US%L_to_m) if (id > 0) call post_data(id, G%dxCu, diag, .true.) id = register_static_field('ocean_model', 'dyCu', diag%axesCu1, & - 'Delta(y) at u points (meter)', 'm', interp_method='none') + 'Delta(y) at u points (meter)', 'm', interp_method='none', conversion=US%L_to_m) if (id > 0) call post_data(id, G%dyCu, diag, .true.) id = register_static_field('ocean_model', 'dxCv', diag%axesCv1, & - 'Delta(x) at v points (meter)', 'm', interp_method='none') + 'Delta(x) at v points (meter)', 'm', interp_method='none', conversion=US%L_to_m) if (id > 0) call post_data(id, G%dxCv, diag, .true.) id = register_static_field('ocean_model', 'dyCv', diag%axesCv1, & - 'Delta(y) at v points (meter)', 'm', interp_method='none') + 'Delta(y) at v points (meter)', 'm', interp_method='none', conversion=US%L_to_m) if (id > 0) call post_data(id, G%dyCv, diag, .true.) id = register_static_field('ocean_model', 'dyCuo', diag%axesCu1, & - 'Open meridional grid spacing at u points (meter)', 'm', interp_method='none') + 'Open meridional grid spacing at u points (meter)', 'm', interp_method='none', conversion=US%L_to_m) if (id > 0) call post_data(id, G%dy_Cu, diag, .true.) id = register_static_field('ocean_model', 'dxCvo', diag%axesCv1, & - 'Open zonal grid spacing at v points (meter)', 'm', interp_method='none') + 'Open zonal grid spacing at v points (meter)', 'm', interp_method='none', conversion=US%L_to_m) if (id > 0) call post_data(id, G%dx_Cv, diag, .true.) id = register_static_field('ocean_model', 'sin_rot', diag%axesT1, & diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 73dc411fa5..d6f495faa5 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -305,9 +305,9 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various @@ -387,6 +387,8 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ real, dimension(SZI_(G),SZJ_(G)) :: & Temp_int, Salt_int ! Layer and cell integrated heat and salt [J] and [g Salt]. real :: H_to_kg_m2 ! Local copy of a unit conversion factor. + real :: KE_scale_factor ! The combination of unit rescaling factors in the kinetic energy + ! calculation [kg T2 L-2 s-2 H-1 ~> kg m-3 or nondim] integer :: num_nc_fields ! The number of fields that will actually go into ! the NetCDF file. integer :: i, j, k, is, ie, js, je, ns, nz, m, Isq, Ieq, Jsq, Jeq @@ -483,7 +485,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ "write_energy: Module must be initialized before it is used.") do j=js,je ; do i=is,ie - areaTm(i,j) = G%mask2dT(i,j)*G%areaT(i,j) + areaTm(i,j) = G%mask2dT(i,j)*US%L_to_m**2*G%areaT(i,j) enddo ; enddo if (GV%Boussinesq) then @@ -664,7 +666,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ hint = Z_0APE(K) + (hbelow - G%bathyT(i,j)) hbot = Z_0APE(K) - G%bathyT(i,j) hbot = (hbot + ABS(hbot)) * 0.5 - PE_pt(i,j,K) = 0.5 * areaTm(i,j) * US%Z_to_m*(GV%Rho0*US%L_to_m**2*US%s_to_T**2*GV%g_prime(K)) * & + PE_pt(i,j,K) = 0.5 * areaTm(i,j) * US%Z_to_m*US%L_T_to_m_s**2*(GV%Rho0*GV%g_prime(K)) * & (hint * hint - hbot * hbot) enddo enddo ; enddo @@ -673,7 +675,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ do k=nz,1,-1 hint = Z_0APE(K) + eta(i,j,K) ! eta and H_0 have opposite signs. hbot = max(Z_0APE(K) - G%bathyT(i,j), 0.0) - PE_pt(i,j,K) = 0.5 * (areaTm(i,j) * US%Z_to_m*(GV%Rho0*US%L_to_m**2*US%s_to_T**2*GV%g_prime(K))) * & + PE_pt(i,j,K) = 0.5 * (areaTm(i,j) * US%Z_to_m*US%L_T_to_m_s**2*(GV%Rho0*GV%g_prime(K))) * & (hint * hint - hbot * hbot) enddo enddo ; enddo @@ -687,9 +689,10 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ endif ! Calculate the Kinetic Energy integrated over each layer. + KE_scale_factor = GV%H_to_kg_m2*US%L_T_to_m_s**2 tmp1(:,:,:) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie - tmp1(i,j,k) = (0.25 * H_to_kg_m2 * (areaTm(i,j) * h(i,j,k))) * & + tmp1(i,j,k) = (0.25 * KE_scale_factor * (areaTm(i,j) * h(i,j,k))) * & (u(I-1,j,k)**2 + u(I,j,k)**2 + v(i,J-1,k)**2 + v(i,J,k)**2) enddo ; enddo ; enddo KE_tot = reproducing_sum(tmp1, sums=KE) @@ -713,21 +716,21 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ max_CFL(1:2) = 0.0 do k=1,nz ; do j=js,je ; do I=Isq,Ieq if (u(I,j,k) < 0.0) then - CFL_trans = (-u(I,j,k) * CS%dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) + CFL_trans = (-u(I,j,k) * US%s_to_T*CS%dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) else - CFL_trans = (u(I,j,k) * CS%dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) + CFL_trans = (u(I,j,k) * US%s_to_T*CS%dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) endif - CFL_lin = abs(u(I,j,k) * CS%dt) * G%IdxCu(I,j) + CFL_lin = abs(u(I,j,k) * US%s_to_T*CS%dt) * G%IdxCu(I,j) max_CFL(1) = max(max_CFL(1), CFL_trans) max_CFL(2) = max(max_CFL(2), CFL_lin) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie if (v(i,J,k) < 0.0) then - CFL_trans = (-v(i,J,k) * CS%dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) + CFL_trans = (-v(i,J,k) * US%s_to_T*CS%dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) else - CFL_trans = (v(i,J,k) * CS%dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) + CFL_trans = (v(i,J,k) * US%s_to_T*CS%dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) endif - CFL_lin = abs(v(i,J,k) * CS%dt) * G%IdyCv(i,J) + CFL_lin = abs(v(i,J,k) * US%s_to_T*CS%dt) * G%IdyCv(i,J) max_CFL(1) = max(max_CFL(1), CFL_trans) max_CFL(2) = max(max_CFL(2), CFL_lin) enddo ; enddo ; enddo @@ -972,7 +975,7 @@ subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) if (associated(fluxes%evap)) then if (associated(fluxes%lprec) .and. associated(fluxes%fprec)) then do j=js,je ; do i=is,ie - FW_in(i,j) = dt*G%areaT(i,j)*(fluxes%evap(i,j) + & + FW_in(i,j) = dt*G%US%L_to_m**2*G%areaT(i,j)*(fluxes%evap(i,j) + & (((fluxes%lprec(i,j) + fluxes%vprec(i,j)) + fluxes%lrunoff(i,j)) + & (fluxes%fprec(i,j) + fluxes%frunoff(i,j)))) enddo ; enddo @@ -983,25 +986,25 @@ subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) endif if (associated(fluxes%seaice_melt)) then ; do j=js,je ; do i=is,ie - FW_in(i,j) = FW_in(i,j) + dt * G%areaT(i,j) * fluxes%seaice_melt(i,j) + FW_in(i,j) = FW_in(i,j) + dt * G%US%L_to_m**2*G%areaT(i,j) * fluxes%seaice_melt(i,j) enddo ; enddo ; endif salt_in(:,:) = 0.0 ; heat_in(:,:) = 0.0 if (CS%use_temperature) then if (associated(fluxes%sw)) then ; do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + dt*G%areaT(i,j) * (fluxes%sw(i,j) + & + heat_in(i,j) = heat_in(i,j) + dt*G%US%L_to_m**2*G%areaT(i,j) * (fluxes%sw(i,j) + & (fluxes%lw(i,j) + (fluxes%latent(i,j) + fluxes%sens(i,j)))) enddo ; enddo ; endif if (associated(fluxes%seaice_melt_heat)) then ; do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + dt*G%areaT(i,j) * fluxes%seaice_melt_heat(i,j) + heat_in(i,j) = heat_in(i,j) + dt*G%US%L_to_m**2*G%areaT(i,j) * fluxes%seaice_melt_heat(i,j) enddo ; enddo ; endif ! smg: new code ! include heat content from water transport across ocean surface ! if (associated(fluxes%heat_content_lprec)) then ; do j=js,je ; do i=is,ie -! heat_in(i,j) = heat_in(i,j) + dt*G%areaT(i,j) * & +! heat_in(i,j) = heat_in(i,j) + dt*G%US%L_to_m**2*G%areaT(i,j) * & ! (fluxes%heat_content_lprec(i,j) + (fluxes%heat_content_fprec(i,j) & ! + (fluxes%heat_content_lrunoff(i,j) + (fluxes%heat_content_frunoff(i,j) & ! + (fluxes%heat_content_cond(i,j) + (fluxes%heat_content_vprec(i,j) & @@ -1011,7 +1014,7 @@ subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) ! smg: old code if (associated(sfc_state%TempxPmE)) then do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + (C_p * G%areaT(i,j)) * sfc_state%TempxPmE(i,j) + heat_in(i,j) = heat_in(i,j) + (C_p * G%US%L_to_m**2*G%areaT(i,j)) * sfc_state%TempxPmE(i,j) enddo ; enddo elseif (associated(fluxes%evap)) then do j=js,je ; do i=is,ie @@ -1023,23 +1026,23 @@ subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) ! The following heat sources may or may not be used. if (associated(sfc_state%internal_heat)) then do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + (C_p * G%areaT(i,j)) * & + heat_in(i,j) = heat_in(i,j) + (C_p * G%US%L_to_m**2*G%areaT(i,j)) * & sfc_state%internal_heat(i,j) enddo ; enddo endif if (associated(sfc_state%frazil)) then ; do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + G%areaT(i,j) * sfc_state%frazil(i,j) + heat_in(i,j) = heat_in(i,j) + G%US%L_to_m**2*G%areaT(i,j) * sfc_state%frazil(i,j) enddo ; enddo ; endif if (associated(fluxes%heat_added)) then ; do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + dt*G%areaT(i,j)*fluxes%heat_added(i,j) + heat_in(i,j) = heat_in(i,j) + dt*G%US%L_to_m**2*G%areaT(i,j)*fluxes%heat_added(i,j) enddo ; enddo ; endif ! if (associated(sfc_state%sw_lost)) then ; do j=js,je ; do i=is,ie -! heat_in(i,j) = heat_in(i,j) - G%areaT(i,j) * sfc_state%sw_lost(i,j) +! heat_in(i,j) = heat_in(i,j) - G%US%L_to_m**2*G%areaT(i,j) * sfc_state%sw_lost(i,j) ! enddo ; enddo ; endif if (associated(fluxes%salt_flux)) then ; do j=js,je ; do i=is,ie ! convert salt_flux from kg (salt)/(m^2 s) to ppt * [m s-1]. - salt_in(i,j) = dt*G%areaT(i,j)*(1000.0*fluxes%salt_flux(i,j)) + salt_in(i,j) = dt*G%US%L_to_m**2*G%areaT(i,j)*(1000.0*fluxes%salt_flux(i,j)) enddo ; enddo ; endif endif @@ -1128,7 +1131,7 @@ subroutine create_depth_list(G, CS) list_pos = (j_global-1)*G%Domain%niglobal + i_global Dlist(list_pos) = G%bathyT(i,j) - Arealist(list_pos) = G%mask2dT(i,j) * G%areaT(i,j) + Arealist(list_pos) = G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) enddo ; enddo ! These sums reproduce across PEs because the arrays are only nonzero on one PE. @@ -1488,7 +1491,7 @@ subroutine get_depth_list_checksums(G, depth_chksum, area_chksum) ! Area checksum do j=G%jsc,G%jec ; do i=G%isc,G%iec - field(i,j) = G%mask2dT(i,j) * G%areaT(i,j) + field(i,j) = G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) enddo ; enddo write(area_chksum, '(Z16)') mpp_chksum(field(:,:)) diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 5c7dabeed9..f8fc9b7cf9 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -522,7 +522,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables integer, intent(in) :: nmodes !< Number of modes - real, dimension(G%isd:G%ied,G%jsd:G%jed,nmodes), intent(out) :: cn !< Waves speeds [m s-1] + real, dimension(G%isd:G%ied,G%jsd:G%jed,nmodes), intent(out) :: cn !< Waves speeds [L T-1 ~> m s-1] type(wave_speed_CS), optional, pointer :: CS !< Control structure for MOM_wave_speed logical, optional, intent(in) :: full_halos !< If true, do the calculation !! over the entire computational domain. @@ -577,7 +577,8 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) integer :: kf(SZI_(G)) integer, parameter :: max_itt = 10 logical :: use_EOS ! If true, density is calculated from T & S using the equation of state. - real, dimension(SZK_(G)+1) :: z_int, N2 + real, dimension(SZK_(G)+1) :: z_int + ! real, dimension(SZK_(G)+1) :: N2 integer :: nsub ! number of subintervals used for root finding integer, parameter :: sub_it_max = 4 ! maximum number of times to subdivide interval @@ -778,12 +779,12 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) do K=2,kc Igl(K) = 1.0/(gprime(K)*Hc(k)) ; Igu(K) = 1.0/(gprime(K)*Hc(k-1)) z_int(K) = z_int(K-1) + Hc(k-1) - N2(K) = US%m_to_Z**2*gprime(K)/(0.5*(Hc(k)+Hc(k-1))) + ! N2(K) = US%m_to_Z**2*gprime(K)/(0.5*(Hc(k)+Hc(k-1))) speed2_tot = speed2_tot + gprime(K)*(Hc(k-1)+Hc(k)) enddo ! Set stratification for surface and bottom (setting equal to nearest interface for now) - N2(1) = N2(2) ; N2(kc+1) = N2(kc) - ! Calcualte depth at bottom + ! N2(1) = N2(2) ; N2(kc+1) = N2(kc) + ! Calculate depth at bottom z_int(kc+1) = z_int(kc)+Hc(kc) ! check that thicknesses sum to total depth if (abs(z_int(kc+1)-htot(i)) > 1.e-12*htot(i)) then @@ -940,6 +941,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) else cn(i,j,2:nmodes) = 0.0 ! else too small to worry about endif ! if nmodes>1 .and. kc>nmodes .and. c1>c1_thresh + do m=1,nmodes ; cn(i,j,m) = US%m_s_to_L_T*cn(i,j,m) ; enddo else cn(i,j,:) = 0.0 endif ! if more than 2 layers diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index 0b7155826a..ac28a8d012 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -96,9 +96,9 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: cn !< The (non-rotational) mode internal - !! gravity wave speed [m s-1]. + !! gravity wave speed [L T-1 ~> m s-1]. integer, intent(in) :: ModeNum !< Mode number - real, intent(in) :: freq !< Intrinsic wave frequency [s-1]. + real, intent(in) :: freq !< Intrinsic wave frequency [T-1 ~> s-1]. type(wave_structure_CS), pointer :: CS !< The control structure returned by a !! previous call to wave_structure_init. real, dimension(SZI_(G),SZJ_(G)), & @@ -130,14 +130,14 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo real :: I_Hnew, drxh_sum real, parameter :: tol1 = 0.0001, tol2 = 0.001 real, pointer, dimension(:,:,:) :: T => NULL(), S => NULL() - real :: g_Rho0 ! G_Earth/Rho0 in m5 Z-1 s-2 kg-1. - real :: rescale, I_rescale + real :: g_Rho0 ! G_Earth/Rho0 in [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1]. + ! real :: rescale, I_rescale integer :: kf(SZI_(G)) integer, parameter :: max_itt = 1 ! number of times to iterate in solving for eigenvector - real, parameter :: cg_subRO = 1e-100 ! a very small number + real :: cg_subRO ! A tiny wave speed to prevent division by zero [L T-1 ~> m s-1] real, parameter :: a_int = 0.5 ! value of normalized integral: \int(w_strct^2)dz = a_int real :: I_a_int ! inverse of a_int - real :: f2 ! squared Coriolis frequency + real :: f2 ! squared Coriolis frequency [T-2 ~> s-2] real :: Kmag2 ! magnitude of horizontal wave number squared logical :: use_EOS ! If true, density is calculated from T & S using an ! equation of state. @@ -179,10 +179,11 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo S => tv%S ; T => tv%T g_Rho0 = US%L_T_to_m_s**2 * GV%g_Earth /GV%Rho0 + cg_subRO = 1e-100*US%m_s_to_L_T ! The hard-coded value here might need to increase. use_EOS = associated(tv%eqn_of_state) H_to_pres = GV%Z_to_H*GV%H_to_Pa - rescale = 1024.0**4 ; I_rescale = 1.0/rescale + ! rescale = 1024.0**4 ; I_rescale = 1.0/rescale min_h_frac = tol1 / real(nz) @@ -248,7 +249,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo !----------------------------------- if (G%mask2dT(i,j) > 0.5) then - lam = 1/(cn(i,j)**2) + lam = 1/(US%L_T_to_m_s**2 * cn(i,j)**2) ! Calculate drxh_sum if (use_EOS) then @@ -421,7 +422,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo do itt=1,max_itt call tridiag_solver(a_diag(1:kc-1),b_diag(1:kc-1),c_diag(1:kc-1), & -lam_z(1:kc-1),e_guess(1:kc-1),"TDMA_H",e_itt) - e_guess(1:kc-1) = e_itt(1:kc-1)/sqrt(sum(e_itt(1:kc-1)**2)) + e_guess(1:kc-1) = e_itt(1:kc-1) / sqrt(sum(e_itt(1:kc-1)**2)) enddo ! itt-loop w_strct(2:kc) = e_guess(1:kc-1) w_strct(1) = 0.0 ! rigid lid at surface @@ -448,26 +449,26 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo enddo !### Some mathematical cancellations could occur in the next two lines. w2avg = w2avg / htot(i,j) - w_strct = w_strct / sqrt(htot(i,j)*w2avg*I_a_int) + w_strct(:) = w_strct(:) / sqrt(htot(i,j)*w2avg*I_a_int) ! Calculate vertical structure function of u (i.e. dw/dz) do K=2,nzm-1 u_strct(K) = 0.5*((w_strct(K-1) - w_strct(K) )/dz(k-1) + & - (w_strct(K) - w_strct(K+1))/dz(k)) + (w_strct(K) - w_strct(K+1))/dz(k)) enddo u_strct(1) = (w_strct(1) - w_strct(2) )/dz(1) - u_strct(nzm) = (w_strct(nzm-1)- w_strct(nzm))/dz(nzm-1) + u_strct(nzm) = (w_strct(nzm-1)- w_strct(nzm))/dz(nzm-1) ! Calculate wavenumber magnitude - f2 = US%s_to_T**2 * G%CoriolisBu(I,J)**2 + f2 = G%CoriolisBu(I,J)**2 !f2 = 0.25*US%s_to_T**2 *((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & ! (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) - Kmag2 = (freq**2 - f2) / (cn(i,j)**2 + cg_subRO**2) + Kmag2 = US%m_to_L**2 * (freq**2 - f2) / (cn(i,j)**2 + cg_subRO**2) ! Calculate terms in vertically integrated energy equation int_dwdz2 = 0.0 ; int_w2 = 0.0 ; int_N2w2 = 0.0 - u_strct2 = u_strct(1:nzm)**2 - w_strct2 = w_strct(1:nzm)**2 + u_strct2(:) = u_strct(1:nzm)**2 + w_strct2(:) = w_strct(1:nzm)**2 ! vertical integration with Trapezoidal rule do k=1,nzm-1 int_dwdz2 = int_dwdz2 + 0.5*(u_strct2(K)+u_strct2(K+1))*dz(k) @@ -477,8 +478,9 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo ! Back-calculate amplitude from energy equation if (Kmag2 > 0.0) then - KE_term = 0.25*GV%Rho0*( (1+f2/freq**2)/Kmag2*int_dwdz2 + int_w2 ) - PE_term = 0.25*GV%Rho0*( int_N2w2/freq**2 ) + !### This should be simpified to use a single division. + KE_term = 0.25*GV%Rho0*( ((1.0 + f2/freq**2) / Kmag2)*int_dwdz2 + int_w2 ) + PE_term = 0.25*GV%Rho0*( int_N2w2/(US%s_to_T*freq)**2 ) if (En(i,j) >= 0.0) then W0 = sqrt( En(i,j)/(KE_term + PE_term) ) else @@ -487,14 +489,15 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo W0 = 0.0 endif ! Calculate actual vertical velocity profile and derivative - W_profile = W0*w_strct - dWdz_profile = W0*u_strct + W_profile(:) = W0*w_strct(:) + dWdz_profile(:) = W0*u_strct(:) ! Calculate average magnitude of actual horizontal velocity over a period - Uavg_profile = abs(dWdz_profile) * sqrt((1+f2/freq**2)/(2.0*Kmag2)) + !### This should be simpified to use a single division. + Uavg_profile(:) = abs(dWdz_profile(:)) * sqrt((1.0 + f2/freq**2) / (2.0*Kmag2)) else - W_profile = 0.0 - dWdz_profile = 0.0 - Uavg_profile = 0.0 + W_profile(:) = 0.0 + dWdz_profile(:) = 0.0 + Uavg_profile(:) = 0.0 endif ! Store values in control structure diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 9320f503b5..54f1934abd 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -3868,7 +3868,7 @@ subroutine downsample_field_3d(field_in, field_out, dl, method, mask, diag_cs, d total_weight = 0.0 do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 ! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 !This seems to be faster!!!! - weight = mask(ii,jj,k)*diag_cs%G%areaT(ii,jj)*diag_cs%h(ii,jj,k) + weight = mask(ii,jj,k)*diag_cs%G%US%L_to_m**2*diag_cs%G%areaT(ii,jj)*diag_cs%h(ii,jj,k) total_weight = total_weight + weight ave=ave+field_in(ii,jj,k)*weight enddo; enddo @@ -3896,7 +3896,7 @@ subroutine downsample_field_3d(field_in, field_out, dl, method, mask, diag_cs, d total_weight = 0.0 do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 ! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 - weight = mask(ii,jj,k)*diag_cs%G%areaT(ii,jj) + weight = mask(ii,jj,k)*diag_cs%G%US%L_to_m**2*diag_cs%G%areaT(ii,jj) total_weight = total_weight + weight ave=ave+field_in(ii,jj,k)*weight enddo; enddo @@ -3910,7 +3910,7 @@ subroutine downsample_field_3d(field_in, field_out, dl, method, mask, diag_cs, d total_weight = 0.0 ii=i0 do jj=j0,j0+dl-1 - weight =mask(ii,jj,k)*diag_cs%G%dyCu(ii,jj)*diag_cs%h(ii,jj,k) + weight =mask(ii,jj,k)*diag_cs%G%US%L_to_m*diag_cs%G%dyCu(ii,jj) * diag_cs%h(ii,jj,k) total_weight = total_weight +weight ave=ave+field_in(ii,jj,k)*weight enddo @@ -3966,7 +3966,7 @@ subroutine downsample_field_3d(field_in, field_out, dl, method, mask, diag_cs, d total_weight = 0.0 jj=j0 do ii=i0,i0+dl-1 - weight = mask(ii,jj,k)*diag_cs%G%dxCv(ii,jj)*diag_cs%h(ii,jj,k) + weight = mask(ii,jj,k)*diag_cs%G%US%L_to_m*diag_cs%G%dxCv(ii,jj)*diag_cs%h(ii,jj,k) total_weight = total_weight + weight ave=ave+field_in(ii,jj,k)*weight enddo @@ -4037,7 +4037,7 @@ subroutine downsample_field_2d(field_in, field_out, dl, method, mask, diag_cs, d total_weight = 0.0 do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 ! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 - weight = mask(ii,jj)*diag_cs%G%areaT(ii,jj) + weight = mask(ii,jj)*diag_cs%G%US%L_to_m**2*diag_cs%G%areaT(ii,jj) total_weight = total_weight + weight ave=ave+field_in(ii,jj)*weight enddo; enddo @@ -4093,7 +4093,7 @@ subroutine downsample_field_2d(field_in, field_out, dl, method, mask, diag_cs, d total_weight = 0.0 ii=i0 do jj=j0,j0+dl-1 - weight =mask(ii,jj)*diag_cs%G%dyCu(ii,jj)!*diag_cs%h(ii,jj,1) !Niki? + weight = mask(ii,jj)*diag_cs%G%US%L_to_m*diag_cs%G%dyCu(ii,jj)!*diag_cs%h(ii,jj,1) !Niki? total_weight = total_weight +weight ave=ave+field_in(ii,jj)*weight enddo @@ -4107,7 +4107,7 @@ subroutine downsample_field_2d(field_in, field_out, dl, method, mask, diag_cs, d total_weight = 0.0 jj=j0 do ii=i0,i0+dl-1 - weight =mask(ii,jj)*diag_cs%G%dxCv(ii,jj)!*diag_cs%h(ii,jj,1) !Niki? + weight = mask(ii,jj)*diag_cs%G%US%L_to_m*diag_cs%G%dxCv(ii,jj)!*diag_cs%h(ii,jj,1) !Niki? total_weight = total_weight +weight ave=ave+field_in(ii,jj)*weight enddo diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index 6640a4b15a..8f1d309b06 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -673,14 +673,14 @@ subroutine horizontally_average_diag_field(G, h, staggered_in_x, staggered_in_y, if (is_extensive) then do j=G%jsc, G%jec ; do I=G%isc, G%iec I1 = I - G%isdB + 1 - volume(I,j,k) = G%areaCu(I,j) * G%mask2dCu(I,j) + volume(I,j,k) = G%US%L_to_m**2*G%areaCu(I,j) * G%mask2dCu(I,j) stuff(I,j,k) = volume(I,j,k) * field(I1,j,k) enddo ; enddo else ! Intensive do j=G%jsc, G%jec ; do I=G%isc, G%iec I1 = i - G%isdB + 1 height = 0.5 * (h(i,j,k) + h(i+1,j,k)) - volume(I,j,k) = G%areaCu(I,j) * height * G%mask2dCu(I,j) + volume(I,j,k) = G%US%L_to_m**2*G%areaCu(I,j) * height * G%mask2dCu(I,j) stuff(I,j,k) = volume(I,j,k) * field(I1,j,k) enddo ; enddo endif @@ -689,7 +689,7 @@ subroutine horizontally_average_diag_field(G, h, staggered_in_x, staggered_in_y, do k=1,nz do j=G%jsc, G%jec ; do I=G%isc, G%iec I1 = I - G%isdB + 1 - volume(I,j,k) = G%areaCu(I,j) * G%mask2dCu(I,j) + volume(I,j,k) = G%US%L_to_m**2*G%areaCu(I,j) * G%mask2dCu(I,j) stuff(I,j,k) = volume(I,j,k) * field(I1,j,k) enddo ; enddo enddo @@ -701,14 +701,14 @@ subroutine horizontally_average_diag_field(G, h, staggered_in_x, staggered_in_y, if (is_extensive) then do J=G%jsc, G%jec ; do i=G%isc, G%iec J1 = J - G%jsdB + 1 - volume(i,J,k) = G%areaCv(i,J) * G%mask2dCv(i,J) + volume(i,J,k) = G%US%L_to_m**2*G%areaCv(i,J) * G%mask2dCv(i,J) stuff(i,J,k) = volume(i,J,k) * field(i,J1,k) enddo ; enddo else ! Intensive do J=G%jsc, G%jec ; do i=G%isc, G%iec J1 = J - G%jsdB + 1 height = 0.5 * (h(i,j,k) + h(i,j+1,k)) - volume(i,J,k) = G%areaCv(i,J) * height * G%mask2dCv(i,J) + volume(i,J,k) = G%US%L_to_m**2*G%areaCv(i,J) * height * G%mask2dCv(i,J) stuff(i,J,k) = volume(i,J,k) * field(i,J1,k) enddo ; enddo endif @@ -717,7 +717,7 @@ subroutine horizontally_average_diag_field(G, h, staggered_in_x, staggered_in_y, do k=1,nz do J=G%jsc, G%jec ; do i=G%isc, G%iec J1 = J - G%jsdB + 1 - volume(i,J,k) = G%areaCv(i,J) * G%mask2dCv(i,J) + volume(i,J,k) = G%US%L_to_m**2*G%areaCv(i,J) * G%mask2dCv(i,J) stuff(i,J,k) = volume(i,J,k) * field(i,J1,k) enddo ; enddo enddo @@ -729,7 +729,7 @@ subroutine horizontally_average_diag_field(G, h, staggered_in_x, staggered_in_y, if (is_extensive) then do j=G%jsc, G%jec ; do i=G%isc, G%iec if (h(i,j,k) > 0.) then - volume(i,j,k) = G%areaT(i,j) * G%mask2dT(i,j) + volume(i,j,k) = G%US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j) stuff(i,j,k) = volume(i,j,k) * field(i,j,k) else volume(i,j,k) = 0. @@ -738,7 +738,7 @@ subroutine horizontally_average_diag_field(G, h, staggered_in_x, staggered_in_y, enddo ; enddo else ! Intensive do j=G%jsc, G%jec ; do i=G%isc, G%iec - volume(i,j,k) = G%areaT(i,j) * h(i,j,k) * G%mask2dT(i,j) + volume(i,j,k) = G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k) * G%mask2dT(i,j) stuff(i,j,k) = volume(i,j,k) * field(i,j,k) enddo ; enddo endif @@ -746,7 +746,7 @@ subroutine horizontally_average_diag_field(G, h, staggered_in_x, staggered_in_y, else ! Interface do k=1,nz do j=G%jsc, G%jec ; do i=G%isc, G%iec - volume(i,j,k) = G%areaT(i,j) * G%mask2dT(i,j) + volume(i,j,k) = G%US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j) stuff(i,j,k) = volume(i,j,k) * field(i,j,k) enddo ; enddo enddo diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 0a83ef983e..ef74a12c9d 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -7,6 +7,7 @@ module MOM_dyn_horgrid use MOM_hor_index, only : hor_index_type use MOM_domains, only : MOM_domain_type use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING +use MOM_unit_scaling, only : unit_scale_type implicit none ; private @@ -70,12 +71,12 @@ module MOM_dyn_horgrid mask2dT, & !< 0 for land points and 1 for ocean points on the h-grid [nondim]. geoLatT, & !< The geographic latitude at q points [degrees of latitude] or [m]. geoLonT, & !< The geographic longitude at q points [degrees of longitude] or [m]. - dxT, & !< dxT is delta x at h points [m]. - IdxT, & !< 1/dxT [m-1]. - dyT, & !< dyT is delta y at h points [m]. - IdyT, & !< IdyT is 1/dyT [m-1]. - areaT, & !< The area of an h-cell [m2]. - IareaT !< 1/areaT [m-2]. + dxT, & !< dxT is delta x at h points [L ~> m]. + IdxT, & !< 1/dxT [L-1 ~> m-1]. + dyT, & !< dyT is delta y at h points [L ~> m]. + IdyT, & !< IdyT is 1/dyT [L-1 ~> m-1]. + areaT, & !< The area of an h-cell [L2 ~> m2]. + IareaT !< 1/areaT [L-2 ~> m-2]. real, allocatable, dimension(:,:) :: sin_rot !< The sine of the angular rotation between the local model grid's northward !! and the true northward directions [nondim]. @@ -87,36 +88,36 @@ module MOM_dyn_horgrid mask2dCu, & !< 0 for boundary points and 1 for ocean points on the u grid [nondim]. geoLatCu, & !< The geographic latitude at u points [degrees of latitude] or [m]. geoLonCu, & !< The geographic longitude at u points [degrees of longitude] or [m]. - dxCu, & !< dxCu is delta x at u points [m]. - IdxCu, & !< 1/dxCu [m-1]. - dyCu, & !< dyCu is delta y at u points [m]. - IdyCu, & !< 1/dyCu [m-1]. - dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [m]. - IareaCu, & !< The masked inverse areas of u-grid cells [m2]. - areaCu !< The areas of the u-grid cells [m2]. + dxCu, & !< dxCu is delta x at u points [L ~> m]. + IdxCu, & !< 1/dxCu [L-1 ~> m-1]. + dyCu, & !< dyCu is delta y at u points [L ~> m]. + IdyCu, & !< 1/dyCu [L-1 ~> m-1]. + dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [L ~> m]. + IareaCu, & !< The masked inverse areas of u-grid cells [L-2 ~> m-2]. + areaCu !< The areas of the u-grid cells [L2 ~> m2]. real, allocatable, dimension(:,:) :: & mask2dCv, & !< 0 for boundary points and 1 for ocean points on the v grid [nondim]. geoLatCv, & !< The geographic latitude at v points [degrees of latitude] or [m]. geoLonCv, & !< The geographic longitude at v points [degrees of longitude] or [m]. - dxCv, & !< dxCv is delta x at v points [m]. - IdxCv, & !< 1/dxCv [m-1]. - dyCv, & !< dyCv is delta y at v points [m]. - IdyCv, & !< 1/dyCv [m-1]. - dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [m]. - IareaCv, & !< The masked inverse areas of v-grid cells [m2]. - areaCv !< The areas of the v-grid cells [m2]. + dxCv, & !< dxCv is delta x at v points [L ~> m]. + IdxCv, & !< 1/dxCv [L-1 ~> m-1]. + dyCv, & !< dyCv is delta y at v points [L ~> m]. + IdyCv, & !< 1/dyCv [L-1 ~> m-1]. + dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [L ~> m]. + IareaCv, & !< The masked inverse areas of v-grid cells [L-2 ~> m-2]. + areaCv !< The areas of the v-grid cells [L2 ~> m2]. real, allocatable, dimension(:,:) :: & mask2dBu, & !< 0 for boundary points and 1 for ocean points on the q grid [nondim]. geoLatBu, & !< The geographic latitude at q points [degrees of latitude] or [m]. geoLonBu, & !< The geographic longitude at q points [degrees of longitude] or [m]. - dxBu, & !< dxBu is delta x at q points [m]. - IdxBu, & !< 1/dxBu [m-1]. - dyBu, & !< dyBu is delta y at q points [m]. - IdyBu, & !< 1/dyBu [m-1]. - areaBu, & !< areaBu is the area of a q-cell [m2] - IareaBu !< IareaBu = 1/areaBu [m-2]. + dxBu, & !< dxBu is delta x at q points [L ~> m]. + IdxBu, & !< 1/dxBu [L-1 ~> m-1]. + dyBu, & !< dyBu is delta y at q points [L ~> m]. + IdyBu, & !< 1/dyBu [L-1 ~> m-1]. + areaBu, & !< areaBu is the area of a q-cell [L ~> m] + IareaBu !< IareaBu = 1/areaBu [L-2 ~> m-2]. real, pointer, dimension(:) :: gridLatT => NULL() !< The latitude of T points for the purpose of labeling the output axes. @@ -150,10 +151,10 @@ module MOM_dyn_horgrid real, allocatable, dimension(:,:) :: & CoriolisBu !< The Coriolis parameter at corner points [T-1 ~> s-1]. real, allocatable, dimension(:,:) :: & - df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points [T-1 m-1 ~> s-1 m-1]. - df_dy !< Derivative d/dy f (Coriolis parameter) at h-points [T-1 m-1 ~> s-1 m-1]. + df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points [T-1 L-1 ~> s-1 m-1]. + df_dy !< Derivative d/dy f (Coriolis parameter) at h-points [T-1 L-1 ~> s-1 m-1]. - ! These variables are global sums that are useful for 1-d diagnostics + ! These variables are global sums that are useful for 1-d diagnostics and should not be rescaled. real :: areaT_global !< Global sum of h-cell area [m2] real :: IareaT_global !< Global sum of inverse h-cell area (1/areaT_global) [m-2] @@ -312,12 +313,17 @@ subroutine rescale_dyn_horgrid_bathymetry(G, m_in_new_units) end subroutine rescale_dyn_horgrid_bathymetry !> set_derived_dyn_horgrid calculates metric terms that are derived from other metrics. -subroutine set_derived_dyn_horgrid(G) +subroutine set_derived_dyn_horgrid(G, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Various inverse grid spacings and derived areas are calculated within this ! subroutine. + real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] + real :: L_to_m ! A unit conversion factor [L m-1 ~> nondim] integer :: i, j, isd, ied, jsd, jed integer :: IsdB, IedB, JsdB, JedB + m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L + L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB diff --git a/src/framework/MOM_spatial_means.F90 b/src/framework/MOM_spatial_means.F90 index 00f1474879..f7084ee7ea 100644 --- a/src/framework/MOM_spatial_means.F90 +++ b/src/framework/MOM_spatial_means.F90 @@ -36,7 +36,7 @@ function global_area_mean(var,G) tmpForSumming(:,:) = 0. do j=js,je ; do i=is, ie - tmpForSumming(i,j) = ( var(i,j) * (G%areaT(i,j) * G%mask2dT(i,j)) ) + tmpForSumming(i,j) = ( var(i,j) * (G%US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j)) ) enddo ; enddo global_area_mean = reproducing_sum( tmpForSumming ) * G%IareaT_global @@ -54,7 +54,7 @@ function global_area_integral(var,G) tmpForSumming(:,:) = 0. do j=js,je ; do i=is, ie - tmpForSumming(i,j) = ( var(i,j) * (G%areaT(i,j) * G%mask2dT(i,j)) ) + tmpForSumming(i,j) = ( var(i,j) * (G%US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j)) ) enddo ; enddo global_area_integral = reproducing_sum( tmpForSumming ) @@ -77,7 +77,7 @@ function global_layer_mean(var, h, G, GV) tmpForSumming(:,:,:) = 0. ; weight(:,:,:) = 0. do k=1,nz ; do j=js,je ; do i=is,ie - weight(i,j,k) = (GV%H_to_m * h(i,j,k)) * (G%areaT(i,j) * G%mask2dT(i,j)) + weight(i,j,k) = (GV%H_to_m * h(i,j,k)) * (G%US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j)) tmpForSumming(i,j,k) = var(i,j,k) * weight(i,j,k) enddo ; enddo ; enddo @@ -108,7 +108,7 @@ function global_volume_mean(var, h, G, GV) tmpForSumming(:,:) = 0. ; sum_weight(:,:) = 0. do k=1,nz ; do j=js,je ; do i=is,ie - weight_here = (GV%H_to_m * h(i,j,k)) * (G%areaT(i,j) * G%mask2dT(i,j)) + weight_here = (GV%H_to_m * h(i,j,k)) * (G%US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j)) tmpForSumming(i,j) = tmpForSumming(i,j) + var(i,j,k) * weight_here sum_weight(i,j) = sum_weight(i,j) + weight_here enddo ; enddo ; enddo @@ -141,12 +141,12 @@ function global_mass_integral(h, G, GV, var, on_PE_only) if (present(var)) then do k=1,nz ; do j=js,je ; do i=is,ie tmpForSumming(i,j) = tmpForSumming(i,j) + var(i,j,k) * & - ((GV%H_to_kg_m2 * h(i,j,k)) * (G%areaT(i,j) * G%mask2dT(i,j))) + ((GV%H_to_kg_m2 * h(i,j,k)) * (G%US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j))) enddo ; enddo ; enddo else do k=1,nz ; do j=js,je ; do i=is,ie tmpForSumming(i,j) = tmpForSumming(i,j) + & - ((GV%H_to_kg_m2 * h(i,j,k)) * (G%areaT(i,j) * G%mask2dT(i,j))) + ((GV%H_to_kg_m2 * h(i,j,k)) * (G%US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j))) enddo ; enddo ; enddo endif global_sum = .true. ; if (present(on_PE_only)) global_sum = .not.on_PE_only @@ -325,9 +325,9 @@ subroutine adjust_area_mean_to_zero(array, G, scaling) do j=G%jsc,G%jec ; do i=G%isc,G%iec posVals(i,j) = max(0., array(i,j)) - areaXposVals(i,j) = G%areaT(i,j) * posVals(i,j) + areaXposVals(i,j) = G%US%L_to_m**2*G%areaT(i,j) * posVals(i,j) negVals(i,j) = min(0., array(i,j)) - areaXnegVals(i,j) = G%areaT(i,j) * negVals(i,j) + areaXnegVals(i,j) = G%US%L_to_m**2*G%areaT(i,j) * negVals(i,j) enddo ; enddo areaIntPosVals = reproducing_sum( areaXposVals ) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index bc3f8323f0..d07fe42676 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -652,7 +652,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) if (CS%debug) call MOM_forcing_chksum("Before add shelf flux", fluxes, G, CS%US, haloshift=0) - call add_shelf_flux(G, CS, state, fluxes) + call add_shelf_flux(G, US, CS, state, fluxes) ! now the thermodynamic data is passed on... time to update the ice dynamic quantities @@ -686,7 +686,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) call disable_averaging(CS%diag) if (present(forces)) then - call add_shelf_forces(G, CS, forces, do_shelf_area=(CS%active_shelf_dynamics .or. & + call add_shelf_forces(G, US, CS, forces, do_shelf_area=(CS%active_shelf_dynamics .or. & CS%override_shelf_movement)) endif @@ -750,8 +750,9 @@ end subroutine change_thickness_using_melt !> This subroutine adds the mechanical forcing fields and perhaps shelf areas, based on !! the ice state in ice_shelf_CS. -subroutine add_shelf_forces(G, CS, forces, do_shelf_area) +subroutine add_shelf_forces(G, US, CS, forces, do_shelf_area) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(ice_shelf_CS), pointer :: CS !< This module's control structure. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces logical, optional, intent(in) :: do_shelf_area !< If true find the shelf-covered areas. @@ -780,20 +781,20 @@ subroutine add_shelf_forces(G, CS, forces, do_shelf_area) forces%frac_shelf_u(I,j) = 0.0 if ((G%areaT(i,j) + G%areaT(i+1,j) > 0.0)) & ! .and. (G%areaCu(I,j) > 0.0)) & forces%frac_shelf_u(I,j) = ((ISS%area_shelf_h(i,j) + ISS%area_shelf_h(i+1,j)) / & - (G%areaT(i,j) + G%areaT(i+1,j))) + (US%L_to_m**2*G%areaT(i,j) + US%L_to_m**2*G%areaT(i+1,j))) enddo ; enddo do J=jsd,jed-1 ; do i=isd,ied forces%frac_shelf_v(i,J) = 0.0 if ((G%areaT(i,j) + G%areaT(i,j+1) > 0.0)) & ! .and. (G%areaCv(i,J) > 0.0)) & forces%frac_shelf_v(i,J) = ((ISS%area_shelf_h(i,j) + ISS%area_shelf_h(i,j+1)) / & - (G%areaT(i,j) + G%areaT(i,j+1))) + (US%L_to_m**2*G%areaT(i,j) + US%L_to_m**2*G%areaT(i,j+1))) enddo ; enddo call pass_vector(forces%frac_shelf_u, forces%frac_shelf_v, G%domain, TO_ALL, CGRID_NE) endif !### Consider working over a smaller array range. do j=jsd,jed ; do i=isd,ied - press_ice = (ISS%area_shelf_h(i,j) * G%IareaT(i,j)) * (CS%g_Earth * ISS%mass_shelf(i,j)) + press_ice = (ISS%area_shelf_h(i,j) * US%m_to_L**2*G%IareaT(i,j)) * (CS%g_Earth * ISS%mass_shelf(i,j)) if (associated(forces%p_surf)) then if (.not.forces%accumulate_p_surf) forces%p_surf(i,j) = 0.0 forces%p_surf(i,j) = forces%p_surf(i,j) + press_ice @@ -830,8 +831,9 @@ subroutine add_shelf_forces(G, CS, forces, do_shelf_area) end subroutine add_shelf_forces !> This subroutine adds the ice shelf pressure to the fluxes type. -subroutine add_shelf_pressure(G, CS, fluxes) +subroutine add_shelf_pressure(G, US, CS, fluxes) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(ice_shelf_CS), intent(in) :: CS !< This module's control structure. type(forcing), intent(inout) :: fluxes !< A structure of surface fluxes that may be updated. @@ -844,7 +846,7 @@ subroutine add_shelf_pressure(G, CS, fluxes) call MOM_error(FATAL,"add_shelf_pressure: Incompatible ocean and ice shelf grids.") do j=js,je ; do i=is,ie - press_ice = (CS%ISS%area_shelf_h(i,j) * G%IareaT(i,j)) * (CS%g_Earth * CS%ISS%mass_shelf(i,j)) + press_ice = (CS%ISS%area_shelf_h(i,j) * US%m_to_L**2*G%IareaT(i,j)) * (CS%g_Earth * CS%ISS%mass_shelf(i,j)) if (associated(fluxes%p_surf)) then if (.not.fluxes%accumulate_p_surf) fluxes%p_surf(i,j) = 0.0 fluxes%p_surf(i,j) = fluxes%p_surf(i,j) + press_ice @@ -858,8 +860,9 @@ subroutine add_shelf_pressure(G, CS, fluxes) end subroutine add_shelf_pressure !> Updates surface fluxes that are influenced by sub-ice-shelf melting -subroutine add_shelf_flux(G, CS, state, fluxes) +subroutine add_shelf_flux(G, US, CS, state, fluxes) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(ice_shelf_CS), pointer :: CS !< This module's control structure. type(surface), intent(inout) :: state!< Surface ocean state type(forcing), intent(inout) :: fluxes !< A structure of surface fluxes that may be used/updated. @@ -903,7 +906,7 @@ subroutine add_shelf_flux(G, CS, state, fluxes) ISS => CS%ISS - call add_shelf_pressure(G, CS, fluxes) + call add_shelf_pressure(G, US, CS, fluxes) ! Determine ustar and the square magnitude of the velocity in the ! bottom boundary layer. Together these give the TKE source and @@ -942,7 +945,7 @@ subroutine add_shelf_flux(G, CS, state, fluxes) if (CS%active_shelf_dynamics .or. CS%override_shelf_movement) then do j=jsd,jed ; do i=isd,ied if (G%areaT(i,j) > 0.0) & - fluxes%frac_shelf_h(i,j) = ISS%area_shelf_h(i,j) * G%IareaT(i,j) + fluxes%frac_shelf_h(i,j) = ISS%area_shelf_h(i,j) * US%m_to_L**2*G%IareaT(i,j) enddo ; enddo endif @@ -993,7 +996,7 @@ subroutine add_shelf_flux(G, CS, state, fluxes) !### These hard-coded limits need to be corrected. They are inappropriate here. if (G%geoLonT(i,j) >= 790.0 .AND. G%geoLonT(i,j) <= 800.0) then - sponge_area = sponge_area + G%areaT(i,j) + sponge_area = sponge_area + US%L_to_m**2*G%areaT(i,j) endif enddo ; enddo @@ -1121,12 +1124,12 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call MOM_domains_init(CS%grid%domain, param_file, min_halo=wd_halos, symmetric=GRID_SYM_) ! call diag_mediator_init(CS%grid,param_file,CS%diag) ! this needs to be fixed - will probably break when not using coupled driver 0 - call MOM_grid_init(CS%grid, param_file) + call MOM_grid_init(CS%grid, param_file, CS%US) call create_dyn_horgrid(dG, CS%grid%HI) call clone_MOM_domain(CS%grid%Domain, dG%Domain) - call set_grid_metrics(dG, param_file) + call set_grid_metrics(dG, param_file, CS%US) ! call set_diag_mediator_grid(CS%grid, CS%diag) ! The ocean grid possibly uses different symmetry. @@ -1396,7 +1399,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl ! Set up the Coriolis parameter, G%f, usually analytically. call MOM_initialize_rotation(dG%CoriolisBu, dG, param_file, US) ! This copies grid elements, including bathyT and CoriolisBu from dG to CS%grid. - call copy_dyngrid_to_MOM_grid(dG, CS%grid) + call copy_dyngrid_to_MOM_grid(dG, CS%grid, US) call destroy_dyn_horgrid(dG) @@ -1505,13 +1508,13 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call cpu_clock_end(id_clock_pass) do j=jsd,jed ; do i=isd,ied - if (ISS%area_shelf_h(i,j) > G%areaT(i,j)) then + if (ISS%area_shelf_h(i,j) > US%L_to_m**2*G%areaT(i,j)) then call MOM_error(WARNING,"Initialize_ice_shelf: area_shelf_h exceeds G%areaT.") - ISS%area_shelf_h(i,j) = G%areaT(i,j) + ISS%area_shelf_h(i,j) = US%L_to_m**2*G%areaT(i,j) endif enddo ; enddo if (present(fluxes)) then ; do j=jsd,jed ; do i=isd,ied - if (G%areaT(i,j) > 0.0) fluxes%frac_shelf_h(i,j) = ISS%area_shelf_h(i,j) / G%areaT(i,j) + if (G%areaT(i,j) > 0.0) fluxes%frac_shelf_h(i,j) = ISS%area_shelf_h(i,j) / (US%L_to_m**2*G%areaT(i,j)) enddo ; enddo ; endif if (CS%debug) then @@ -1519,9 +1522,9 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl endif if (present(forces)) & - call add_shelf_forces(G, CS, forces, do_shelf_area=.not.CS%solo_ice_sheet) + call add_shelf_forces(G, US, CS, forces, do_shelf_area=.not.CS%solo_ice_sheet) - if (present(fluxes)) call add_shelf_pressure(G, CS, fluxes) + if (present(fluxes)) call add_shelf_pressure(G, US, CS, fluxes) if (CS%active_shelf_dynamics .and. .not.CS%isthermo) then ISS%water_flux(:,:) = 0.0 @@ -1684,7 +1687,7 @@ subroutine update_shelf_mass(G, CS, ISS, Time) ISS%area_shelf_h(i,j) = 0.0 ISS%hmask(i,j) = 0. if (ISS%mass_shelf(i,j) > 0.0) then - ISS%area_shelf_h(i,j) = G%areaT(i,j) + ISS%area_shelf_h(i,j) = G%US%L_to_m**2*G%areaT(i,j) ISS%h_shelf(i,j) = ISS%mass_shelf(i,j) / CS%rho_ice ISS%hmask(i,j) = 1. endif diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 415ae3d813..5e53c09923 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -580,14 +580,16 @@ function ice_time_step_CFL(CS, ISS, G) real :: local_u_max, local_v_max integer :: i, j - min_ratio = 1.0e16 ! This is just an arbitrary large value. + min_ratio = 1.0e16 ! This is just an arbitrary large nondiensional value. do j=G%jsc,G%jec ; do i=G%isc,G%iec ; if (ISS%hmask(i,j) == 1.0) then local_u_max = max(abs(CS%u_shelf(i,j)), abs(CS%u_shelf(i+1,j+1)), & abs(CS%u_shelf(i+1,j)), abs(CS%u_shelf(i,j+1))) local_v_max = max(abs(CS%v_shelf(i,j)), abs(CS%v_shelf(i+1,j+1)), & abs(CS%v_shelf(i+1,j)), abs(CS%v_shelf(i,j+1))) - ratio = min(G%areaT(i,j) / (local_u_max+1.0e-12), G%areaT(i,j) / (local_v_max+1.0e-12)) + ! Here the hard-coded 1e-12 has units of m s-1. Consider revising. + ratio = G%US%L_to_m**2*min(G%areaT(i,j) / (local_u_max + 1.0e-12), & + G%areaT(i,j) / (local_v_max + 1.0e-12)) min_ratio = min(min_ratio, ratio) endif ; enddo ; enddo ! i- and j- loops @@ -869,9 +871,9 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u, v, iters, time) Y(:,:) = G%geoLatBu(i-1:i,j-1:j)*1000 else X(2,:) = G%geoLonBu(i,j)*1000 - X(1,:) = G%geoLonBu(i,j)*1000-G%dxT(i,j) + X(1,:) = G%geoLonBu(i,j)*1000 - US%L_to_m*G%dxT(i,j) Y(:,2) = G%geoLatBu(i,j)*1000 - Y(:,1) = G%geoLatBu(i,j)*1000-G%dyT(i,j) + Y(:,1) = G%geoLatBu(i,j)*1000 - US%L_to_m*G%dyT(i,j) endif call bilinear_shape_functions(X, Y, Phi_temp, area) @@ -896,7 +898,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u, v, iters, time) Au(:,:) = 0.0 ; Av(:,:) = 0.0 call CG_action(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, ISS%hmask, H_node, & - CS%ice_visc, float_cond, G%bathyT(:,:), CS%taub_beta_eff, G%areaT, & + CS%ice_visc, float_cond, G%bathyT(:,:), CS%taub_beta_eff, G%US%L_to_m**2*G%areaT, & G, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi_rhow) err_init = 0 ; err_tempu = 0; err_tempv = 0 @@ -955,7 +957,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u, v, iters, time) Au(:,:) = 0 ; Av(:,:) = 0 call CG_action(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, ISS%hmask, H_node, & - CS%ice_visc, float_cond, G%bathyT(:,:), CS%taub_beta_eff, G%areaT, & + CS%ice_visc, float_cond, G%bathyT(:,:), CS%taub_beta_eff, G%US%L_to_m**2*G%areaT, & G, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi_rhow) err_max = 0 @@ -1120,7 +1122,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, u, v, taudx, taudy, H_node, float_c call CG_action(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, hmask, & H_node, CS%ice_visc, float_cond, G%bathyT(:,:), CS%taub_beta_eff, & - G%areaT, G, isc-1, iec+1, jsc-1, jec+1, CS%density_ice/CS%density_ocean_avg) + G%US%L_to_m**2*G%areaT, G, isc-1, iec+1, jsc-1, jec+1, CS%density_ice/CS%density_ocean_avg) call pass_vector(Au, Av, G%domain, TO_ALL, BGRID_NE) @@ -1191,7 +1193,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, u, v, taudx, taudy, H_node, float_c call CG_action(Au, Av, Du, Dv, Phi, Phisub, CS%umask, CS%vmask, hmask, & H_node, CS%ice_visc, float_cond, G%bathyT(:,:), CS%taub_beta_eff, & - G%areaT, G, is, ie, js, je, CS%density_ice/CS%density_ocean_avg) + G%US%L_to_m**2*G%areaT, G, is, ie, js, je, CS%density_ice/CS%density_ocean_avg) ! Au, Av valid region moves in by 1 @@ -1483,7 +1485,7 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl if (hmask(i,j) == 1) then - dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%areaT(i,j) + dxh = G%US%L_to_m*G%dxT(i,j) ; dyh = G%US%L_to_m*G%dyT(i,j) ; dxdyh = G%US%L_to_m**2*G%areaT(i,j) h_after_uflux(i,j) = h0(i,j) @@ -1603,16 +1605,16 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl if (at_west_bdry .AND. (hmask(i-1,j) == 3)) then u_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i-1,j)) - flux_enter(i,j,1) = ABS(u_face) * G%dyT(i,j) * time_step * CS%thickness_bdry_val(i-1,j) + flux_enter(i,j,1) = ABS(u_face) * G%US%L_to_m*G%dyT(i,j) * time_step * CS%thickness_bdry_val(i-1,j) elseif (CS%u_face_mask(i-1,j) == 4.) then - flux_enter(i,j,1) = G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i-1,j) + flux_enter(i,j,1) = G%US%L_to_m*G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i-1,j) endif if (at_east_bdry .AND. (hmask(i+1,j) == 3)) then u_face = 0.5 * (CS%u_shelf(i,j-1) + CS%u_shelf(i,j)) - flux_enter(i,j,2) = ABS(u_face) * G%dyT(i,j) * time_step * CS%thickness_bdry_val(i+1,j) + flux_enter(i,j,2) = ABS(u_face) * G%US%L_to_m*G%dyT(i,j) * time_step * CS%thickness_bdry_val(i+1,j) elseif (CS%u_face_mask(i+1,j) == 4.) then - flux_enter(i,j,2) = G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i+1,j) + flux_enter(i,j,2) = G%US%L_to_m*G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i+1,j) endif if ((i == is) .AND. (hmask(i,j) == 0) .AND. (hmask(i-1,j) == 1)) then @@ -1712,7 +1714,7 @@ subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, endif if (hmask(i,j) == 1) then - dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%areaT(i,j) + dxh = G%US%L_to_m*G%dxT(i,j) ; dyh = G%US%L_to_m*G%dyT(i,j) ; dxdyh = G%US%L_to_m**2*G%areaT(i,j) h_after_vflux(i,j) = h_after_uflux(i,j) stencil(:) = h_after_uflux(i,j-2:j+2) ! fine as long has ny_halo >= 2 @@ -1819,16 +1821,16 @@ subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, if (at_south_bdry .AND. (hmask(i,j-1) == 3)) then v_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i,j-1)) - flux_enter(i,j,3) = ABS(v_face) * G%dxT(i,j) * time_step * CS%thickness_bdry_val(i,j-1) + flux_enter(i,j,3) = ABS(v_face) * G%US%L_to_m*G%dxT(i,j) * time_step * CS%thickness_bdry_val(i,j-1) elseif (CS%v_face_mask(i,j-1) == 4.) then - flux_enter(i,j,3) = G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j-1) + flux_enter(i,j,3) = G%US%L_to_m*G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j-1) endif if (at_north_bdry .AND. (hmask(i,j+1) == 3)) then v_face = 0.5 * (CS%u_shelf(i-1,j) + CS%u_shelf(i,j)) - flux_enter(i,j,4) = ABS(v_face) * G%dxT(i,j) * time_step * CS%thickness_bdry_val(i,j+1) + flux_enter(i,j,4) = ABS(v_face) * G%US%L_to_m*G%dxT(i,j) * time_step * CS%thickness_bdry_val(i,j+1) elseif (CS%v_face_mask(i,j+1) == 4.) then - flux_enter(i,j,4) = G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j+1) + flux_enter(i,j,4) = G%US%L_to_m*G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j+1) endif if ((j == js) .AND. (hmask(i,j) == 0) .AND. (hmask(i,j-1) == 1)) then @@ -1952,7 +1954,7 @@ subroutine shelf_advance_front(CS, ISS, G, flux_enter) enddo if (n_flux > 0) then - dxdyh = G%areaT(i,j) + dxdyh = G%US%L_to_m**2*G%areaT(i,j) h_reference = h_reference / real(n_flux) partial_vol = ISS%h_shelf(i,j) * ISS%area_shelf_h(i,j) + tot_flux @@ -2140,9 +2142,9 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, TAUD_X, TAUD_Y, OD) cnt = 0 sx = 0 sy = 0 - dxh = G%dxT(i,j) - dyh = G%dyT(i,j) - dxdyh = G%areaT(i,j) + dxh = US%L_to_m*G%dxT(i,j) + dyh = US%L_to_m*G%dyT(i,j) + dxdyh = US%L_to_m**2*G%areaT(i,j) if (ISS%hmask(i,j) == 1) then ! we are inside the global computational bdry, at an ice-filled cell @@ -2671,9 +2673,9 @@ subroutine matrix_diagonal(CS, G, float_cond, H_node, nu, beta, hmask, dens_rati do j=jsc-1,jec+1 ; do i=isc-1,iec+1 ; if (hmask(i,j) == 1) then - dxh = G%dxT(i,j) - dyh = G%dyT(i,j) - dxdyh = G%areaT(i,j) + dxh = G%US%L_to_m*G%dxT(i,j) + dyh = G%US%L_to_m*G%dyT(i,j) + dxdyh = G%US%L_to_m**2*G%areaT(i,j) X(1:2) = G%geoLonBu(i-1:i,j-1)*1000 X(3:4) = G%geoLonBu(i-1:i,j) *1000 @@ -2863,10 +2865,9 @@ subroutine apply_boundary_values(CS, ISS, G, time, Phisub, H_node, nu, beta, flo if ((CS%umask(i-1,j-1) == 3) .OR. (CS%umask(i,j-1) == 3) .OR. & (CS%umask(i-1,j) == 3) .OR. (CS%umask(i,j) == 3)) then - - dxh = G%dxT(i,j) - dyh = G%dyT(i,j) - dxdyh = G%areaT(i,j) + dxh = G%US%L_to_m*G%dxT(i,j) + dyh = G%US%L_to_m*G%dyT(i,j) + dxdyh = G%US%L_to_m**2*G%areaT(i,j) X(1:2) = G%geoLonBu(i-1:i,j-1)*1000 X(3:4) = G%geoLonBu(i-1:i,j)*1000 @@ -2882,8 +2883,6 @@ subroutine apply_boundary_values(CS, ISS, G, time, Phisub, H_node, nu, beta, flo ! Phi (2*i-1,j) gives d(Phi_i)/dx at quadrature point j ! Phi (2*i,j) gives d(Phi_i)/dy at quadrature point j - - do iq=1,2 ; do jq=1,2 uq = CS%u_bdry_val(i-1,j-1) * xquad(3-iq) * xquad(3-jq) + & @@ -3020,9 +3019,9 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u, v) do j=jsd+1,jed-1 do i=isd+1,ied-1 - dxh = G%dxT(i,j) - dyh = G%dyT(i,j) - dxdyh = G%areaT(i,j) + dxh = US%L_to_m*G%dxT(i,j) + dyh = US%L_to_m*G%dyT(i,j) + dxdyh = US%L_to_m**2*G%areaT(i,j) if (ISS%hmask(i,j) == 1) then ux = (u(i,j) + u(i,j-1) - u(i-1,j) - u(i-1,j-1)) / (2*dxh) @@ -3679,7 +3678,7 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f if (hmask(i,j) == 1) then - dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%areaT(i,j) + dxh = G%US%L_to_m*G%dxT(i,j) ; dyh = G%US%L_to_m*G%dyT(i,j) ; dxdyh = G%US%L_to_m**2*G%areaT(i,j) h_after_uflux(i,j) = h0(i,j) @@ -3799,18 +3798,18 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f if (at_west_bdry .AND. (hmask(i-1,j) == 3)) then u_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i-1,j)) - flux_enter(i,j,1) = ABS(u_face) * G%dyT(i,j) * time_step * CS%t_bdry_val(i-1,j)* & + flux_enter(i,j,1) = ABS(u_face) * G%US%L_to_m*G%dyT(i,j) * time_step * CS%t_bdry_val(i-1,j)* & CS%thickness_bdry_val(i+1,j) elseif (CS%u_face_mask(i-1,j) == 4.) then - flux_enter(i,j,1) = G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i-1,j)*CS%t_bdry_val(i-1,j) + flux_enter(i,j,1) = G%US%L_to_m*G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i-1,j)*CS%t_bdry_val(i-1,j) endif if (at_east_bdry .AND. (hmask(i+1,j) == 3)) then u_face = 0.5 * (CS%u_shelf(i,j-1) + CS%u_shelf(i,j)) - flux_enter(i,j,2) = ABS(u_face) * G%dyT(i,j) * time_step * CS%t_bdry_val(i+1,j)* & + flux_enter(i,j,2) = ABS(u_face) * G%US%L_to_m*G%dyT(i,j) * time_step * CS%t_bdry_val(i+1,j)* & CS%thickness_bdry_val(i+1,j) elseif (CS%u_face_mask(i+1,j) == 4.) then - flux_enter(i,j,2) = G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i+1,j) * CS%t_bdry_val(i+1,j) + flux_enter(i,j,2) = G%US%L_to_m*G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i+1,j) * CS%t_bdry_val(i+1,j) endif ! if ((i == is) .AND. (hmask(i,j) == 0) .AND. (hmask(i-1,j) == 1)) then @@ -3907,7 +3906,7 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_aft endif if (hmask(i,j) == 1) then - dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%areaT(i,j) + dxh = G%US%L_to_m*G%dxT(i,j) ; dyh = G%US%L_to_m*G%dyT(i,j) ; dxdyh = G%US%L_to_m**2*G%areaT(i,j) h_after_vflux(i,j) = h_after_uflux(i,j) stencil(:) = h_after_uflux(i,j-2:j+2) ! fine as long has ny_halo >= 2 @@ -4014,18 +4013,18 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_aft if (at_south_bdry .AND. (hmask(i,j-1) == 3)) then v_face = 0.5 * (CS%v_shelf(i-1,j-1) + CS%v_shelf(i,j-1)) - flux_enter(i,j,3) = ABS(v_face) * G%dxT(i,j) * time_step * CS%t_bdry_val(i,j-1)* & + flux_enter(i,j,3) = ABS(v_face) * G%US%L_to_m*G%dxT(i,j) * time_step * CS%t_bdry_val(i,j-1)* & CS%thickness_bdry_val(i,j-1) elseif (CS%v_face_mask(i,j-1) == 4.) then - flux_enter(i,j,3) = G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j-1)*CS%t_bdry_val(i,j-1) + flux_enter(i,j,3) = G%US%L_to_m*G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j-1)*CS%t_bdry_val(i,j-1) endif if (at_north_bdry .AND. (hmask(i,j+1) == 3)) then v_face = 0.5 * (CS%v_shelf(i-1,j) + CS%v_shelf(i,j)) - flux_enter(i,j,4) = ABS(v_face) * G%dxT(i,j) * time_step * CS%t_bdry_val(i,j+1)* & + flux_enter(i,j,4) = ABS(v_face) * G%US%L_to_m*G%dxT(i,j) * time_step * CS%t_bdry_val(i,j+1)* & CS%thickness_bdry_val(i,j+1) elseif (CS%v_face_mask(i,j+1) == 4.) then - flux_enter(i,j,4) = G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j+1)*CS%t_bdry_val(i,j+1) + flux_enter(i,j,4) = G%US%L_to_m*G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j+1)*CS%t_bdry_val(i,j+1) endif ! if ((j == js) .AND. (hmask(i,j) == 0) .AND. (hmask(i,j-1) == 1)) then diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index bc00ac61a9..2ace1b2137 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -128,11 +128,11 @@ subroutine initialize_ice_thickness_from_file(h_shelf, area_shelf_h, hmask, G, U ! update thickness mask - if (area_shelf_h (i,j) >= G%areaT(i,j)) then + if (area_shelf_h (i,j) >= US%L_to_m**2*G%areaT(i,j)) then hmask(i,j) = 1. elseif (area_shelf_h (i,j) == 0.0) then hmask(i,j) = 0. - elseif ((area_shelf_h(i,j) > 0) .and. (area_shelf_h(i,j) <= G%areaT(i,j))) then + elseif ((area_shelf_h(i,j) > 0) .and. (area_shelf_h(i,j) <= US%L_to_m**2*G%areaT(i,j))) then hmask(i,j) = 2. else call MOM_error(FATAL,mdl// " AREA IN CELL OUT OF RANGE") @@ -206,11 +206,11 @@ subroutine initialize_ice_thickness_channel(h_shelf, area_shelf_h, hmask, G, US, h_shelf (i,j) = 0.0 else if (G%geoLonCu(i,j) > edge_pos) then - area_shelf_h(i,j) = G%areaT(i,j) * (edge_pos - G%geoLonCu(i-1,j)) / & + area_shelf_h(i,j) = US%L_to_m**2*G%areaT(i,j) * (edge_pos - G%geoLonCu(i-1,j)) / & (G%geoLonCu(i,j) - G%geoLonCu(i-1,j)) hmask (i,j) = 2.0 else - area_shelf_h(i,j) = G%areaT(i,j) + area_shelf_h(i,j) = US%L_to_m**2*G%areaT(i,j) hmask (i,j) = 1.0 endif diff --git a/src/ice_shelf/MOM_marine_ice.F90 b/src/ice_shelf/MOM_marine_ice.F90 index 5505154d23..16b543387d 100644 --- a/src/ice_shelf/MOM_marine_ice.F90 +++ b/src/ice_shelf/MOM_marine_ice.F90 @@ -80,18 +80,18 @@ subroutine iceberg_forces(G, forces, use_ice_shelf, sfc_state, & do j=js,je ; do I=is-1,ie if ((G%areaT(i,j) + G%areaT(i+1,j) > 0.0)) & ! .and. (G%dxdy_u(I,j) > 0.0)) & forces%frac_shelf_u(I,j) = forces%frac_shelf_u(I,j) + & - (((forces%area_berg(i,j)*G%areaT(i,j)) + & - (forces%area_berg(i+1,j)*G%areaT(i+1,j))) / & - (G%areaT(i,j) + G%areaT(i+1,j)) ) + (((forces%area_berg(i,j)*G%US%L_to_m**2*G%areaT(i,j)) + & + (forces%area_berg(i+1,j)*G%US%L_to_m**2*G%areaT(i+1,j))) / & + (G%US%L_to_m**2*G%areaT(i,j) + G%US%L_to_m**2*G%areaT(i+1,j)) ) forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + kv_rho_ice * & min(forces%mass_berg(i,j), forces%mass_berg(i+1,j)) enddo ; enddo do J=js-1,je ; do i=is,ie if ((G%areaT(i,j) + G%areaT(i,j+1) > 0.0)) & ! .and. (G%dxdy_v(i,J) > 0.0)) & forces%frac_shelf_v(i,J) = forces%frac_shelf_v(i,J) + & - (((forces%area_berg(i,j)*G%areaT(i,j)) + & - (forces%area_berg(i,j+1)*G%areaT(i,j+1))) / & - (G%areaT(i,j) + G%areaT(i,j+1)) ) + (((forces%area_berg(i,j)*G%US%L_to_m**2*G%areaT(i,j)) + & + (forces%area_berg(i,j+1)*G%US%L_to_m**2*G%areaT(i,j+1))) / & + (G%US%L_to_m**2*G%areaT(i,j) + G%US%L_to_m**2*G%areaT(i,j+1)) ) forces%rigidity_ice_v(i,J) = forces%rigidity_ice_v(i,J) + kv_rho_ice * & min(forces%mass_berg(i,j), forces%mass_berg(i,j+1)) enddo ; enddo diff --git a/src/ice_shelf/user_shelf_init.F90 b/src/ice_shelf/user_shelf_init.F90 index ec2787bae3..c0c7c96a59 100644 --- a/src/ice_shelf/user_shelf_init.F90 +++ b/src/ice_shelf/user_shelf_init.F90 @@ -168,11 +168,11 @@ subroutine USER_update_shelf_mass(mass_shelf, area_shelf_h, h_shelf, hmask, G, C h_shelf (i,j) = 0.0 else if (G%geoLonCu(i,j) > edge_pos) then - area_shelf_h(i,j) = G%areaT(i,j) * (edge_pos - G%geoLonCu(i-1,j)) / & + area_shelf_h(i,j) = G%US%L_to_m**2*G%areaT(i,j) * (edge_pos - G%geoLonCu(i-1,j)) / & (G%geoLonCu(i,j) - G%geoLonCu(i-1,j)) hmask (i,j) = 2.0 else - area_shelf_h(i,j) = G%areaT(i,j) + area_shelf_h(i,j) = G%US%L_to_m**2*G%areaT(i,j) hmask (i,j) = 1.0 endif diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index 71d9c4f90b..8ed9a0a4c7 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -78,7 +78,7 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir) inputdir = slasher(inputdir) ! Set up the parameters of the physical domain (i.e. the grid), G - call set_grid_metrics(G, PF) + call set_grid_metrics(G, PF, US) ! Set up the bottom depth, G%bathyT either analytically or from file ! This also sets G%max_depth based on the input parameter MAXIMUM_DEPTH, @@ -99,7 +99,7 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir) call initialize_masks(G, PF, US) ! Make OBC mask consistent with land mask - call open_boundary_impose_land_mask(OBC, G, G%areaCu, G%areaCv) + call open_boundary_impose_land_mask(OBC, G, G%areaCu, G%areaCv, US) if (debug) then call hchksum(G%bathyT, 'MOM_initialize_fixed: depth ', G%HI, haloshift=1, scale=US%Z_to_m) @@ -124,9 +124,9 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir) default="none") select case ( trim(config) ) case ("none") - case ("list") ; call reset_face_lengths_list(G, PF) - case ("file") ; call reset_face_lengths_file(G, PF) - case ("global_1deg") ; call reset_face_lengths_named(G, PF, trim(config)) + case ("list") ; call reset_face_lengths_list(G, PF, US) + case ("file") ; call reset_face_lengths_file(G, PF, US) + case ("global_1deg") ; call reset_face_lengths_named(G, PF, trim(config), US) case default ; call MOM_error(FATAL, "MOM_initialize_fixed: "// & "Unrecognized channel configuration "//trim(config)) end select @@ -152,8 +152,8 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir) call MOM_calculate_grad_Coriolis(G%dF_dx, G%dF_dy, G, US=US) if (debug) then call qchksum(G%CoriolisBu, "MOM_initialize_fixed: f ", G%HI, scale=US%s_to_T) - call hchksum(G%dF_dx, "MOM_initialize_fixed: dF_dx ", G%HI, scale=US%s_to_T) - call hchksum(G%dF_dy, "MOM_initialize_fixed: dF_dy ", G%HI, scale=US%s_to_T) + call hchksum(G%dF_dx, "MOM_initialize_fixed: dF_dx ", G%HI, scale=US%m_to_L*US%s_to_T) + call hchksum(G%dF_dy, "MOM_initialize_fixed: dF_dy ", G%HI, scale=US%m_to_L*US%s_to_T) endif call initialize_grid_rotation_angle(G, PF) diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 305087dc44..1c594f45c1 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -87,10 +87,10 @@ subroutine set_grid_metrics(G, param_file, US) ! These are defaults that may be changed in the next select block. G%x_axis_units = "degrees_east" ; G%y_axis_units = "degrees_north" select case (trim(config)) - case ("mosaic"); call set_grid_metrics_from_mosaic(G, param_file) - case ("cartesian"); call set_grid_metrics_cartesian(G, param_file) - case ("spherical"); call set_grid_metrics_spherical(G, param_file) - case ("mercator"); call set_grid_metrics_mercator(G, param_file) + case ("mosaic"); call set_grid_metrics_from_mosaic(G, param_file, US) + case ("cartesian"); call set_grid_metrics_cartesian(G, param_file, US) + case ("spherical"); call set_grid_metrics_spherical(G, param_file, US) + case ("mercator"); call set_grid_metrics_mercator(G, param_file, US) case ("file"); call MOM_error(FATAL, "MOM_grid_init: set_grid_metrics "//& 'GRID_CONFIG "file" is no longer a supported option. Use a '//& 'mosaic file ("mosaic") or one of the analytic forms instead.') @@ -100,10 +100,10 @@ subroutine set_grid_metrics(G, param_file, US) ! Calculate derived metrics (i.e. reciprocals and products) call callTree_enter("set_derived_metrics(), MOM_grid_initialize.F90") - call set_derived_dyn_horgrid(G) + call set_derived_dyn_horgrid(G, US) call callTree_leave("set_derived_metrics()") - if (debug) call grid_metrics_chksum('MOM_grid_init/set_grid_metrics',G) + if (debug) call grid_metrics_chksum('MOM_grid_init/set_grid_metrics', G, US) call callTree_leave("set_grid_metrics()") end subroutine set_grid_metrics @@ -112,42 +112,40 @@ end subroutine set_grid_metrics !> grid_metrics_chksum performs a set of checksums on metrics on the grid for !! debugging. -subroutine grid_metrics_chksum(parent, G) - character(len=*), intent(in) :: parent !< A string identifying the caller +subroutine grid_metrics_chksum(parent, G, US) + character(len=*), intent(in) :: parent !< A string identifying the caller type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] + real :: L_to_m ! A unit conversion factor [m L-1 ~> nondim] integer :: halo + m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L + L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m halo = min(G%ied-G%iec, G%jed-G%jec, 1) - call hchksum_pair(trim(parent)//': d[xy]T', & - G%dxT, G%dyT, G%HI, haloshift=halo) + call hchksum_pair(trim(parent)//': d[xy]T', G%dxT, G%dyT, G%HI, haloshift=halo, scale=L_to_m) - call uvchksum(trim(parent)//': dxC[uv]', G%dxCu, G%dyCv, G%HI, haloshift=halo) + call uvchksum(trim(parent)//': dxC[uv]', G%dxCu, G%dyCv, G%HI, haloshift=halo, scale=L_to_m) - call uvchksum(trim(parent)//': dxC[uv]', & - G%dyCu, G%dxCv, G%HI, haloshift=halo) + call uvchksum(trim(parent)//': dxC[uv]', G%dyCu, G%dxCv, G%HI, haloshift=halo, scale=L_to_m) - call Bchksum_pair(trim(parent)//': dxB[uv]', & - G%dxBu, G%dyBu, G%HI, haloshift=halo) + call Bchksum_pair(trim(parent)//': dxB[uv]', G%dxBu, G%dyBu, G%HI, haloshift=halo, scale=L_to_m) - call hchksum_pair(trim(parent)//': Id[xy]T', & - G%IdxT, G%IdyT, G%HI, haloshift=halo) + call hchksum_pair(trim(parent)//': Id[xy]T', G%IdxT, G%IdyT, G%HI, haloshift=halo, scale=m_to_L) - call uvchksum(trim(parent)//': Id[xy]C[uv]', & - G%IdxCu, G%IdyCv, G%HI, haloshift=halo) + call uvchksum(trim(parent)//': Id[xy]C[uv]', G%IdxCu, G%IdyCv, G%HI, haloshift=halo, scale=m_to_L) - call uvchksum(trim(parent)//': Id[xy]C[uv]', & - G%IdyCu, G%IdxCv, G%HI, haloshift=halo) + call uvchksum(trim(parent)//': Id[xy]C[uv]', G%IdyCu, G%IdxCv, G%HI, haloshift=halo, scale=m_to_L) - call Bchksum_pair(trim(parent)//': Id[xy]B[uv]', & - G%IdxBu, G%IdyBu, G%HI, haloshift=halo) + call Bchksum_pair(trim(parent)//': Id[xy]B[uv]', G%IdxBu, G%IdyBu, G%HI, haloshift=halo, scale=m_to_L) - call hchksum(G%areaT, trim(parent)//': areaT',G%HI, haloshift=halo) - call Bchksum(G%areaBu, trim(parent)//': areaBu',G%HI, haloshift=halo) + call hchksum(G%areaT, trim(parent)//': areaT',G%HI, haloshift=halo, scale=L_to_m**2) + call Bchksum(G%areaBu, trim(parent)//': areaBu',G%HI, haloshift=halo, scale=L_to_m**2) - call hchksum(G%IareaT, trim(parent)//': IareaT',G%HI, haloshift=halo) - call Bchksum(G%IareaBu, trim(parent)//': IareaBu',G%HI, haloshift=halo) + call hchksum(G%IareaT, trim(parent)//': IareaT',G%HI, haloshift=halo, scale=m_to_L**2) + call Bchksum(G%IareaBu, trim(parent)//': IareaBu',G%HI, haloshift=halo, scale=m_to_L**2) call hchksum(G%geoLonT,trim(parent)//': geoLonT',G%HI, haloshift=halo) call hchksum(G%geoLatT,trim(parent)//': geoLatT',G%HI, haloshift=halo) @@ -155,20 +153,19 @@ subroutine grid_metrics_chksum(parent, G) call Bchksum(G%geoLonBu, trim(parent)//': geoLonBu',G%HI, haloshift=halo) call Bchksum(G%geoLatBu, trim(parent)//': geoLatBu',G%HI, haloshift=halo) - call uvchksum(trim(parent)//': geoLonC[uv]', & - G%geoLonCu, G%geoLonCv, G%HI, haloshift=halo) + call uvchksum(trim(parent)//': geoLonC[uv]', G%geoLonCu, G%geoLonCv, G%HI, haloshift=halo) - call uvchksum(trim(parent)//': geoLatC[uv]', & - G%geoLatCu, G%geoLatCv, G%HI, haloshift=halo) + call uvchksum(trim(parent)//': geoLatC[uv]', G%geoLatCu, G%geoLatCv, G%HI, haloshift=halo) end subroutine grid_metrics_chksum ! ------------------------------------------------------------------------------ !> Sets the grid metrics from a mosaic file. -subroutine set_grid_metrics_from_mosaic(G, param_file) +subroutine set_grid_metrics_from_mosaic(G, param_file, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type type(param_file_type), intent(in) :: param_file !< Parameter file structure + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables real, dimension(G%isd :G%ied ,G%jsd :G%jed ) :: tempH1, tempH2, tempH3, tempH4 real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB) :: tempQ1, tempQ2, tempQ3, tempQ4 @@ -186,6 +183,7 @@ subroutine set_grid_metrics_from_mosaic(G, param_file) real, dimension(2*G%isd-2:2*G%ied+1,2*G%jsd-3:2*G%jed+1) :: tmpV real, dimension(2*G%isd-3:2*G%ied+1,2*G%jsd-3:2*G%jed+1) :: tmpZ real, dimension(:,:), allocatable :: tmpGlbl + real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] character(len=200) :: filename, grid_file, inputdir character(len=64) :: mdl = "MOM_grid_init set_grid_metrics_from_mosaic" integer :: err=0, ni, nj, global_indices(4) @@ -198,6 +196,7 @@ subroutine set_grid_metrics_from_mosaic(G, param_file) call callTree_enter("set_grid_metrics_from_mosaic(), MOM_grid_initialize.F90") + m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L call get_param(param_file, mdl, "GRID_FILE", grid_file, & "Name of the file from which to read horizontal grid data.", & fail_if_missing=.true.) @@ -355,16 +354,16 @@ subroutine set_grid_metrics_from_mosaic(G, param_file) call pass_var(areaBu, G%Domain, position=CORNER) do i=G%isd,G%ied ; do j=G%jsd,G%jed - G%dxT(i,j) = dxT(i,j) ; G%dyT(i,j) = dyT(i,j) ; G%areaT(i,j) = areaT(i,j) + G%dxT(i,j) = m_to_L*dxT(i,j) ; G%dyT(i,j) = m_to_L*dyT(i,j) ; G%areaT(i,j) = m_to_L**2*areaT(i,j) enddo ; enddo do I=G%IsdB,G%IedB ; do j=G%jsd,G%jed - G%dxCu(I,j) = dxCu(I,j) ; G%dyCu(I,j) = dyCu(I,j) + G%dxCu(I,j) = m_to_L*dxCu(I,j) ; G%dyCu(I,j) = m_to_L*dyCu(I,j) enddo ; enddo do i=G%isd,G%ied ; do J=G%JsdB,G%JedB - G%dxCv(i,J) = dxCv(i,J) ; G%dyCv(i,J) = dyCv(i,J) + G%dxCv(i,J) = m_to_L*dxCv(i,J) ; G%dyCv(i,J) = m_to_L*dyCv(i,J) enddo ; enddo do I=G%IsdB,G%IedB ; do J=G%JsdB,G%JedB - G%dxBu(I,J) = dxBu(I,J) ; G%dyBu(I,J) = dyBu(I,J) ; G%areaBu(I,J) = areaBu(I,J) + G%dxBu(I,J) = m_to_L*dxBu(I,J) ; G%dyBu(I,J) = m_to_L*dyBu(I,J) ; G%areaBu(I,J) = m_to_L**2*areaBu(I,J) enddo ; enddo ! Construct axes for diagnostic output (only necessary because "ferret" uses @@ -415,17 +414,20 @@ end subroutine set_grid_metrics_from_mosaic !! inverses and the cell areas centered on h, q, u, and v points are !! calculated, as are the geographic locations of each of these 4 !! sets of points. -subroutine set_grid_metrics_cartesian(G, param_file) +subroutine set_grid_metrics_cartesian(G, param_file, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type type(param_file_type), intent(in) :: param_file !< Parameter file structure + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, I1off, J1off integer :: niglobal, njglobal real :: grid_latT(G%jsd:G%jed), grid_latB(G%JsdB:G%JedB) real :: grid_lonT(G%isd:G%ied), grid_lonB(G%IsdB:G%IedB) - real :: dx_everywhere, dy_everywhere ! Grid spacings in m. - real :: I_dx, I_dy ! Inverse grid spacings in m. + real :: dx_everywhere, dy_everywhere ! Grid spacings [m]. + real :: I_dx, I_dy ! Inverse grid spacings [m-1]. real :: PI + real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] + real :: L_to_m ! A unit conversion factor [m L-1 ~> nondim] character(len=80) :: units_temp character(len=48) :: mdl = "MOM_grid_init set_grid_metrics_cartesian" @@ -436,6 +438,8 @@ subroutine set_grid_metrics_cartesian(G, param_file) call callTree_enter("set_grid_metrics_cartesian(), MOM_grid_initialize.F90") + m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L + L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m PI = 4.0*atan(1.0) call get_param(param_file, mdl, "AXIS_UNITS", units_temp, & @@ -510,30 +514,30 @@ subroutine set_grid_metrics_cartesian(G, param_file) do J=JsdB,JedB ; do I=IsdB,IedB G%geoLonBu(I,J) = grid_lonB(I) ; G%geoLatBu(I,J) = grid_latB(J) - G%dxBu(I,J) = dx_everywhere ; G%IdxBu(I,J) = I_dx - G%dyBu(I,J) = dy_everywhere ; G%IdyBu(I,J) = I_dy - G%areaBu(I,J) = dx_everywhere * dy_everywhere ; G%IareaBu(I,J) = I_dx * I_dy + G%dxBu(I,J) = m_to_L*dx_everywhere ; G%IdxBu(I,J) = L_to_m*I_dx + G%dyBu(I,J) = m_to_L*dy_everywhere ; G%IdyBu(I,J) = L_to_m*I_dy + G%areaBu(I,J) = m_to_L**2*dx_everywhere * dy_everywhere ; G%IareaBu(I,J) = L_to_m**2*I_dx * I_dy enddo ; enddo do j=jsd,jed ; do i=isd,ied G%geoLonT(i,j) = grid_lonT(i) ; G%geoLatT(i,j) = grid_LatT(j) - G%dxT(i,j) = dx_everywhere ; G%IdxT(i,j) = I_dx - G%dyT(i,j) = dy_everywhere ; G%IdyT(i,j) = I_dy - G%areaT(i,j) = dx_everywhere * dy_everywhere ; G%IareaT(i,j) = I_dx * I_dy + G%dxT(i,j) = m_to_L*dx_everywhere ; G%IdxT(i,j) = L_to_m*I_dx + G%dyT(i,j) = m_to_L*dy_everywhere ; G%IdyT(i,j) = L_to_m*I_dy + G%areaT(i,j) = m_to_L**2*dx_everywhere * dy_everywhere ; G%IareaT(i,j) = L_to_m**2*I_dx * I_dy enddo ; enddo do j=jsd,jed ; do I=IsdB,IedB G%geoLonCu(I,j) = grid_lonB(I) ; G%geoLatCu(I,j) = grid_LatT(j) - G%dxCu(I,j) = dx_everywhere ; G%IdxCu(I,j) = I_dx - G%dyCu(I,j) = dy_everywhere ; G%IdyCu(I,j) = I_dy + G%dxCu(I,j) = m_to_L*dx_everywhere ; G%IdxCu(I,j) = L_to_m*I_dx + G%dyCu(I,j) = m_to_L*dy_everywhere ; G%IdyCu(I,j) = L_to_m*I_dy enddo ; enddo do J=JsdB,JedB ; do i=isd,ied G%geoLonCv(i,J) = grid_lonT(i) ; G%geoLatCv(i,J) = grid_latB(J) - G%dxCv(i,J) = dx_everywhere ; G%IdxCv(i,J) = I_dx - G%dyCv(i,J) = dy_everywhere ; G%IdyCv(i,J) = I_dy + G%dxCv(i,J) = m_to_L*dx_everywhere ; G%IdxCv(i,J) = L_to_m*I_dx + G%dyCv(i,J) = m_to_L*dy_everywhere ; G%IdyCv(i,J) = L_to_m*I_dy enddo ; enddo call callTree_leave("set_grid_metrics_cartesian()") @@ -548,9 +552,10 @@ end subroutine set_grid_metrics_cartesian !! inverses and the cell areas centered on h, q, u, and v points are !! calculated, as are the geographic locations of each of these 4 !! sets of points. -subroutine set_grid_metrics_spherical(G, param_file) +subroutine set_grid_metrics_spherical(G, param_file, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type type(param_file_type), intent(in) :: param_file !< Parameter file structure + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables real :: PI, PI_180! PI = 3.1415926... as 4*atan(1) integer :: i, j, isd, ied, jsd, jed @@ -559,6 +564,7 @@ subroutine set_grid_metrics_spherical(G, param_file) real :: grid_latT(G%jsd:G%jed), grid_latB(G%JsdB:G%JedB) real :: grid_lonT(G%isd:G%ied), grid_lonB(G%IsdB:G%IedB) real :: dLon,dLat,latitude,longitude,dL_di + real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] character(len=48) :: mdl = "MOM_grid_init set_grid_metrics_spherical" is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -568,6 +574,7 @@ subroutine set_grid_metrics_spherical(G, param_file) i_offset = G%idg_offset ; j_offset = G%jdg_offset call callTree_enter("set_grid_metrics_spherical(), MOM_grid_initialize.F90") + m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L ! Calculate the values of the metric terms that might be used ! and save them in arrays. @@ -630,9 +637,9 @@ subroutine set_grid_metrics_spherical(G, param_file) ! The following line is needed to reproduce the solution from ! set_grid_metrics_mercator when used to generate a simple spherical grid. - G%dxBu(I,J) = G%Rad_Earth * COS( G%geoLatBu(I,J)*PI_180 ) * dL_di -! G%dxBu(I,J) = G%Rad_Earth * dLon*PI_180 * COS( G%geoLatBu(I,J)*PI_180 ) - G%dyBu(I,J) = G%Rad_Earth * dLat*PI_180 + G%dxBu(I,J) = m_to_L*G%Rad_Earth * COS( G%geoLatBu(I,J)*PI_180 ) * dL_di +! G%dxBu(I,J) = m_to_L*G%Rad_Earth * dLon*PI_180 * COS( G%geoLatBu(I,J)*PI_180 ) + G%dyBu(I,J) = m_to_L*G%Rad_Earth * dLat*PI_180 G%areaBu(I,J) = G%dxBu(I,J) * G%dyBu(I,J) enddo ; enddo @@ -642,9 +649,9 @@ subroutine set_grid_metrics_spherical(G, param_file) ! The following line is needed to reproduce the solution from ! set_grid_metrics_mercator when used to generate a simple spherical grid. - G%dxCv(i,J) = G%Rad_Earth * COS( G%geoLatCv(i,J)*PI_180 ) * dL_di -! G%dxCv(i,J) = G%Rad_Earth * (dLon*PI_180) * COS( G%geoLatCv(i,J)*PI_180 ) - G%dyCv(i,J) = G%Rad_Earth * dLat*PI_180 + G%dxCv(i,J) = m_to_L*G%Rad_Earth * COS( G%geoLatCv(i,J)*PI_180 ) * dL_di +! G%dxCv(i,J) = m_to_L*G%Rad_Earth * (dLon*PI_180) * COS( G%geoLatCv(i,J)*PI_180 ) + G%dyCv(i,J) = m_to_L*G%Rad_Earth * dLat*PI_180 enddo ; enddo do j=jsd,jed ; do I=IsdB,IedB @@ -653,9 +660,9 @@ subroutine set_grid_metrics_spherical(G, param_file) ! The following line is needed to reproduce the solution from ! set_grid_metrics_mercator when used to generate a simple spherical grid. - G%dxCu(I,j) = G%Rad_Earth * COS( G%geoLatCu(I,j)*PI_180 ) * dL_di -! G%dxCu(I,j) = G%Rad_Earth * dLon*PI_180 * COS( latitude ) - G%dyCu(I,j) = G%Rad_Earth * dLat*PI_180 + G%dxCu(I,j) = m_to_L*G%Rad_Earth * COS( G%geoLatCu(I,j)*PI_180 ) * dL_di +! G%dxCu(I,j) = m_to_L*G%Rad_Earth * dLon*PI_180 * COS( latitude ) + G%dyCu(I,j) = m_to_L*G%Rad_Earth * dLat*PI_180 enddo ; enddo do j=jsd,jed ; do i=isd,ied @@ -664,13 +671,13 @@ subroutine set_grid_metrics_spherical(G, param_file) ! The following line is needed to reproduce the solution from ! set_grid_metrics_mercator when used to generate a simple spherical grid. - G%dxT(i,j) = G%Rad_Earth * COS( G%geoLatT(i,j)*PI_180 ) * dL_di + G%dxT(i,j) = m_to_L*G%Rad_Earth * COS( G%geoLatT(i,j)*PI_180 ) * dL_di ! G%dxT(i,j) = G%Rad_Earth * dLon*PI_180 * COS( latitude ) - G%dyT(i,j) = G%Rad_Earth * dLat*PI_180 + G%dyT(i,j) = m_to_L*G%Rad_Earth * dLat*PI_180 ! latitude = G%geoLatCv(i,J)*PI_180 ! In radians ! dL_di = G%geoLatCv(i,max(jsd,J-1))*PI_180 ! In radians -! G%areaT(i,j) = Rad_Earth**2*dLon*dLat*ABS(SIN(latitude)-SIN(dL_di)) +! G%areaT(i,j) = m_to_L**2 * Rad_Earth**2*dLon*dLat*ABS(SIN(latitude)-SIN(dL_di)) G%areaT(i,j) = G%dxT(i,j) * G%dyT(i,j) enddo ; enddo @@ -684,9 +691,10 @@ end subroutine set_grid_metrics_spherical !! inverses and the cell areas centered on h, q, u, and v points are !! calculated, as are the geographic locations of each of these 4 !! sets of points. -subroutine set_grid_metrics_mercator(G, param_file) +subroutine set_grid_metrics_mercator(G, param_file, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type type(param_file_type), intent(in) :: param_file !< Parameter file structure + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables integer :: i, j, isd, ied, jsd, jed integer :: I_off, J_off @@ -706,6 +714,7 @@ subroutine set_grid_metrics_mercator(G, param_file) real :: fnRef ! fnRef is the value of Int_dj_dy or ! Int_dj_dy at a latitude or longitude that is real :: jRef, iRef ! being set to be at grid index jRef or iRef. + real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] integer :: itt1, itt2 logical :: debug = .FALSE., simple_area = .true. integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, IsdB, IedB, JsdB, JedB @@ -724,6 +733,7 @@ subroutine set_grid_metrics_mercator(G, param_file) call callTree_enter("set_grid_metrics_mercator(), MOM_grid_initialize.F90") + m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L ! Calculate the values of the metric terms that might be used ! and save them in arrays. PI = 4.0*atan(1.0) ; PI_2 = 0.5*PI @@ -853,40 +863,40 @@ subroutine set_grid_metrics_mercator(G, param_file) do J=JsdB,JedB ; do I=IsdB,IedB G%geoLonBu(I,J) = xq(I,J)*180.0/PI G%geoLatBu(I,J) = yq(I,J)*180.0/PI - G%dxBu(I,J) = ds_di(xq(I,J), yq(I,J), GP) - G%dyBu(I,J) = ds_dj(xq(I,J), yq(I,J), GP) + G%dxBu(I,J) = m_to_L*ds_di(xq(I,J), yq(I,J), GP) + G%dyBu(I,J) = m_to_L*ds_dj(xq(I,J), yq(I,J), GP) G%areaBu(I,J) = G%dxBu(I,J) * G%dyBu(I,J) - G%IareaBu(I,J) = 1.0 / G%areaBu(I,J) + G%IareaBu(I,J) = 1.0 / (G%areaBu(I,J)) enddo ; enddo do j=jsd,jed ; do i=isd,ied G%geoLonT(i,j) = xh(i,j)*180.0/PI G%geoLatT(i,j) = yh(i,j)*180.0/PI - G%dxT(i,j) = ds_di(xh(i,j), yh(i,j), GP) - G%dyT(i,j) = ds_dj(xh(i,j), yh(i,j), GP) + G%dxT(i,j) = m_to_L*ds_di(xh(i,j), yh(i,j), GP) + G%dyT(i,j) = m_to_L*ds_dj(xh(i,j), yh(i,j), GP) G%areaT(i,j) = G%dxT(i,j)*G%dyT(i,j) - G%IareaT(i,j) = 1.0 / G%areaT(i,j) + G%IareaT(i,j) = 1.0 / (G%areaT(i,j)) enddo ; enddo do j=jsd,jed ; do I=IsdB,IedB G%geoLonCu(I,j) = xu(I,j)*180.0/PI G%geoLatCu(I,j) = yu(I,j)*180.0/PI - G%dxCu(I,j) = ds_di(xu(I,j), yu(I,j), GP) - G%dyCu(I,j) = ds_dj(xu(I,j), yu(I,j), GP) + G%dxCu(I,j) = m_to_L*ds_di(xu(I,j), yu(I,j), GP) + G%dyCu(I,j) = m_to_L*ds_dj(xu(I,j), yu(I,j), GP) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied G%geoLonCv(i,J) = xv(i,J)*180.0/PI G%geoLatCv(i,J) = yv(i,J)*180.0/PI - G%dxCv(i,J) = ds_di(xv(i,J), yv(i,J), GP) - G%dyCv(i,J) = ds_dj(xv(i,J), yv(i,J), GP) + G%dxCv(i,J) = m_to_L*ds_di(xv(i,J), yv(i,J), GP) + G%dyCv(i,J) = m_to_L*ds_dj(xv(i,J), yv(i,J), GP) enddo ; enddo if (.not.simple_area) then do j=JsdB+1,jed ; do i=IsdB+1,ied - G%areaT(I,J) = GP%Rad_Earth**2 * & + G%areaT(I,J) = m_to_L**2*GP%Rad_Earth**2 * & (dL(xq(I-1,J-1),xq(I-1,J),yq(I-1,J-1),yq(I-1,J)) + & (dL(xq(I-1,J),xq(I,J),yq(I-1,J),yq(I,J)) + & (dL(xq(I,J),xq(I,J-1),yq(I,J),yq(I,J-1)) + & @@ -903,7 +913,7 @@ subroutine set_grid_metrics_mercator(G, param_file) call pass_var(G%areaT,G%Domain) endif do j=jsd,jed ; do i=isd,ied - G%IareaT(i,j) = 1.0 / G%areaT(i,j) + G%IareaT(i,j) = 1.0 / (G%areaT(i,j)) enddo ; enddo endif @@ -1227,6 +1237,7 @@ subroutine initialize_masks(G, PF, US) type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables real :: m_to_Z_scale ! A unit conversion factor from m to Z. + real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] real :: Dmin ! The depth for masking in the same units as G%bathyT [Z ~> m]. real :: min_depth ! The minimum ocean depth in the same units as G%bathyT [Z ~> m]. real :: mask_depth ! The depth shallower than which to mask a point as land [Z ~> m]. @@ -1235,6 +1246,8 @@ subroutine initialize_masks(G, PF, US) call callTree_enter("initialize_masks(), MOM_grid_initialize.F90") m_to_Z_scale = 1.0 ; if (present(US)) m_to_Z_scale = US%m_to_Z + m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L + call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, & "If MASKING_DEPTH is unspecified, then anything shallower than "//& "MINIMUM_DEPTH is assumed to be land and all fluxes are masked out. "//& diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 42e99f2ef6..3d0fe6f1ed 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -90,14 +90,17 @@ end subroutine MOM_initialize_rotation subroutine MOM_calculate_grad_Coriolis(dF_dx, dF_dy, G, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: dF_dx !< x-component of grad f [T-1 m-1 ~> s-1 m-1] + intent(out) :: dF_dx !< x-component of grad f [T-1 L-1 ~> s-1 m-1] real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: dF_dy !< y-component of grad f [T-1 m-1 ~> s-1 m-1] + intent(out) :: dF_dy !< y-component of grad f [T-1 L-1 ~> s-1 m-1] type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables integer :: i,j + real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] real :: f1, f2 + m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L + if ((LBOUND(G%CoriolisBu,1) > G%isc-1) .or. & (LBOUND(G%CoriolisBu,2) > G%isc-1)) then ! The gradient of the Coriolis parameter can not be calculated with this grid. @@ -114,6 +117,7 @@ subroutine MOM_calculate_grad_Coriolis(dF_dx, dF_dy, G, US) dF_dy(i,j) = G%IdyT(i,j) * ( f1 - f2 ) enddo ; enddo call pass_vector(dF_dx, dF_dy, G%Domain, stagger=AGRID) + end subroutine MOM_calculate_grad_Coriolis !> Return the global maximum ocean bottom depth in the same units as the input depth. @@ -623,6 +627,8 @@ subroutine reset_face_lengths_named(G, param_file, name, US) ! Local variables character(len=256) :: mesg ! Message for error messages. + real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] + real :: L_to_m ! A unit conversion factor [m L-1 ~> nondim] real :: dx_2 = -1.0, dy_2 = -1.0 real :: pi_180 integer :: option = -1 @@ -637,68 +643,70 @@ subroutine reset_face_lengths_named(G, param_file, name, US) "Unrecognized channel configuration name "//trim(name)) end select + m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L + L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m + if (option==1) then ! 1-degree settings. do j=jsd,jed ; do I=IsdB,IedB ! Change any u-face lengths within this loop. dy_2 = dx_2 * G%dyCu(I,j)*G%IdxCu(I,j) * cos(pi_180 * G%geoLatCu(I,j)) if ((abs(G%geoLatCu(I,j)-35.5) < dy_2) .and. (G%geoLonCu(I,j) < -4.5) .and. & (G%geoLonCu(I,j) > -6.5)) & - G%dy_Cu(I,j) = G%mask2dCu(I,j)*12000.0 ! Gibraltar + G%dy_Cu(I,j) = G%mask2dCu(I,j)*12000.0*m_to_L ! Gibraltar if ((abs(G%geoLatCu(I,j)-12.5) < dy_2) .and. (abs(G%geoLonCu(I,j)-43.0) < dx_2)) & - G%dy_Cu(I,j) = G%mask2dCu(I,j)*10000.0 ! Red Sea + G%dy_Cu(I,j) = G%mask2dCu(I,j)*10000.0*m_to_L ! Red Sea if ((abs(G%geoLatCu(I,j)-40.5) < dy_2) .and. (abs(G%geoLonCu(I,j)-26.0) < dx_2)) & - G%dy_Cu(I,j) = G%mask2dCu(I,j)*5000.0 ! Dardanelles + G%dy_Cu(I,j) = G%mask2dCu(I,j)*5000.0*m_to_L ! Dardanelles if ((abs(G%geoLatCu(I,j)-41.5) < dy_2) .and. (abs(G%geoLonCu(I,j)+220.0) < dx_2)) & - G%dy_Cu(I,j) = G%mask2dCu(I,j)*35000.0 ! Tsugaru strait at 140.0e + G%dy_Cu(I,j) = G%mask2dCu(I,j)*35000.0*m_to_L ! Tsugaru strait at 140.0e if ((abs(G%geoLatCu(I,j)-45.5) < dy_2) .and. (abs(G%geoLonCu(I,j)+217.5) < 0.9)) & - G%dy_Cu(I,j) = G%mask2dCu(I,j)*15000.0 ! Betw Hokkaido and Sakhalin at 217&218 = 142e - + G%dy_Cu(I,j) = G%mask2dCu(I,j)*15000.0*m_to_L ! Betw Hokkaido and Sakhalin at 217&218 = 142e ! Greater care needs to be taken in the tripolar region. if ((abs(G%geoLatCu(I,j)-80.84) < 0.2) .and. (abs(G%geoLonCu(I,j)+64.9) < 0.8)) & - G%dy_Cu(I,j) = G%mask2dCu(I,j)*38000.0 ! Smith Sound in Canadian Arch - tripolar region + G%dy_Cu(I,j) = G%mask2dCu(I,j)*38000.0*m_to_L ! Smith Sound in Canadian Arch - tripolar region enddo ; enddo do J=JsdB,JedB ; do i=isd,ied ! Change any v-face lengths within this loop. dy_2 = dx_2 * G%dyCv(i,J)*G%IdxCv(i,J) * cos(pi_180 * G%geoLatCv(i,J)) if ((abs(G%geoLatCv(i,J)-41.0) < dy_2) .and. (abs(G%geoLonCv(i,J)-28.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*2500.0 ! Bosporus - should be 1000.0 m wide. + G%dx_Cv(i,J) = G%mask2dCv(i,J)*2500.0*m_to_L ! Bosporus - should be 1000.0 m wide. if ((abs(G%geoLatCv(i,J)-13.0) < dy_2) .and. (abs(G%geoLonCv(i,J)-42.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*10000.0 ! Red Sea + G%dx_Cv(i,J) = G%mask2dCv(i,J)*10000.0*m_to_L ! Red Sea if ((abs(G%geoLatCv(i,J)+2.8) < 0.8) .and. (abs(G%geoLonCv(i,J)+241.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*40000.0 ! Makassar Straits at 241.5 W = 118.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*40000.0*m_to_L ! Makassar Straits at 241.5 W = 118.5 E if ((abs(G%geoLatCv(i,J)-0.56) < 0.5) .and. (abs(G%geoLonCv(i,J)+240.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*80000.0 ! entry to Makassar Straits at 240.5 W = 119.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*80000.0*m_to_L ! entry to Makassar Straits at 240.5 W = 119.5 E if ((abs(G%geoLatCv(i,J)-0.19) < 0.5) .and. (abs(G%geoLonCv(i,J)+230.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*25000.0 ! Channel betw N Guinea and Halmahara 230.5 W = 129.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*25000.0*m_to_L ! Channel betw N Guinea and Halmahara 230.5 W = 129.5 E if ((abs(G%geoLatCv(i,J)-0.19) < 0.5) .and. (abs(G%geoLonCv(i,J)+229.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*25000.0 ! Channel betw N Guinea and Halmahara 229.5 W = 130.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*25000.0*m_to_L ! Channel betw N Guinea and Halmahara 229.5 W = 130.5 E if ((abs(G%geoLatCv(i,J)-0.0) < 0.25) .and. (abs(G%geoLonCv(i,J)+228.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*25000.0 ! Channel betw N Guinea and Halmahara 228.5 W = 131.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*25000.0*m_to_L ! Channel betw N Guinea and Halmahara 228.5 W = 131.5 E if ((abs(G%geoLatCv(i,J)+8.5) < 0.5) .and. (abs(G%geoLonCv(i,J)+244.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*20000.0 ! Lombok Straits at 244.5 W = 115.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*20000.0*m_to_L ! Lombok Straits at 244.5 W = 115.5 E if ((abs(G%geoLatCv(i,J)+8.5) < 0.5) .and. (abs(G%geoLonCv(i,J)+235.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*20000.0 ! Timor Straits at 235.5 W = 124.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*20000.0*m_to_L ! Timor Straits at 235.5 W = 124.5 E if ((abs(G%geoLatCv(i,J)-52.5) < dy_2) .and. (abs(G%geoLonCv(i,J)+218.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*2500.0 ! Russia and Sakhalin Straits at 218.5 W = 141.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*2500.0*m_to_L ! Russia and Sakhalin Straits at 218.5 W = 141.5 E ! Greater care needs to be taken in the tripolar region. if ((abs(G%geoLatCv(i,J)-76.8) < 0.06) .and. (abs(G%geoLonCv(i,J)+88.7) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*8400.0 ! Jones Sound in Canadian Arch - tripolar region + G%dx_Cv(i,J) = G%mask2dCv(i,J)*8400.0*m_to_L ! Jones Sound in Canadian Arch - tripolar region enddo ; enddo endif @@ -706,30 +714,30 @@ subroutine reset_face_lengths_named(G, param_file, name, US) ! These checks apply regardless of the chosen option. do j=jsd,jed ; do I=IsdB,IedB - if (G%dy_Cu(I,j) > G%dyCu(I,j)) then + if (L_to_m*G%dy_Cu(I,j) > L_to_m*G%dyCu(I,j)) then write(mesg,'("dy_Cu of ",ES11.4," exceeds unrestricted width of ",ES11.4,& &" by ",ES11.4," at lon/lat of ", ES11.4, ES11.4)') & - G%dy_Cu(I,j), G%dyCu(I,j), G%dy_Cu(I,j)-G%dyCu(I,j), & + L_to_m*G%dy_Cu(I,j), L_to_m*G%dyCu(I,j), L_to_m*G%dy_Cu(I,j)-L_to_m*G%dyCu(I,j), & G%geoLonCu(I,j), G%geoLatCu(I,j) call MOM_error(FATAL,"reset_face_lengths_named "//mesg) endif - G%areaCu(I,j) = G%dxCu(I,j)*G%dy_Cu(I,j) + G%areaCu(I,j) = G%dxCu(I,j) * G%dy_Cu(I,j) G%IareaCu(I,j) = 0.0 - if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / G%areaCu(I,j) + if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (G%areaCu(I,j)) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied - if (G%dx_Cv(i,J) > G%dxCv(i,J)) then + if (L_to_m*G%dx_Cv(i,J) > L_to_m*G%dxCv(i,J)) then write(mesg,'("dx_Cv of ",ES11.4," exceeds unrestricted width of ",ES11.4,& &" by ",ES11.4, " at lon/lat of ", ES11.4, ES11.4)') & - G%dx_Cv(i,J), G%dxCv(i,J), G%dx_Cv(i,J)-G%dxCv(i,J), & + L_to_m*G%dx_Cv(i,J), L_to_m*G%dxCv(i,J), L_to_m*G%dx_Cv(i,J)-L_to_m*G%dxCv(i,J), & G%geoLonCv(i,J), G%geoLatCv(i,J) call MOM_error(FATAL,"reset_face_lengths_named "//mesg) endif - G%areaCv(i,J) = G%dyCv(i,J)*G%dx_Cv(i,J) + G%areaCv(i,J) = G%dyCv(i,J) * G%dx_Cv(i,J) G%IareaCv(i,J) = 0.0 - if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / G%areaCv(i,J) + if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (G%areaCv(i,J)) enddo ; enddo end subroutine reset_face_lengths_named @@ -747,12 +755,16 @@ subroutine reset_face_lengths_file(G, param_file, US) character(len=40) :: mdl = "reset_face_lengths_file" ! This subroutine's name. character(len=256) :: mesg ! Message for error messages. character(len=200) :: filename, chan_file, inputdir ! Strings for file/path + real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] + real :: L_to_m ! A unit conversion factor [m L-1 ~> nondim] integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB ! These checks apply regardless of the chosen option. call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") + m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L + L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m call get_param(param_file, mdl, "CHANNEL_WIDTH_FILE", chan_file, & "The file from which the list of narrowed channels is read.", & @@ -767,34 +779,34 @@ subroutine reset_face_lengths_file(G, param_file, US) trim(filename)) endif - call MOM_read_vector(filename, "dyCuo", "dxCvo", G%dy_Cu, G%dx_Cv, G%Domain) + call MOM_read_vector(filename, "dyCuo", "dxCvo", G%dy_Cu, G%dx_Cv, G%Domain, scale=m_to_L) call pass_vector(G%dy_Cu, G%dx_Cv, G%Domain, To_All+SCALAR_PAIR, CGRID_NE) do j=jsd,jed ; do I=IsdB,IedB - if (G%dy_Cu(I,j) > G%dyCu(I,j)) then + if (L_to_m*G%dy_Cu(I,j) > L_to_m*G%dyCu(I,j)) then write(mesg,'("dy_Cu of ",ES11.4," exceeds unrestricted width of ",ES11.4,& &" by ",ES11.4," at lon/lat of ", ES11.4, ES11.4)') & - G%dy_Cu(I,j), G%dyCu(I,j), G%dy_Cu(I,j)-G%dyCu(I,j), & + L_to_m*G%dy_Cu(I,j), L_to_m*G%dyCu(I,j), L_to_m*G%dy_Cu(I,j)-L_to_m*G%dyCu(I,j), & G%geoLonCu(I,j), G%geoLatCu(I,j) call MOM_error(FATAL,"reset_face_lengths_file "//mesg) endif - G%areaCu(I,j) = G%dxCu(I,j)*G%dy_Cu(I,j) + G%areaCu(I,j) = G%dxCu(I,j) * G%dy_Cu(I,j) G%IareaCu(I,j) = 0.0 - if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / G%areaCu(I,j) + if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (G%areaCu(I,j)) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied - if (G%dx_Cv(i,J) > G%dxCv(i,J)) then + if (L_to_m*G%dx_Cv(i,J) > L_to_m*G%dxCv(i,J)) then write(mesg,'("dx_Cv of ",ES11.4," exceeds unrestricted width of ",ES11.4,& &" by ",ES11.4, " at lon/lat of ", ES11.4, ES11.4)') & - G%dx_Cv(i,J), G%dxCv(i,J), G%dx_Cv(i,J)-G%dxCv(i,J), & + L_to_m*G%dx_Cv(i,J), L_to_m*G%dxCv(i,J), L_to_m*G%dx_Cv(i,J)-L_to_m*G%dxCv(i,J), & G%geoLonCv(i,J), G%geoLatCv(i,J) call MOM_error(FATAL,"reset_face_lengths_file "//mesg) endif - G%areaCv(i,J) = G%dyCv(i,J)*G%dx_Cv(i,J) + G%areaCv(i,J) = G%dyCv(i,J) * G%dx_Cv(i,J) G%IareaCv(i,J) = 0.0 - if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / G%areaCv(i,J) + if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (G%areaCv(i,J)) enddo ; enddo call callTree_leave(trim(mdl)//'()') @@ -818,6 +830,8 @@ subroutine reset_face_lengths_list(G, param_file, US) u_lat => NULL(), u_lon => NULL(), v_lat => NULL(), v_lon => NULL() real, pointer, dimension(:) :: & u_width => NULL(), v_width => NULL() + real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] + real :: L_to_m ! A unit conversion factor [m L-1 ~> nondim] real :: lat, lon ! The latitude and longitude of a point. real :: len_lon ! The periodic range of longitudes, usually 360 degrees. real :: len_lat ! The range of latitudes, usually 180 degrees. @@ -833,6 +847,8 @@ subroutine reset_face_lengths_list(G, param_file, US) IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") + m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L + L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m call get_param(param_file, mdl, "CHANNEL_LIST_FILE", chan_file, & "The file from which the list of narrowed channels is read.", & @@ -976,7 +992,7 @@ subroutine reset_face_lengths_list(G, param_file, US) ((lon_p >= u_lon(1,npt)) .and. (lon_p <= u_lon(2,npt))) .or. & ((lon_m >= u_lon(1,npt)) .and. (lon_m <= u_lon(2,npt)))) ) then - G%dy_Cu(I,j) = G%mask2dCu(I,j) * min(G%dyCu(I,j), max(u_width(npt), 0.0)) + G%dy_Cu(I,j) = G%mask2dCu(I,j) * m_to_L*min(L_to_m*G%dyCu(I,j), max(u_width(npt), 0.0)) if (j>=G%jsc .and. j<=G%jec .and. I>=G%isc .and. I<=G%iec) then ! Limit messages/checking to compute domain if ( G%mask2dCu(I,j) == 0.0 ) then write(*,'(A,2F8.2,A,4F8.2,A)') "read_face_lengths_list : G%mask2dCu=0 at ",lat,lon," (",& @@ -984,15 +1000,15 @@ subroutine reset_face_lengths_list(G, param_file, US) else write(*,'(A,2F8.2,A,4F8.2,A5,F9.2,A1)') & "read_face_lengths_list : Modifying dy_Cu gridpoint at ",lat,lon," (",& - u_lat(1,npt), u_lat(2,npt), u_lon(1,npt), u_lon(2,npt),") to ",G%dy_Cu(I,j),"m" + u_lat(1,npt), u_lat(2,npt), u_lon(1,npt), u_lon(2,npt),") to ",L_to_m*G%dy_Cu(I,j),"m" endif endif endif enddo - G%areaCu(I,j) = G%dxCu(I,j)*G%dy_Cu(I,j) + G%areaCu(I,j) = G%dxCu(I,j) * G%dy_Cu(I,j) G%IareaCu(I,j) = 0.0 - if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / G%areaCu(I,j) + if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (G%areaCu(I,j)) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied @@ -1005,7 +1021,7 @@ subroutine reset_face_lengths_list(G, param_file, US) (((lon >= v_lon(1,npt)) .and. (lon <= v_lon(2,npt))) .or. & ((lon_p >= v_lon(1,npt)) .and. (lon_p <= v_lon(2,npt))) .or. & ((lon_m >= v_lon(1,npt)) .and. (lon_m <= v_lon(2,npt)))) ) then - G%dx_Cv(i,J) = G%mask2dCv(i,J) * min(G%dxCv(i,J), max(v_width(npt), 0.0)) + G%dx_Cv(i,J) = G%mask2dCv(i,J) * m_to_L*min(L_to_m*G%dxCv(i,J), max(v_width(npt), 0.0)) if (i>=G%isc .and. i<=G%iec .and. J>=G%jsc .and. J<=G%jec) then ! Limit messages/checking to compute domain if ( G%mask2dCv(i,J) == 0.0 ) then write(*,'(A,2F8.2,A,4F8.2,A)') "read_face_lengths_list : G%mask2dCv=0 at ",lat,lon," (",& @@ -1013,15 +1029,15 @@ subroutine reset_face_lengths_list(G, param_file, US) else write(*,'(A,2F8.2,A,4F8.2,A5,F9.2,A1)') & "read_face_lengths_list : Modifying dx_Cv gridpoint at ",lat,lon," (",& - v_lat(1,npt), v_lat(2,npt), v_lon(1,npt), v_lon(2,npt),") to ",G%dx_Cv(I,j),"m" + v_lat(1,npt), v_lat(2,npt), v_lon(1,npt), v_lon(2,npt),") to ",L_to_m*G%dx_Cv(I,j),"m" endif endif endif enddo - G%areaCv(i,J) = G%dyCv(i,J)*G%dx_Cv(i,J) + G%areaCv(i,J) = G%dyCv(i,J) * G%dx_Cv(i,J) G%IareaCv(i,J) = 0.0 - if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / G%areaCv(i,J) + if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (G%areaCv(i,J)) enddo ; enddo if (num_lines > 0) then @@ -1147,7 +1163,7 @@ subroutine compute_global_grid_integrals(G) call MOM_error(FATAL, "compute_global_grid_integrals: "//& "zero ocean area (check topography?)") - G%IareaT_global = 1. / G%areaT_global + G%IareaT_global = 1.0 / (G%areaT_global) end subroutine compute_global_grid_integrals ! ----------------------------------------------------------------------------- @@ -1170,6 +1186,7 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) type(fieldtype) :: fields(nFlds) real :: Z_to_m_scale ! A unit conversion factor from Z to m. real :: s_to_T_scale ! A unit conversion factor from T-1 to s-1. + real :: L_to_m_scale ! A unit conversion factor from L to m. integer :: unit integer :: file_threading integer :: nFlds_used @@ -1188,6 +1205,7 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) Z_to_m_scale = 1.0 ; if (present(US)) Z_to_m_scale = US%Z_to_m s_to_T_scale = 1.0 ; if (present(US)) s_to_T_scale = US%s_to_T + L_to_m_scale = 1.0 ; if (present(US)) L_to_m_scale = US%L_to_m ! vardesc is a structure defined in MOM_io.F90. The elements of ! this structure, in order, are: @@ -1265,24 +1283,24 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) ! I think that all of these copies are holdovers from a much earlier ! ancestor code in which many of the metrics were macros that could have ! had reduced dimensions, and that they are no longer needed in MOM6. -RWH - do J=Jsq,Jeq ; do i=is,ie ; out_v(i,J) = G%dxCv(i,J) ; enddo ; enddo + do J=Jsq,Jeq ; do i=is,ie ; out_v(i,J) = L_to_m_scale*G%dxCv(i,J) ; enddo ; enddo call write_field(unit, fields(7), G%Domain%mpp_domain, out_v) - do j=js,je ; do I=Isq,Ieq ; out_u(I,j) = G%dyCu(I,j) ; enddo ; enddo + do j=js,je ; do I=Isq,Ieq ; out_u(I,j) = L_to_m_scale*G%dyCu(I,j) ; enddo ; enddo call write_field(unit, fields(8), G%Domain%mpp_domain, out_u) - do j=js,je ; do I=Isq,Ieq ; out_u(I,j) = G%dxCu(I,j) ; enddo ; enddo + do j=js,je ; do I=Isq,Ieq ; out_u(I,j) = L_to_m_scale*G%dxCu(I,j) ; enddo ; enddo call write_field(unit, fields(9), G%Domain%mpp_domain, out_u) - do J=Jsq,Jeq ; do i=is,ie ; out_v(i,J) = G%dyCv(i,J) ; enddo ; enddo + do J=Jsq,Jeq ; do i=is,ie ; out_v(i,J) = L_to_m_scale*G%dyCv(i,J) ; enddo ; enddo call write_field(unit, fields(10), G%Domain%mpp_domain, out_v) - do j=js,je ; do i=is,ie ; out_h(i,j) = G%dxT(i,j); enddo ; enddo + do j=js,je ; do i=is,ie ; out_h(i,j) = L_to_m_scale*G%dxT(i,j); enddo ; enddo call write_field(unit, fields(11), G%Domain%mpp_domain, out_h) - do j=js,je ; do i=is,ie ; out_h(i,j) = G%dyT(i,j) ; enddo ; enddo + do j=js,je ; do i=is,ie ; out_h(i,j) = L_to_m_scale*G%dyT(i,j) ; enddo ; enddo call write_field(unit, fields(12), G%Domain%mpp_domain, out_h) - do J=Jsq,Jeq ; do I=Isq,Ieq ; out_q(i,J) = G%dxBu(I,J) ; enddo ; enddo + do J=Jsq,Jeq ; do I=Isq,Ieq ; out_q(i,J) = L_to_m_scale*G%dxBu(I,J) ; enddo ; enddo call write_field(unit, fields(13), G%Domain%mpp_domain, out_q) - do J=Jsq,Jeq ; do I=Isq,Ieq ; out_q(I,J) = G%dyBu(I,J) ; enddo ; enddo + do J=Jsq,Jeq ; do I=Isq,Ieq ; out_q(I,J) = L_to_m_scale*G%dyBu(I,J) ; enddo ; enddo call write_field(unit, fields(14), G%Domain%mpp_domain, out_q) do j=js,je ; do i=is,ie ; out_h(i,j) = G%areaT(i,j) ; enddo ; enddo @@ -1290,8 +1308,10 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) do J=Jsq,Jeq ; do I=Isq,Ieq ; out_q(I,J) = G%areaBu(I,J) ; enddo ; enddo call write_field(unit, fields(16), G%Domain%mpp_domain, out_q) - call write_field(unit, fields(17), G%Domain%mpp_domain, G%dx_Cv) - call write_field(unit, fields(18), G%Domain%mpp_domain, G%dy_Cu) + do J=Jsq,Jeq ; do i=is,ie ; out_v(i,J) = L_to_m_scale*G%dx_Cv(i,J) ; enddo ; enddo + call write_field(unit, fields(17), G%Domain%mpp_domain, out_v) + do j=js,je ; do I=Isq,Ieq ; out_u(I,j) = L_to_m_scale*G%dy_Cu(I,j) ; enddo ; enddo + call write_field(unit, fields(18), G%Domain%mpp_domain, out_u) call write_field(unit, fields(19), G%Domain%mpp_domain, G%mask2dT) if (G%bathymetry_at_vel) then diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index bb89b8b41b..063c970f94 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -127,10 +127,10 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: u !< The zonal velocity that is being - !! initialized [m s-1] + !! initialized [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(out) :: v !< The meridional velocity that is being - !! initialized [m s-1] + !! initialized [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(out) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic @@ -154,9 +154,11 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & character(len=200) :: filename2 ! The name of an input files. character(len=200) :: inputdir ! The directory where NetCDF input files are. character(len=200) :: config - real :: H_rescale ! A rescaling factor for thicknesses from the representation in - ! a restart file to the internal representation in this run. - real :: dt ! The baroclinic dynamics timestep for this run [s]. + real :: H_rescale ! A rescaling factor for thicknesses from the representation in + ! a restart file to the internal representation in this run. + real :: vel_rescale ! A rescaling factor for velocities from the representation in + ! a restart file to the internal representation in this run. + real :: dt ! The baroclinic dynamics timestep for this run [s]. logical :: from_Z_file, useALE logical :: new_sim integer :: write_geom @@ -406,20 +408,20 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & " \t USER - call a user modified routine.", default="zero", & do_not_log=just_read) select case (trim(config)) - case ("file"); call initialize_velocity_from_file(u, v, G, PF, & + case ("file"); call initialize_velocity_from_file(u, v, G, US, PF, & just_read_params=just_read) case ("zero"); call initialize_velocity_zero(u, v, G, PF, & just_read_params=just_read) - case ("uniform"); call initialize_velocity_uniform(u, v, G, PF, & + case ("uniform"); call initialize_velocity_uniform(u, v, G, US, PF, & just_read_params=just_read) - case ("circular"); call initialize_velocity_circular(u, v, G, PF, & + case ("circular"); call initialize_velocity_circular(u, v, G, US, PF, & just_read_params=just_read) case ("phillips"); call Phillips_initialize_velocity(u, v, G, GV, US, PF, & just_read_params=just_read) case ("rossby_front"); call Rossby_front_initialize_velocity(u, v, h, & G, GV, US, PF, just_read_params=just_read) - case ("soliton"); call soliton_initialize_velocity(u, v, h, G) - case ("USER"); call user_initialize_velocity(u, v, G, PF, & + case ("soliton"); call soliton_initialize_velocity(u, v, h, G, US) + case ("USER"); call user_initialize_velocity(u, v, G, US, PF, & just_read_params=just_read) case default ; call MOM_error(FATAL, "MOM_initialize_state: "//& "Unrecognized velocity configuration "//trim(config)) @@ -427,7 +429,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & if (new_sim) call pass_vector(u, v, G%Domain) if (debug .and. new_sim) then - call uvchksum("MOM_initialize_state [uv]", u, v, G%HI, haloshift=1) + call uvchksum("MOM_initialize_state [uv]", u, v, G%HI, haloshift=1, scale=US%m_s_to_L_T) endif ! Optionally convert the thicknesses from m to kg m-2. This is particularly @@ -494,6 +496,12 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & H_rescale = GV%m_to_H / GV%m_to_H_restart do k=1,nz ; do j=js,je ; do i=is,ie ; h(i,j,k) = H_rescale * h(i,j,k) ; enddo ; enddo ; enddo endif + if ( (US%s_to_T_restart * US%m_to_L_restart /= 0.0) .and. & + ((US%m_to_L * US%s_to_T_restart) /= (US%m_to_L_restart * US%s_to_T)) ) then + vel_rescale = (US%m_to_L * US%s_to_T_restart) / (US%m_to_L_restart * US%s_to_T) + do k=1,nz ; do j=jsd,jed ; do I=IsdB,IeDB ; u(I,j,k) = vel_rescale * u(I,j,k) ; enddo ; enddo ; enddo + do k=1,nz ; do J=JsdB,JedB ; do i=isd,ied ; v(i,J,k) = vel_rescale * v(i,J,k) ; enddo ; enddo ; enddo + endif endif if ( use_temperature ) then @@ -1243,12 +1251,13 @@ subroutine cut_off_column_top(nk, tv, GV, G_earth, depth, min_thickness, & end subroutine cut_off_column_top !> Initialize horizontal velocity components from file -subroutine initialize_velocity_from_file(u, v, G, param_file, just_read_params) +subroutine initialize_velocity_from_file(u, v, G, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: u !< The zonal velocity that is being initialized [m s-1] + intent(out) :: u !< The zonal velocity that is being initialized [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: v !< The meridional velocity that is being initialized [m s-1] + intent(out) :: v !< The meridional velocity that is being initialized [L T-1 ~> m s-1] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for modelparameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -1277,7 +1286,7 @@ subroutine initialize_velocity_from_file(u, v, G, param_file, just_read_params) " initialize_velocity_from_file: Unable to open "//trim(filename)) ! Read the velocities from a netcdf file. - call MOM_read_vector(filename, "u", "v", u(:,:,:), v(:,:,:),G%Domain) + call MOM_read_vector(filename, "u", "v", u(:,:,:), v(:,:,:), G%Domain, scale=US%m_s_to_L_T) call callTree_leave(trim(mdl)//'()') end subroutine initialize_velocity_from_file @@ -1286,9 +1295,9 @@ end subroutine initialize_velocity_from_file subroutine initialize_velocity_zero(u, v, G, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: u !< The zonal velocity that is being initialized [m s-1] + intent(out) :: u !< The zonal velocity that is being initialized [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: v !< The meridional velocity that is being initialized [m s-1] + intent(out) :: v !< The meridional velocity that is being initialized [L T-1 ~> m s-1] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for modelparameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -1317,12 +1326,13 @@ subroutine initialize_velocity_zero(u, v, G, param_file, just_read_params) end subroutine initialize_velocity_zero !> Sets the initial velocity components to uniform -subroutine initialize_velocity_uniform(u, v, G, param_file, just_read_params) +subroutine initialize_velocity_uniform(u, v, G, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: u !< The zonal velocity that is being initialized [m s-1] + intent(out) :: u !< The zonal velocity that is being initialized [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: v !< The meridional velocity that is being initialized [m s-1] + intent(out) :: v !< The meridional velocity that is being initialized [L T-1 ~> m s-1] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for modelparameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -1339,10 +1349,10 @@ subroutine initialize_velocity_uniform(u, v, G, param_file, just_read_params) call get_param(param_file, mdl, "INITIAL_U_CONST", initial_u_const, & "A initial uniform value for the zonal flow.", & - units="m s-1", fail_if_missing=.not.just_read, do_not_log=just_read) + units="m s-1", scale=US%m_s_to_L_T, fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl, "INITIAL_V_CONST", initial_v_const, & "A initial uniform value for the meridional flow.", & - units="m s-1", fail_if_missing=.not.just_read, do_not_log=just_read) + units="m s-1", scale=US%m_s_to_L_T, fail_if_missing=.not.just_read, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. @@ -1357,12 +1367,13 @@ end subroutine initialize_velocity_uniform !> Sets the initial velocity components to be circular with !! no flow at edges of domain and center. -subroutine initialize_velocity_circular(u, v, G, param_file, just_read_params) +subroutine initialize_velocity_circular(u, v, G, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: u !< The zonal velocity that is being initialized [m s-1] + intent(out) :: u !< The zonal velocity that is being initialized [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: v !< The meridional velocity that is being initialized [m s-1] + intent(out) :: v !< The meridional velocity that is being initialized [L T-1 ~> m s-1] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -1381,7 +1392,7 @@ subroutine initialize_velocity_circular(u, v, G, param_file, just_read_params) call get_param(param_file, mdl, "CIRCULAR_MAX_U", circular_max_u, & "The amplitude of zonal flow from which to scale the "// & "circular stream function [m s-1].", & - units="m s-1", default=0., do_not_log=just_read) + units="m s-1", default=0., scale=US%L_T_to_m_s, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. @@ -1390,12 +1401,12 @@ subroutine initialize_velocity_circular(u, v, G, param_file, just_read_params) do k=1,nz ; do j=js,je ; do I=Isq,Ieq psi1 = my_psi(I,j) psi2 = my_psi(I,j-1) - u(I,j,k) = (psi1-psi2)/G%dy_Cu(I,j)! *(circular_max_u*G%len_lon/(2.0*dpi)) + u(I,j,k) = (psi1-psi2) / (G%US%L_to_m*G%dy_Cu(I,j)) ! *(circular_max_u*G%len_lon/(2.0*dpi)) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie psi1 = my_psi(i,J) psi2 = my_psi(i-1,J) - v(i,J,k) = (psi2-psi1)/G%dx_Cv(i,J)! *(circular_max_u*G%len_lon/(2.0*dpi)) + v(i,J,k) = (psi2-psi1) / (G%US%L_to_m*G%dx_Cv(i,J)) ! *(circular_max_u*G%len_lon/(2.0*dpi)) enddo ; enddo ; enddo contains @@ -1407,12 +1418,12 @@ real function my_psi(ig,jg) ! Local variables real :: x, y, r - x = 2.0*(G%geoLonBu(ig,jg)-G%west_lon)/G%len_lon-1.0 ! -1 This subroutine sets the 4 bottom depths at velocity points to be the @@ -2161,7 +2172,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param ! Compute fractional ice shelf coverage of h do j=jsd,jed ; do i=isd,ied if (G%areaT(i,j) > 0.0) & - frac_shelf_h(i,j) = area_shelf_h(i,j) / G%areaT(i,j) + frac_shelf_h(i,j) = area_shelf_h(i,j) / (US%L_to_m**2*G%areaT(i,j)) enddo ; enddo ! Pass to the pointer for use as an argument to regridding_main shelf_area => frac_shelf_h diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index 27dde7f69d..74afd4868a 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -222,8 +222,8 @@ subroutine init_oda(Time, G, GV, CS) dirs%output_directory, tv_dummy, dG%max_depth) call ALE_init(PF, CS%GV, CS%US, dG%max_depth, CS%ALE_CS) call MOM_grid_init(CS%Grid, PF, global_indexing=.true.) - call ALE_updateVerticalGridType(CS%ALE_CS,CS%GV) - call copy_dyngrid_to_MOM_grid(dG, CS%Grid) + call ALE_updateVerticalGridType(CS%ALE_CS, CS%GV) + call copy_dyngrid_to_MOM_grid(dG, CS%Grid, CS%US) CS%mpp_domain => CS%Grid%Domain%mpp_domain CS%Grid%ke = CS%GV%ke CS%nk = CS%GV%ke diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 620b53fbda..d204db1305 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -33,7 +33,7 @@ module MOM_MEKE real :: MEKE_FrCoeff !< Efficiency of conversion of ME into MEKE [nondim] real :: MEKE_GMcoeff !< Efficiency of conversion of PE into MEKE [nondim] real :: MEKE_GMECoeff !< Efficiency of conversion of MEKE into ME by GME [nondim] - real :: MEKE_damping !< Local depth-independent MEKE dissipation rate [s-1]. + real :: MEKE_damping !< Local depth-independent MEKE dissipation rate [T-1 ~> s-1]. real :: MEKE_Cd_scale !< The ratio of the bottom eddy velocity to the column mean !! eddy velocity, i.e. sqrt(2*MEKE). This should be less than 1 !! to account for the surface intensification of MEKE. @@ -50,12 +50,12 @@ module MOM_MEKE logical :: use_old_lscale !< Use the old formula for mixing length scale. logical :: use_min_lscale !< Use simple minimum for mixing length scale. real :: cdrag !< The bottom drag coefficient for MEKE [nondim]. - real :: MEKE_BGsrc !< Background energy source for MEKE [W kg-1] (= m2 s-3). + real :: MEKE_BGsrc !< Background energy source for MEKE [L2 T-3 ~> W kg-1] (= m2 s-3). real :: MEKE_dtScale !< Scale factor to accelerate time-stepping [nondim] real :: MEKE_KhCoeff !< Scaling factor to convert MEKE into Kh [nondim] - real :: MEKE_Uscale !< MEKE velocity scale for bottom drag [m s-1] - real :: MEKE_KH !< Background lateral diffusion of MEKE [m2 s-1] - real :: MEKE_K4 !< Background bi-harmonic diffusivity (of MEKE) [m4 s-1] + real :: MEKE_Uscale !< MEKE velocity scale for bottom drag [L T-1 ~> m s-1] + real :: MEKE_KH !< Background lateral diffusion of MEKE [L2 T-1 ~> m2 s-1] + real :: MEKE_K4 !< Background bi-harmonic diffusivity (of MEKE) [L4 T-1 ~> m4 s-1] real :: KhMEKE_Fac !< A factor relating MEKE%Kh to the diffusivity used for !! MEKE itself [nondim]. real :: viscosity_coeff_Ku !< The scaling coefficient in the expression for @@ -64,7 +64,7 @@ module MOM_MEKE real :: viscosity_coeff_Au !< The scaling coefficient in the expression for !! viscosity used to parameterize lateral biharmonic momentum mixing !! by unresolved eddies represented by MEKE. - real :: Lfixed !< Fixed mixing length scale [m]. + real :: Lfixed !< Fixed mixing length scale [L ~> m]. real :: aDeform !< Weighting towards deformation scale of mixing length [nondim] real :: aRhines !< Weighting towards Rhines scale of mixing length [nondim] real :: aFrict !< Weighting towards frictional arrest scale of mixing length [nondim] @@ -103,51 +103,59 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. - real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: SN_u !< Eady growth rate at u-points [s-1]. - real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: SN_v !< Eady growth rate at v-points [s-1]. + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points [T-1 ~> s-1]. + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [T-1 ~> s-1]. type(vertvisc_type), intent(in) :: visc !< The vertical viscosity type. real, intent(in) :: dt !< Model(baroclinic) time-step [s]. type(MEKE_CS), pointer :: CS !< MEKE control structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: hu !< Zonal mass flux [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: hv !< Meridional mass flux [H m2 s-1 ~> m3 s-1 or kg s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: hu !< Accumlated zonal mass flux [H L2 ~> m3 or kg]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: hv !< Accumlated meridional mass flux [H L2 ~> m3 or kg] ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & mass, & ! The total mass of the water column [kg m-2]. I_mass, & ! The inverse of mass [m2 kg-1]. - src, & ! The sum of all MEKE sources [m2 s-3]. - MEKE_decay, & ! The MEKE decay timescale [s-1]. - MEKE_GM_src, & ! The MEKE source from thickness mixing [m2 s-3]. - MEKE_mom_src, & ! The MEKE source from momentum [m2 s-3]. - MEKE_GME_snk, & ! The MEKE sink from GME backscatter [m2 s-3]. - drag_rate_visc, & - drag_rate, & ! The MEKE spindown timescale due to bottom drag [s-1]. - del2MEKE, & ! Laplacian of MEKE, used for bi-harmonic diffusion [s-2]. - del4MEKE, & ! MEKE tendency arising from the biharmonic of MEKE [m2 s-2]. - LmixScale, & ! Square of eddy mixing length [m2]. + src, & ! The sum of all MEKE sources [L2 T-3 ~> W kg-1] (= m2 s-3). + MEKE_decay, & ! A diagnostic of the MEKE decay timescale [T-1 ~> s-1]. + ! MEKE_GM_src, & ! The MEKE source from thickness mixing [m2 s-3]. + ! MEKE_mom_src, & ! The MEKE source from momentum [m2 s-3]. + ! MEKE_GME_snk, & ! The MEKE sink from GME backscatter [m2 s-3]. + drag_rate_visc, & ! Near-bottom velocity contribution to bottom dratg [L T-1 ~> m s-1] + drag_rate, & ! The MEKE spindown timescale due to bottom drag [T-1 ~> s-1]. + drag_rate_J15, & ! The MEKE spindown timescale due to bottom drag with the Jansen 2015 scheme. + ! Unfortunately, as written the units seem inconsistent. [T-1 ~> s-1]. + del2MEKE, & ! Laplacian of MEKE, used for bi-harmonic diffusion [T-2 ~> s-2]. + del4MEKE, & ! Time-integrated MEKE tendency arising from the biharmonic of MEKE [L2 T-2 ~> m2 s-2]. + LmixScale, & ! Eddy mixing length [L ~> m]. barotrFac2, & ! Ratio of EKE_barotropic / EKE [nondim] bottomFac2 ! Ratio of EKE_bottom / EKE [nondim] real, dimension(SZIB_(G),SZJ_(G)) :: & - MEKE_uflux, & ! The zonal diffusive flux of MEKE [kg m2 s-3]. - Kh_u, & ! The zonal diffusivity that is actually used [m2 s-1]. - baroHu, & ! Depth integrated zonal mass flux [H m2 s-1 ~> m3 s-1 or kg s-1]. + MEKE_uflux, & ! The zonal advective and diffusive flux of MEKE with different units in different + ! places of [L2 T-2 ~> m2 s-2] or [m L4 T-3 ~> m5 s-3] or [kg m-2 L4 T-3 ~> kg m-2 s-3]. + Kh_u, & ! The zonal diffusivity that is actually used [L2 T-1 ~> m2 s-1]. + baroHu, & ! Depth integrated accumulated zonal mass flux [H L2 ~> m3 or kg]. drag_vel_u ! A (vertical) viscosity associated with bottom drag at - ! u-points [m s-1]. + ! u-points [Z T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G)) :: & - MEKE_vflux, & ! The meridional diffusive flux of MEKE [kg m2 s-3]. - Kh_v, & ! The meridional diffusivity that is actually used [m2 s-1]. - baroHv, & ! Depth integrated meridional mass flux [H m2 s-1 ~> m3 s-1 or kg s-1]. + MEKE_vflux, & ! The meridional advective and diffusive flux of MEKE with different units in different + ! places of [L2 T-2 ~> m2 s-2] or [m L4 T-3 ~> m5 s-3] or [kg m-2 L4 T-3 ~> kg m-2 s-3]. + Kh_v, & ! The meridional diffusivity that is actually used [L2 T-1 ~> m2 s-1]. + baroHv, & ! Depth integrated accumulated meridional mass flux [H L2 ~> m3 or kg]. drag_vel_v ! A (vertical) viscosity associated with bottom drag at - ! v-points [m s-1]. - real :: Kh_here, Inv_Kh_max, K4_here + ! v-points [Z T-1 ~> m s-1]. + real :: Kh_here ! The local horizontal viscosity [L2 T-1 ~> m2 s-1] + real :: Inv_Kh_max ! The inverse of the local horizontal viscosity [T L-2 ~> s m-2] + real :: K4_here ! The local horizontal biharmonic viscosity [L4 T-1 ~> m4 s-1] + real :: Inv_K4_max ! The inverse of the local horizontal biharmonic viscosity [T L-4 ~> s m-4] real :: cdrag2 - real :: advFac + real :: advFac ! The product of the advection scaling factor and some unit conversion + ! factors divided by the timestep [m H-1 T-1 ~> s-1 or m3 kg-1 s-1] real :: mass_neglect ! A negligible mass [kg m-2]. - real :: ldamping ! The MEKE damping rate [s-1]. + real :: ldamping ! The MEKE damping rate [T-1 ~> s-1]. real :: Rho0 ! A density used to convert mass to distance [kg m-3]. - real :: sdt ! dt to use locally [s] (could be scaled to accelerate) - real :: sdt_damp ! dt for damping [s] (sdt could be split). + real :: sdt ! dt to use locally [T ~> s] (could be scaled to accelerate) + real :: sdt_damp ! dt for damping [T ~> s] (sdt could be split). logical :: use_drag_rate ! Flag to indicate drag_rate is finite integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz @@ -159,10 +167,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (.not.associated(MEKE)) call MOM_error(FATAL, & "MOM_MEKE: MEKE must be initialized before it is used.") - Rho0 = GV%H_to_kg_m2 * GV%m_to_H - mass_neglect = GV%H_to_kg_m2 * GV%H_subroundoff - sdt = dt*CS%MEKE_dtScale ! Scaled dt to use for time-stepping - if (CS%MEKE_damping + CS%MEKE_Cd_scale > 0.0 .or. CS%MEKE_Cb>0. & + if ((CS%MEKE_damping > 0.0) .or. (CS%MEKE_Cd_scale > 0.0) .or. (CS%MEKE_Cb>0.) & .or. CS%visc_drag) then use_drag_rate = .true. else @@ -170,19 +175,24 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h endif ! Only integrate the MEKE equations if MEKE is required. - if (associated(MEKE%MEKE)) then + if (.not.associated(MEKE%MEKE)) then +! call MOM_error(FATAL, "MOM_MEKE: MEKE%MEKE is not associated!") + return + endif if (CS%debug) then - if (associated(MEKE%mom_src)) call hchksum(MEKE%mom_src, 'MEKE mom_src',G%HI) - if (associated(MEKE%GME_snk)) call hchksum(MEKE%GME_snk, 'MEKE GME_snk',G%HI) - if (associated(MEKE%GM_src)) call hchksum(MEKE%GM_src, 'MEKE GM_src',G%HI) - if (associated(MEKE%MEKE)) call hchksum(MEKE%MEKE, 'MEKE MEKE',G%HI) - call uvchksum("MEKE SN_[uv]", SN_u, SN_v, G%HI) + if (associated(MEKE%mom_src)) & + call hchksum(MEKE%mom_src, 'MEKE mom_src', G%HI, scale=US%L_to_m**2*US%s_to_T**3) + if (associated(MEKE%GME_snk)) & + call hchksum(MEKE%GME_snk, 'MEKE GME_snk', G%HI, scale=US%L_to_m**2*US%s_to_T**3) + if (associated(MEKE%GM_src)) & + call hchksum(MEKE%GM_src, 'MEKE GM_src', G%HI, scale=US%L_to_m**2*US%s_to_T**3) + if (associated(MEKE%MEKE)) call hchksum(MEKE%MEKE, 'MEKE MEKE', G%HI, scale=US%L_T_to_m_s**2) + call uvchksum("MEKE SN_[uv]", SN_u, SN_v, G%HI, scale=US%s_to_T) call uvchksum("MEKE h[uv]", hu, hv, G%HI, haloshift=1, scale=GV%H_to_m) endif - ! Why are these 3 lines repeated from above? - sdt = dt*CS%MEKE_dtScale ! Scaled dt to use for time-stepping + sdt = US%s_to_T*dt*CS%MEKE_dtScale ! Scaled dt to use for time-stepping Rho0 = GV%H_to_kg_m2 * GV%m_to_H mass_neglect = GV%H_to_kg_m2 * GV%H_subroundoff cdrag2 = CS%cdrag**2 @@ -214,7 +224,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (CS%MEKE_Cd_scale == 0.0 .and. .not. CS%visc_drag) then !$OMP parallel do default(shared) private(ldamping) do j=js,je ; do i=is,ie - drag_rate(i,j) = 0. + drag_rate(i,j) = 0. ; drag_rate_J15(i,j) = 0. enddo ; enddo endif @@ -224,18 +234,18 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h do j=js,je ; do I=is-1,ie drag_vel_u(I,j) = 0.0 if ((G%mask2dCu(I,j) > 0.0) .and. (visc%bbl_thick_u(I,j) > 0.0)) & - drag_vel_u(I,j) = US%Z_to_m*US%s_to_T*visc%Kv_bbl_u(I,j) / visc%bbl_thick_u(I,j) + drag_vel_u(I,j) = visc%Kv_bbl_u(I,j) / visc%bbl_thick_u(I,j) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie drag_vel_v(i,J) = 0.0 if ((G%mask2dCv(i,J) > 0.0) .and. (visc%bbl_thick_v(i,J) > 0.0)) & - drag_vel_v(i,J) = US%Z_to_m*US%s_to_T*visc%Kv_bbl_v(i,J) / visc%bbl_thick_v(i,J) + drag_vel_v(i,J) = visc%Kv_bbl_v(i,J) / visc%bbl_thick_v(i,J) enddo ; enddo !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - drag_rate_visc(i,j) = (0.25*G%IareaT(i,j) * & + drag_rate_visc(i,j) = (0.25*G%IareaT(i,j) * US%Z_to_L * & ((G%areaCu(I-1,j)*drag_vel_u(I-1,j) + & G%areaCu(I,j)*drag_vel_u(I,j)) + & (G%areaCv(i,J-1)*drag_vel_v(i,J-1) + & @@ -268,12 +278,12 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! Calculates bottomFac2, barotrFac2 and LmixScale call MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, MEKE%MEKE, bottomFac2, barotrFac2, LmixScale) if (CS%debug) then - call uvchksum("MEKE drag_vel_[uv]", drag_vel_u, drag_vel_v, G%HI) + call uvchksum("MEKE drag_vel_[uv]", drag_vel_u, drag_vel_v, G%HI, scale=US%Z_to_m*US%s_to_T) call hchksum(mass, 'MEKE mass',G%HI,haloshift=1) - call hchksum(drag_rate_visc, 'MEKE drag_rate_visc',G%HI) + call hchksum(drag_rate_visc, 'MEKE drag_rate_visc',G%HI, scale=US%L_T_to_m_s) call hchksum(bottomFac2, 'MEKE bottomFac2',G%HI) call hchksum(barotrFac2, 'MEKE barotrFac2',G%HI) - call hchksum(LmixScale, 'MEKE LmixScale',G%HI) + call hchksum(LmixScale, 'MEKE LmixScale',G%HI,scale=US%L_to_m) endif ! Aggregate sources of MEKE (background, frictional and GM) @@ -290,19 +300,21 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h endif if (associated(MEKE%GME_snk)) then -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie src(i,j) = src(i,j) - CS%MEKE_GMECoeff*I_mass(i,j)*MEKE%GME_snk(i,j) enddo ; enddo endif if (associated(MEKE%GM_src)) then -!$OMP do if (CS%GM_src_alt) then + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - src(i,j) = src(i,j) - CS%MEKE_GMcoeff*MEKE%GM_src(i,j) / MAX(1.0,G%bathyT(i,j)) + src(i,j) = src(i,j) - CS%MEKE_GMcoeff*MEKE%GM_src(i,j) / & + MAX(1.0, G%bathyT(i,j)) !### 1.0 seems to be a hard-coded dimensional constant (1 m?). enddo ; enddo else + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie src(i,j) = src(i,j) - CS%MEKE_GMcoeff*I_mass(i,j)*MEKE%GM_src(i,j) enddo ; enddo @@ -312,29 +324,28 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! Increase EKE by a full time-steps worth of source !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - MEKE%MEKE(i,j) = (MEKE%MEKE(i,j) + sdt*src(i,j) )*G%mask2dT(i,j) + MEKE%MEKE(i,j) = (MEKE%MEKE(i,j) + sdt*src(i,j))*G%mask2dT(i,j) enddo ; enddo if (use_drag_rate) then ! Calculate a viscous drag rate (includes BBL contributions from mean flow and eddies) -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - drag_rate(i,j) = (Rho0 * I_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 & - + cdrag2 * ( max(0.0, 2.0*bottomFac2(i,j)*MEKE%MEKE(i,j)) + CS%MEKE_Uscale**2 ) ) + drag_rate(i,j) = (US%L_to_m*Rho0 * I_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 + & + cdrag2 * ( max(0.0, 2.0*bottomFac2(i,j)*MEKE%MEKE(i,j)) + CS%MEKE_Uscale**2 ) ) enddo ; enddo endif ! First stage of Strang splitting -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie ldamping = CS%MEKE_damping + drag_rate(i,j) * bottomFac2(i,j) - if (MEKE%MEKE(i,j)<0.) ldamping = 0. + if (MEKE%MEKE(i,j) < 0.) ldamping = 0. ! notice that the above line ensures a damping only if MEKE is positive, ! while leaving MEKE unchanged if it is negative MEKE%MEKE(i,j) = MEKE%MEKE(i,j) / (1.0 + sdt_damp*ldamping) MEKE_decay(i,j) = ldamping*G%mask2dT(i,j) enddo ; enddo -!$OMP end parallel if (CS%kh_flux_enabled .or. CS%MEKE_K4 >= 0.0) then ! Update MEKE in the halos for lateral or bi-harmonic diffusion @@ -347,6 +358,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! Calculate Laplacian of MEKE !$OMP parallel do default(shared) do j=js-1,je+1 ; do I=is-2,ie+1 + ! Here the units of MEKE_uflux are [L2 T-2]. MEKE_uflux(I,j) = ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * G%mask2dCu(I,j)) * & (MEKE%MEKE(i+1,j) - MEKE%MEKE(i,j)) ! MEKE_uflux(I,j) = ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * & @@ -355,6 +367,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h enddo ; enddo !$OMP parallel do default(shared) do J=js-2,je+1 ; do i=is-1,ie+1 + ! Here the units of MEKE_vflux are [L2 T-2]. MEKE_vflux(i,J) = ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * G%mask2dCv(i,J)) * & (MEKE%MEKE(i,j+1) - MEKE%MEKE(i,j)) ! MEKE_vflux(i,J) = ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * & @@ -371,24 +384,24 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h enddo ; enddo ! Bi-harmonic diffusion of MEKE - !$OMP parallel do default(shared) private(K4_here,Inv_Kh_max) + !$OMP parallel do default(shared) private(K4_here,Inv_K4_max) do j=js,je ; do I=is-1,ie K4_here = CS%MEKE_K4 ! Limit Kh to avoid CFL violations. - Inv_Kh_max = 64.0*sdt * (((G%dy_Cu(I,j)*G%IdxCu(I,j)) * & - max(G%IareaT(i,j),G%IareaT(i+1,j))))**2 - if (K4_here*Inv_Kh_max > 0.3) K4_here = 0.3 / Inv_Kh_max + Inv_K4_max = 64.0 * sdt * ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * & + max(G%IareaT(i,j), G%IareaT(i+1,j)))**2 + if (K4_here*Inv_K4_max > 0.3) K4_here = 0.3 / Inv_K4_max + ! Here the units of MEKE_uflux are [kg m-2 L4 T-3]. MEKE_uflux(I,j) = ((K4_here * (G%dy_Cu(I,j)*G%IdxCu(I,j))) * & ((2.0*mass(i,j)*mass(i+1,j)) / ((mass(i,j)+mass(i+1,j)) + mass_neglect)) ) * & (del2MEKE(i+1,j) - del2MEKE(i,j)) enddo ; enddo - !$OMP parallel do default(shared) private(K4_here,Inv_Kh_max) + !$OMP parallel do default(shared) private(K4_here,Inv_K4_max) do J=js-1,je ; do i=is,ie K4_here = CS%MEKE_K4 - Inv_Kh_max = 64.0*sdt * (((G%dx_Cv(i,J)*G%IdyCv(i,J)) * & - max(G%IareaT(i,j),G%IareaT(i,j+1))))**2 - if (K4_here*Inv_Kh_max > 0.3) K4_here = 0.3 / Inv_Kh_max + Inv_K4_max = 64.0 * sdt * ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * max(G%IareaT(i,j), G%IareaT(i,j+1)))**2 + if (K4_here*Inv_K4_max > 0.3) K4_here = 0.3 / Inv_K4_max MEKE_vflux(i,J) = ((K4_here * (G%dx_Cv(i,J)*G%IdyCv(i,J))) * & ((2.0*mass(i,j)*mass(i,j+1)) / ((mass(i,j)+mass(i,j+1)) + mass_neglect)) ) * & @@ -406,19 +419,22 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (CS%kh_flux_enabled) then ! Lateral diffusion of MEKE - Kh_here = max(0.,CS%MEKE_Kh) + Kh_here = max(0., CS%MEKE_Kh) !$OMP parallel do default(shared) firstprivate(Kh_here) private(Inv_Kh_max) do j=js,je ; do I=is-1,ie ! Limit Kh to avoid CFL violations. if (associated(MEKE%Kh)) & - Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac*0.5*(MEKE%Kh(i,j)+MEKE%Kh(i+1,j)) + Kh_here = max(0., CS%MEKE_Kh) + & + CS%KhMEKE_Fac*0.5*(MEKE%Kh(i,j)+MEKE%Kh(i+1,j)) if (associated(MEKE%Kh_diff)) & - Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac*0.5*(MEKE%Kh_diff(i,j)+MEKE%Kh_diff(i+1,j)) + Kh_here = max(0.,CS%MEKE_Kh) + & + CS%KhMEKE_Fac*0.5*(MEKE%Kh_diff(i,j)+MEKE%Kh_diff(i+1,j)) Inv_Kh_max = 2.0*sdt * ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * & max(G%IareaT(i,j),G%IareaT(i+1,j))) if (Kh_here*Inv_Kh_max > 0.25) Kh_here = 0.25 / Inv_Kh_max Kh_u(I,j) = Kh_here + ! Here the units of MEKE_uflux and MEKE_vflux are [kg m-2 L4 T-3]. MEKE_uflux(I,j) = ((Kh_here * (G%dy_Cu(I,j)*G%IdxCu(I,j))) * & ((2.0*mass(i,j)*mass(i+1,j)) / ((mass(i,j)+mass(i+1,j)) + mass_neglect)) ) * & (MEKE%MEKE(i,j) - MEKE%MEKE(i+1,j)) @@ -426,22 +442,25 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h !$OMP parallel do default(shared) firstprivate(Kh_here) private(Inv_Kh_max) do J=js-1,je ; do i=is,ie if (associated(MEKE%Kh)) & - Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac*0.5*(MEKE%Kh(i,j)+MEKE%Kh(i,j+1)) + Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac * 0.5*(MEKE%Kh(i,j)+MEKE%Kh(i,j+1)) if (associated(MEKE%Kh_diff)) & - Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac*0.5*(MEKE%Kh_diff(i,j)+MEKE%Kh_diff(i,j+1)) - Inv_Kh_max = 2.0*sdt * ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * & - max(G%IareaT(i,j),G%IareaT(i,j+1))) + Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac * 0.5*(MEKE%Kh_diff(i,j)+MEKE%Kh_diff(i,j+1)) + Inv_Kh_max = 2.0*sdt * ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * max(G%IareaT(i,j),G%IareaT(i,j+1))) if (Kh_here*Inv_Kh_max > 0.25) Kh_here = 0.25 / Inv_Kh_max Kh_v(i,J) = Kh_here + ! Here the units of MEKE_uflux and MEKE_vflux are [kg m-2 L4 T-3]. MEKE_vflux(i,J) = ((Kh_here * (G%dx_Cv(i,J)*G%IdyCv(i,J))) * & ((2.0*mass(i,j)*mass(i,j+1)) / ((mass(i,j)+mass(i,j+1)) + mass_neglect)) ) * & (MEKE%MEKE(i,j) - MEKE%MEKE(i,j+1)) enddo ; enddo if (CS%MEKE_advection_factor>0.) then - advFac = GV%H_to_m * CS%MEKE_advection_factor / dt + !### I think that for dimensional consistency, this should be: + ! advFac = GV%H_to_kg_m2 * CS%MEKE_advection_factor / (US%s_to_T*dt) + advFac = GV%H_to_m * CS%MEKE_advection_factor / (US%s_to_T*dt) !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie + ! Here the units of the quantities added to MEKE_uflux and MEKE_vflux are [m L4 T-3]. if (baroHu(I,j)>0.) then MEKE_uflux(I,j) = MEKE_uflux(I,j) + baroHu(I,j)*MEKE%MEKE(i,j)*advFac elseif (baroHu(I,j)<0.) then @@ -450,6 +469,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie + ! Here the units of the quantities added to MEKE_uflux and MEKE_vflux are [m L4 T-3]. if (baroHv(i,J)>0.) then MEKE_vflux(i,J) = MEKE_vflux(i,J) + baroHv(i,J)*MEKE%MEKE(i,j)*advFac elseif (baroHv(i,J)<0.) then @@ -457,8 +477,11 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h endif enddo ; enddo endif + + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie + ! This expression is correct if the units of MEKE_uflux and MEKE_vflux are [kg m-2 L4 T-3]. MEKE%MEKE(i,j) = MEKE%MEKE(i,j) + (sdt*(G%IareaT(i,j)*I_mass(i,j))) * & ((MEKE_uflux(I-1,j) - MEKE_uflux(I,j)) + & (MEKE_vflux(i,J-1) - MEKE_vflux(i,J))) @@ -478,21 +501,21 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (sdt>sdt_damp) then ! Recalculate the drag rate, since MEKE has changed. if (use_drag_rate) then -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - drag_rate(i,j) = (Rho0 * I_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 & - + cdrag2 * ( max(0.0, 2.0*bottomFac2(i,j)*MEKE%MEKE(i,j)) + CS%MEKE_Uscale**2 ) ) + drag_rate(i,j) = (US%L_to_m*Rho0 * I_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 + & + cdrag2 * ( max(0.0, 2.0*bottomFac2(i,j)*MEKE%MEKE(i,j)) + CS%MEKE_Uscale**2 ) ) enddo ; enddo + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie ldamping = CS%MEKE_damping + drag_rate(i,j) * bottomFac2(i,j) - if (MEKE%MEKE(i,j)<0.) ldamping = 0. + if (MEKE%MEKE(i,j) < 0.) ldamping = 0. ! notice that the above line ensures a damping only if MEKE is positive, ! while leaving MEKE unchanged if it is negative MEKE%MEKE(i,j) = MEKE%MEKE(i,j) / (1.0 + sdt_damp*ldamping) MEKE_decay(i,j) = ldamping*G%mask2dT(i,j) enddo ; enddo endif -!$OMP do endif endif ! MEKE_KH>=0 @@ -500,7 +523,6 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! MEKE%MEKE(i,j) = MAX(MEKE%MEKE(i,j),0.0) ! enddo ; enddo -!$OMP end parallel call cpu_clock_begin(CS%id_clock_pass) call do_group_pass(CS%pass_MEKE, G%Domain) call cpu_clock_end(CS%id_clock_pass) @@ -512,20 +534,22 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (CS%Rd_as_max_scale) then !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - MEKE%Kh(i,j) = (CS%MEKE_KhCoeff & - * sqrt(2.*max(0.,barotrFac2(i,j)*MEKE%MEKE(i,j))*G%areaT(i,j))) & - * min(MEKE%Rd_dx_h(i,j), 1.0) + MEKE%Kh(i,j) = (CS%MEKE_KhCoeff * & + sqrt(2.*max(0.,barotrFac2(i,j)*MEKE%MEKE(i,j))*G%areaT(i,j)) ) * & + min(MEKE%Rd_dx_h(i,j), 1.0) enddo ; enddo else !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - MEKE%Kh(i,j) = CS%MEKE_KhCoeff*sqrt(2.*max(0.,barotrFac2(i,j)*MEKE%MEKE(i,j))*G%areaT(i,j)) + MEKE%Kh(i,j) = CS%MEKE_KhCoeff * & + sqrt(2.*max(0., barotrFac2(i,j)*MEKE%MEKE(i,j))*G%areaT(i,j)) enddo ; enddo endif else !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - MEKE%Kh(i,j) = (CS%MEKE_KhCoeff*sqrt(2.*max(0.,barotrFac2(i,j)*MEKE%MEKE(i,j)))*LmixScale(i,j)) + MEKE%Kh(i,j) = CS%MEKE_KhCoeff * & + sqrt(2.*max(0., barotrFac2(i,j)*MEKE%MEKE(i,j))) * LmixScale(i,j) enddo ; enddo endif endif @@ -534,13 +558,13 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! Calculate viscosity for the main model to use if (CS%viscosity_coeff_Ku /=0.) then do j=js,je ; do i=is,ie - MEKE%Ku(i,j) = US%T_to_s*CS%viscosity_coeff_Ku*sqrt(2.*max(0.,MEKE%MEKE(i,j)))*LmixScale(i,j) + MEKE%Ku(i,j) = CS%viscosity_coeff_Ku * sqrt(2.*max(0.,MEKE%MEKE(i,j))) * LmixScale(i,j) enddo ; enddo endif if (CS%viscosity_coeff_Au /=0.) then do j=js,je ; do i=is,ie - MEKE%Au(i,j) = US%T_to_s*CS%viscosity_coeff_Au*sqrt(2.*max(0.,MEKE%MEKE(i,j)))*LmixScale(i,j)**3 + MEKE%Au(i,j) = CS%viscosity_coeff_Au * sqrt(2.*max(0.,MEKE%MEKE(i,j))) * LmixScale(i,j)**3 enddo ; enddo endif @@ -579,10 +603,6 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h call post_data(CS%id_gamma_t, barotrFac2, CS%diag) endif -! else ! if MEKE%MEKE -! call MOM_error(FATAL, "MOM_MEKE: MEKE%MEKE is not associated!") - endif - end subroutine step_forward_MEKE !> Calculates the equilibrium solutino where the source depends only on MEKE diffusivity @@ -593,17 +613,28 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(MEKE_CS), pointer :: CS !< MEKE control structure. - type(MEKE_type), pointer :: MEKE !< MEKE data. - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points [s-1]. - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [s-1]. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: drag_rate_visc !< Mean flow contrib. to drag rate - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: I_mass !< Inverse of column mass. + type(MEKE_type), pointer :: MEKE !< A structure with MEKE data. + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points [T-1 ~> s-1]. + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [T-1 ~> s-1]. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: drag_rate_visc !< Mean flow velocity contribution + !! to the MEKE drag rate [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: I_mass !< Inverse of column mass [m2 kg-1]. ! Local variables - real :: beta, SN, bottomFac2, barotrFac2, LmixScale, Lrhines, Leady - real :: I_H, KhCoeff, Kh, Ubg2, cd2, drag_rate, ldamping, src - real :: EKE, EKEmin, EKEmax, resid, ResMin, ResMax, EKEerr - real :: FatH ! Coriolis parameter at h points; to compute topographic beta [s-1] - real :: beta_topo_x, beta_topo_y ! Topographic PV gradients in x and y [s-1 m-1] + real :: beta ! Combined topograpic and planetary vorticity gradient [T-1 L-1 ~> s-1 m-1] + real :: SN ! The local Eady growth rate [T-1 ~> s-1] + real :: bottomFac2, barotrFac2 ! Vertical structure factors [nondim] + real :: LmixScale, LRhines, LEady ! Various mixing length scales [L ~> m] + real :: I_H, KhCoeff + real :: Kh ! A lateral diffusivity [L2 T-1 ~> m2 s-1] + real :: Ubg2 ! Background (tidal?) velocity squared [L2 T-2 ~> m2 s-2] + real :: cd2 + real :: drag_rate ! The MEKE spindown timescale due to bottom drag [T-1 ~> s-1]. + real :: src ! The sum of MEKE sources [L2 T-3 ~> W kg-1] + real :: ldamping ! The MEKE damping rate [T-1 ~> s-1]. + real :: EKE, EKEmin, EKEmax, EKEerr ! [L2 T-2 ~> m2 s-2] + real :: resid, ResMin, ResMax ! Residuals [L2 T-3 ~> W kg-1] + real :: FatH ! Coriolis parameter at h points; to compute topographic beta [T-1 ~> s-1] + real :: beta_topo_x, beta_topo_y ! Topographic PV gradients in x and y [T-1 L-1 ~> s-1 m-1] integer :: i, j, is, ie, js, je, n1, n2 real, parameter :: tolerance = 1.e-12 ! Width of EKE bracket [m2 s-2]. logical :: useSecant, debugIteration @@ -617,12 +648,12 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m !$OMP do do j=js,je ; do i=is,ie - !SN = 0.25*max( (SN_u(I,j) + SN_u(I-1,j)) + (SN_v(i,J) + SN_v(i,J-1)), 0.) + ! SN = 0.25*max( (SN_u(I,j) + SN_u(I-1,j)) + (SN_v(i,J) + SN_v(i,J-1)), 0.) ! This avoids extremes values in equilibrium solution due to bad values in SN_u, SN_v - SN = min( min(SN_u(I,j) , SN_u(I-1,j)) , min(SN_v(i,J), SN_v(i,J-1)) ) + SN = min(SN_u(I,j), SN_u(I-1,j), SN_v(i,J), SN_v(i,J-1)) - FatH = 0.25*US%s_to_T*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J-1)) + & - (G%CoriolisBu(I-1,J) + G%CoriolisBu(I,J-1))) ! Coriolis parameter at h points + FatH = 0.25*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J-1)) + & + (G%CoriolisBu(I-1,J) + G%CoriolisBu(I,J-1))) ! Coriolis parameter at h points ! Since zero-bathymetry cells are masked, this avoids calculations on land if (CS%MEKE_topographic_beta == 0. .or. G%bathyT(i,j) == 0.) then @@ -632,61 +663,60 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m ! of the water column thickness instead of the bathymetric depth. beta_topo_x = CS%MEKE_topographic_beta * FatH * 0.5 * ( & (G%bathyT(i+1,j)-G%bathyT(i,j)) * G%IdxCu(I,j) & - /max(G%bathyT(i+1,j),G%bathyT(i,j), GV%H_subroundoff) & + / max(G%bathyT(i+1,j),G%bathyT(i,j), GV%H_subroundoff) & + (G%bathyT(i,j)-G%bathyT(i-1,j)) * G%IdxCu(I-1,j) & - /max(G%bathyT(i,j),G%bathyT(i-1,j), GV%H_subroundoff) ) + / max(G%bathyT(i,j),G%bathyT(i-1,j), GV%H_subroundoff) ) + !### There is a bug in the 4th lne below, where IdxCu should be IdyCv. beta_topo_y = CS%MEKE_topographic_beta * FatH * 0.5 * ( & (G%bathyT(i,j+1)-G%bathyT(i,j)) * G%IdyCv(i,J) & - /max(G%bathyT(i,j+1),G%bathyT(i,j), GV%H_subroundoff) + & + / max(G%bathyT(i,j+1),G%bathyT(i,j), GV%H_subroundoff) + & (G%bathyT(i,j)-G%bathyT(i,j-1)) * G%IdxCu(i,J-1) & - /max(G%bathyT(i,j),G%bathyT(i,j-1), GV%H_subroundoff) ) + / max(G%bathyT(i,j),G%bathyT(i,j-1), GV%H_subroundoff) ) endif + beta = sqrt((G%dF_dx(i,j) - beta_topo_x)**2 + & + (G%dF_dy(i,j) - beta_topo_y)**2 ) - beta = sqrt((US%s_to_T * G%dF_dx(i,j) - beta_topo_x)**2 & - + (US%s_to_T * G%dF_dy(i,j) - beta_topo_y)**2 ) - - I_H = GV%Rho0 * I_mass(i,j) + I_H = US%L_to_m*GV%Rho0 * I_mass(i,j) if (KhCoeff*SN*I_H>0.) then ! Solve resid(E) = 0, where resid = Kh(E) * (SN)^2 - damp_rate(E) E EKEmin = 0. ! Use the trivial root as the left bracket ResMin = 0. ! Need to detect direction of left residual - EKEmax = 0.01 ! First guess at right bracket + EKEmax = 0.01*US%m_s_to_L_T**2 ! First guess at right bracket useSecant = .false. ! Start using a bisection method ! First find right bracket for which resid<0 - resid = 1. ; n1 = 0 + resid = 1.0*US%m_to_L**2*US%T_to_s**3 ; n1 = 0 do while (resid>0.) n1 = n1 + 1 EKE = EKEmax - call MEKE_lengthScales_0d(CS, G%areaT(i,j), beta, G%bathyT(i,j), & - MEKE%Rd_dx_h(i,j), SN, EKE, US%Z_to_m, & - bottomFac2, barotrFac2, LmixScale, & - Lrhines, Leady) + call MEKE_lengthScales_0d(CS, US, G%areaT(i,j), beta, G%bathyT(i,j), & + MEKE%Rd_dx_h(i,j), SN, EKE, & + bottomFac2, barotrFac2, LmixScale, LRhines, LEady) ! TODO: Should include resolution function in Kh Kh = (KhCoeff * sqrt(2.*barotrFac2*EKE) * LmixScale) src = Kh * (SN * SN) - drag_rate = I_H * sqrt( drag_rate_visc(i,j)**2 + cd2 * ( 2.0*bottomFac2*EKE + Ubg2 ) ) + drag_rate = I_H * sqrt(drag_rate_visc(i,j)**2 + cd2 * ( 2.0*bottomFac2*EKE + Ubg2 ) ) ldamping = CS%MEKE_damping + drag_rate * bottomFac2 resid = src - ldamping * EKE - if (debugIteration) then - write(0,*) n1, 'EKE=',EKE,'resid=',resid - write(0,*) 'EKEmin=',EKEmin,'ResMin=',ResMin - write(0,*) 'src=',src,'ldamping=',ldamping - write(0,*) 'gamma-b=',bottomFac2,'gamma-t=',barotrFac2 - write(0,*) 'drag_visc=',drag_rate_visc(i,j),'Ubg2=',Ubg2 - endif + ! if (debugIteration) then + ! write(0,*) n1, 'EKE=',EKE,'resid=',resid + ! write(0,*) 'EKEmin=',EKEmin,'ResMin=',ResMin + ! write(0,*) 'src=',src,'ldamping=',ldamping + ! write(0,*) 'gamma-b=',bottomFac2,'gamma-t=',barotrFac2 + ! write(0,*) 'drag_visc=',drag_rate_visc(i,j),'Ubg2=',Ubg2 + ! endif if (resid>0.) then ! EKE is to the left of the root EKEmin = EKE ! so we move the left bracket here EKEmax = 10. * EKE ! and guess again for the right bracket if (resid 2.e17) then + if (US%L_T_to_m_s**2*EKEmax > 2.e17) then if (debugIteration) stop 'Something has gone very wrong' debugIteration = .true. resid = 1. ; n1 = 0 EKEmin = 0. ; ResMin = 0. - EKEmax = 0.01 + EKEmax = 0.01*US%m_s_to_L_T**2 useSecant = .false. endif endif @@ -695,7 +725,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m ! Bisect the bracket n2 = 0 ; EKEerr = EKEmax - EKEmin - do while (EKEerr>tolerance) + do while (US%L_T_to_m_s**2*EKEerr>tolerance) n2 = n2 + 1 if (useSecant) then EKE = EKEmin + (EKEmax - EKEmin) * (ResMin / (ResMin - ResMax)) @@ -709,7 +739,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m drag_rate = I_H * sqrt( drag_rate_visc(i,j)**2 + cd2 * ( 2.0*bottomFac2*EKE + Ubg2 ) ) ldamping = CS%MEKE_damping + drag_rate * bottomFac2 resid = src - ldamping * EKE - if (useSecant.and.resid>ResMin) useSecant = .false. + if (useSecant .and. resid>ResMin) useSecant = .false. if (resid>0.) then ! EKE is to the left of the root EKEmin = EKE ! so we move the left bracket here if (resid s-1]. + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [T-1 ~> s-1]. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: EKE !< Eddy kinetic energy [L2 T-2 ~> m2 s-2]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: bottomFac2 !< gamma_b^2 real, dimension(SZI_(G),SZJ_(G)), intent(out) :: barotrFac2 !< gamma_t^2 - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: LmixScale !< Eddy mixing length [m]. + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: LmixScale !< Eddy mixing length [L ~> m]. ! Local variables - real, dimension(SZI_(G),SZJ_(G)) :: Lrhines, Leady - real :: beta, SN - real :: FatH ! Coriolis parameter at h points [s-1] - real :: beta_topo_x, beta_topo_y ! Topographic PV gradients in x and y [s-1 m-1] + real, dimension(SZI_(G),SZJ_(G)) :: LRhines, LEady ! Possible mixing length scales [L ~> m] + real :: beta ! Combined topograpic and planetary vorticity gradient [T-1 L-1 ~> s-1 m-1] + real :: SN ! The local Eady growth rate [T-1 ~> s-1] + real :: FatH ! Coriolis parameter at h points [T-1 ~> s-1] + real :: beta_topo_x, beta_topo_y ! Topographic PV gradients in x and y [T-1 L-1 ~> s-1 m-1] integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -762,12 +793,12 @@ subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, & do j=js,je ; do i=is,ie if (.not.CS%use_old_lscale) then if (CS%aEady > 0.) then - SN = 0.25*( (SN_u(I,j) + SN_u(I-1,j)) + (SN_v(i,J) + SN_v(i,J-1)) ) + SN = 0.25 * ( (SN_u(I,j) + SN_u(I-1,j)) + (SN_v(i,J) + SN_v(i,J-1)) ) else SN = 0. endif - FatH = 0.25*US%s_to_T* ( ( G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J-1) ) + & - ( G%CoriolisBu(I-1,J) + G%CoriolisBu(I,J-1) ) ) ! Coriolis parameter at h points + FatH = 0.25* ( ( G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J-1) ) + & + ( G%CoriolisBu(I-1,J) + G%CoriolisBu(I,J-1) ) ) ! Coriolis parameter at h points ! If bathyT is zero, then a division by zero FPE will be raised. In this ! case, we apply Adcroft's rule of reciprocals and set the term to zero. @@ -779,59 +810,61 @@ subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, & ! of the water column thickness instead of the bathymetric depth. beta_topo_x = CS%MEKE_topographic_beta * FatH * 0.5 * ( & (G%bathyT(i+1,j)-G%bathyT(i,j)) * G%IdxCu(I,j) & - /max(G%bathyT(i+1,j),G%bathyT(i,j), GV%H_subroundoff) & + / max(G%bathyT(i+1,j),G%bathyT(i,j), GV%H_subroundoff) & + (G%bathyT(i,j)-G%bathyT(i-1,j)) * G%IdxCu(I-1,j) & - /max(G%bathyT(i,j),G%bathyT(i-1,j), GV%H_subroundoff) ) + / max(G%bathyT(i,j),G%bathyT(i-1,j), GV%H_subroundoff) ) + !### There is a bug in the 4th lne below, where IdxCu should be IdyCv. beta_topo_y = CS%MEKE_topographic_beta * FatH * 0.5 * ( & (G%bathyT(i,j+1)-G%bathyT(i,j)) * G%IdyCv(i,J) & - /max(G%bathyT(i,j+1),G%bathyT(i,j), GV%H_subroundoff) + & + / max(G%bathyT(i,j+1),G%bathyT(i,j), GV%H_subroundoff) + & (G%bathyT(i,j)-G%bathyT(i,j-1)) * G%IdxCu(i,J-1) & - /max(G%bathyT(i,j),G%bathyT(i,j-1), GV%H_subroundoff) ) + / max(G%bathyT(i,j),G%bathyT(i,j-1), GV%H_subroundoff) ) endif - - beta = sqrt((US%s_to_T * G%dF_dx(i,j) - beta_topo_x)**2 & - + (US%s_to_T * G%dF_dy(i,j) - beta_topo_y)**2 ) + beta = sqrt((G%dF_dx(i,j) - beta_topo_x)**2 + & + (G%dF_dy(i,j) - beta_topo_y)**2 ) else beta = 0. endif ! Returns bottomFac2, barotrFac2 and LmixScale - call MEKE_lengthScales_0d(CS, G%areaT(i,j), beta, G%bathyT(i,j), & - MEKE%Rd_dx_h(i,j), SN, MEKE%MEKE(i,j), US%Z_to_m, & + call MEKE_lengthScales_0d(CS, US, G%areaT(i,j), beta, G%bathyT(i,j), & + MEKE%Rd_dx_h(i,j), SN, MEKE%MEKE(i,j), & bottomFac2(i,j), barotrFac2(i,j), LmixScale(i,j), & - Lrhines(i,j), Leady(i,j)) + LRhines(i,j), LEady(i,j)) enddo ; enddo - if (CS%id_Lrhines>0) call post_data(CS%id_Lrhines, Lrhines, CS%diag) - if (CS%id_Leady>0) call post_data(CS%id_Leady, Leady, CS%diag) + if (CS%id_Lrhines>0) call post_data(CS%id_LRhines, LRhines, CS%diag) + if (CS%id_Leady>0) call post_data(CS%id_LEady, LEady, CS%diag) end subroutine MEKE_lengthScales !> Calculates the eddy mixing length scale and \f$\gamma_b\f$ and \f$\gamma_t\f$ !! functions that are ratios of either bottom or barotropic eddy energy to the !! column eddy energy, respectively. See \ref section_MEKE_equations. -subroutine MEKE_lengthScales_0d(CS, area, beta, depth, Rd_dx, SN, EKE, Z_to_L, & +subroutine MEKE_lengthScales_0d(CS, US, area, beta, depth, Rd_dx, SN, EKE, & ! Z_to_L, & bottomFac2, barotrFac2, LmixScale, Lrhines, Leady) type(MEKE_CS), pointer :: CS !< MEKE control structure. - real, intent(in) :: area !< Grid cell area [m2] - real, intent(in) :: beta !< Planetary beta = |grad F| [s-1 m-1] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: area !< Grid cell area [L2 ~> m2] + real, intent(in) :: beta !< Planetary beta = |grad F| [T-1 L-1 ~> s-1 m-1] real, intent(in) :: depth !< Ocean depth [Z ~> m] real, intent(in) :: Rd_dx !< Resolution Ld/dx [nondim]. - real, intent(in) :: SN !< Eady growth rate [s-1]. - real, intent(in) :: EKE !< Eddy kinetic energy [m s-1]. - real, intent(in) :: Z_to_L !< A conversion factor from depth units (Z) to - !! the units for lateral distances (L). + real, intent(in) :: SN !< Eady growth rate [T-1 ~> s-1]. + real, intent(in) :: EKE !< Eddy kinetic energy [L2 T-2 ~> m2 s-2]. +! real, intent(in) :: Z_to_L !< A conversion factor from depth units (Z) to +! !! the units for lateral distances (L). real, intent(out) :: bottomFac2 !< gamma_b^2 real, intent(out) :: barotrFac2 !< gamma_t^2 - real, intent(out) :: LmixScale !< Eddy mixing length [m]. - real, intent(out) :: Lrhines !< Rhines length scale [m]. - real, intent(out) :: Leady !< Eady length scale [m]. + real, intent(out) :: LmixScale !< Eddy mixing length [L ~> m]. + real, intent(out) :: Lrhines !< Rhines length scale [L ~> m]. + real, intent(out) :: Leady !< Eady length scale [L ~> m]. ! Local variables - real :: Lgrid, Ldeform, LdeformLim, Ue, Lfrict + real :: Lgrid, Ldeform, Lfrict ! Length scales [L ~> m] + real :: Ue ! An eddy velocity [L T-1 ~> m s-1] ! Length scale for MEKE derived diffusivity Lgrid = sqrt(area) ! Grid scale Ldeform = Lgrid * Rd_dx ! Deformation scale - Lfrict = (Z_to_L * depth) / CS%cdrag ! Frictional arrest scale + Lfrict = (US%Z_to_L * depth) / CS%cdrag ! Frictional arrest scale ! gamma_b^2 is the ratio of bottom eddy energy to mean column eddy energy ! used in calculating bottom drag bottomFac2 = CS%MEKE_CD_SCALE**2 @@ -840,7 +873,7 @@ subroutine MEKE_lengthScales_0d(CS, area, beta, depth, Rd_dx, SN, EKE, Z_to_L, & ! gamma_t^2 is the ratio of barotropic eddy energy to mean column eddy energy ! used in the velocity scale for diffusivity barotrFac2 = 1. - if (Lfrict*CS%MEKE_Ct>0.) barotrFac2 = 1./( 1. + CS%MEKE_Ct*(Ldeform/Lfrict) )**0.25 + if (Lfrict*CS%MEKE_Ct>0.) barotrFac2 = 1. / ( 1. + CS%MEKE_Ct*(Ldeform/Lfrict) )**0.25 barotrFac2 = max(barotrFac2, CS%MEKE_min_gamma) if (CS%use_old_lscale) then if (CS%Rd_as_max_scale) then @@ -850,9 +883,9 @@ subroutine MEKE_lengthScales_0d(CS, area, beta, depth, Rd_dx, SN, EKE, Z_to_L, & endif else Ue = sqrt( 2.0 * max( 0., barotrFac2*EKE ) ) ! Barotropic eddy flow scale - Lrhines = sqrt( Ue / max( beta, 1.e-30 ) ) ! Rhines scale + Lrhines = sqrt( Ue / max( beta, 1.e-30*US%T_to_s*US%L_to_m ) ) ! Rhines scale if (CS%aEady > 0.) then - Leady = Ue / max( SN, 1.e-15 ) ! Bound Eady time-scale < 1e15 seconds + Leady = Ue / max( SN, 1.e-15*US%T_to_s ) ! Bound Eady time-scale < 1e15 seconds else Leady = 0. endif @@ -893,6 +926,8 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) ! Local variables real :: I_T_rescale ! A rescaling factor for time from the internal representation in this ! run to the representation in a restart file. + real :: L_rescale ! A rescaling factor for length from the internal representation in this + ! run to the representation in a restart file. integer :: i, j, is, ie, js, je, isd, ied, jsd, jed logical :: laplacian, biharmonic, useVarMix, coldStart ! This include declares and sets the variable "version". @@ -927,7 +962,7 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) ! Read all relevant parameters and write them to the model log. call get_param(param_file, mdl, "MEKE_DAMPING", CS%MEKE_damping, & "The local depth-independent MEKE dissipation rate.", & - units="s-1", default=0.0) + units="s-1", default=0.0, scale=US%T_to_s) call get_param(param_file, mdl, "MEKE_CD_SCALE", CS%MEKE_Cd_scale, & "The ratio of the bottom eddy velocity to the column mean "//& "eddy velocity, i.e. sqrt(2*MEKE). This should be less than 1 "//& @@ -962,15 +997,15 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) "is not used or calculated.", units="nondim", default=-1.0) call get_param(param_file, mdl, "MEKE_BGSRC", CS%MEKE_BGsrc, & "A background energy source for MEKE.", units="W kg-1", & - default=0.0) + default=0.0, scale=US%m_to_L**2*US%T_to_s**3) call get_param(param_file, mdl, "MEKE_KH", CS%MEKE_Kh, & "A background lateral diffusivity of MEKE. "//& "Use a negative value to not apply lateral diffusion to MEKE.", & - units="m2 s-1", default=-1.0) + units="m2 s-1", default=-1.0, scale=US%m_to_L**2*US%T_to_s) call get_param(param_file, mdl, "MEKE_K4", CS%MEKE_K4, & "A lateral bi-harmonic diffusivity of MEKE. "//& "Use a negative value to not apply bi-harmonic diffusion to MEKE.", & - units="m4 s-1", default=-1.0) + units="m4 s-1", default=-1.0, scale=US%m_to_L**4*US%T_to_s) call get_param(param_file, mdl, "MEKE_DTSCALE", CS%MEKE_dtScale, & "A scaling factor to accelerate the time evolution of MEKE.", & units="nondim", default=1.0) @@ -983,7 +1018,7 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) units="nondim", default=1.0) call get_param(param_file, mdl, "MEKE_USCALE", CS%MEKE_Uscale, & "The background velocity that is combined with MEKE to "//& - "calculate the bottom drag.", units="m s-1", default=0.0) + "calculate the bottom drag.", units="m s-1", default=0.0, scale=US%m_s_to_L_T) call get_param(param_file, mdl, "MEKE_GM_SRC_ALT", CS%GM_src_alt, & "If true, use the GM energy conversion form S^2*N^2*kappa rather "//& "than the streamfunction for the MEKE GM source term.", default=.false.) @@ -1026,7 +1061,7 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) call get_param(param_file, mdl, "MEKE_FIXED_MIXING_LENGTH", CS%Lfixed, & "If positive, is a fixed length contribution to the expression "//& "for mixing length used in MEKE-derived diffusivity.", & - units="m", default=0.0) + units="m", default=0.0, scale=US%m_to_L) call get_param(param_file, mdl, "MEKE_ALPHA_DEFORM", CS%aDeform, & "If positive, is a coefficient weighting the deformation scale "//& "in the expression for mixing length used in MEKE-derived diffusivity.", & @@ -1092,45 +1127,45 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) ! Register fields for output from this module. CS%diag => diag CS%id_MEKE = register_diag_field('ocean_model', 'MEKE', diag%axesT1, Time, & - 'Mesoscale Eddy Kinetic Energy', 'm2 s-2') + 'Mesoscale Eddy Kinetic Energy', 'm2 s-2', conversion=US%L_T_to_m_s**2) if (.not. associated(MEKE%MEKE)) CS%id_MEKE = -1 CS%id_Kh = register_diag_field('ocean_model', 'MEKE_KH', diag%axesT1, Time, & - 'MEKE derived diffusivity', 'm2 s-1') + 'MEKE derived diffusivity', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) if (.not. associated(MEKE%Kh)) CS%id_Kh = -1 CS%id_Ku = register_diag_field('ocean_model', 'MEKE_KU', diag%axesT1, Time, & - 'MEKE derived lateral viscosity', 'm2 s-1', conversion=US%s_to_T) + 'MEKE derived lateral viscosity', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) if (.not. associated(MEKE%Ku)) CS%id_Ku = -1 CS%id_Au = register_diag_field('ocean_model', 'MEKE_AU', diag%axesT1, Time, & - 'MEKE derived lateral biharmonic viscosity', 'm4 s-1', conversion=US%s_to_T) + 'MEKE derived lateral biharmonic viscosity', 'm4 s-1', conversion=US%L_to_m**4*US%s_to_T) if (.not. associated(MEKE%Au)) CS%id_Au = -1 CS%id_Ue = register_diag_field('ocean_model', 'MEKE_Ue', diag%axesT1, Time, & - 'MEKE derived eddy-velocity scale', 'm s-1') + 'MEKE derived eddy-velocity scale', 'm s-1', conversion=US%L_T_to_m_s) if (.not. associated(MEKE%MEKE)) CS%id_Ue = -1 CS%id_Ub = register_diag_field('ocean_model', 'MEKE_Ub', diag%axesT1, Time, & - 'MEKE derived bottom eddy-velocity scale', 'm s-1') + 'MEKE derived bottom eddy-velocity scale', 'm s-1', conversion=US%L_T_to_m_s) if (.not. associated(MEKE%MEKE)) CS%id_Ub = -1 CS%id_Ut = register_diag_field('ocean_model', 'MEKE_Ut', diag%axesT1, Time, & - 'MEKE derived barotropic eddy-velocity scale', 'm s-1') + 'MEKE derived barotropic eddy-velocity scale', 'm s-1', conversion=US%L_T_to_m_s) if (.not. associated(MEKE%MEKE)) CS%id_Ut = -1 CS%id_src = register_diag_field('ocean_model', 'MEKE_src', diag%axesT1, Time, & 'MEKE energy source', 'm2 s-3') CS%id_decay = register_diag_field('ocean_model', 'MEKE_decay', diag%axesT1, Time, & - 'MEKE decay rate', 's-1') + 'MEKE decay rate', 's-1', conversion=US%s_to_T) CS%id_GM_src = register_diag_field('ocean_model', 'MEKE_GM_src', diag%axesT1, Time, & - 'MEKE energy available from thickness mixing', 'W m-2') + 'MEKE energy available from thickness mixing', 'W m-2', conversion=US%L_to_m**2*US%s_to_T**3) if (.not. associated(MEKE%GM_src)) CS%id_GM_src = -1 CS%id_mom_src = register_diag_field('ocean_model', 'MEKE_mom_src',diag%axesT1, Time, & - 'MEKE energy available from momentum', 'W m-2') + 'MEKE energy available from momentum', 'W m-2', conversion=US%L_to_m**2*US%s_to_T**3) if (.not. associated(MEKE%mom_src)) CS%id_mom_src = -1 CS%id_GME_snk = register_diag_field('ocean_model', 'MEKE_GME_snk',diag%axesT1, Time, & - 'MEKE energy lost to GME backscatter', 'W m-2') + 'MEKE energy lost to GME backscatter', 'W m-2', conversion=US%L_to_m**2*US%s_to_T**3) if (.not. associated(MEKE%GME_snk)) CS%id_GME_snk = -1 CS%id_Le = register_diag_field('ocean_model', 'MEKE_Le', diag%axesT1, Time, & - 'Eddy mixing length used in the MEKE derived eddy diffusivity', 'm') + 'Eddy mixing length used in the MEKE derived eddy diffusivity', 'm', conversion=US%L_to_m) CS%id_Lrhines = register_diag_field('ocean_model', 'MEKE_Lrhines', diag%axesT1, Time, & - 'Rhines length scale used in the MEKE derived eddy diffusivity', 'm') + 'Rhines length scale used in the MEKE derived eddy diffusivity', 'm', conversion=US%L_to_m) CS%id_Leady = register_diag_field('ocean_model', 'MEKE_Leady', diag%axesT1, Time, & - 'Eady length scale used in the MEKE derived eddy diffusivity', 'm') + 'Eady length scale used in the MEKE derived eddy diffusivity', 'm', conversion=US%L_to_m) CS%id_gamma_b = register_diag_field('ocean_model', 'MEKE_gamma_b', diag%axesT1, Time, & 'Ratio of bottom-projected eddy velocity to column-mean eddy velocity', 'nondim') CS%id_gamma_t = register_diag_field('ocean_model', 'MEKE_gamma_t', diag%axesT1, Time, & @@ -1138,9 +1173,9 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) if (CS%kh_flux_enabled) then CS%id_KhMEKE_u = register_diag_field('ocean_model', 'KHMEKE_u', diag%axesCu1, Time, & - 'Zonal diffusivity of MEKE', 'm2 s-1') + 'Zonal diffusivity of MEKE', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_KhMEKE_v = register_diag_field('ocean_model', 'KHMEKE_v', diag%axesCv1, Time, & - 'Meridional diffusivity of MEKE', 'm2 s-1') + 'Meridional diffusivity of MEKE', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) endif CS%id_clock_pass = cpu_clock_id('(Ocean continuity halo updates)', grain=CLOCK_ROUTINE) @@ -1158,16 +1193,38 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) I_T_rescale = 1.0 if ((US%s_to_T_restart /= 0.0) .and. (US%s_to_T_restart /= US%s_to_T)) & I_T_rescale = US%s_to_T_restart / US%s_to_T + L_rescale = 1.0 + if ((US%m_to_L_restart /= 0.0) .and. (US%m_to_L_restart /= US%m_to_L)) & + L_rescale = US%m_to_L / US%m_to_L_restart - if (I_T_rescale /= 1.0) then + if (L_rescale*I_T_rescale /= 1.0) then + if (associated(MEKE%MEKE)) then ; if (query_initialized(MEKE%MEKE, "MEKE_MEKE", restart_CS)) then + do j=js,je ; do i=is,ie + MEKE%MEKE(i,j) = L_rescale*I_T_rescale * MEKE%MEKE(i,j) + enddo ; enddo + endif ; endif + endif + if (L_rescale**2*I_T_rescale /= 1.0) then + if (associated(MEKE%Kh)) then ; if (query_initialized(MEKE%Kh, "MEKE_Kh", restart_CS)) then + do j=js,je ; do i=is,ie + MEKE%Kh(i,j) = L_rescale**2*I_T_rescale * MEKE%Kh(i,j) + enddo ; enddo + endif ; endif if (associated(MEKE%Ku)) then ; if (query_initialized(MEKE%Ku, "MEKE_Ku", restart_CS)) then do j=js,je ; do i=is,ie - MEKE%Ku(i,j) = I_T_rescale * MEKE%Ku(i,j) + MEKE%Ku(i,j) = L_rescale**2*I_T_rescale * MEKE%Ku(i,j) enddo ; enddo endif ; endif + if (associated(MEKE%Kh_diff)) then ; if (query_initialized(MEKE%Kh, "MEKE_Kh_diff", restart_CS)) then + do j=js,je ; do i=is,ie + MEKE%Kh_diff(i,j) = L_rescale**2*I_T_rescale * MEKE%Kh_diff(i,j) + enddo ; enddo + endif ; endif + endif + if (L_rescale**4*I_T_rescale /= 1.0) then if (associated(MEKE%Au)) then ; if (query_initialized(MEKE%Au, "MEKE_Au", restart_CS)) then do j=js,je ; do i=is,ie - MEKE%Au(i,j) = I_T_rescale * MEKE%Au(i,j) + MEKE%Au(i,j) = L_rescale**4*I_T_rescale * MEKE%Au(i,j) enddo ; enddo endif ; endif endif diff --git a/src/parameterizations/lateral/MOM_MEKE_types.F90 b/src/parameterizations/lateral/MOM_MEKE_types.F90 index 438e394e3b..33f8f5d1b2 100644 --- a/src/parameterizations/lateral/MOM_MEKE_types.F90 +++ b/src/parameterizations/lateral/MOM_MEKE_types.F90 @@ -8,20 +8,20 @@ module MOM_MEKE_types type, public :: MEKE_type ! Variables real, dimension(:,:), pointer :: & - MEKE => NULL(), & !< Vertically averaged eddy kinetic energy [m2 s-2]. - GM_src => NULL(), & !< MEKE source due to thickness mixing (GM) [W m-2]. - mom_src => NULL(),& !< MEKE source from lateral friction in the momentum equations [W m-2]. - GME_snk => NULL(),& !< MEKE sink from GME backscatter in the momentum equations [W m-2]. - Kh => NULL(), & !< The MEKE-derived lateral mixing coefficient [m2 s-1]. + MEKE => NULL(), & !< Vertically averaged eddy kinetic energy [L2 T-2 ~> m2 s-2]. + GM_src => NULL(), & !< MEKE source due to thickness mixing (GM) [kg m-2 L2 T-3 ~> W m-2]. + mom_src => NULL(),& !< MEKE source from lateral friction in the momentum equations [kg m-2 L2 T-3 ~> W m-2]. + GME_snk => NULL(),& !< MEKE sink from GME backscatter in the momentum equations [kg m-2 L2 T-3 ~> W m-2]. + Kh => NULL(), & !< The MEKE-derived lateral mixing coefficient [L2 T-1 ~> m2 s-1]. Kh_diff => NULL(), & !< Uses the non-MEKE-derived thickness diffusion coefficient to diffuse - !! MEKE [m2 s-1]. + !! MEKE [L2 T-1 ~> m2 s-1]. Rd_dx_h => NULL() !< The deformation radius compared with the grid spacing [nondim]. !! Rd_dx_h is copied from VarMix_CS. real, dimension(:,:), pointer :: Ku => NULL() !< The MEKE-derived lateral viscosity coefficient - !! [m2 T-1 ~> m2 s-1]. This viscosity can be negative when representing + !! [L2 T-1 ~> m2 s-1]. This viscosity can be negative when representing !! backscatter from unresolved eddies (see Jansen and Held, 2014). real, dimension(:,:), pointer :: Au => NULL() !< The MEKE-derived lateral biharmonic viscosity - !! coefficient [m4 T-1 ~> m4 s-1]. + !! coefficient [L4 T-1 ~> m4 s-1]. ! Parameters real :: KhTh_fac = 1.0 !< Multiplier to map Kh(MEKE) to KhTh [nondim] real :: KhTr_fac = 1.0 !< Multiplier to map Kh(MEKE) to KhTr [nondim]. diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 7450382553..4c545953d0 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -3,6 +3,7 @@ module MOM_hor_visc ! This file is part of MOM6. See LICENSE.md for the license. +use MOM_checksums, only : hchksum, Bchksum use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : diag_ctrl, time_type use MOM_domains, only : pass_var, CORNER, pass_vector @@ -29,6 +30,7 @@ module MOM_hor_visc type, public :: hor_visc_CS ; private logical :: Laplacian !< Use a Laplacian horizontal viscosity if true. logical :: biharmonic !< Use a biharmonic horizontal viscosity if true. + logical :: debug !< If true, write verbose checksums for debugging purposes. logical :: no_slip !< If true, no slip boundary conditions are used. !! Otherwise free slip boundary conditions are assumed. !! The implementation of the free slip boundary @@ -66,14 +68,14 @@ module MOM_hor_visc !! scales quadratically with the velocity shears. logical :: use_Kh_bg_2d !< Read 2d background viscosity from a file. real :: Kh_bg_min !< The minimum value allowed for Laplacian horizontal - !! viscosity [m2 T-1 ~> m2 s-1]. The default is 0.0 + !! viscosity [L2 T-1 ~> m2 s-1]. The default is 0.0. logical :: use_land_mask !< Use the land mask for the computation of thicknesses !! at velocity locations. This eliminates the dependence on !! arbitrary values over land or outside of the domain. !! Default is False to maintain answers with legacy experiments !! but should be changed to True for new experiments. logical :: anisotropic !< If true, allow anisotropic component to the viscosity. - real :: Kh_aniso !< The anisotropic viscosity [m2 T-1 ~> m2 s-1]. + real :: Kh_aniso !< The anisotropic viscosity [L2 T-1 ~> m2 s-1]. logical :: dynamic_aniso !< If true, the anisotropic viscosity is recomputed as a function !! of state. This is set depending on ANISOTROPIC_MODE. logical :: res_scale_MEKE !< If true, the viscosity contribution from MEKE is scaled by @@ -84,15 +86,15 @@ module MOM_hor_visc !! forms of the same expressions. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: Kh_bg_xx - !< The background Laplacian viscosity at h points [m2 T-1 ~> m2 s-1]. + !< The background Laplacian viscosity at h points [L2 T-1 ~> m2 s-1]. !! The actual viscosity may be the larger of this !! viscosity and the Smagorinsky and Leith viscosities. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: Kh_bg_2d - !< The background Laplacian viscosity at h points [m2 T-1 ~> m2 s-1]. + !< The background Laplacian viscosity at h points [L2 T-1 ~> m2 s-1]. !! The actual viscosity may be the larger of this !! viscosity and the Smagorinsky and Leith viscosities. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: Ah_bg_xx - !< The background biharmonic viscosity at h points [m4 T-1 ~> m4 s-1]. + !< The background biharmonic viscosity at h points [L4 T-1 ~> m4 s-1]. !! The actual viscosity may be the larger of this !! viscosity and the Smagorinsky and Leith viscosities. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: Biharm5_const2_xx @@ -102,19 +104,19 @@ module MOM_hor_visc !! velocity differences reach a value of order 1/2 MAXVEL. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: reduction_xx !< The amount by which stresses through h points are reduced - !! due to partial barriers. Nondimensional. + !! due to partial barriers [nondim]. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - Kh_Max_xx, & !< The maximum permitted Laplacian viscosity [m2 T-1 ~> m2 s-1]. - Ah_Max_xx, & !< The maximum permitted biharmonic viscosity [m4 T-1 ~> m4 s-1]. + Kh_Max_xx, & !< The maximum permitted Laplacian viscosity [L2 T-1 ~> m2 s-1]. + Ah_Max_xx, & !< The maximum permitted biharmonic viscosity [L4 T-1 ~> m4 s-1]. n1n2_h, & !< Factor n1*n2 in the anisotropic direction tensor at h-points n1n1_m_n2n2_h !< Factor n1**2-n2**2 in the anisotropic direction tensor at h-points real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: Kh_bg_xy - !< The background Laplacian viscosity at q points [m2 T-1 ~> m2 s-1]. + !< The background Laplacian viscosity at q points [L2 T-1 ~> m2 s-1]. !! The actual viscosity may be the larger of this !! viscosity and the Smagorinsky and Leith viscosities. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: Ah_bg_xy - !< The background biharmonic viscosity at q points [m4 T-1 ~> m4 s-1]. + !< The background biharmonic viscosity at q points [L4 T-1 ~> m4 s-1]. !! The actual viscosity may be the larger of this !! viscosity and the Smagorinsky and Leith viscosities. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: Biharm5_const2_xy @@ -126,43 +128,43 @@ module MOM_hor_visc !< The amount by which stresses through q points are reduced !! due to partial barriers [nondim]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & - Kh_Max_xy, & !< The maximum permitted Laplacian viscosity [m2 T-1 ~> m2 s-1]. - Ah_Max_xy, & !< The maximum permitted biharmonic viscosity [m4 T-1 ~> m4 s-1]. + Kh_Max_xy, & !< The maximum permitted Laplacian viscosity [L2 T-1 ~> m2 s-1]. + Ah_Max_xy, & !< The maximum permitted biharmonic viscosity [L4 T-1 ~> m4 s-1]. n1n2_q, & !< Factor n1*n2 in the anisotropic direction tensor at q-points n1n1_m_n2n2_q !< Factor n1**2-n2**2 in the anisotropic direction tensor at q-points real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - dx2h, & !< Pre-calculated dx^2 at h points [m2] - dy2h, & !< Pre-calculated dy^2 at h points [m2] + dx2h, & !< Pre-calculated dx^2 at h points [L2 ~> m2] + dy2h, & !< Pre-calculated dy^2 at h points [L2 ~> m2] dx_dyT, & !< Pre-calculated dx/dy at h points [nondim] dy_dxT !< Pre-calculated dy/dx at h points [nondim] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & - dx2q, & !< Pre-calculated dx^2 at q points [m2] - dy2q, & !< Pre-calculated dy^2 at q points [m2] + dx2q, & !< Pre-calculated dx^2 at q points [L2 ~> m2] + dy2q, & !< Pre-calculated dy^2 at q points [L2 ~> m2] dx_dyBu, & !< Pre-calculated dx/dy at q points [nondim] dy_dxBu !< Pre-calculated dy/dx at q points [nondim] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: & - Idx2dyCu, & !< 1/(dx^2 dy) at u points [m-3] - Idxdy2u !< 1/(dx dy^2) at u points [m-3] + Idx2dyCu, & !< 1/(dx^2 dy) at u points [L-3 ~> m-3] + Idxdy2u !< 1/(dx dy^2) at u points [L-3 ~> m-3] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: & - Idx2dyCv, & !< 1/(dx^2 dy) at v points [m-3] - Idxdy2v !< 1/(dx dy^2) at v points [m-3] + Idx2dyCv, & !< 1/(dx^2 dy) at v points [L-3 ~> m-3] + Idxdy2v !< 1/(dx dy^2) at v points [L-3 ~> m-3] ! The following variables are precalculated time-invariant combinations of ! parameters and metric terms. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - Laplac2_const_xx, & !< Laplacian metric-dependent constants [m2] - Biharm5_const_xx, & !< Biharmonic metric-dependent constants [m5] - Laplac3_const_xx, & !< Laplacian metric-dependent constants [m3] - Biharm_const_xx, & !< Biharmonic metric-dependent constants [m4] - Biharm_const2_xx !< Biharmonic metric-dependent constants [T m4 ~> s m4] + Laplac2_const_xx, & !< Laplacian metric-dependent constants [L2 ~> m2] + Biharm5_const_xx, & !< Biharmonic metric-dependent constants [L5 ~> m5] + Laplac3_const_xx, & !< Laplacian metric-dependent constants [L3 ~> m3] + Biharm_const_xx, & !< Biharmonic metric-dependent constants [L4 ~> m4] + Biharm_const2_xx !< Biharmonic metric-dependent constants [T L4 ~> s m4] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & - Laplac2_const_xy, & !< Laplacian metric-dependent constants [m2] - Biharm5_const_xy, & !< Biharmonic metric-dependent constants [m5] - Laplac3_const_xy, & !< Laplacian metric-dependent constants [m3] - Biharm_const_xy, & !< Biharmonic metric-dependent constants [m4] - Biharm_const2_xy !< Biharmonic metric-dependent constants [T m4 ~> s m4] + Laplac2_const_xy, & !< Laplacian metric-dependent constants [L2 ~> m2] + Biharm5_const_xy, & !< Biharmonic metric-dependent constants [L5 ~> m5] + Laplac3_const_xy, & !< Laplacian metric-dependent constants [L3 ~> m3] + Biharm_const_xy, & !< Biharmonic metric-dependent constants [L4 ~> m4] + Biharm_const2_xy !< Biharmonic metric-dependent constants [T L4 ~> s m4] type(diag_ctrl), pointer :: diag => NULL() !< structure to regulate diagnostics @@ -200,17 +202,17 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, 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(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: diffu !< Zonal acceleration due to convergence of - !! along-coordinate stress tensor [m s-1 T-1 ~> m s-2] + !! along-coordinate stress tensor [L T-2 ~> m s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(out) :: diffv !< Meridional acceleration due to convergence - !! of along-coordinate stress tensor [m s-1 T-1 ~> m s-2]. + !! of along-coordinate stress tensor [L T-2 ~> m s-2]. type(MEKE_type), pointer :: MEKE !< Pointer to a structure containing fields !! related to Mesoscale Eddy Kinetic Energy. type(VarMix_CS), pointer :: VarMix !< Pointer to a structure with fields that @@ -224,99 +226,100 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Local variables real, dimension(SZIB_(G),SZJ_(G)) :: & - u0, & ! Laplacian of u [m-1 s-1] + Del2u, & ! The u-compontent of the Laplacian of velocity [L-1 T-1 ~> m-1 s-1] h_u, & ! Thickness interpolated to u points [H ~> m or kg m-2]. - vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) [m-1 s-1] - div_xx_dx, & ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) [m-1 s-1] - ubtav ! zonal barotropic vel. ave. over baroclinic time-step [m s-1] + vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] + div_xx_dx, & ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1] + ubtav ! zonal barotropic vel. ave. over baroclinic time-step [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G)) :: & - v0, & ! Laplacian of v [m-1 s-1] + Del2v, & ! The v-compontent of the Laplacian of velocity [L-1 T-1 ~> m-1 s-1] h_v, & ! Thickness interpolated to v points [H ~> m or kg m-2]. - vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) [m-1 s-1] - div_xx_dy, & ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) [m-1 s-1] - vbtav ! meridional barotropic vel. ave. over baroclinic time-step [m s-1] + vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] + div_xx_dy, & ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1] + vbtav ! meridional barotropic vel. ave. over baroclinic time-step [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G)) :: & - dudx_bt, dvdy_bt, & ! components in the barotropic horizontal tension [s-1] - div_xx, & ! Estimate of horizontal divergence at h-points [s-1] - sh_xx, & ! horizontal tension (du/dx - dv/dy) including metric terms [s-1] - sh_xx_bt, & ! barotropic horizontal tension (du/dx - dv/dy) including metric terms [s-1] - str_xx,& ! str_xx is the diagonal term in the stress tensor [H m2 s-1 T-1 ~> m3 s-2 or kg s-2] - str_xx_GME,& ! smoothed diagonal term in the stress tensor from GME [H m2 s-1 T-1 ~> m3 s-2 or kg s-2] + dudx_bt, dvdy_bt, & ! components in the barotropic horizontal tension [T-1 ~> s-1] + div_xx, & ! Estimate of horizontal divergence at h-points [T-1 ~> s-1] + sh_xx, & ! horizontal tension (du/dx - dv/dy) including metric terms [T-1 ~> s-1] + sh_xx_bt, & ! barotropic horizontal tension (du/dx - dv/dy) including metric terms [T-1 ~> s-1] + str_xx,& ! str_xx is the diagonal term in the stress tensor [H L2 T-2 ~> m3 s-2 or kg s-2] + str_xx_GME,& ! smoothed diagonal term in the stress tensor from GME [H L2 T-2 ~> m3 s-2 or kg s-2] bhstr_xx,& ! A copy of str_xx that only contains the biharmonic contribution - ! [H m2 T-1 s-1 ~> m3 s-2 or kg s-2] - FrictWorkIntz, & ! depth integrated energy dissipated by lateral friction [W m-2] - Leith_Kh_h, & ! Leith Laplacian viscosity at h-points [m2 s-1] - Leith_Ah_h, & ! Leith bi-harmonic viscosity at h-points [m4 s-1] - beta_h, & ! Gradient of planetary vorticity at h-points [m-1 s-1] - grad_vort_mag_h, & ! Magnitude of vorticity gradient at h-points [m-1 s-1] - grad_vort_mag_h_2d, & ! Magnitude of 2d vorticity gradient at h-points [m-1 s-1] - grad_div_mag_h, & ! Magnitude of divergence gradient at h-points [m-1 s-1] - dudx, dvdy, & ! components in the horizontal tension [s-1] - grad_vel_mag_h, & ! Magnitude of the velocity gradient tensor squared at h-points [s-2] - grad_vel_mag_bt_h, & ! Magnitude of the barotropic velocity gradient tensor squared at h-points [s-2] - grad_d2vel_mag_h, & ! Magnitude of the Laplacian of the velocity vector, squared [m-2 s-2] - max_diss_rate_bt, & ! maximum possible energy dissipated by barotropic lateral friction [m2 s-3] - boundary_mask ! A mask that zeroes out cells with at least one land edge + ! [H L2 T-2 ~> m3 s-2 or kg s-2] + FrictWorkIntz, & ! depth integrated energy dissipated by lateral friction [kg m-2 L2 T-3 ~> W m-2] + ! Leith_Kh_h, & ! Leith Laplacian viscosity at h-points [m2 s-1] + ! Leith_Ah_h, & ! Leith bi-harmonic viscosity at h-points [m4 s-1] + ! beta_h, & ! Gradient of planetary vorticity at h-points [L-1 T-1 ~> m-1 s-1] + grad_vort_mag_h, & ! Magnitude of vorticity gradient at h-points [L-1 T-1 ~> m-1 s-1] + grad_vort_mag_h_2d, & ! Magnitude of 2d vorticity gradient at h-points [L-1 T-1 ~> m-1 s-1] + grad_div_mag_h, & ! Magnitude of divergence gradient at h-points [L-1 T-1 ~> m-1 s-1] + dudx, dvdy, & ! components in the horizontal tension [T-1 ~> s-1] + grad_vel_mag_h, & ! Magnitude of the velocity gradient tensor squared at h-points [T-2 ~> s-2] + grad_vel_mag_bt_h, & ! Magnitude of the barotropic velocity gradient tensor squared at h-points [T-2 ~> s-2] + grad_d2vel_mag_h, & ! Magnitude of the Laplacian of the velocity vector, squared [L-2 T-2 ~> m-2 s-2] + max_diss_rate_bt, & ! maximum possible energy dissipated by barotropic lateral friction [L2 T-3 ~> m2 s-3] + boundary_mask ! A mask that zeroes out cells with at least one land edge [nondim] real, dimension(SZIB_(G),SZJB_(G)) :: & - dvdx, dudy, & ! components in the shearing strain [s-1] - dvdx_bt, dudy_bt, & ! components in the barotropic shearing strain [s-1] - sh_xy, & ! horizontal shearing strain (du/dy + dv/dx) including metric terms [s-1] - sh_xy_bt, & ! barotropic horizontal shearing strain (du/dy + dv/dx) inc. metric terms [s-1] - str_xy, & ! str_xy is the cross term in the stress tensor [H m2 s-2 ~> m3 s-2 or kg s-2] - str_xy_GME, & ! smoothed cross term in the stress tensor from GME [H m2 s-2] + dvdx, dudy, & ! components in the shearing strain [T-1 s-1] + dDel2vdx, dDel2udy, & ! Components in the biharmonic equivalent of the shearing strain [L-2 T-1 ~> m-2 s-1] + dvdx_bt, dudy_bt, & ! components in the barotropic shearing strain [T-1 s-1] + sh_xy, & ! horizontal shearing strain (du/dy + dv/dx) including metric terms [T-1 ~> s-1] + sh_xy_bt, & ! barotropic horizontal shearing strain (du/dy + dv/dx) inc. metric terms [T-1 ~> s-1] + str_xy, & ! str_xy is the cross term in the stress tensor [H L2 T-2 ~> m3 s-2 or kg s-2] + str_xy_GME, & ! smoothed cross term in the stress tensor from GME [H L2 T-2 ~> m3 s-2 or kg s-2] bhstr_xy, & ! A copy of str_xy that only contains the biharmonic contribution - ! [H m2 s-2 ~> m3 s-2 or kg s-2] - vort_xy, & ! Vertical vorticity (dv/dx - du/dy) including metric terms [s-1] - Leith_Kh_q, & ! Leith Laplacian viscosity at q-points [m2 s-1] - Leith_Ah_q, & ! Leith bi-harmonic viscosity at q-points [m4 s-1] - beta_q, & ! Gradient of planetary vorticity at q-points [m-1 s-1] - grad_vort_mag_q, & ! Magnitude of vorticity gradient at q-points [m-1 s-1] - grad_vort_mag_q_2d, & ! Magnitude of 2d vorticity gradient at q-points [m-1 s-1] - grad_div_mag_q, & ! Magnitude of divergence gradient at q-points [m-1 s-1] - grad_vel_mag_q, & ! Magnitude of the velocity gradient tensor squared at q-points [s-2] + ! [H L2 T-2 ~> m3 s-2 or kg s-2] + vort_xy, & ! Vertical vorticity (dv/dx - du/dy) including metric terms [T-1 ~> s-1] + ! Leith_Kh_q, & ! Leith Laplacian viscosity at q-points [m2 s-1] + ! Leith_Ah_q, & ! Leith bi-harmonic viscosity at q-points [m4 s-1] + ! beta_q, & ! Gradient of planetary vorticity at q-points [L-1 T-1 ~> m-1 s-1] + grad_vort_mag_q, & ! Magnitude of vorticity gradient at q-points [L-1 T-1 ~> m-1 s-1] + grad_vort_mag_q_2d, & ! Magnitude of 2d vorticity gradient at q-points [L-1 T-1 ~> m-1 s-1] + grad_div_mag_q, & ! Magnitude of divergence gradient at q-points [L-1 T-1 ~> m-1 s-1] + grad_vel_mag_q, & ! Magnitude of the velocity gradient tensor squared at q-points [T-2 ~> s-2] hq, & ! harmonic mean of the harmonic means of the u- & v point thicknesses [H ~> m or kg m-2] ! This form guarantees that hq/hu < 4. - grad_vel_mag_bt_q ! Magnitude of the barotropic velocity gradient tensor squared at q-points [s-2] + grad_vel_mag_bt_q ! Magnitude of the barotropic velocity gradient tensor squared at q-points [T-2 ~> s-2] real, dimension(SZIB_(G),SZJB_(G),SZK_(G)) :: & - Ah_q, & ! biharmonic viscosity at corner points [m4 T-1 ~> m4 s-1] - Kh_q, & ! Laplacian viscosity at corner points [m2 s-1] - vort_xy_q, & ! vertical vorticity at corner points [s-1] - GME_coeff_q !< GME coeff. at q-points [m2 T-1 ~> m2 s-1] + Ah_q, & ! biharmonic viscosity at corner points [L4 T-1 ~> m4 s-1] + Kh_q, & ! Laplacian viscosity at corner points [L2 T-1 ~> m2 s-1] + sh_xy_3d, & ! horizontal shearing strain (du/dy + dv/dx) including metric terms [T-1 ~> s-1] + vort_xy_q, & ! vertical vorticity at corner points [T-1 ~> s-1] + GME_coeff_q !< GME coeff. at q-points [L2 T-1 ~> m2 s-1] ! These 3-d arrays are unused. ! real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1) :: & - ! KH_u_GME !< interface height diffusivities in u-columns [m2 s-1] + ! KH_u_GME !< interface height diffusivities in u-columns [L2 T-1 ~> m2 s-1] ! real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1) :: & - ! KH_v_GME !< interface height diffusivities in v-columns [m2 s-1] + ! KH_v_GME !< interface height diffusivities in v-columns [L2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - Ah_h, & ! biharmonic viscosity at thickness points [m4 T-1 ~> m4 s-1] - Kh_h, & ! Laplacian viscosity at thickness points [m2 T-1 ~> m2 s-1] - diss_rate, & ! MKE dissipated by parameterized shear production [m2 s-3] - max_diss_rate, & ! maximum possible energy dissipated by lateral friction [m2 s-3] + Ah_h, & ! biharmonic viscosity at thickness points [L4 T-1 ~> m4 s-1] + Kh_h, & ! Laplacian viscosity at thickness points [L2 T-1 ~> m2 s-1] + sh_xx_3d, & ! horizontal tension (du/dx - dv/dy) including metric terms [T-1 ~> s-1] + diss_rate, & ! MKE dissipated by parameterized shear production [L2 T-3 ~> m2 s-3] + max_diss_rate, & ! maximum possible energy dissipated by lateral friction [L2 T-3 ~> m2 s-3] target_diss_rate_GME, & ! the maximum theoretical dissipation plus the amount spuriously dissipated - ! by friction [m2 s-3] - FrictWork, & ! work done by MKE dissipation mechanisms [W m-2] - FrictWork_diss, & ! negative definite work done by MKE dissipation mechanisms [W m-2] - FrictWorkMax, & ! maximum possible work done by MKE dissipation mechanisms [W m-2] - FrictWork_GME, & ! work done by GME [W m-2] - div_xx_h ! horizontal divergence [s-1] + ! by friction [L2 T-3 ~> m2 s-3] + FrictWork, & ! work done by MKE dissipation mechanisms [kg m-2 L2 T-3 ~> W m-2] + FrictWork_diss, & ! negative definite work done by MKE dissipation mechanisms [kg m-2 L2 T-3 ~> W m-2] + FrictWorkMax, & ! maximum possible work done by MKE dissipation mechanisms [kg m-2 L2 T-3 ~> W m-2] + FrictWork_GME, & ! work done by GME [kg m-2 L2 T-3 ~> W m-2] + div_xx_h ! horizontal divergence [T-1 ~> s-1] ! real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & ! KH_t_GME, & !< interface height diffusivities in t-columns [m2 s-1] - GME_coeff_h !< GME coeff. at h-points [m2 T-1 ~> m2 s-1] - real :: Ah ! biharmonic viscosity [m4 T-1 ~> m4 s-1] - real :: Kh ! Laplacian viscosity [m2 T-1 ~> m2 s-1] - real :: AhSm ! Smagorinsky biharmonic viscosity [m4 T-1 ~> m4 s-1] -! real :: KhSm ! Smagorinsky Laplacian viscosity [m2 T-1 ~> m2 s-1] - real :: AhLth ! 2D Leith biharmonic viscosity [m4 T-1 ~> m4 s-1] -! real :: KhLth ! 2D Leith Laplacian viscosity [m2 s-1] + GME_coeff_h !< GME coeff. at h-points [L2 T-1 ~> m2 s-1] + real :: Ah ! biharmonic viscosity [L4 T-1 ~> m4 s-1] + real :: Kh ! Laplacian viscosity [L2 T-1 ~> m2 s-1] + real :: AhSm ! Smagorinsky biharmonic viscosity [L4 T-1 ~> m4 s-1] + real :: AhLth ! 2D Leith biharmonic viscosity [L4 T-1 ~> m4 s-1] real :: mod_Leith ! nondimensional coefficient for divergence part of modified Leith ! viscosity. Here set equal to nondimensional Laplacian Leith constant. ! This is set equal to zero if modified Leith is not used. real :: Shear_mag ! magnitude of the shear [T-1 ~> s-1] - real :: vert_vort_mag ! magnitude of the vertical vorticity gradient [m-1 T-1 ~> m-1 s-1] + real :: vert_vort_mag ! magnitude of the vertical vorticity gradient [L-1 T-1 ~> m-1 s-1] real :: h2uq, h2vq ! temporary variables [H2 ~> m2 or kg2 m-4]. real :: hu, hv ! Thicknesses interpolated by arithmetic means to corner ! points; these are first interpolated to u or v velocity @@ -334,10 +337,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Laplacian viscosity is rescaled [nondim] real :: RoScl ! The scaling function for MEKE source term [nondim] real :: FatH ! abs(f) at h-point for MEKE source term [T-1 ~> s-1] - real :: local_strain ! Local variable for interpolating computed strain rates [s-1]. + real :: local_strain ! Local variable for interpolating computed strain rates [T-1 ~> s-1]. real :: meke_res_fn ! A copy of the resolution scaling factor if being applied to MEKE. Otherwise =1. - real :: GME_coeff ! The GME (negative) viscosity coefficient [m2 T-1 ~> m2 s-1] - real :: GME_coeff_limiter ! Maximum permitted value of the GME coefficient [m2 T-1 ~> m2 s-1] + real :: GME_coeff ! The GME (negative) viscosity coefficient [L2 T-1 ~> m2 s-1] + real :: GME_coeff_limiter ! Maximum permitted value of the GME coefficient [L2 T-1 ~> m2 s-1] real :: FWfrac ! Fraction of maximum theoretical energy transfer to use when scaling GME coefficient [nondim] real :: DY_dxBu ! Ratio of meridional over zonal grid spacing at vertices [nondim] real :: DX_dyBu ! Ratio of zonal over meridiononal grid spacing at vertices [nondim] @@ -365,6 +368,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, Ah_h(:,:,:) = 0.0 Kh_h(:,:,:) = 0.0 + if (CS%debug) then + sh_xx_3d(:,:,:) = 0.0 ; sh_xy_3d(:,:,:) = 0.0 + Kh_q(:,:,:) = 0.0 ; Ah_q(:,:,:) = 0.0 + endif + if (present(OBC)) then ; if (associated(OBC)) then ; if (OBC%OBC_pe) then apply_OBC = OBC%Flather_u_BCs_exist_globally .or. OBC%Flather_v_BCs_exist_globally apply_OBC = .true. @@ -407,7 +415,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! GME tapers off above this depth H0_GME = 1000.0*US%m_to_Z FWfrac = 1.0 - GME_coeff_limiter = 1e7*US%T_to_s + GME_coeff_limiter = 1e7*US%m_to_L**2*US%T_to_s ! initialize diag. array with zeros GME_coeff_h(:,:,:) = 0.0 @@ -477,10 +485,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, enddo ; enddo !#GME# max_diss_rate_bt is not used. + !### Also, the expression for max_diss_rate_bt is dimensionally inconsistent. Perhaps + ! US%s_to_T**2*grad_vel_mag_t_h should be US%s_to_T*sqrt(grad_vel_mag_bt_h) if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then !#GME# These loops bounds should be: do j=js-1,je+1 ; do i=is-1,is+1 do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - max_diss_rate_bt(i,j) = 2.0*MEKE%MEKE(i,j) * grad_vel_mag_bt_h(i,j) + max_diss_rate_bt(i,j) = 2.0*MEKE%MEKE(i,j) * US%s_to_T*grad_vel_mag_bt_h(i,j) enddo ; enddo endif ; endif @@ -491,21 +501,21 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 grad_vel_mag_bt_q(I,J) = boundary_mask(i,j) * (dvdx_bt(I,J)**2 + dudy_bt(I,J)**2 + & (0.25*(dudx_bt(i,j)+dudx_bt(i+1,j)+dudx_bt(i,j+1)+dudx_bt(i+1,j+1)))**2 + & - (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2) + (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)))**2) enddo ; enddo endif ! use_GME - !$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,CS,G,GV,u,v,is,js,ie,je,h, & - !$OMP rescale_Kh,VarMix,h_neglect,h_neglect3, & + !$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,CS,G,GV,US,u,v,is,js,ie,je, & + !$OMP h,rescale_Kh,VarMix,h_neglect,h_neglect3, & !$OMP Kh_h,Ah_h,Kh_q,Ah_q,diffu,diffv,apply_OBC,OBC, & !$OMP find_FrictWork,FrictWork,use_MEKE_Ku, & !$OMP use_MEKE_Au, MEKE, hq, & !$OMP mod_Leith, legacy_bound, div_xx_h, vort_xy_q) & - !$OMP private(u0, v0, sh_xx, str_xx, visc_bound_rem, & - !$OMP sh_xy, str_xy, Ah, Kh, AhSm, dvdx, dudy, & - !$OMP sh_xx_bt, sh_xy_bt, dvdx_bt, dudy_bt, & - !$OMP bhstr_xx, bhstr_xy,FatH,RoScl, hu, hv, h_u, h_v, & + !$OMP private(Del2u, Del2v, sh_xx, str_xx, visc_bound_rem, & + !$OMP sh_xy,str_xy,Ah,Kh,AhSm,dvdx,dudy,dDel2udy, & + !$OMP dDel2vdx,sh_xx_bt, sh_xy_bt, dvdx_bt, dudy_bt, & + !$OMP bhstr_xx, bhstr_xy,FatH,RoScl, hu, hv,h_u,h_v, & !$OMP vort_xy,vort_xy_dx,vort_xy_dy,Vort_mag,AhLth, & !$OMP div_xx, div_xx_dx, div_xx_dy, local_strain, & !$OMP meke_res_fn,Sh_F_pow, & @@ -565,9 +575,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, dudy(I,J) = 0. elseif (OBC%computed_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_N) then - dudy(I,J) = 2.0*CS%DX_dyBu(I,J)*(OBC%segment(n)%tangential_vel(I,J,k) - u(I,j,k))*G%IdxCu(I,j) + dudy(I,J) = 2.0*CS%DX_dyBu(I,J)* & + (OBC%segment(n)%tangential_vel(I,J,k) - u(I,j,k))*G%IdxCu(I,j) else - dudy(I,J) = 2.0*CS%DX_dyBu(I,J)*(u(I,j+1,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%IdxCu(I,j+1) + dudy(I,J) = 2.0*CS%DX_dyBu(I,J)* & + (u(I,j+1,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%IdxCu(I,j+1) endif elseif (OBC%specified_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_N) then @@ -585,9 +597,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, dvdx(I,J) = 0. elseif (OBC%computed_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_E) then - dvdx(I,J) = 2.0*CS%DY_dxBu(I,J)*(OBC%segment(n)%tangential_vel(I,J,k) - v(i,J,k))*G%IdyCv(i,J) + dvdx(I,J) = 2.0*CS%DY_dxBu(I,J)* & + (OBC%segment(n)%tangential_vel(I,J,k) - v(i,J,k))*G%IdyCv(i,J) else - dvdx(I,J) = 2.0*CS%DY_dxBu(I,J)*(v(i+1,J,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%IdyCv(i+1,J) + dvdx(I,J) = 2.0*CS%DY_dxBu(I,J)* & + (v(i+1,J,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%IdyCv(i+1,J) endif elseif (OBC%specified_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_E) then @@ -671,26 +685,26 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, enddo ; enddo endif - ! Evaluate u0 = x.Div(Grad u) and v0 = y.Div( Grad u) + ! Evaluate Del2u = x.Div(Grad u) and Del2v = y.Div( Grad u) if (CS%biharmonic) then do j=js-1,Jeq+1 ; do I=Isq-1,Ieq+1 - u0(I,j) = CS%IDXDY2u(I,j)*(CS%DY2h(i+1,j)*sh_xx(i+1,j) - CS%DY2h(i,j)*sh_xx(i,j)) + & - CS%IDX2dyCu(I,j)*(CS%DX2q(I,J)*sh_xy(I,J) - CS%DX2q(I,J-1)*sh_xy(I,J-1)) + Del2u(I,j) = CS%Idxdy2u(I,j)*(CS%dy2h(i+1,j)*sh_xx(i+1,j) - CS%dy2h(i,j)*sh_xx(i,j)) + & + CS%Idx2dyCu(I,j)*(CS%dx2q(I,J)*sh_xy(I,J) - CS%dx2q(I,J-1)*sh_xy(I,J-1)) enddo ; enddo do J=Jsq-1,Jeq+1 ; do i=is-1,Ieq+1 - v0(i,J) = CS%IDXDY2v(i,J)*(CS%DY2q(I,J)*sh_xy(I,J) - CS%DY2q(I-1,J)*sh_xy(I-1,J)) - & - CS%IDX2dyCv(i,J)*(CS%DX2h(i,j+1)*sh_xx(i,j+1) - CS%DX2h(i,j)*sh_xx(i,j)) + Del2v(i,J) = CS%Idxdy2v(i,J)*(CS%dy2q(I,J)*sh_xy(I,J) - CS%dy2q(I-1,J)*sh_xy(I-1,J)) - & + CS%Idx2dyCv(i,J)*(CS%dx2h(i,j+1)*sh_xx(i,j+1) - CS%dx2h(i,j)*sh_xx(i,j)) enddo ; enddo if (apply_OBC) then; if (OBC%zero_biharmonic) then do n=1,OBC%number_of_segments I = OBC%segment(n)%HI%IsdB ; J = OBC%segment(n)%HI%JsdB if (OBC%segment(n)%is_N_or_S .and. (J >= Jsq-1) .and. (J <= Jeq+1)) then do I=OBC%segment(n)%HI%isd,OBC%segment(n)%HI%ied - v0(i,J) = 0. + Del2v(i,J) = 0. enddo elseif (OBC%segment(n)%is_E_or_W .and. (I >= Isq-1) .and. (I <= Ieq+1)) then do j=OBC%segment(n)%HI%jsd,OBC%segment(n)%HI%jed - u0(I,j) = 0. + Del2u(I,j) = 0. enddo endif enddo @@ -746,7 +760,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, div_xx(i,j) = 0.5*((G%dyCu(I,j) * u(I,j,k) * (h(i+1,j,k)+h(i,j,k)) - & G%dyCu(I-1,j) * u(I-1,j,k) * (h(i-1,j,k)+h(i,j,k)) ) + & (G%dxCv(i,J) * v(i,J,k) * (h(i,j,k)+h(i,j+1,k)) - & - G%dxCv(i,J-1)*v(i,J-1,k)*(h(i,j,k)+h(i,j-1,k))))*G%IareaT(i,j)/ & + G%dxCv(i,J-1)*v(i,J-1,k)*(h(i,j,k)+h(i,j-1,k))))*G%IareaT(i,j) / & (h(i,j,k) + GV%H_subroundoff) enddo ; enddo @@ -802,13 +816,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Add in beta for the Leith viscosity if (CS%use_beta_in_Leith) then !#GME# beta_h and beta_q are never used. - do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - beta_h(i,j) = sqrt( G%dF_dx(i,j)**2 + G%dF_dy(i,j)**2 ) - enddo; enddo - do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - beta_q(I,J) = sqrt( (0.25*(G%dF_dx(i,j)+G%dF_dx(i+1,j)+G%dF_dx(i,j+1)+G%dF_dx(i+1,j+1))**2) + & - (0.25*(G%dF_dy(i,j)+G%dF_dy(i+1,j)+G%dF_dy(i,j+1)+G%dF_dy(i+1,j+1))**2) ) - enddo ; enddo + ! do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 + ! beta_h(i,j) = sqrt( G%dF_dx(i,j)**2 + G%dF_dy(i,j)**2 ) + ! enddo ; enddo + ! do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 + ! beta_q(I,J) = sqrt( (0.25*(G%dF_dx(i,j)+G%dF_dx(i+1,j)+G%dF_dx(i,j+1)+G%dF_dx(i+1,j+1))**2) + & + ! (0.25*(G%dF_dy(i,j)+G%dF_dy(i+1,j)+G%dF_dy(i,j+1)+G%dF_dy(i+1,j+1))**2) ) + ! enddo ; enddo do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 vort_xy_dx(i,J) = vort_xy_dx(i,J) + 0.5 * ( G%dF_dx(i,j) + G%dF_dx(i,j+1)) @@ -831,7 +845,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, (0.5*(vort_xy_dy(I,j) + vort_xy_dy(I,j+1)))**2 ) enddo ; enddo - call calc_QG_Leith_viscosity(VarMix, G, GV, h, k, div_xx_dx, div_xx_dy, & + ! This accumulates terms, some of which are in VarMix, so rescaling can not be done here. + call calc_QG_Leith_viscosity(VarMix, G, GV, US, h, k, div_xx_dx, div_xx_dy, & vort_xy_dx, vort_xy_dy) endif @@ -853,15 +868,15 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 if ((CS%Smagorinsky_Kh) .or. (CS%Smagorinsky_Ah)) then - Shear_mag = US%T_to_s * sqrt(sh_xx(i,j)*sh_xx(i,j) + & + Shear_mag = sqrt(sh_xx(i,j)*sh_xx(i,j) + & 0.25*((sh_xy(I-1,J-1)*sh_xy(I-1,J-1) + sh_xy(I,J)*sh_xy(I,J)) + & (sh_xy(I-1,J)*sh_xy(I-1,J) + sh_xy(I,J-1)*sh_xy(I,J-1)))) endif if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then if (CS%use_QG_Leith_visc) then - vert_vort_mag = US%T_to_s*MIN(grad_vort_mag_h(i,j) + grad_div_mag_h(i,j),3*grad_vort_mag_h_2d(i,j)) + vert_vort_mag = MIN(grad_vort_mag_h(i,j) + grad_div_mag_h(i,j),3.*grad_vort_mag_h_2d(i,j)) else - vert_vort_mag = US%T_to_s*(grad_vort_mag_h(i,j) + grad_div_mag_h(i,j)) + vert_vort_mag = (grad_vort_mag_h(i,j) + grad_div_mag_h(i,j)) endif endif if (CS%better_bound_Ah .or. CS%better_bound_Kh) then @@ -898,8 +913,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif endif - if ((CS%id_Kh_h>0) .or. find_FrictWork) Kh_h(i,j,k) = Kh + if ((CS%id_Kh_h>0) .or. find_FrictWork .or. CS%debug) Kh_h(i,j,k) = Kh if (CS%id_div_xx_h>0) div_xx_h(i,j,k) = div_xx(i,j) + if (CS%debug) sh_xx_3d(i,j,k) = sh_xx(i,j) str_xx(i,j) = -Kh * sh_xx(i,j) else ! not Laplacian @@ -926,7 +942,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, AhSm = CS%Biharm_const_xx(i,j) * Shear_mag endif endif - if (CS%Leith_Ah) AhLth = CS%biharm5_const_xx(i,j) * vert_vort_mag * inv_PI5 + if (CS%Leith_Ah) AhLth = CS%Biharm5_const_xx(i,j) * vert_vort_mag * inv_PI5 Ah = MAX(MAX(CS%Ah_bg_xx(i,j), AhSm), AhLth) if (CS%bound_Ah .and. .not.CS%better_bound_Ah) & Ah = MIN(Ah, CS%Ah_Max_xx(i,j)) @@ -940,16 +956,16 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, Ah = MIN(Ah, visc_bound_rem*hrat_min*CS%Ah_Max_xx(i,j)) endif - if ((CS%id_Ah_h>0) .or. find_FrictWork) Ah_h(i,j,k) = Ah + if ((CS%id_Ah_h>0) .or. find_FrictWork .or. CS%debug) Ah_h(i,j,k) = Ah str_xx(i,j) = str_xx(i,j) + Ah * & - (CS%DY_dxT(i,j)*(G%IdyCu(I,j)*u0(I,j) - G%IdyCu(I-1,j)*u0(I-1,j)) - & - CS%DX_dyT(i,j) *(G%IdxCv(i,J)*v0(i,J) - G%IdxCv(i,J-1)*v0(i,J-1))) + (CS%DY_dxT(i,j) * (G%IdyCu(I,j)*Del2u(I,j) - G%IdyCu(I-1,j)*Del2u(I-1,j)) - & + CS%DX_dyT(i,j) * (G%IdxCv(i,J)*Del2v(i,J) - G%IdxCv(i,J-1)*Del2v(i,J-1))) ! Keep a copy of the biharmonic contribution for backscatter parameterization - bhstr_xx(i,j) = Ah * & - (CS%DY_dxT(i,j)*(G%IdyCu(I,j)*u0(I,j) - G%IdyCu(I-1,j)*u0(I-1,j)) - & - CS%DX_dyT(i,j) *(G%IdxCv(i,J)*v0(i,J) - G%IdxCv(i,J-1)*v0(i,J-1))) + bhstr_xx(i,j) = Ah * & + (CS%DY_dxT(i,j) * (G%IdyCu(I,j)*Del2u(I,j) - G%IdyCu(I-1,j)*Del2u(I-1,j)) - & + CS%DX_dyT(i,j) * (G%IdxCv(i,J)*Del2v(i,J) - G%IdxCv(i,J-1)*Del2v(i,J-1))) bhstr_xx(i,j) = bhstr_xx(i,j) * (h(i,j,k) * CS%reduction_xx(i,j)) endif ! biharmonic @@ -959,8 +975,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%biharmonic) then ! Gradient of Laplacian, for use in bi-harmonic term do J=js-1,Jeq ; do I=is-1,Ieq - dvdx(I,J) = CS%DY_dxBu(I,J)*(v0(i+1,J)*G%IdyCv(i+1,J) - v0(i,J)*G%IdyCv(i,J)) - dudy(I,J) = CS%DX_dyBu(I,J)*(u0(I,j+1)*G%IdxCu(I,j+1) - u0(I,j)*G%IdxCu(I,j)) + dDel2vdx(I,J) = CS%DY_dxBu(I,J)*(Del2v(i+1,J)*G%IdyCv(i+1,J) - Del2v(i,J)*G%IdyCv(i,J)) + dDel2udy(I,J) = CS%DX_dyBu(I,J)*(Del2u(I,j+1)*G%IdxCu(I,j+1) - Del2u(I,j)*G%IdxCu(I,j)) enddo ; enddo ! Adjust contributions to shearing strain on open boundaries. if (apply_OBC) then ; if (OBC%zero_strain .or. OBC%freeslip_strain) then @@ -969,17 +985,17 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (OBC%segment(n)%is_N_or_S .and. (J >= js-1) .and. (J <= Jeq)) then do I=OBC%segment(n)%HI%IsdB,OBC%segment(n)%HI%IedB if (OBC%zero_strain) then - dvdx(I,J) = 0. ; dudy(I,J) = 0. + dDel2vdx(I,J) = 0. ; dDel2udy(I,J) = 0. elseif (OBC%freeslip_strain) then - dudy(I,J) = 0. + dDel2udy(I,J) = 0. endif enddo elseif (OBC%segment(n)%is_E_or_W .and. (I >= is-1) .and. (I <= Ieq)) then do J=OBC%segment(n)%HI%JsdB,OBC%segment(n)%HI%JedB if (OBC%zero_strain) then - dvdx(I,J) = 0. ; dudy(I,J) = 0. + dDel2vdx(I,J) = 0. ; dDel2udy(I,J) = 0. elseif (OBC%freeslip_strain) then - dvdx(I,J) = 0. + dDel2vdx(I,J) = 0. endif enddo endif @@ -991,15 +1007,15 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, do J=js-1,Jeq ; do I=is-1,Ieq if ((CS%Smagorinsky_Kh) .or. (CS%Smagorinsky_Ah)) then - Shear_mag = US%T_to_s * sqrt(sh_xy(I,J)*sh_xy(I,J) + & + Shear_mag = sqrt(sh_xy(I,J)*sh_xy(I,J) + & 0.25*((sh_xx(i,j)*sh_xx(i,j) + sh_xx(i+1,j+1)*sh_xx(i+1,j+1)) + & (sh_xx(i,j+1)*sh_xx(i,j+1) + sh_xx(i+1,j)*sh_xx(i+1,j)))) endif if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then if (CS%use_QG_Leith_visc) then - vert_vort_mag = US%T_to_s*MIN(grad_vort_mag_q(I,J) + grad_div_mag_q(I,J), 3*grad_vort_mag_q_2d(I,J)) + vert_vort_mag = MIN(grad_vort_mag_q(I,J) + grad_div_mag_q(I,J), 3.*grad_vort_mag_q_2d(I,J)) else - vert_vort_mag = US%T_to_s*(grad_vort_mag_q(I,J) + grad_div_mag_q(I,J)) + vert_vort_mag = (grad_vort_mag_q(I,J) + grad_div_mag_q(I,J)) endif endif h2uq = 4.0 * h_u(I,j) * h_u(I,j+1) @@ -1064,8 +1080,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif endif - if (CS%id_Kh_q>0) Kh_q(I,J,k) = Kh + if (CS%id_Kh_q>0 .or. CS%debug) Kh_q(I,J,k) = Kh if (CS%id_vort_xy_q>0) vort_xy_q(I,J,k) = vort_xy(I,J) + if (CS%debug) sh_xy_3d(I,J,k) = sh_xy(I,J) str_xy(I,J) = -Kh * sh_xy(I,J) else ! not Laplacian @@ -1109,21 +1126,31 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, Ah = MIN(Ah, visc_bound_rem*hrat_min*CS%Ah_Max_xy(I,J)) endif - if (CS%id_Ah_q>0) Ah_q(I,J,k) = Ah + if (CS%id_Ah_q>0 .or. CS%debug) Ah_q(I,J,k) = Ah - str_xy(I,J) = str_xy(I,J) + Ah * ( dvdx(I,J) + dudy(I,J) ) + str_xy(I,J) = str_xy(I,J) + Ah * ( dDel2vdx(I,J) + dDel2udy(I,J) ) ! Keep a copy of the biharmonic contribution for backscatter parameterization - bhstr_xy(I,J) = Ah * ( dvdx(I,J) + dudy(I,J) ) * & + bhstr_xy(I,J) = Ah * ( dDel2vdx(I,J) + dDel2udy(I,J) ) * & (hq(I,J) * G%mask2dBu(I,J) * CS%reduction_xy(I,J)) endif ! biharmonic enddo ; enddo - if (find_FrictWork) then if (CS%Laplacian) then + ! if (CS%biharmonic) then + !### This code is dimensionally incorrect, but needed to reproduce previous answers. + ! This should be considered a serious bug in cases where the answers change if the + ! following code is commented out - i.e. if both biharmonic and Laplacian are used + ! and FindFrictWork is true. + ! do J=js-1,Jeq ; do I=is-1,Ieq + ! dvdx(I,J) = US%m_to_L**2*dDel2vdx(I,J) + ! dudy(I,J) = US%m_to_L**2*dDel2udy(I,J) + ! enddo ; enddo + ! endif + if (CS%answers_2018) then do j=js,je ; do i=is,ie grad_vel_mag_h(i,j) = boundary_mask(i,j) * (dudx(i,j)**2 + dvdy(i,j)**2 + & @@ -1145,8 +1172,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%biharmonic) then do j=js,je ; do i=is,ie - grad_d2vel_mag_h(i,j) = boundary_mask(i,j) * ((0.5*(u0(I,j) + u0(I-1,j)))**2 + & - (0.5*(v0(i,J) + v0(i,J-1)))**2) + grad_d2vel_mag_h(i,j) = boundary_mask(i,j) * & + ((0.5*(Del2u(I,j) + Del2u(I-1,j)))**2 + & + (0.5*(Del2v(i,J) + Del2v(i,J-1)))**2) enddo ; enddo else do j=js,je ; do i=is,ie @@ -1156,8 +1184,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, do j=js,je ; do i=is,ie ! Diagnose -Kh * |del u|^2 - Ah * |del^2 u|^2 - diss_rate(i,j,k) = -US%s_to_T*Kh_h(i,j,k) * grad_vel_mag_h(i,j) - & - US%s_to_T*Ah_h(i,j,k) * grad_d2vel_mag_h(i,j) + diss_rate(i,j,k) = -Kh_h(i,j,k) * grad_vel_mag_h(i,j) - & + Ah_h(i,j,k) * grad_d2vel_mag_h(i,j) if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then ! This is the maximum possible amount of energy that can be converted @@ -1187,8 +1215,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 GME_coeff = 0.0 if ((max_diss_rate(i,j,k) > 0) .and. (grad_vel_mag_bt_h(i,j)>0) ) then - GME_coeff = FWfrac*US%T_to_s*max_diss_rate(i,j,k) / grad_vel_mag_bt_h(i,j) -! GME_coeff = FWfrac*US%T_to_s*target_diss_rate_GME(i,j,k) / grad_vel_mag_bt_h(i,j) + GME_coeff = FWfrac*max_diss_rate(i,j,k) / grad_vel_mag_bt_h(i,j) +! GME_coeff = FWfrac*target_diss_rate_GME(i,j,k) / grad_vel_mag_bt_h(i,j) if ((G%bathyT(i,j) < H0_GME) .and. (H0_GME > 0.0)) & GME_coeff = (G%bathyT(i,j) / H0_GME)**2 * GME_coeff @@ -1207,8 +1235,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, GME_coeff = 0.0 if ((max_diss_rate(i,j,k) > 0) .and. (grad_vel_mag_bt_q(I,J)>0) ) then !#GME# target_diss_rate_GME and max_diss_rate are defined at h points, not q points as used here. - GME_coeff = FWfrac*US%T_to_s*max_diss_rate(i,j,k) / grad_vel_mag_bt_q(I,J) -! GME_coeff = FWfrac*US%T_to_s*target_diss_rate_GME(i,j,k) / grad_vel_mag_bt_q(I,J) + GME_coeff = FWfrac*max_diss_rate(i,j,k) / grad_vel_mag_bt_q(I,J) +! GME_coeff = FWfrac*target_diss_rate_GME(i,j,k) / grad_vel_mag_bt_q(I,J) if ((G%bathyT(i,j) < H0_GME) .and. (H0_GME > 0.0)) & GME_coeff = (G%bathyT(i,j) / H0_GME)**2 * GME_coeff @@ -1222,7 +1250,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, enddo ; enddo - ! applying GME diagonal term + ! Applying GME diagonal term. This is linear and the arguments can be rescaled. call smooth_GME(CS,G,GME_flux_h=str_xx_GME) call smooth_GME(CS,G,GME_flux_q=str_xy_GME) @@ -1241,7 +1269,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (associated(MEKE%GME_snk)) then do j=js,je ; do i=is,ie - FrictWork_GME(i,j,k) = US%s_to_T*GME_coeff_h(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 * grad_vel_mag_bt_h(i,j) + FrictWork_GME(i,j,k) = GME_coeff_h(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 * grad_vel_mag_bt_h(i,j) enddo ; enddo endif @@ -1262,10 +1290,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Evaluate 1/h x.Div(h Grad u) or the biharmonic equivalent. do j=js,je ; do I=Isq,Ieq - diffu(I,j,k) = ((G%IdyCu(I,j)*(CS%DY2h(i,j) *str_xx(i,j) - & - CS%DY2h(i+1,j)*str_xx(i+1,j)) + & - G%IdxCu(I,j)*(CS%DX2q(I,J-1)*str_xy(I,J-1) - & - CS%DX2q(I,J) *str_xy(I,J))) * & + diffu(I,j,k) = ((G%IdyCu(I,j)*(CS%dy2h(i,j) *str_xx(i,j) - & + CS%dy2h(i+1,j)*str_xx(i+1,j)) + & + G%IdxCu(I,j)*(CS%dx2q(I,J-1)*str_xy(I,J-1) - & + CS%dx2q(I,J) *str_xy(I,J))) * & G%IareaCu(I,j)) / (h_u(i,j) + h_neglect) enddo ; enddo @@ -1284,10 +1312,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Evaluate 1/h y.Div(h Grad u) or the biharmonic equivalent. do J=Jsq,Jeq ; do i=is,ie - diffv(i,J,k) = ((G%IdyCv(i,J)*(CS%DY2q(I-1,J)*str_xy(I-1,J) - & - CS%DY2q(I,J) *str_xy(I,J)) - & - G%IdxCv(i,J)*(CS%DX2h(i,j) *str_xx(i,j) - & - CS%DX2h(i,j+1)*str_xx(i,j+1))) * & + diffv(i,J,k) = ((G%IdyCv(i,J)*(CS%dy2q(I-1,J)*str_xy(I-1,J) - & + CS%dy2q(I,J) *str_xy(I,J)) - & + G%IdxCv(i,J)*(CS%dx2h(i,j) *str_xx(i,j) - & + CS%dx2h(i,j+1)*str_xx(i,j+1))) * & G%IareaCv(i,J)) / (h_v(i,J) + h_neglect) enddo ; enddo if (apply_OBC) then @@ -1306,7 +1334,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (find_FrictWork) then ; do j=js,je ; do i=is,ie ! Diagnose str_xx*d_x u - str_yy*d_y v + str_xy*(d_y u + d_x v) ! This is the old formulation that includes energy diffusion - FrictWork(i,j,k) = US%s_to_T*GV%H_to_kg_m2 * ( & + FrictWork(i,j,k) = GV%H_to_kg_m2 * ( & (str_xx(i,j)*(u(I,j,k)-u(I-1,j,k))*G%IdxT(i,j) & -str_xx(i,j)*(v(i,J,k)-v(i,J-1,k))*G%IdyT(i,j)) & +0.25*((str_xy(I,J)*( & @@ -1341,7 +1369,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, do j=js,je ; do i=is,ie FatH = 0.25*( (abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & (abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J-1))) ) - Shear_mag = US%T_to_s * sqrt(sh_xx(i,j)*sh_xx(i,j) + & + Shear_mag = sqrt(sh_xx(i,j)*sh_xx(i,j) + & 0.25*((sh_xy(I-1,J-1)*sh_xy(I-1,J-1) + sh_xy(I,J)*sh_xy(I,J)) + & (sh_xy(I-1,J)*sh_xy(I-1,J) + sh_xy(I,J-1)*sh_xy(I,J-1)))) if (CS%answers_2018) then @@ -1361,7 +1389,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, RoScl = Sh_F_pow / (1.0 + Sh_F_pow) ! = 1 - f^n/(f^n+c*D^n) endif endif - MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + US%s_to_T*GV%H_to_kg_m2 * ( & + MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + GV%H_to_kg_m2 * ( & ((str_xx(i,j)-RoScl*bhstr_xx(i,j))*(u(I,j,k)-u(I-1,j,k))*G%IdxT(i,j) & -(str_xx(i,j)-RoScl*bhstr_xx(i,j))*(v(i,J,k)-v(i,J-1,k))*G%IdyT(i,j)) & +0.25*(((str_xy(I,J)-RoScl*bhstr_xy(I,J))*( & @@ -1418,6 +1446,17 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%id_GME_coeff_h > 0) call post_data(CS%id_GME_coeff_h, GME_coeff_h, CS%diag) if (CS%id_GME_coeff_q > 0) call post_data(CS%id_GME_coeff_q, GME_coeff_q, CS%diag) + if (CS%debug) then + if (CS%Laplacian) then + call hchksum(Kh_h, "Kh_h", G%HI, haloshift=0, scale=US%L_to_m**2*US%s_to_T) + call Bchksum(Kh_q, "Kh_q", G%HI, haloshift=0, scale=US%L_to_m**2*US%s_to_T) + call Bchksum(sh_xy_3d, "shear_xy", G%HI, haloshift=0, scale=US%s_to_T) + call hchksum(sh_xx_3d, "shear_xx", G%HI, haloshift=0, scale=US%s_to_T) + endif + if (CS%biharmonic) call hchksum(Ah_h, "Ah_h", G%HI, haloshift=0, scale=US%L_to_m**4*US%s_to_T) + if (CS%biharmonic) call Bchksum(Ah_q, "Ah_q", G%HI, haloshift=0, scale=US%L_to_m**4*US%s_to_T) + endif + if (CS%id_FrictWorkIntz > 0) then do j=js,je do i=is,ie ; FrictWorkIntz(i,j) = FrictWork(i,j,1) ; enddo @@ -1446,11 +1485,11 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) real, dimension(SZIB_(G),SZJ_(G)) :: u0u, u0v real, dimension(SZI_(G),SZJB_(G)) :: v0u, v0v ! u0v is the Laplacian sensitivities to the v velocities - ! at u points [m-2], with u0u, v0u, and v0v defined similarly. - real :: grid_sp_h2 ! Harmonic mean of the squares of the grid [m2] - real :: grid_sp_h3 ! Harmonic mean of the squares of the grid^(3/2) [m3] - real :: grid_sp_q2 ! spacings at h and q points [m2] - real :: grid_sp_q3 ! spacings at h and q points^(3/2) [m3] + ! at u points [L-2 ~> m-2], with u0u, v0u, and v0v defined similarly. + real :: grid_sp_h2 ! Harmonic mean of the squares of the grid [L2 ~> m2] + real :: grid_sp_h3 ! Harmonic mean of the squares of the grid^(3/2) [L3 ~> m3] + real :: grid_sp_q2 ! spacings at h and q points [L2 ~> m2] + real :: grid_sp_q3 ! spacings at h and q points^(3/2) [L3 ~> m3] real :: Kh_Limit ! A coefficient [T-1 ~> s-1] used, along with the ! grid spacing, to limit Laplacian viscosity. real :: fmax ! maximum absolute value of f at the four @@ -1459,10 +1498,10 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) ! [T2 L-2 ~> s2 m-2] real :: Ah_Limit ! coefficient [T-1 ~> s-1] used, along with the ! grid spacing, to limit biharmonic viscosity - real :: Kh ! Lapacian horizontal viscosity [m2 s-1] - real :: Ah ! biharmonic horizontal viscosity [m4 s-1] - real :: Kh_vel_scale ! this speed [m T-1 ~> m s-1] times grid spacing gives Lap visc - real :: Ah_vel_scale ! this speed [m T-1 ~> m s-1] times grid spacing cubed gives bih visc + real :: Kh ! Lapacian horizontal viscosity [L2 s-1] + real :: Ah ! biharmonic horizontal viscosity [L4 s-1] + real :: Kh_vel_scale ! this speed [L T-1 ~> m s-1] times grid spacing gives Lap visc + real :: Ah_vel_scale ! this speed [L T-1 ~> m s-1] times grid spacing cubed gives bih visc real :: Ah_time_scale ! damping time-scale for biharmonic visc [T ~> s] real :: Smag_Lap_const ! nondimensional Laplacian Smagorinsky constant real :: Smag_bi_const ! nondimensional biharmonic Smagorinsky constant @@ -1475,7 +1514,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) real :: bound_Cor_vel ! grid-scale velocity variations at which value ! the quadratically varying biharmonic viscosity ! balances Coriolis acceleration [L T-1 ~> m s-1] - real :: Kh_sin_lat ! Amplitude of latitudinally dependent viscosity [m2 T-1 ~> m2 s-1] + real :: Kh_sin_lat ! Amplitude of latitudinally dependent viscosity [L2 T-1 ~> m2 s-1] real :: Kh_pwr_of_sine ! Power used to raise sin(lat) when using Kh_sin_lat logical :: bound_Cor_def ! parameter setting of BOUND_CORIOLIS logical :: get_all ! If true, read and log all parameters, regardless of @@ -1537,26 +1576,28 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& "forms of the same expressions.", default=default_2018_answers) + call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false.) + call get_param(param_file, mdl, "LAPLACIAN", CS%Laplacian, & "If true, use a Laplacian horizontal viscosity.", & default=.false.) if (CS%Laplacian .or. get_all) then call get_param(param_file, mdl, "KH", Kh, & "The background Laplacian horizontal viscosity.", & - units = "m2 s-1", default=0.0, scale=US%T_to_s) + units = "m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s) call get_param(param_file, mdl, "KH_BG_MIN", CS%Kh_bg_min, & "The minimum value allowed for Laplacian horizontal viscosity, KH.", & - units = "m2 s-1", default=0.0, scale=US%T_to_s) + units = "m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s) call get_param(param_file, mdl, "KH_VEL_SCALE", Kh_vel_scale, & "The velocity scale which is multiplied by the grid "//& "spacing to calculate the Laplacian viscosity. "//& "The final viscosity is the largest of this scaled "//& "viscosity, the Smagorinsky and Leith viscosities, and KH.", & - units="m s-1", default=0.0, scale=US%T_to_s) + units="m s-1", default=0.0, scale=US%m_s_to_L_T) call get_param(param_file, mdl, "KH_SIN_LAT", Kh_sin_lat, & "The amplitude of a latitudinally-dependent background "//& "viscosity of the form KH_SIN_LAT*(SIN(LAT)**KH_PWR_OF_SINE).", & - units = "m2 s-1", default=0.0, scale=US%T_to_s) + units = "m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s) if (Kh_sin_lat>0. .or. get_all) & call get_param(param_file, mdl, "KH_PWR_OF_SINE", Kh_pwr_of_sine, & "The power used to raise SIN(LAT) when using a latitudinally "//& @@ -1619,7 +1660,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) if (CS%anisotropic .or. get_all) then call get_param(param_file, mdl, "KH_ANISO", CS%Kh_aniso, & "The background Laplacian anisotropic horizontal viscosity.", & - units = "m2 s-1", default=0.0, scale=US%T_to_s) + units = "m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s) call get_param(param_file, mdl, "ANISOTROPIC_MODE", aniso_mode, & "Selects the mode for setting the direction of anistropy.\n"//& "\t 0 - Points along the grid i-direction.\n"//& @@ -1647,13 +1688,13 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) if (CS%biharmonic .or. get_all) then call get_param(param_file, mdl, "AH", Ah, & "The background biharmonic horizontal viscosity.", & - units = "m4 s-1", default=0.0, scale=US%T_to_s) + units = "m4 s-1", default=0.0, scale=US%m_to_L**4*US%T_to_s) call get_param(param_file, mdl, "AH_VEL_SCALE", Ah_vel_scale, & "The velocity scale which is multiplied by the cube of "//& "the grid spacing to calculate the biharmonic viscosity. "//& "The final viscosity is the largest of this scaled "//& "viscosity, the Smagorinsky and Leith viscosities, and AH.", & - units="m s-1", default=0.0, scale=US%T_to_s) + units="m s-1", default=0.0, scale=US%m_s_to_L_T) call get_param(param_file, mdl, "AH_TIME_SCALE", Ah_time_scale, & "A time scale whose inverse is multiplied by the fourth "//& "power of the grid spacing to calculate biharmonic viscosity. "//& @@ -1820,7 +1861,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) call MOM_read_data(trim(inputdir)//trim(filename), 'Kh', CS%Kh_bg_2d, & - G%domain, timelevel=1, scale=US%T_to_s) + G%domain, timelevel=1, scale=US%m_to_L**2*US%T_to_s) call pass_var(CS%Kh_bg_2d, G%domain) endif @@ -1851,11 +1892,11 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) endif do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - CS%DX2q(I,J) = G%dxBu(I,J)*G%dxBu(I,J) ; CS%DY2q(I,J) = G%dyBu(I,J)*G%dyBu(I,J) + CS%dx2q(I,J) = G%dxBu(I,J)*G%dxBu(I,J) ; CS%dy2q(I,J) = G%dyBu(I,J)*G%dyBu(I,J) CS%DX_dyBu(I,J) = G%dxBu(I,J)*G%IdyBu(I,J) ; CS%DY_dxBu(I,J) = G%dyBu(I,J)*G%IdxBu(I,J) enddo ; enddo do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - CS%DX2h(i,j) = G%dxT(i,j)*G%dxT(i,j) ; CS%DY2h(i,j) = G%dyT(i,j)*G%dyT(i,j) + CS%dx2h(i,j) = G%dxT(i,j)*G%dxT(i,j) ; CS%dy2h(i,j) = G%dyT(i,j)*G%dyT(i,j) CS%DX_dyT(i,j) = G%dxT(i,j)*G%IdyT(i,j) ; CS%DY_dxT(i,j) = G%dyT(i,j)*G%IdxT(i,j) enddo ; enddo @@ -1863,32 +1904,32 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) CS%reduction_xx(i,j) = 1.0 if ((G%dy_Cu(I,j) > 0.0) .and. (G%dy_Cu(I,j) < G%dyCu(I,j)) .and. & (G%dy_Cu(I,j) < G%dyCu(I,j) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = G%dy_Cu(I,j) / G%dyCu(I,j) + CS%reduction_xx(i,j) = G%dy_Cu(I,j) / (G%dyCu(I,j)) if ((G%dy_Cu(I-1,j) > 0.0) .and. (G%dy_Cu(I-1,j) < G%dyCu(I-1,j)) .and. & (G%dy_Cu(I-1,j) < G%dyCu(I-1,j) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = G%dy_Cu(I-1,j) / G%dyCu(I-1,j) + CS%reduction_xx(i,j) = G%dy_Cu(I-1,j) / (G%dyCu(I-1,j)) if ((G%dx_Cv(i,J) > 0.0) .and. (G%dx_Cv(i,J) < G%dxCv(i,J)) .and. & (G%dx_Cv(i,J) < G%dxCv(i,J) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = G%dx_Cv(i,J) / G%dxCv(i,J) + CS%reduction_xx(i,j) = G%dx_Cv(i,J) / (G%dxCv(i,J)) if ((G%dx_Cv(i,J-1) > 0.0) .and. (G%dx_Cv(i,J-1) < G%dxCv(i,J-1)) .and. & (G%dx_Cv(i,J-1) < G%dxCv(i,J-1) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = G%dx_Cv(i,J-1) / G%dxCv(i,J-1) + CS%reduction_xx(i,j) = G%dx_Cv(i,J-1) / (G%dxCv(i,J-1)) enddo ; enddo do J=js-1,Jeq ; do I=is-1,Ieq CS%reduction_xy(I,J) = 1.0 if ((G%dy_Cu(I,j) > 0.0) .and. (G%dy_Cu(I,j) < G%dyCu(I,j)) .and. & (G%dy_Cu(I,j) < G%dyCu(I,j) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = G%dy_Cu(I,j) / G%dyCu(I,j) + CS%reduction_xy(I,J) = G%dy_Cu(I,j) / (G%dyCu(I,j)) if ((G%dy_Cu(I,j+1) > 0.0) .and. (G%dy_Cu(I,j+1) < G%dyCu(I,j+1)) .and. & (G%dy_Cu(I,j+1) < G%dyCu(I,j+1) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = G%dy_Cu(I,j+1) / G%dyCu(I,j+1) + CS%reduction_xy(I,J) = G%dy_Cu(I,j+1) / (G%dyCu(I,j+1)) if ((G%dx_Cv(i,J) > 0.0) .and. (G%dx_Cv(i,J) < G%dxCv(i,J)) .and. & (G%dx_Cv(i,J) < G%dxCv(i,J) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = G%dx_Cv(i,J) / G%dxCv(i,J) + CS%reduction_xy(I,J) = G%dx_Cv(i,J) / (G%dxCv(i,J)) if ((G%dx_Cv(i+1,J) > 0.0) .and. (G%dx_Cv(i+1,J) < G%dxCv(i+1,J)) .and. & (G%dx_Cv(i+1,J) < G%dxCv(i+1,J) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = G%dx_Cv(i+1,J) / G%dxCv(i+1,J) + CS%reduction_xy(I,J) = G%dx_Cv(i+1,J) / (G%dxCv(i+1,J)) enddo ; enddo if (CS%Laplacian) then @@ -1899,7 +1940,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) ! Calculate and store the background viscosity at h-points do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 ! Static factors in the Smagorinsky and Leith schemes - grid_sp_h2 = (2.0*CS%DX2h(i,j)*CS%DY2h(i,j)) / (CS%DX2h(i,j) + CS%DY2h(i,j)) + grid_sp_h2 = (2.0*CS%dx2h(i,j)*CS%dy2h(i,j)) / (CS%dx2h(i,j) + CS%dy2h(i,j)) grid_sp_h3 = grid_sp_h2*sqrt(grid_sp_h2) if (CS%Smagorinsky_Kh) CS%Laplac2_const_xx(i,j) = Smag_Lap_const * grid_sp_h2 if (CS%Leith_Kh) CS%Laplac3_const_xx(i,j) = Leith_Lap_const * grid_sp_h3 @@ -1925,7 +1966,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) ! Calculate and store the background viscosity at q-points do J=js-1,Jeq ; do I=is-1,Ieq ! Static factors in the Smagorinsky and Leith schemes - grid_sp_q2 = (2.0*CS%DX2q(I,J)*CS%DY2q(I,J)) / (CS%DX2q(I,J) + CS%DY2q(I,J)) + grid_sp_q2 = (2.0*CS%dx2q(I,J)*CS%dy2q(I,J)) / (CS%dx2q(I,J) + CS%dy2q(I,J)) grid_sp_q3 = grid_sp_q2*sqrt(grid_sp_q2) if (CS%Smagorinsky_Kh) CS%Laplac2_const_xy(I,J) = Smag_Lap_const * grid_sp_q2 if (CS%Leith_Kh) CS%Laplac3_const_xy(I,J) = Leith_Lap_const * grid_sp_q3 @@ -1953,12 +1994,12 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) if (CS%biharmonic) then do j=js-1,Jeq+1 ; do I=Isq-1,Ieq+1 - CS%IDX2dyCu(I,j) = (G%IdxCu(I,j)*G%IdxCu(I,j)) * G%IdyCu(I,j) - CS%IDXDY2u(I,j) = G%IdxCu(I,j) * (G%IdyCu(I,j)*G%IdyCu(I,j)) + CS%Idx2dyCu(I,j) = (G%IdxCu(I,j)*G%IdxCu(I,j)) * G%IdyCu(I,j) + CS%Idxdy2u(I,j) = G%IdxCu(I,j) * (G%IdyCu(I,j)*G%IdyCu(I,j)) enddo ; enddo do J=Jsq-1,Jeq+1 ; do i=is-1,Ieq+1 - CS%IDX2dyCv(i,J) = (G%IdxCv(i,J)*G%IdxCv(i,J)) * G%IdyCv(i,J) - CS%IDXDY2v(i,J) = G%IdxCv(i,J) * (G%IdyCv(i,J)*G%IdyCv(i,J)) + CS%Idx2dyCv(i,J) = (G%IdxCv(i,J)*G%IdxCv(i,J)) * G%IdyCv(i,J) + CS%Idxdy2v(i,J) = G%IdxCv(i,J) * (G%IdyCv(i,J)*G%IdyCv(i,J)) enddo ; enddo CS%Ah_bg_xy(:,:) = 0.0 @@ -1968,7 +2009,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) if (CS%Smagorinsky_Ah .and. CS%bound_Coriolis) & BoundCorConst = 1.0 / (5.0*(bound_Cor_vel*bound_Cor_vel)) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - grid_sp_h2 = (2.0*CS%DX2h(i,j)*CS%DY2h(i,j)) / (CS%DX2h(i,j)+CS%DY2h(i,j)) + grid_sp_h2 = (2.0*CS%dx2h(i,j)*CS%dy2h(i,j)) / (CS%dx2h(i,j)+CS%dy2h(i,j)) grid_sp_h3 = grid_sp_h2*sqrt(grid_sp_h2) if (CS%Smagorinsky_Ah) then @@ -1976,7 +2017,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) if (CS%bound_Coriolis) then fmax = MAX(abs(G%CoriolisBu(I-1,J-1)), abs(G%CoriolisBu(I,J-1)), & abs(G%CoriolisBu(I-1,J)), abs(G%CoriolisBu(I,J))) - CS%Biharm_const2_xx(i,j) = US%m_to_L**2*(grid_sp_h2 * grid_sp_h2 * grid_sp_h2) * & + CS%Biharm_const2_xx(i,j) = (grid_sp_h2 * grid_sp_h2 * grid_sp_h2) * & (fmax * BoundCorConst) endif endif @@ -1992,13 +2033,13 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) endif enddo ; enddo do J=js-1,Jeq ; do I=is-1,Ieq - grid_sp_q2 = (2.0*CS%DX2q(I,J)*CS%DY2q(I,J)) / (CS%DX2q(I,J)+CS%DY2q(I,J)) + grid_sp_q2 = (2.0*CS%dx2q(I,J)*CS%dy2q(I,J)) / (CS%dx2q(I,J)+CS%dy2q(I,J)) grid_sp_q3 = grid_sp_q2*sqrt(grid_sp_q2) if (CS%Smagorinsky_Ah) then CS%Biharm_const_xy(I,J) = Smag_bi_const * (grid_sp_q2 * grid_sp_q2) if (CS%bound_Coriolis) then - CS%Biharm_const2_xy(I,J) = US%m_to_L**2*(grid_sp_q2 * grid_sp_q2 * grid_sp_q2) * & + CS%Biharm_const2_xy(I,J) = (grid_sp_q2 * grid_sp_q2 * grid_sp_q2) * & (abs(G%CoriolisBu(I,J)) * BoundCorConst) endif endif @@ -2021,9 +2062,9 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) Idt = 1.0 / dt do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 denom = max( & - (CS%DY2h(i,j) * CS%DY_dxT(i,j) * (G%IdyCu(I,j) + G%IdyCu(I-1,j)) * & + (CS%dy2h(i,j) * CS%DY_dxT(i,j) * (G%IdyCu(I,j) + G%IdyCu(I-1,j)) * & max(G%IdyCu(I,j)*G%IareaCu(I,j), G%IdyCu(I-1,j)*G%IareaCu(I-1,j)) ), & - (CS%DX2h(i,j) * CS%DX_dyT(i,j) * (G%IdxCv(i,J) + G%IdxCv(i,J-1)) * & + (CS%dx2h(i,j) * CS%DX_dyT(i,j) * (G%IdxCv(i,J) + G%IdxCv(i,J-1)) * & max(G%IdxCv(i,J)*G%IareaCv(i,J), G%IdxCv(i,J-1)*G%IareaCv(i,J-1)) ) ) CS%Kh_Max_xx(i,j) = 0.0 if (denom > 0.0) & @@ -2031,14 +2072,18 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) enddo ; enddo do J=js-1,Jeq ; do I=is-1,Ieq denom = max( & - (CS%DX2q(I,J) * CS%DX_dyBu(I,J) * (G%IdxCu(I,j+1) + G%IdxCu(I,j)) * & + (CS%dx2q(I,J) * CS%DX_dyBu(I,J) * (G%IdxCu(I,j+1) + G%IdxCu(I,j)) * & max(G%IdxCu(I,j)*G%IareaCu(I,j), G%IdxCu(I,j+1)*G%IareaCu(I,j+1)) ), & - (CS%DY2q(I,J) * CS%DY_dxBu(I,J) * (G%IdyCv(i+1,J) + G%IdyCv(i,J)) * & + (CS%dy2q(I,J) * CS%DY_dxBu(I,J) * (G%IdyCv(i+1,J) + G%IdyCv(i,J)) * & max(G%IdyCv(i,J)*G%IareaCv(i,J), G%IdyCv(i+1,J)*G%IareaCv(i+1,J)) ) ) CS%Kh_Max_xy(I,J) = 0.0 if (denom > 0.0) & CS%Kh_Max_xy(I,J) = CS%bound_coef * 0.25 * Idt / denom enddo ; enddo + if (CS%debug) then + call hchksum(CS%Kh_Max_xx, "Kh_Max_xx", G%HI, haloshift=0, scale=US%L_to_m**2*US%s_to_T) + call Bchksum(CS%Kh_Max_xx, "Kh_Max_xy", G%HI, haloshift=0, scale=US%L_to_m**2*US%s_to_T) + endif endif ! The biharmonic bounds should avoid overshoots when CS%bound_coef < 0.5, but @@ -2046,35 +2091,35 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) if (CS%biharmonic .and. CS%better_bound_Ah) then Idt = 1.0 / dt do j=js-1,Jeq+1 ; do I=Isq-1,Ieq+1 - u0u(I,j) = CS%IDXDY2u(I,j)*(CS%DY2h(i+1,j)*CS%DY_dxT(i+1,j)*(G%IdyCu(I+1,j) + G%IdyCu(I,j)) + & - CS%DY2h(i,j) * CS%DY_dxT(i,j) * (G%IdyCu(I,j) + G%IdyCu(I-1,j)) ) + & - CS%IDX2dyCu(I,j)*(CS%DX2q(I,J) * CS%DX_dyBu(I,J) * (G%IdxCu(I,j+1) + G%IdxCu(I,j)) + & - CS%DX2q(I,J-1)*CS%DX_dyBu(I,J-1)*(G%IdxCu(I,j) + G%IdxCu(I,j-1)) ) - - u0v(I,j) = CS%IDXDY2u(I,j)*(CS%DY2h(i+1,j)*CS%DX_dyT(i+1,j)*(G%IdxCv(i+1,J) + G%IdxCv(i+1,J-1)) + & - CS%DY2h(i,j) * CS%DX_dyT(i,j) * (G%IdxCv(i,J) + G%IdxCv(i,J-1)) ) + & - CS%IDX2dyCu(I,j)*(CS%DX2q(I,J) * CS%DY_dxBu(I,J) * (G%IdyCv(i+1,J) + G%IdyCv(i,J)) + & - CS%DX2q(I,J-1)*CS%DY_dxBu(I,J-1)*(G%IdyCv(i+1,J-1) + G%IdyCv(i,J-1)) ) + u0u(I,j) = (CS%Idxdy2u(I,j)*(CS%dy2h(i+1,j)*CS%DY_dxT(i+1,j)*(G%IdyCu(I+1,j) + G%IdyCu(I,j)) + & + CS%dy2h(i,j) * CS%DY_dxT(i,j) * (G%IdyCu(I,j) + G%IdyCu(I-1,j)) ) + & + CS%Idx2dyCu(I,j)*(CS%dx2q(I,J) * CS%DX_dyBu(I,J) * (G%IdxCu(I,j+1) + G%IdxCu(I,j)) + & + CS%dx2q(I,J-1)*CS%DX_dyBu(I,J-1)*(G%IdxCu(I,j) + G%IdxCu(I,j-1)) ) ) + + u0v(I,j) = (CS%Idxdy2u(I,j)*(CS%dy2h(i+1,j)*CS%DX_dyT(i+1,j)*(G%IdxCv(i+1,J) + G%IdxCv(i+1,J-1)) + & + CS%dy2h(i,j) * CS%DX_dyT(i,j) * (G%IdxCv(i,J) + G%IdxCv(i,J-1)) ) + & + CS%Idx2dyCu(I,j)*(CS%dx2q(I,J) * CS%DY_dxBu(I,J) * (G%IdyCv(i+1,J) + G%IdyCv(i,J)) + & + CS%dx2q(I,J-1)*CS%DY_dxBu(I,J-1)*(G%IdyCv(i+1,J-1) + G%IdyCv(i,J-1)) ) ) enddo ; enddo do J=Jsq-1,Jeq+1 ; do i=is-1,Ieq+1 - v0u(i,J) = CS%IDXDY2v(i,J)*(CS%DY2q(I,J) * CS%DX_dyBu(I,J) * (G%IdxCu(I,j+1) + G%IdxCu(I,j)) + & - CS%DY2q(I-1,J)*CS%DX_dyBu(I-1,J)*(G%IdxCu(I-1,j+1) + G%IdxCu(I-1,j)) ) + & - CS%IDX2dyCv(i,J)*(CS%DX2h(i,j+1)*CS%DY_dxT(i,j+1)*(G%IdyCu(I,j+1) + G%IdyCu(I-1,j+1)) + & - CS%DX2h(i,j) * CS%DY_dxT(i,j) * (G%IdyCu(I,j) + G%IdyCu(I-1,j)) ) - - v0v(i,J) = CS%IDXDY2v(i,J)*(CS%DY2q(I,J) * CS%DY_dxBu(I,J) * (G%IdyCv(i+1,J) + G%IdyCv(i,J)) + & - CS%DY2q(I-1,J)*CS%DY_dxBu(I-1,J)*(G%IdyCv(i,J) + G%IdyCv(i-1,J)) ) + & - CS%IDX2dyCv(i,J)*(CS%DX2h(i,j+1)*CS%DX_dyT(i,j+1)*(G%IdxCv(i,J+1) + G%IdxCv(i,J)) + & - CS%DX2h(i,j) * CS%DX_dyT(i,j) * (G%IdxCv(i,J) + G%IdxCv(i,J-1)) ) + v0u(i,J) = (CS%Idxdy2v(i,J)*(CS%dy2q(I,J) * CS%DX_dyBu(I,J) * (G%IdxCu(I,j+1) + G%IdxCu(I,j)) + & + CS%dy2q(I-1,J)*CS%DX_dyBu(I-1,J)*(G%IdxCu(I-1,j+1) + G%IdxCu(I-1,j)) ) + & + CS%Idx2dyCv(i,J)*(CS%dx2h(i,j+1)*CS%DY_dxT(i,j+1)*(G%IdyCu(I,j+1) + G%IdyCu(I-1,j+1)) + & + CS%dx2h(i,j) * CS%DY_dxT(i,j) * (G%IdyCu(I,j) + G%IdyCu(I-1,j)) ) ) + + v0v(i,J) = (CS%Idxdy2v(i,J)*(CS%dy2q(I,J) * CS%DY_dxBu(I,J) * (G%IdyCv(i+1,J) + G%IdyCv(i,J)) + & + CS%dy2q(I-1,J)*CS%DY_dxBu(I-1,J)*(G%IdyCv(i,J) + G%IdyCv(i-1,J)) ) + & + CS%Idx2dyCv(i,J)*(CS%dx2h(i,j+1)*CS%DX_dyT(i,j+1)*(G%IdxCv(i,J+1) + G%IdxCv(i,J)) + & + CS%dx2h(i,j) * CS%DX_dyT(i,j) * (G%IdxCv(i,J) + G%IdxCv(i,J-1)) ) ) enddo ; enddo do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 denom = max( & - (CS%DY2h(i,j) * & + (CS%dy2h(i,j) * & (CS%DY_dxT(i,j)*(G%IdyCu(I,j)*u0u(I,j) + G%IdyCu(I-1,j)*u0u(I-1,j)) + & CS%DX_dyT(i,j)*(G%IdxCv(i,J)*v0u(i,J) + G%IdxCv(i,J-1)*v0u(i,J-1))) * & max(G%IdyCu(I,j)*G%IareaCu(I,j), G%IdyCu(I-1,j)*G%IareaCu(I-1,j)) ), & - (CS%DX2h(i,j) * & + (CS%dx2h(i,j) * & (CS%DY_dxT(i,j)*(G%IdyCu(I,j)*u0v(I,j) + G%IdyCu(I-1,j)*u0v(I-1,j)) + & CS%DX_dyT(i,j)*(G%IdxCv(i,J)*v0v(i,J) + G%IdxCv(i,J-1)*v0v(i,J-1))) * & max(G%IdxCv(i,J)*G%IareaCv(i,J), G%IdxCv(i,J-1)*G%IareaCv(i,J-1)) ) ) @@ -2085,11 +2130,11 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) do J=js-1,Jeq ; do I=is-1,Ieq denom = max( & - (CS%DX2q(I,J) * & + (CS%dx2q(I,J) * & (CS%DX_dyBu(I,J)*(u0u(I,j+1)*G%IdxCu(I,j+1) + u0u(I,j)*G%IdxCu(I,j)) + & CS%DY_dxBu(I,J)*(v0u(i+1,J)*G%IdyCv(i+1,J) + v0u(i,J)*G%IdyCv(i,J))) * & max(G%IdxCu(I,j)*G%IareaCu(I,j), G%IdxCu(I,j+1)*G%IareaCu(I,j+1)) ), & - (CS%DY2q(I,J) * & + (CS%dy2q(I,J) * & (CS%DX_dyBu(I,J)*(u0v(I,j+1)*G%IdxCu(I,j+1) + u0v(I,j)*G%IdxCu(I,j)) + & CS%DY_dxBu(I,J)*(v0v(i+1,J)*G%IdyCv(i+1,J) + v0v(i,J)*G%IdyCv(i,J))) * & max(G%IdyCv(i,J)*G%IareaCv(i,J), G%IdyCv(i+1,J)*G%IareaCv(i+1,J)) ) ) @@ -2097,73 +2142,80 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) if (denom > 0.0) & CS%Ah_Max_xy(I,J) = CS%bound_coef * 0.5 * Idt / denom enddo ; enddo + if (CS%debug) then + call hchksum(CS%Ah_Max_xx, "Ah_Max_xx", G%HI, haloshift=0, scale=US%L_to_m**4*US%s_to_T) + call Bchksum(CS%Ah_Max_xx, "Ah_Max_xy", G%HI, haloshift=0, scale=US%L_to_m**4*US%s_to_T) + endif endif ! Register fields for output from this module. CS%id_diffu = register_diag_field('ocean_model', 'diffu', diag%axesCuL, Time, & - 'Zonal Acceleration from Horizontal Viscosity', 'm s-2', conversion=US%s_to_T) + 'Zonal Acceleration from Horizontal Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_diffv = register_diag_field('ocean_model', 'diffv', diag%axesCvL, Time, & - 'Meridional Acceleration from Horizontal Viscosity', 'm s-2', conversion=US%s_to_T) + 'Meridional Acceleration from Horizontal Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%biharmonic) then CS%id_Ah_h = register_diag_field('ocean_model', 'Ahh', diag%axesTL, Time, & - 'Biharmonic Horizontal Viscosity at h Points', 'm4 s-1', conversion=US%s_to_T, & + 'Biharmonic Horizontal Viscosity at h Points', 'm4 s-1', conversion=US%L_to_m**4*US%s_to_T, & cmor_field_name='difmxybo', & cmor_long_name='Ocean lateral biharmonic viscosity', & cmor_standard_name='ocean_momentum_xy_biharmonic_diffusivity') CS%id_Ah_q = register_diag_field('ocean_model', 'Ahq', diag%axesBL, Time, & - 'Biharmonic Horizontal Viscosity at q Points', 'm4 s-1', conversion=US%s_to_T) + 'Biharmonic Horizontal Viscosity at q Points', 'm4 s-1', conversion=US%L_to_m**4*US%s_to_T) endif if (CS%Laplacian) then CS%id_Kh_h = register_diag_field('ocean_model', 'Khh', diag%axesTL, Time, & - 'Laplacian Horizontal Viscosity at h Points', 'm2 s-1', conversion=US%s_to_T, & + 'Laplacian Horizontal Viscosity at h Points', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T, & cmor_field_name='difmxylo', & cmor_long_name='Ocean lateral Laplacian viscosity', & cmor_standard_name='ocean_momentum_xy_laplacian_diffusivity') CS%id_Kh_q = register_diag_field('ocean_model', 'Khq', diag%axesBL, Time, & - 'Laplacian Horizontal Viscosity at q Points', 'm2 s-1', conversion=US%s_to_T) + 'Laplacian Horizontal Viscosity at q Points', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) if (CS%Leith_Kh) then CS%id_vort_xy_q = register_diag_field('ocean_model', 'vort_xy_q', diag%axesBL, Time, & - 'Vertical vorticity at q Points', 's-1') + 'Vertical vorticity at q Points', 's-1', conversion=US%s_to_T) CS%id_div_xx_h = register_diag_field('ocean_model', 'div_xx_h', diag%axesTL, Time, & - 'Horizontal divergence at h Points', 's-1') + 'Horizontal divergence at h Points', 's-1', conversion=US%s_to_T) endif endif if (CS%use_GME) then CS%id_GME_coeff_h = register_diag_field('ocean_model', 'GME_coeff_h', diag%axesTL, Time, & - 'GME coefficient at h Points', 'm2 s-1', conversion=US%s_to_T) + 'GME coefficient at h Points', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_GME_coeff_q = register_diag_field('ocean_model', 'GME_coeff_q', diag%axesBL, Time, & - 'GME coefficient at q Points', 'm2 s-1', conversion=US%s_to_T) + 'GME coefficient at q Points', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_FrictWork_GME = register_diag_field('ocean_model','FrictWork_GME',diag%axesTL,Time,& - 'Integral work done by lateral friction terms in GME (excluding diffusion of energy)', 'W m-2') + 'Integral work done by lateral friction terms in GME (excluding diffusion of energy)', & + 'W m-2', conversion=US%s_to_T**3*US%L_to_m**2) endif CS%id_FrictWork = register_diag_field('ocean_model','FrictWork',diag%axesTL,Time,& - 'Integral work done by lateral friction terms', 'W m-2') + 'Integral work done by lateral friction terms', 'W m-2', conversion=US%s_to_T**3*US%L_to_m**2) CS%id_FrictWork_diss = register_diag_field('ocean_model','FrictWork_diss',diag%axesTL,Time,& - 'Integral work done by lateral friction terms (excluding diffusion of energy)', 'W m-2') + 'Integral work done by lateral friction terms (excluding diffusion of energy)', & + 'W m-2', conversion=US%s_to_T**3*US%L_to_m**2) if (associated(MEKE)) then if (associated(MEKE%mom_src)) then CS%id_FrictWorkMax = register_diag_field('ocean_model', 'FrictWorkMax', diag%axesTL, Time,& - 'Maximum possible integral work done by lateral friction terms', 'W m-2') + 'Maximum possible integral work done by lateral friction terms', & + 'W m-2', conversion=US%s_to_T**3*US%L_to_m**2) endif endif CS%id_FrictWorkIntz = register_diag_field('ocean_model','FrictWorkIntz',diag%axesT1,Time, & - 'Depth integrated work done by lateral friction', 'W m-2', & + 'Depth integrated work done by lateral friction', 'W m-2', conversion=US%s_to_T**3*US%L_to_m**2, & cmor_field_name='dispkexyfo', & cmor_long_name='Depth integrated ocean kinetic energy dissipation due to lateral friction',& cmor_standard_name='ocean_kinetic_energy_dissipation_per_unit_area_due_to_xy_friction') diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index fb35d5b45c..9014cb1dbb 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -65,7 +65,7 @@ module MOM_internal_tides !! is possible (i.e. ridge cells) ! (could be in G control structure) real, allocatable, dimension(:,:,:,:) :: cp - !< horizontal phase speed [m s-1] + !< horizontal phase speed [L T-1 ~> m s-1] real, allocatable, dimension(:,:,:,:,:) :: TKE_leak_loss !< energy lost due to misc background processes [W m-2] real, allocatable, dimension(:,:,:,:,:) :: TKE_quad_loss @@ -74,7 +74,7 @@ module MOM_internal_tides !< energy lost due to wave breaking [W m-2] real, allocatable, dimension(:,:) :: TKE_itidal_loss_fixed !< fixed part of the energy lost due to small-scale drag - !! [kg Z-2 ~> kg m-2] here; will be multiplied by N and En to get into [W m-2] + !! [kg m L-2 Z-1 ~> kg m-2] here; will be multiplied by N and En to get into [W m-2] real, allocatable, dimension(:,:,:,:,:) :: TKE_itidal_loss !< energy lost due to small-scale wave drag [W m-2] real, allocatable, dimension(:,:) :: tot_leak_loss !< Energy loss rates due to misc bakground processes, @@ -106,7 +106,7 @@ module MOM_internal_tides !< The internal wave energy density as a function of (i,j,angle,frequency,mode) real, dimension(:,:,:), pointer :: En_restart => NULL() !< The internal wave energy density as a function of (i,j,angle); temporary for restart - real, allocatable, dimension(:) :: frequency !< The frequency of each band [s-1]. + real, allocatable, dimension(:) :: frequency !< The frequency of each band [T-1 ~> s-1]. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate the !! timing of diagnostic output. @@ -166,13 +166,15 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & type(int_tide_CS), pointer :: CS !< The control structure returned by a !! previous call to int_tide_init. real, dimension(SZI_(G),SZJ_(G),CS%nMode), & - intent(in) :: cn !< The internal wave speeds of each mode [m s-1]. + intent(in) :: cn !< The internal wave speeds of each + !! mode [L T-1 ~> m s-1]. ! Local variables real, dimension(SZI_(G),SZJ_(G),2) :: & test real, dimension(SZI_(G),SZJ_(G),CS%nFreq,CS%nMode) :: & tot_En_mode, & ! energy summed over angles only - Ub, Umax ! near-bottom & max horizontal velocity of wave (modal) + Ub, & ! near-bottom horizontal velocity of wave (modal) [m s-1] + Umax ! Maximum horizontal velocity of wave (modal) [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G)) :: & flux_heat_y, & flux_prec_y @@ -183,9 +185,12 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & drag_scale, & ! bottom drag scale, s-1 itidal_loss_mode, allprocesses_loss_mode ! energy loss rates for a given mode and frequency (summed over angles) - real :: frac_per_sector, f2, I_rho0, I_D_here, freq2, Kmag2 - real :: c_phase, loss_rate, Fr2_max - real, parameter :: cn_subRO = 1e-100 ! to prevent division by zero + real :: frac_per_sector, f2, I_rho0, I_D_here, Kmag2 + real :: freq2 ! The frequency squared [T-2 ~> s-2] + real :: c_phase ! The phase speed [m s-1] + real :: loss_rate, Fr2_max + real :: cn_subRO ! A tiny wave speed to prevent division by zero [L T-1 ~> m s-1] + real :: dt_in_T ! The timestep [T ~> s] real :: En_new, En_check ! for debugging real :: En_initial, Delta_E_check ! for debugging real :: TKE_Froude_loss_check, TKE_Froude_loss_tot ! for debugging @@ -198,6 +203,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nAngle = CS%NAngle I_rho0 = 1.0 / GV%Rho0 + dt_in_T = US%s_to_T*dt + cn_subRO = 1e-100*US%m_s_to_L_T ! The hard-coded value here might need to increase. ! Set the wave speeds for the modes, using cg(n) ~ cg(1)/n.********************** ! This is wrong, of course, but it works reasonably in some cases. @@ -210,8 +217,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & if (CS%energized_angle <= 0) then frac_per_sector = 1.0 / real(CS%nAngle * CS%nMode * CS%nFreq) do m=1,CS%nMode ; do fr=1,CS%nFreq ; do a=1,CS%nAngle ; do j=js,je ; do i=is,ie - f2 = 0.25*US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & - (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) + f2 = 0.25*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) if (CS%frequency(fr)**2 > f2) & CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) + & dt*frac_per_sector*(1-CS%q_itides)*TKE_itidal_input(i,j) @@ -220,8 +227,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & frac_per_sector = 1.0 / real(CS%nMode * CS%nFreq) a = CS%energized_angle do m=1,CS%nMode ; do fr=1,CS%nFreq ; do j=js,je ; do i=is,ie - f2 = 0.25*US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & - (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) + f2 = 0.25*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) if (CS%frequency(fr)**2 > f2) & CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) + & dt*frac_per_sector**(1-CS%q_itides)*TKE_itidal_input(i,j) @@ -241,7 +248,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Apply half the refraction. do m=1,CS%nMode ; do fr=1,CS%nFreq - call refract(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), 0.5*dt, G, US, CS%nAngle, CS%use_PPMang) + call refract(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), 0.5*dt_in_T, & + G, US, CS%nAngle, CS%use_PPMang) enddo ; enddo ! Check for En<0 - for debugging, delete later @@ -267,7 +275,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Propagate the waves. do m=1,CS%NMode ; do fr=1,CS%Nfreq - call propagate(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), dt, G, US, CS, CS%NAngle) + call propagate(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), dt_in_T, & + G, US, CS, CS%NAngle) enddo ; enddo ! Check for En<0 - for debugging, delete later @@ -288,7 +297,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Apply the other half of the refraction. do m=1,CS%NMode ; do fr=1,CS%Nfreq - call refract(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), 0.5*dt, G, US, CS%NAngle, CS%use_PPMang) + call refract(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), 0.5*dt_in_T, & + G, US, CS%NAngle, CS%use_PPMang) enddo ; enddo ! Check for En<0 - for debugging, delete later @@ -384,8 +394,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & do j=jsd,jed ; do i=isd,ied id_g = i + G%idg_offset ; jd_g = j + G%jdg_offset ! for debugging nzm = CS%wave_structure_CSp%num_intfaces(i,j) - Ub(i,j,fr,m) = CS%wave_structure_CSp%Uavg_profile(i,j,nzm) - Umax(i,j,fr,m) = maxval(CS%wave_structure_CSp%Uavg_profile(i,j,1:nzm)) + Ub(i,j,fr,m) = US%m_s_to_L_T * CS%wave_structure_CSp%Uavg_profile(i,j,nzm) + Umax(i,j,fr,m) = US%m_s_to_L_T * maxval(CS%wave_structure_CSp%Uavg_profile(i,j,1:nzm)) enddo ; enddo ! i-loop, j-loop enddo ; enddo ! fr-loop, m-loop endif ! apply_wave or _Froude_drag (Ub or Umax needed) @@ -417,14 +427,14 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & do j=jsd,jed ; do i=isd,ied id_g = i + G%idg_offset ; jd_g = j + G%jdg_offset ! for debugging ! Calculate horizontal phase velocity magnitudes - f2 = 0.25*US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & - (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) + f2 = 0.25*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) Kmag2 = (freq2 - f2) / (cn(i,j,m)**2 + cn_subRO**2) c_phase = 0.0 if (Kmag2 > 0.0) then c_phase = sqrt(freq2/Kmag2) nzm = CS%wave_structure_CSp%num_intfaces(i,j) - Fr2_max = (Umax(i,j,fr,m)/c_phase)**2 + Fr2_max = (Umax(i,j,fr,m) / c_phase)**2 ! Dissipate energy if Fr>1; done here with an arbitrary time scale if (Fr2_max > 1.0) then En_initial = sum(CS%En(i,j,:,fr,m)) ! for debugging @@ -626,9 +636,9 @@ subroutine itidal_lowmode_loss(G, US, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss, intent(in) :: Nb !< Near-bottom stratification [s-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%nFreq,CS%nMode), & intent(inout) :: Ub !< RMS (over one period) near-bottom horizontal - !! mode velocity [m s-1]. + !! mode velocity [L T-1 ~> m s-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(in) :: TKE_loss_fixed !< Fixed part of energy loss [kg Z-2 ~> kg m-2] + intent(in) :: TKE_loss_fixed !< Fixed part of energy loss [kg m L-2 Z-1 ~> kg m-2] !! (rho*kappa*h^2). real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%NAngle,CS%nFreq,CS%nMode), & intent(inout) :: En !< Energy density of the internal waves [J m-2]. @@ -666,7 +676,8 @@ subroutine itidal_lowmode_loss(G, US, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss, enddo ! Calculate TKE loss rate; units of [W m-2] here. - TKE_loss_tot = q_itides * US%Z_to_m**2 * TKE_loss_fixed(i,j) * Nb(i,j) * Ub(i,j,fr,m)**2 + TKE_loss_tot = q_itides * US%Z_to_m**3*US%s_to_T**3 * TKE_loss_fixed(i,j) * & + US%T_to_s*Nb(i,j) * Ub(i,j,fr,m)**2 ! Update energy remaining (this is a pseudo implicit calc) ! (E(t+1)-E(t))/dt = -TKE_loss(E(t+1)/E(t)), which goes to zero as E(t+1) goes to zero @@ -726,7 +737,7 @@ subroutine get_lowmode_loss(i,j,G,CS,mechanism,TKE_loss_sum) end subroutine get_lowmode_loss !> Implements refraction on the internal waves at a single frequency. -subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) +subroutine refract(En, cn, freq, dt_in_T, G, US, NAngle, use_PPMang) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. @@ -735,9 +746,9 @@ subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) !! function of space and angular resolution, !! [J m-2 radian-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(in) :: cn !< Baroclinic mode speed [m s-1]. - real, intent(in) :: freq !< Wave frequency [s-1]. - real, intent(in) :: dt !< Time step [s]. + intent(in) :: cn !< Baroclinic mode speed [L T-1 ~> m s-1]. + real, intent(in) :: freq !< Wave frequency [T-1 ~> s-1]. + real, intent(in) :: dt_in_T !< Time step [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type logical, intent(in) :: use_PPMang !< If true, use PPM for advection rather !! than upwind. @@ -753,15 +764,14 @@ subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) Flux_E real, dimension(SZI_(G),SZJ_(G),1-stencil:NAngle+stencil) :: & CFL_ang - real :: f2 ! The squared Coriolis parameter [s-2]. - real :: favg ! The average Coriolis parameter at a point [s-1]. - real :: df2_dy, df2_dx ! The x- and y- gradients of the squared Coriolis parameter [s-2 m-1]. - real :: df_dy, df_dx ! The x- and y- gradients of the Coriolis parameter [s-1 m-1]. + real :: f2 ! The squared Coriolis parameter [T-2 ~> s-2]. + real :: favg ! The average Coriolis parameter at a point [T-1 ~> s-1]. + real :: df_dy, df_dx ! The x- and y- gradients of the Coriolis parameter [T-1 L-1 ~> s-1 m-1]. real :: dlnCn_dx ! The x-gradient of the wave speed divided by itself [m-1]. real :: dlnCn_dy ! The y-gradient of the wave speed divided by itself [m-1]. real :: Angle_size, dt_Angle_size, angle real :: Ifreq, Kmag2, I_Kmag - real, parameter :: cn_subRO = 1e-100 + real :: cn_subRO ! A tiny wave speed to prevent division by zero [L T-1 ~> m s-1] integer :: is, ie, js, je, asd, aed, na integer :: i, j, a @@ -769,9 +779,9 @@ subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) asd = 1-stencil ; aed = NAngle+stencil Ifreq = 1.0 / freq - + cn_subRO = 1e-100*US%m_s_to_L_T ! The hard-coded value here might need to increase. Angle_size = (8.0*atan(1.0)) / (real(NAngle)) - dt_Angle_size = dt / Angle_size + dt_Angle_size = dt_in_T / Angle_size do A=asd,aed angle = (real(A) - 0.5) * Angle_size @@ -792,26 +802,18 @@ subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) ! Do the refraction. do i=is,ie - f2 = 0.25*US%s_to_T**2 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + f2 = 0.25* ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) - favg = 0.25*US%s_to_T*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J-1)) + & - (G%CoriolisBu(I,J-1) + G%CoriolisBu(I-1,J))) - df2_dx = 0.5*US%s_to_T**2 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I,J-1)**2) - & - (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I-1,J-1)**2)) * & - G%IdxT(i,j) - df_dx = 0.5*US%s_to_T*((G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1)) - & - (G%CoriolisBu(I-1,J) + G%CoriolisBu(I-1,J-1))) * & - G%IdxT(i,j) + favg = 0.25*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J-1)) + & + (G%CoriolisBu(I,J-1) + G%CoriolisBu(I-1,J))) + df_dx = 0.5*((G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1)) - & + (G%CoriolisBu(I-1,J) + G%CoriolisBu(I-1,J-1))) * G%IdxT(i,j) dlnCn_dx = 0.5*( G%IdxCu(I,j) * (cn(i+1,j) - cn(i,j)) / & (0.5*(cn(i+1,j) + cn(i,j)) + cn_subRO) + & G%IdxCu(I-1,j) * (cn(i,j) - cn(i-1,j)) / & (0.5*(cn(i,j) + cn(i-1,j)) + cn_subRO) ) - df2_dy = 0.5*US%s_to_T**2 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J)**2) - & - (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J-1)**2)) * & - G%IdyT(i,j) - df_dy = 0.5*US%s_to_T*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) - & - (G%CoriolisBu(I,J-1) + G%CoriolisBu(I-1,J-1))) * & - G%IdyT(i,j) + df_dy = 0.5*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) - & + (G%CoriolisBu(I,J-1) + G%CoriolisBu(I-1,J-1))) * G%IdyT(i,j) dlnCn_dy = 0.5*( G%IdyCv(i,J) * (cn(i,j+1) - cn(i,j)) / & (0.5*(cn(i,j+1) + cn(i,j)) + cn_subRO) + & G%IdyCv(i,J-1) * (cn(i,j) - cn(i,j-1)) / & @@ -829,8 +831,7 @@ subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) ! Determine the energy fluxes in angular orientation space. do A=asd,aed ; do i=is,ie - CFL_ang(i,j,A) = (cos_angle(A) * Dl_Dt_Kmag(i) - sin_angle(A) * Dk_Dt_Kmag(i)) * & - dt_Angle_size + CFL_ang(i,j,A) = (cos_angle(A) * Dl_Dt_Kmag(i) - sin_angle(A) * Dk_Dt_Kmag(i)) * dt_Angle_size if (abs(CFL_ang(i,j,A)) > 1.0) then call MOM_error(WARNING, "refract: CFL exceeds 1.", .true.) if (CFL_ang(i,j,A) > 0.0) then ; CFL_ang(i,j,A) = 1.0 ; else ; CFL_ang(i,j,A) = -1.0 ; endif @@ -850,7 +851,7 @@ subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) else ! Use PPM do i=is,ie - call PPM_angular_advect(En2d(i,:),CFL_ang(i,j,:),Flux_E(i,:),NAngle,dt,stencil) + call PPM_angular_advect(En2d(i,:),CFL_ang(i,j,:),Flux_E(i,:),NAngle,dt_in_T,stencil) enddo endif @@ -866,10 +867,10 @@ end subroutine refract !> This subroutine calculates the 1-d flux for advection in angular space using a monotonic !! piecewise parabolic scheme. This needs to be called from within i and j spatial loops. -subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt, halo_ang) +subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt_in_T, halo_ang) integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. integer, intent(in) :: halo_ang !< The halo size in angular space real, dimension(1-halo_ang:NAngle+halo_ang), & intent(in) :: En2d !< The internal gravity wave energy density as a @@ -887,7 +888,7 @@ subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt, halo_ang) integer :: a real :: aR, aL, dMx, dMn, Ep, Ec, Em, dA, mA, a6 - I_dt = 1 / dt + I_dt = 1 / dt_in_T Angle_size = (8.0*atan(1.0)) / (real(NAngle)) I_Angle_size = 1 / Angle_size Flux_En(:) = 0 @@ -916,7 +917,7 @@ subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt, halo_ang) flux = u_ang*( aR + 0.5 * CFL_ang(A) * ( ( aL - aR ) + a6 * ( 1. - 2./3. * CFL_ang(A) ) ) ) !flux = u_ang*( aR - 0.5 * CFL_ang(A) * ( ( aR - aL ) - a6 * ( 1. - 2./3. * CFL_ang(A) ) ) ) ! CALCULATE AMOUNT FLUXED (Jm-2) - Flux_En(A) = dt * flux + Flux_En(A) = dt_in_T * flux !Flux_En(A) = (dt * I_Angle_size) * flux else ! Implementation of PPM-H3 @@ -940,14 +941,14 @@ subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt, halo_ang) flux = u_ang*( aR + 0.5 * CFL_ang(A) * ( ( aL - aR ) + a6 * ( 1. - 2./3. * CFL_ang(A) ) ) ) !flux = u_ang*( aL + 0.5 * CFL_ang(A) * ( ( aR - aL ) + a6 * ( 1. - 2./3. * CFL_ang(A) ) ) ) ! CALCULATE AMOUNT FLUXED (Jm-2) - Flux_En(A) = dt * flux + Flux_En(A) = dt_in_T * flux !Flux_En(A) = (dt * I_Angle_size) * flux endif enddo end subroutine PPM_angular_advect !> Propagates internal waves at a single frequency. -subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle) +subroutine propagate(En, cn, freq, dt_in_T, G, US, CS, NAngle) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. @@ -956,28 +957,28 @@ subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle) !! function of space and angular resolution, !! [J m-2 radian-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(in) :: cn !< Baroclinic mode speed [m s-1]. - real, intent(in) :: freq !< Wave frequency [s-1]. - real, intent(in) :: dt !< Time step [s]. + intent(in) :: cn !< Baroclinic mode speed [L T-1 ~> m s-1]. + real, intent(in) :: freq !< Wave frequency [T-1 ~> s-1]. + real, intent(in) :: dt_in_T !< Time step [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(int_tide_CS), pointer :: CS !< The control structure returned by a !! previous call to int_tide_init. ! Local variables real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB) :: & - speed ! The magnitude of the group velocity at the q points for corner adv [m s-1]. + speed ! The magnitude of the group velocity at the q points for corner adv [L T-1 ~> m s-1]. integer, parameter :: stencil = 2 real, dimension(SZIB_(G),SZJ_(G)) :: & - speed_x ! The magnitude of the group velocity at the Cu points [m s-1]. + speed_x ! The magnitude of the group velocity at the Cu points [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G)) :: & - speed_y ! The magnitude of the group velocity at the Cv points [m s-1]. + speed_y ! The magnitude of the group velocity at the Cv points [L T-1 ~> m s-1]. real, dimension(0:NAngle) :: & cos_angle, sin_angle real, dimension(NAngle) :: & Cgx_av, Cgy_av, dCgx, dCgy real :: f2 ! The squared Coriolis parameter [s-2]. real :: Angle_size, I_Angle_size, angle - real :: Ifreq, freq2 - real, parameter :: cn_subRO = 1e-100 + real :: Ifreq ! The inverse of the frequency [T ~> s] + real :: freq2 ! The frequency squared [T-2 ~> s-2] type(loop_bounds_type) :: LB integer :: is, ie, js, je, asd, aed, na integer :: ish, ieh, jsh, jeh @@ -1010,14 +1011,14 @@ subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle) ! Fix indexing here later speed(:,:) = 0 do J=jsh-1,jeh ; do I=ish-1,ieh - f2 = US%s_to_T**2 * G%CoriolisBu(I,J)**2 + f2 = G%CoriolisBu(I,J)**2 speed(I,J) = 0.25*(cn(i,j) + cn(i+1,j) + cn(i+1,j+1) + cn(i,j+1)) * & sqrt(max(freq2 - f2, 0.0)) * Ifreq enddo ; enddo do a=1,na ! Apply the propagation WITH CORNER ADVECTION/FINITE VOLUME APPROACH. LB%jsh = js ; LB%jeh = je ; LB%ish = is ; LB%ieh = ie - call propagate_corner_spread(En(:,:,a), a, NAngle, speed, dt, G, CS, LB) + call propagate_corner_spread(En(:,:,a), a, NAngle, speed, dt_in_T, G, CS, LB) enddo ! a-loop else ! IMPLEMENT PPM ADVECTION IN HORIZONTAL----------------------- @@ -1040,19 +1041,19 @@ subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle) enddo do j=jsh,jeh ; do I=ish-1,ieh - f2 = 0.5*US%s_to_T**2 * (G%CoriolisBu(I,J)**2 + G%CoriolisBu(I,J-1)**2) + f2 = 0.5 * (G%CoriolisBu(I,J)**2 + G%CoriolisBu(I,J-1)**2) speed_x(I,j) = 0.5*(cn(i,j) + cn(i+1,j)) * G%mask2dCu(I,j) * & sqrt(max(freq2 - f2, 0.0)) * Ifreq enddo ; enddo do J=jsh-1,jeh ; do i=ish,ieh - f2 = 0.5*US%s_to_T**2 * (G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J)**2) + f2 = 0.5 * (G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J)**2) speed_y(i,J) = 0.5*(cn(i,j) + cn(i,j+1)) * G%mask2dCv(i,J) * & sqrt(max(freq2 - f2, 0.0)) * Ifreq enddo ; enddo ! Apply propagation in x-direction (reflection included) LB%jsh = jsh ; LB%jeh = jeh ; LB%ish = ish ; LB%ieh = ieh - call propagate_x(En(:,:,:), speed_x, Cgx_av(:), dCgx(:), dt, G, CS%nAngle, CS, LB) + call propagate_x(En(:,:,:), speed_x, Cgx_av(:), dCgx(:), dt_in_T, G, US, CS%nAngle, CS, LB) ! Check for energy conservation on computational domain (for debugging) !call sum_En(G,CS,En(:,:,:),'post-propagate_x') @@ -1063,29 +1064,29 @@ subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle) ! Apply propagation in y-direction (reflection included) ! LB%jsh = js ; LB%jeh = je ; LB%ish = is ; LB%ieh = ie ! Use if no teleport LB%jsh = jsh ; LB%jeh = jeh ; LB%ish = ish ; LB%ieh = ieh - call propagate_y(En(:,:,:), speed_y, Cgy_av(:), dCgy(:), dt, G, CS%nAngle, CS, LB) + call propagate_y(En(:,:,:), speed_y, Cgy_av(:), dCgy(:), dt_in_T, G, US, CS%nAngle, CS, LB) ! Check for energy conservation on computational domain (for debugging) !call sum_En(G,CS,En(:,:,:),'post-propagate_y') - endif + end subroutine propagate !> This subroutine does first-order corner advection. It was written with the hopes !! of smoothing out the garden sprinkler effect, but is too numerically diffusive to !! be of much use as of yet. It is not yet compatible with reflection schemes (BDM). -subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS, LB) +subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt_in_T, G, CS, LB) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. real, dimension(G%isd:G%ied,G%jsd:G%jed), & intent(inout) :: En !< The energy density integrated over an angular !! band [W m-2], intent in/out. real, dimension(G%IsdB:G%IedB,G%Jsd:G%Jed), & intent(in) :: speed !< The magnitude of the group velocity at the cell - !! corner points [m s-1]. + !! corner points [L T-1 ~> m s-1]. integer, intent(in) :: energized_wedge !< Index of current ray direction. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. type(int_tide_CS), pointer :: CS !< The control structure returned by a previous !! call to continuity_PPM_init. type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. @@ -1123,12 +1124,16 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS energized_angle = Angle_size * real(energized_wedge - 1) ! for a=1 aligned with x-axis !energized_angle = Angle_size * real(energized_wedge - 1) + 2.0*Angle_size ! !energized_angle = Angle_size * real(energized_wedge - 1) + 0.5*Angle_size ! - x = G%geoLonBu - y = G%geoLatBu - Idx = G%IdxBu; dx = G%dxBu - Idy = G%IdyBu; dy = G%dyBu + do J=jsh-1,jeh ; do I=ish-1,ieh + ! This will only work for a Cartesian grid for which G%geoLonBu is in the same units has dx. + ! This needs to be extensively revised to work for a general grid. + x(I,J) = G%US%m_to_L*G%geoLonBu(I,J) + y(I,J) = G%US%m_to_L*G%geoLatBu(I,J) + Idx(I,J) = G%IdxBu(I,J) ; dx(I,J) = G%dxBu(I,J) + Idy(I,J) = G%IdyBu(I,J) ; dy(I,J) = G%dyBu(I,J) + enddo ; enddo - do j=jsh,jeh; do i=ish,ieh + do j=jsh,jeh ; do i=ish,ieh do m=1,int(Nsubrays) theta = energized_angle - 0.5*Angle_size + real(m - 1)*Angle_size*I_Nsubwedges if (theta < 0.0) then @@ -1136,8 +1141,8 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS elseif (theta > TwoPi) then theta = theta - TwoPi endif - cos_thetaDT = cos(theta)*dt - sin_thetaDT = sin(theta)*dt + cos_thetaDT = cos(theta)*dt_in_T + sin_thetaDT = sin(theta)*dt_in_T ! corner point coordinates of advected fluid parcel ---------- xg = x(I,J); yg = y(I,J) @@ -1335,7 +1340,7 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS end subroutine propagate_corner_spread !> Propagates the internal wave energy in the logical x-direction. -subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, Nangle, CS, LB) +subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt_in_T, G, US, Nangle, CS, LB) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. @@ -1344,11 +1349,12 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, Nangle, CS, LB) !! band [J m-2], intent in/out. real, dimension(G%IsdB:G%IedB,G%jsd:G%jed), & intent(in) :: speed_x !< The magnitude of the group velocity at the - !! Cu points [m s-1]. + !! Cu points [L T-1 ~> m s-1]. real, dimension(Nangle), intent(in) :: Cgx_av !< The average x-projection in each angular band. real, dimension(Nangle), intent(in) :: dCgx !< The difference in x-projections between the !! edges of each angular band. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(int_tide_CS), pointer :: CS !< The control structure returned by a previous call !! to continuity_PPM_init. type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. @@ -1381,25 +1387,19 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, Nangle, CS, LB) cg_p(I) = speed_x(I,j) * (Cgx_av(a)) enddo call zonal_flux_En(cg_p, En(:,j,a), EnL(:,j), EnR(:,j), flux1, & - dt, G, j, ish, ieh, CS%vol_CFL) + dt_in_T, G, US, j, ish, ieh, CS%vol_CFL) do I=ish-1,ieh ; flux_x(I,j) = flux1(I); enddo enddo do j=jsh,jeh ; do i=ish,ieh - Fdt_m(i,j,a) = dt*flux_x(I-1,j) ! left face influx (J) - Fdt_p(i,j,a) = -dt*flux_x(I,j) ! right face influx (J) + Fdt_m(i,j,a) = dt_in_T*flux_x(I-1,j) ! left face influx (J) + Fdt_p(i,j,a) = -dt_in_T*flux_x(I,j) ! right face influx (J) enddo ; enddo - ! test with old (take out later) - !do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - ! En(i,j,a) = En(i,j,a) - dt* G%IareaT(i,j) * (flux_x(I,j) - flux_x(I-1,j)) - !enddo ; enddo - enddo ! a-loop - ! Only reflect newly arrived energy; existing energy in incident wedge - ! is not reflected and will eventually propagate out of cell. - ! (only reflects if En > 0) + ! Only reflect newly arrived energy; existing energy in incident wedge is not reflected + ! and will eventually propagate out of cell. (Thid code only reflects if En > 0) call reflect(Fdt_m(:,:,:), Nangle, CS, G, LB) call teleport(Fdt_m(:,:,:), Nangle, CS, G, LB) call reflect(Fdt_p(:,:,:), Nangle, CS, G, LB) @@ -1407,18 +1407,15 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, Nangle, CS, LB) ! Update reflected energy (Jm-2) do j=jsh,jeh ; do i=ish,ieh - !do a=1,CS%nAngle - ! if ((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0) then ! for debugging + ! if ((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0) & ! for debugging ! call MOM_error(FATAL, "propagate_x: OutFlux>Available") - ! endif - !enddo En(i,j,:) = En(i,j,:) + G%IareaT(i,j)*(Fdt_m(i,j,:) + Fdt_p(i,j,:)) enddo ; enddo end subroutine propagate_x !> Propagates the internal wave energy in the logical y-direction. -subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, Nangle, CS, LB) +subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt_in_T, G, US, Nangle, CS, LB) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. @@ -1427,11 +1424,12 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, Nangle, CS, LB) !! band [J m-2], intent in/out. real, dimension(G%isd:G%ied,G%JsdB:G%JedB), & intent(in) :: speed_y !< The magnitude of the group velocity at the - !! Cv points [m s-1]. + !! Cv points [L T-1 ~> m s-1]. real, dimension(Nangle), intent(in) :: Cgy_av !< The average y-projection in each angular band. real, dimension(Nangle), intent(in) :: dCgy !< The difference in y-projections between the !! edges of each angular band. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(int_tide_CS), pointer :: CS !< The control structure returned by a previous call !! to continuity_PPM_init. type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. @@ -1465,14 +1463,14 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, Nangle, CS, LB) cg_p(i) = speed_y(i,J) * (Cgy_av(a)) enddo call merid_flux_En(cg_p, En(:,:,a), EnL(:,:), EnR(:,:), flux1, & - dt, G, J, ish, ieh, CS%vol_CFL) + dt_in_T, G, US, J, ish, ieh, CS%vol_CFL) do i=ish,ieh ; flux_y(i,J) = flux1(i); enddo enddo do j=jsh,jeh ; do i=ish,ieh - Fdt_m(i,j,a) = dt*flux_y(i,J-1) ! south face influx (J) - Fdt_p(i,j,a) = -dt*flux_y(i,J) ! north face influx (J) - !if ((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0)then ! for debugging + Fdt_m(i,j,a) = dt_in_T*flux_y(i,J-1) ! south face influx (J) + Fdt_p(i,j,a) = -dt_in_T*flux_y(i,J) ! north face influx (J) + !if ((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0) then ! for debugging ! call MOM_error(WARNING, "propagate_y: OutFlux>Available prior to reflection", .true.) ! write(mesg,*) "flux_y_south=",flux_y(i,J-1),"flux_y_north=",flux_y(i,J),"En=",En(i,j,a), & ! "cn_south=", speed_y(i,J-1) * (Cgy_av(a)), "cn_north=", speed_y(i,J) * (Cgy_av(a)) @@ -1480,45 +1478,37 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, Nangle, CS, LB) !endif enddo ; enddo - ! test with old (take out later) - !do j=jsh,jeh ; do i=ish,ieh - ! En(i,j,a) = En(i,j,a) - dt* G%IareaT(i,j) * (flux_y(i,J) - flux_y(i,J-1)) - !enddo ; enddo - enddo ! a-loop - ! Only reflect newly arrived energy; existing energy in incident wedge - ! is not reflected and will eventually propagate out of cell. - ! (only reflects if En > 0) + ! Only reflect newly arrived energy; existing energy in incident wedge is not reflected + ! and will eventually propagate out of cell. (Thid code only reflects if En > 0) call reflect(Fdt_m(:,:,:), Nangle, CS, G, LB) call teleport(Fdt_m(:,:,:), Nangle, CS, G, LB) call reflect(Fdt_p(:,:,:), Nangle, CS, G, LB) call teleport(Fdt_p(:,:,:), Nangle, CS, G, LB) ! Update reflected energy (Jm-2) - do j=jsh,jeh ; do i=ish,ieh - !do a=1,CS%nAngle - ! if ((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0)then ! for debugging + do a=1,Nangle ; do j=jsh,jeh ; do i=ish,ieh + ! if ((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0) & ! for debugging ! call MOM_error(FATAL, "propagate_y: OutFlux>Available", .true.) - ! endif - !enddo - En(i,j,:) = En(i,j,:) + G%IareaT(i,j)*(Fdt_m(i,j,:) + Fdt_p(i,j,:)) - enddo ; enddo + En(i,j,a) = En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a)) + enddo ; enddo ; enddo end subroutine propagate_y !> Evaluates the zonal mass or volume fluxes in a layer. -subroutine zonal_flux_En(u, h, hL, hR, uh, dt, G, j, ish, ieh, vol_CFL) +subroutine zonal_flux_En(u, h, hL, hR, uh, dt, G, US, j, ish, ieh, vol_CFL) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - real, dimension(SZIB_(G)), intent(in) :: u !< The zonal velocity [m s-1]. + real, dimension(SZIB_(G)), intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G)), intent(in) :: h !< Energy density used to calculate the fluxes !! [J m-2]. real, dimension(SZI_(G)), intent(in) :: hL !< Left- Energy densities in the reconstruction !! [J m-2]. real, dimension(SZI_(G)), intent(in) :: hR !< Right- Energy densities in the reconstruction !! [J m-2]. - real, dimension(SZIB_(G)), intent(inout) :: uh !< The zonal energy transport [J s-1]. - real, intent(in) :: dt !< Time increment [s]. + real, dimension(SZIB_(G)), intent(inout) :: uh !< The zonal energy transport [L2 T-1 J m-2 ~> J s-1]. + real, intent(in) :: dt !< Time increment [T ~> s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: j !< The j-index to work on. integer, intent(in) :: ish !< The start i-index range to work on. integer, intent(in) :: ieh !< The end i-index range to work on. @@ -1551,17 +1541,18 @@ subroutine zonal_flux_En(u, h, hL, hR, uh, dt, G, j, ish, ieh, vol_CFL) end subroutine zonal_flux_En !> Evaluates the meridional mass or volume fluxes in a layer. -subroutine merid_flux_En(v, h, hL, hR, vh, dt, G, J, ish, ieh, vol_CFL) +subroutine merid_flux_En(v, h, hL, hR, vh, dt, G, US, J, ish, ieh, vol_CFL) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - real, dimension(SZI_(G)), intent(in) :: v !< The meridional velocity [m s-1]. + real, dimension(SZI_(G)), intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h !< Energy density used to calculate the !! fluxes [J m-2]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: hL !< Left- Energy densities in the !! reconstruction [J m-2]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: hR !< Right- Energy densities in the !! reconstruction [J m-2]. - real, dimension(SZI_(G)), intent(inout) :: vh !< The meridional energy transport [J s-1]. - real, intent(in) :: dt !< Time increment [s]. + real, dimension(SZI_(G)), intent(inout) :: vh !< The meridional energy transport [L2 T-1 J m-2 ~> J s-1]. + real, intent(in) :: dt !< Time increment [T ~> s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: J !< The j-index to work on. integer, intent(in) :: ish !< The start i-index range to work on. integer, intent(in) :: ieh !< The end i-index range to work on. @@ -2122,7 +2113,8 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) ! array for temporary storage of flags ! of cells with double-reflecting ridges logical :: use_int_tides, use_temperature - integer :: num_angle, num_freq, num_mode, m, fr, period_1 + real :: period_1 ! The period of the gravest modeled mode [T ~> s] + integer :: num_angle, num_freq, num_mode, m, fr integer :: isd, ied, jsd, jed, a, id_ang, i, j type(axes_grp) :: axes_ang ! This include declares and sets the variable "version". @@ -2176,7 +2168,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) ! Allocate and populate frequency array (each a multiple of first for now) allocate(CS%frequency(num_freq)) - call read_param(param_file, "FIRST_MODE_PERIOD", period_1); ! ADDED BDM + call get_param(param_file, mdl, "FIRST_MODE_PERIOD", period_1, units="s", scale=US%s_to_T) do fr=1,num_freq CS%frequency(fr) = (8.0*atan(1.0) * (real(fr)) / period_1) ! ADDED BDM enddo @@ -2280,7 +2272,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "KAPPA_ITIDES", kappa_itides, & "A topographic wavenumber used with INT_TIDE_DISSIPATION. "//& "The default is 2pi/10 km, as in St.Laurent et al. 2002.", & - units="m-1", default=8.e-4*atan(1.0)) + units="m-1", default=8.e-4*atan(1.0), scale=US%L_to_m) call get_param(param_file, mdl, "KAPPA_H2_FACTOR", kappa_h2_factor, & "A scaling factor for the roughness amplitude with n"//& "INT_TIDE_DISSIPATION.", units="nondim", default=1.0) @@ -2315,8 +2307,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) h2(i,j) = min(0.01*(G%bathyT(i,j))**2, h2(i,j)) ! Compute the fixed part; units are [kg m-2] here ! will be multiplied by N and En to get into [W m-2] - CS%TKE_itidal_loss_fixed(i,j) = 0.5*kappa_h2_factor*GV%Rho0*& - kappa_itides * h2(i,j) + CS%TKE_itidal_loss_fixed(i,j) = 0.5*kappa_h2_factor*GV%Rho0 * US%L_to_Z*kappa_itides * h2(i,j) enddo ; enddo deallocate(h2) @@ -2387,8 +2378,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) !call MOM_read_data(filename, 'land_mask', G%mask2dCu, G%domain, timelevel=1) !call MOM_read_data(filename, 'land_mask', G%mask2dCv, G%domain, timelevel=1) !call MOM_read_data(filename, 'land_mask', G%mask2dT, G%domain, timelevel=1) - !call pass_var(G%mask2dCu,G%domain) - !call pass_var(G%mask2dCv,G%domain) + !call pass_vector(G%mask2dCu, G%mask2dCv, G%domain, To_All+Scalar_Pair, CGRID_NE) !call pass_var(G%mask2dT,G%domain) ! Read in prescribed partial east face blockages from file (if overwriting -BDM) @@ -2398,8 +2388,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) !filename = trim(CS%inputdir) // trim(dy_Cu_file) !call log_param(param_file, mdl, "INPUTDIR/dy_Cu_FILE", filename) !G%dy_Cu(:,:) = 0.0 - !call MOM_read_data(filename, 'dy_Cu', G%dy_Cu, G%domain, timelevel=1) - !call pass_var(G%dy_Cu,G%domain) + !call MOM_read_data(filename, 'dy_Cu', G%dy_Cu, G%domain, timelevel=1, scale=US%m_to_L) ! Read in prescribed partial north face blockages from file (if overwriting -BDM) !call get_param(param_file, mdl, "dx_Cv_FILE", dx_Cv_file, & @@ -2408,8 +2397,8 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) !filename = trim(CS%inputdir) // trim(dx_Cv_file) !call log_param(param_file, mdl, "INPUTDIR/dx_Cv_FILE", filename) !G%dx_Cv(:,:) = 0.0 - !call MOM_read_data(filename, 'dx_Cv', G%dx_Cv, G%domain, timelevel=1) - !call pass_var(G%dx_Cv,G%domain) + !call MOM_read_data(filename, 'dx_Cv', G%dx_Cv, G%domain, timelevel=1, scale=US%m_to_L) + !call pass_vector(G%dy_Cu, G%dx_Cv, G%domain, To_All+Scalar_Pair, CGRID_NE) ! Register maps of reflection parameters CS%id_refl_ang = register_diag_field('ocean_model', 'refl_angle', diag%axesT1, & @@ -2417,9 +2406,9 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) CS%id_refl_pref = register_diag_field('ocean_model', 'refl_pref', diag%axesT1, & Time, 'Partial reflection coefficients', '') CS%id_dx_Cv = register_diag_field('ocean_model', 'dx_Cv', diag%axesT1, & - Time, 'North face unblocked width', 'm') ! used if overriding (BDM) + Time, 'North face unblocked width', 'm', conversion=US%L_to_m) CS%id_dy_Cu = register_diag_field('ocean_model', 'dy_Cu', diag%axesT1, & - Time, 'East face unblocked width', 'm') ! used if overriding (BDM) + Time, 'East face unblocked width', 'm', conversion=US%L_to_m) CS%id_land_mask = register_diag_field('ocean_model', 'land_mask', diag%axesT1, & Time, 'Land mask', 'logical') ! used if overriding (BDM) ! Output reflection parameters as diags here (not needed every timestep) @@ -2508,14 +2497,14 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) write(var_name, '("Itide_Ub_freq",i1,"_mode",i1)') fr, m write(var_descript, '("Near-bottom horizonal velocity for frequency ",i1," mode ",i1)') fr, m CS%id_Ub_mode(fr,m) = register_diag_field('ocean_model', var_name, & - diag%axesT1, Time, var_descript, 'm s-1') + diag%axesT1, Time, var_descript, 'm s-1', conversion=US%L_T_to_m_s) call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5) ! Register 2-D horizonal phase velocity for each freq and mode write(var_name, '("Itide_cp_freq",i1,"_mode",i1)') fr, m write(var_descript, '("Horizonal phase velocity for frequency ",i1," mode ",i1)') fr, m CS%id_cp_mode(fr,m) = register_diag_field('ocean_model', var_name, & - diag%axesT1, Time, var_descript, 'm s-1') + diag%axesT1, Time, var_descript, 'm s-1', conversion=US%L_T_to_m_s) call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5) enddo ; enddo diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 70b80b38cb..1582b23615 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -51,11 +51,11 @@ module MOM_lateral_mixing_coeffs logical :: calculate_Eady_growth_rate !< If true, calculate all the Eady growth rate. !! This parameter is set depending on other parameters. real, dimension(:,:), pointer :: & - SN_u => NULL(), & !< S*N at u-points [s-1] - SN_v => NULL(), & !< S*N at v-points [s-1] - L2u => NULL(), & !< Length scale^2 at u-points [m2] - L2v => NULL(), & !< Length scale^2 at v-points [m2] - cg1 => NULL(), & !< The first baroclinic gravity wave speed [m s-1]. + SN_u => NULL(), & !< S*N at u-points [T-1 ~> s-1] + SN_v => NULL(), & !< S*N at v-points [T-1 ~> s-1] + L2u => NULL(), & !< Length scale^2 at u-points [L2 ~> m2] + L2v => NULL(), & !< Length scale^2 at v-points [L2 ~> m2] + cg1 => NULL(), & !< The first baroclinic gravity wave speed [L T-1 ~> m s-1]. Res_fn_h => NULL(), & !< Non-dimensional function of the ratio the first baroclinic !! deformation radius to the grid spacing at h points [nondim]. Res_fn_q => NULL(), & !< Non-dimensional function of the ratio the first baroclinic @@ -65,40 +65,41 @@ module MOM_lateral_mixing_coeffs Res_fn_v => NULL(), & !< Non-dimensional function of the ratio the first baroclinic !! deformation radius to the grid spacing at v points [nondim]. beta_dx2_h => NULL(), & !< The magnitude of the gradient of the Coriolis parameter - !! times the grid spacing squared at h points [m T-1 ~> m s-1]. + !! times the grid spacing squared at h points [L T-1 ~> m s-1]. beta_dx2_q => NULL(), & !< The magnitude of the gradient of the Coriolis parameter - !! times the grid spacing squared at q points [m T-1 ~> m s-1]. + !! times the grid spacing squared at q points [L T-1 ~> m s-1]. beta_dx2_u => NULL(), & !< The magnitude of the gradient of the Coriolis parameter - !! times the grid spacing squared at u points [m T-1 ~> m s-1]. + !! times the grid spacing squared at u points [L T-1 ~> m s-1]. beta_dx2_v => NULL(), & !< The magnitude of the gradient of the Coriolis parameter - !! times the grid spacing squared at v points [m T-1 ~> m s-1]. + !! times the grid spacing squared at v points [L T-1 ~> m s-1]. f2_dx2_h => NULL(), & !< The Coriolis parameter squared times the grid - !! spacing squared at h [m2 T-2 ~> m2 s-2]. + !! spacing squared at h [L2 T-2 ~> m2 s-2]. f2_dx2_q => NULL(), & !< The Coriolis parameter squared times the grid - !! spacing squared at q [m2 T-2 ~> m2 s-2]. + !! spacing squared at q [L2 T-2 ~> m2 s-2]. f2_dx2_u => NULL(), & !< The Coriolis parameter squared times the grid - !! spacing squared at u [m2 T-2 ~> m2 s-2]. + !! spacing squared at u [L2 T-2 ~> m2 s-2]. f2_dx2_v => NULL(), & !< The Coriolis parameter squared times the grid - !! spacing squared at v [m2 T-2 ~> m2 s-2]. + !! spacing squared at v [L2 T-2 ~> m2 s-2]. Rd_dx_h => NULL() !< Deformation radius over grid spacing [nondim] real, dimension(:,:,:), pointer :: & slope_x => NULL(), & !< Zonal isopycnal slope [nondim] slope_y => NULL(), & !< Meridional isopycnal slope [nondim] + !### These are posted as diagnostics but are never set. N2_u => NULL(), & !< Brunt-Vaisala frequency at u-points [s-2] N2_v => NULL(), & !< Brunt-Vaisala frequency at v-points [s-2] ebt_struct => NULL() !< Vertical structure function to scale diffusivities with [nondim] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: & - Laplac3_const_u !< Laplacian metric-dependent constants [nondim] + Laplac3_const_u !< Laplacian metric-dependent constants [L3 ~> m3] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: & - Laplac3_const_v !< Laplacian metric-dependent constants [nondim] + Laplac3_const_v !< Laplacian metric-dependent constants [L3 ~> m3] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & - KH_u_QG !< QG Leith GM coefficient at u-points [m2 s-1] + KH_u_QG !< QG Leith GM coefficient at u-points [L2 T-1 ~> m2 s-1] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & - KH_v_QG !< QG Leith GM coefficient at v-points [m2 s-1] + KH_v_QG !< QG Leith GM coefficient at v-points [L2 T-1 ~> m2 s-1] ! Parameters logical :: use_Visbeck !< Use Visbeck formulation for thickness diffusivity @@ -110,7 +111,7 @@ module MOM_lateral_mixing_coeffs real :: Res_coef_visc !< A non-dimensional number that determines the function !! of resolution, used for lateral viscosity, as: !! F = 1 / (1 + (Res_coef_visc*Ld/dx)^Res_fn_power) - real :: kappa_smooth !< A diffusivity for smoothing T/S in vanished layers [m2 s-1] + real :: kappa_smooth !< A diffusivity for smoothing T/S in vanished layers [Z2 T-1 ~> m2 s-1] integer :: Res_fn_power_khth !< The power of dx/Ld in the KhTh resolution function. Any !! positive integer power may be used, but even powers !! and especially 2 are coded to be more efficient. @@ -155,10 +156,10 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) ! Local variables ! Depending on the power-function being used, dimensional rescaling may be limited, so some ! of the following variables have units that depend on that power. - real :: cg1_q ! The gravity wave speed interpolated to q points [m T-1 ~> m s-1] or [m s-1]. - real :: cg1_u ! The gravity wave speed interpolated to u points [m T-1 ~> m s-1] or [m s-1]. - real :: cg1_v ! The gravity wave speed interpolated to v points [m T-1 ~> m s-1] or [m s-1]. - real :: dx_term ! A term in the denominator [m2 T-2 ~> m2 s-2] or [m2 s-2] + real :: cg1_q ! The gravity wave speed interpolated to q points [L T-1 ~> m s-1] or [m s-1]. + real :: cg1_u ! The gravity wave speed interpolated to u points [L T-1 ~> m s-1] or [m s-1]. + real :: cg1_v ! The gravity wave speed interpolated to v points [L T-1 ~> m s-1] or [m s-1]. + real :: dx_term ! A term in the denominator [L2 T-2 ~> m2 s-2] or [m2 s-2] integer :: power_2 integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz integer :: i, j, k @@ -187,6 +188,10 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp) endif + do j=js,je ; do i=is,ie + CS%cg1(i,j) = US%m_s_to_L_T*CS%cg1(i,j) + enddo ; enddo + call create_group_pass(CS%pass_cg1, CS%cg1, G%Domain) call do_group_pass(CS%pass_cg1, G%Domain) endif @@ -196,13 +201,11 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) if (CS%calculate_rd_dx) then if (.not. associated(CS%Rd_dx_h)) call MOM_error(FATAL, & "calc_resoln_function: %Rd_dx_h is not associated with calculate_rd_dx.") -!$OMP parallel default(none) shared(is,ie,js,je,CS) -!$OMP do + !$OMP parallel do default(shared) do j=js-1,je+1 ; do i=is-1,ie+1 - CS%Rd_dx_h(i,j) = US%T_to_s*CS%cg1(i,j) / & - (sqrt(CS%f2_dx2_h(i,j) + US%T_to_s*CS%cg1(i,j)*CS%beta_dx2_h(i,j))) + CS%Rd_dx_h(i,j) = CS%cg1(i,j) / & + (sqrt(CS%f2_dx2_h(i,j) + CS%cg1(i,j)*CS%beta_dx2_h(i,j))) enddo ; enddo -!$OMP end parallel if (query_averaging_enabled(CS%diag)) then if (CS%id_Rd_dx > 0) call post_data(CS%id_Rd_dx, CS%Rd_dx_h, CS%diag) endif @@ -243,8 +246,8 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) if (CS%Res_fn_power_visc >= 100) then !$OMP do do j=js-1,je+1 ; do i=is-1,ie+1 - dx_term = CS%f2_dx2_h(i,j) + US%T_to_s*CS%cg1(i,j)*CS%beta_dx2_h(i,j) - if ((CS%Res_coef_visc * US%T_to_s*CS%cg1(i,j))**2 > dx_term) then + dx_term = CS%f2_dx2_h(i,j) + CS%cg1(i,j)*CS%beta_dx2_h(i,j) + if ((CS%Res_coef_visc * CS%cg1(i,j))**2 > dx_term) then CS%Res_fn_h(i,j) = 0.0 else CS%Res_fn_h(i,j) = 1.0 @@ -252,8 +255,7 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) enddo ; enddo !$OMP do do J=js-1,Jeq ; do I=is-1,Ieq - cg1_q = US%T_to_s * 0.25 * ((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + & - (CS%cg1(i+1,j) + CS%cg1(i,j+1))) + cg1_q = 0.25 * ((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + (CS%cg1(i+1,j) + CS%cg1(i,j+1))) dx_term = CS%f2_dx2_q(I,J) + cg1_q * CS%beta_dx2_q(I,J) if ((CS%Res_coef_visc * cg1_q)**2 > dx_term) then CS%Res_fn_q(I,J) = 0.0 @@ -264,13 +266,12 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) elseif (CS%Res_fn_power_visc == 2) then !$OMP do do j=js-1,je+1 ; do i=is-1,ie+1 - dx_term = CS%f2_dx2_h(i,j) + US%T_to_s*CS%cg1(i,j)*CS%beta_dx2_h(i,j) - CS%Res_fn_h(i,j) = dx_term / (dx_term + (CS%Res_coef_visc * US%T_to_s*CS%cg1(i,j))**2) + dx_term = CS%f2_dx2_h(i,j) + CS%cg1(i,j)*CS%beta_dx2_h(i,j) + CS%Res_fn_h(i,j) = dx_term / (dx_term + (CS%Res_coef_visc * CS%cg1(i,j))**2) enddo ; enddo !$OMP do do J=js-1,Jeq ; do I=is-1,Ieq - cg1_q = US%T_to_s * 0.25 * ((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + & - (CS%cg1(i+1,j) + CS%cg1(i,j+1))) + cg1_q = 0.25 * ((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + (CS%cg1(i+1,j) + CS%cg1(i,j+1))) dx_term = CS%f2_dx2_q(I,J) + cg1_q * CS%beta_dx2_q(I,J) CS%Res_fn_q(I,J) = dx_term / (dx_term + (CS%Res_coef_visc * cg1_q)**2) enddo ; enddo @@ -278,34 +279,32 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) power_2 = CS%Res_fn_power_visc / 2 !$OMP do do j=js-1,je+1 ; do i=is-1,ie+1 - dx_term = (US%s_to_T**2*CS%f2_dx2_h(i,j) + CS%cg1(i,j)*US%s_to_T*CS%beta_dx2_h(i,j))**power_2 + dx_term = (US%L_T_to_m_s**2*(CS%f2_dx2_h(i,j) + CS%cg1(i,j)*CS%beta_dx2_h(i,j)))**power_2 CS%Res_fn_h(i,j) = dx_term / & - (dx_term + (CS%Res_coef_visc * CS%cg1(i,j))**CS%Res_fn_power_visc) + (dx_term + (CS%Res_coef_visc * US%L_T_to_m_s*CS%cg1(i,j))**CS%Res_fn_power_visc) enddo ; enddo !$OMP do do J=js-1,Jeq ; do I=is-1,Ieq - cg1_q = 0.25 * ((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + & - (CS%cg1(i+1,j) + CS%cg1(i,j+1))) - dx_term = (US%s_to_T**2*CS%f2_dx2_q(I,J) + cg1_q * US%s_to_T*CS%beta_dx2_q(I,J))**power_2 + cg1_q = 0.25 * ((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + (CS%cg1(i+1,j) + CS%cg1(i,j+1))) + dx_term = (US%L_T_to_m_s**2*(CS%f2_dx2_q(I,J) + cg1_q * CS%beta_dx2_q(I,J)))**power_2 CS%Res_fn_q(I,J) = dx_term / & - (dx_term + (CS%Res_coef_visc * cg1_q)**CS%Res_fn_power_visc) + (dx_term + (CS%Res_coef_visc * US%L_T_to_m_s*cg1_q)**CS%Res_fn_power_visc) enddo ; enddo else !$OMP do do j=js-1,je+1 ; do i=is-1,ie+1 - dx_term = (US%s_to_T*sqrt(CS%f2_dx2_h(i,j) + & - US%T_to_s*CS%cg1(i,j)*CS%beta_dx2_h(i,j)))**CS%Res_fn_power_visc + dx_term = (US%L_T_to_m_s*sqrt(CS%f2_dx2_h(i,j) + & + CS%cg1(i,j)*CS%beta_dx2_h(i,j)))**CS%Res_fn_power_visc CS%Res_fn_h(i,j) = dx_term / & - (dx_term + (CS%Res_coef_visc * CS%cg1(i,j))**CS%Res_fn_power_visc) + (dx_term + (CS%Res_coef_visc * US%L_T_to_m_s*CS%cg1(i,j))**CS%Res_fn_power_visc) enddo ; enddo !$OMP do do J=js-1,Jeq ; do I=is-1,Ieq - cg1_q = 0.25 * ((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + & - (CS%cg1(i+1,j) + CS%cg1(i,j+1))) - dx_term = (US%s_to_T*sqrt(CS%f2_dx2_q(I,J) + & - US%T_to_s*cg1_q * CS%beta_dx2_q(I,J)))**CS%Res_fn_power_visc + cg1_q = 0.25 * ((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + (CS%cg1(i+1,j) + CS%cg1(i,j+1))) + dx_term = (US%L_T_to_m_s*sqrt(CS%f2_dx2_q(I,J) + & + cg1_q * CS%beta_dx2_q(I,J)))**CS%Res_fn_power_visc CS%Res_fn_q(I,J) = dx_term / & - (dx_term + (CS%Res_coef_visc * cg1_q)**CS%Res_fn_power_visc) + (dx_term + (CS%Res_coef_visc * US%L_T_to_m_s*cg1_q)**CS%Res_fn_power_visc) enddo ; enddo endif @@ -320,7 +319,7 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) if (CS%Res_fn_power_khth >= 100) then !$OMP do do j=js,je ; do I=is-1,Ieq - cg1_u = 0.5 * US%T_to_s * (CS%cg1(i,j) + CS%cg1(i+1,j)) + cg1_u = 0.5 * (CS%cg1(i,j) + CS%cg1(i+1,j)) dx_term = CS%f2_dx2_u(I,j) + cg1_u * CS%beta_dx2_u(I,j) if ((CS%Res_coef_khth * cg1_u)**2 > dx_term) then CS%Res_fn_u(I,j) = 0.0 @@ -330,7 +329,7 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) enddo ; enddo !$OMP do do J=js-1,Jeq ; do i=is,ie - cg1_v = 0.5 * US%T_to_s * (CS%cg1(i,j) + CS%cg1(i,j+1)) + cg1_v = 0.5 * (CS%cg1(i,j) + CS%cg1(i,j+1)) dx_term = CS%f2_dx2_v(i,J) + cg1_v * CS%beta_dx2_v(i,J) if ((CS%Res_coef_khth * cg1_v)**2 > dx_term) then CS%Res_fn_v(i,J) = 0.0 @@ -341,13 +340,13 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) elseif (CS%Res_fn_power_khth == 2) then !$OMP do do j=js,je ; do I=is-1,Ieq - cg1_u = 0.5 * US%T_to_s * (CS%cg1(i,j) + CS%cg1(i+1,j)) + cg1_u = 0.5 * (CS%cg1(i,j) + CS%cg1(i+1,j)) dx_term = CS%f2_dx2_u(I,j) + cg1_u * CS%beta_dx2_u(I,j) CS%Res_fn_u(I,j) = dx_term / (dx_term + (CS%Res_coef_khth * cg1_u)**2) enddo ; enddo !$OMP do do J=js-1,Jeq ; do i=is,ie - cg1_v = 0.5 * US%T_to_s * (CS%cg1(i,j) + CS%cg1(i,j+1)) + cg1_v = 0.5 * (CS%cg1(i,j) + CS%cg1(i,j+1)) dx_term = CS%f2_dx2_v(i,J) + cg1_v * CS%beta_dx2_v(i,J) CS%Res_fn_v(i,J) = dx_term / (dx_term + (CS%Res_coef_khth * cg1_v)**2) enddo ; enddo @@ -356,33 +355,33 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) !$OMP do do j=js,je ; do I=is-1,Ieq cg1_u = 0.5 * (CS%cg1(i,j) + CS%cg1(i+1,j)) - dx_term = (US%s_to_T**2*CS%f2_dx2_u(I,j) + cg1_u * US%s_to_T*CS%beta_dx2_u(I,j))**power_2 + dx_term = (US%L_T_to_m_s**2 * (CS%f2_dx2_u(I,j) + cg1_u * CS%beta_dx2_u(I,j)))**power_2 CS%Res_fn_u(I,j) = dx_term / & - (dx_term + (CS%Res_coef_khth * cg1_u)**CS%Res_fn_power_khth) + (dx_term + (CS%Res_coef_khth * US%L_T_to_m_s*cg1_u)**CS%Res_fn_power_khth) enddo ; enddo !$OMP do do J=js-1,Jeq ; do i=is,ie cg1_v = 0.5 * (CS%cg1(i,j) + CS%cg1(i,j+1)) - dx_term = (US%s_to_T**2*CS%f2_dx2_v(i,J) + cg1_v * US%s_to_T*CS%beta_dx2_v(i,J))**power_2 + dx_term = (US%L_T_to_m_s**2 * (CS%f2_dx2_v(i,J) + cg1_v * CS%beta_dx2_v(i,J)))**power_2 CS%Res_fn_v(i,J) = dx_term / & - (dx_term + (CS%Res_coef_khth * cg1_v)**CS%Res_fn_power_khth) + (dx_term + (CS%Res_coef_khth * US%L_T_to_m_s*cg1_v)**CS%Res_fn_power_khth) enddo ; enddo else !$OMP do do j=js,je ; do I=is-1,Ieq cg1_u = 0.5 * (CS%cg1(i,j) + CS%cg1(i+1,j)) - dx_term = (US%s_to_T*sqrt(CS%f2_dx2_u(I,j) + & - US%T_to_s*cg1_u * CS%beta_dx2_u(I,j)))**CS%Res_fn_power_khth + dx_term = (US%L_T_to_m_s*sqrt(CS%f2_dx2_u(I,j) + & + cg1_u * CS%beta_dx2_u(I,j)))**CS%Res_fn_power_khth CS%Res_fn_u(I,j) = dx_term / & - (dx_term + (CS%Res_coef_khth * cg1_u)**CS%Res_fn_power_khth) + (dx_term + (CS%Res_coef_khth * US%L_T_to_m_s*cg1_u)**CS%Res_fn_power_khth) enddo ; enddo !$OMP do do J=js-1,Jeq ; do i=is,ie cg1_v = 0.5 * (CS%cg1(i,j) + CS%cg1(i,j+1)) - dx_term = (US%s_to_T*sqrt(CS%f2_dx2_v(i,J) + & - US%T_to_s*cg1_v * CS%beta_dx2_v(i,J)))**CS%Res_fn_power_khth + dx_term = (US%L_T_to_m_s*sqrt(CS%f2_dx2_v(i,J) + & + cg1_v * CS%beta_dx2_v(i,J)))**CS%Res_fn_power_khth CS%Res_fn_v(i,J) = dx_term / & - (dx_term + (CS%Res_coef_khth * cg1_v)**CS%Res_fn_power_khth) + (dx_term + (CS%Res_coef_khth * US%L_T_to_m_s*cg1_v)**CS%Res_fn_power_khth) enddo ; enddo endif endif @@ -407,7 +406,7 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS) ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(G)+1) :: & e ! The interface heights relative to mean sea level [Z ~> m]. - real, dimension(SZIB_(G), SZJ_(G), SZK_(G)+1) :: N2_u ! Square of Brunt-Vaisala freq at u-points [s-2] + real, dimension(SZIB_(G), SZJ_(G), SZK_(G)+1) :: N2_u ! Square of Brunt-Vaisala freq at u-points [T-2 ~> s-2] real, dimension(SZI_(G), SZJB_(G), SZK_(G)+1) :: N2_v ! Square of Brunt-Vaisala freq at v-points [s-2] if (.not. associated(CS)) call MOM_error(FATAL, "MOM_lateral_mixing_coeffs.F90, calc_slope_functions:"//& @@ -416,9 +415,9 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS) if (CS%calculate_Eady_growth_rate) then call find_eta(h, tv, G, GV, US, e, halo_size=2) if (CS%use_stored_slopes) then - call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*CS%kappa_smooth, & + call calc_isoneutral_slopes(G, GV, US, h, e, tv, US%s_to_T*dt*CS%kappa_smooth, & CS%slope_x, CS%slope_y, N2_u, N2_v, 1) - call calc_Visbeck_coeffs(h, CS%slope_x, CS%slope_y, N2_u, N2_v, G, GV, CS) + call calc_Visbeck_coeffs(h, CS%slope_x, CS%slope_y, N2_u, N2_v, G, GV, US, CS) ! call calc_slope_functions_using_just_e(h, G, CS, e, .false.) else !call calc_isoneutral_slopes(G, GV, h, e, tv, dt*CS%kappa_smooth, CS%slope_x, CS%slope_y) @@ -431,6 +430,8 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS) if (CS%id_SN_v > 0) call post_data(CS%id_SN_v, CS%SN_v, CS%diag) if (CS%id_L2u > 0) call post_data(CS%id_L2u, CS%L2u, CS%diag) if (CS%id_L2v > 0) call post_data(CS%id_L2v, CS%L2v, CS%diag) + !### I do not believe that CS%N2_u and CS%N2_v are ever set, but because the contents + ! of CS are public, they might be set somewhere outside of this module. if (CS%id_N2_u > 0) call post_data(CS%id_N2_u, CS%N2_u, CS%diag) if (CS%id_N2_v > 0) call post_data(CS%id_N2_v, CS%N2_v, CS%diag) endif @@ -438,19 +439,22 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS) end subroutine calc_slope_functions !> Calculates factors used when setting diffusivity coefficients similar to Visbeck et al. -subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) +subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, CS) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: slope_x !< Zonal isoneutral slope - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: N2_u !< Brunt-Vaisala frequency at u-points [s-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: N2_u !< Buoyancy (Brunt-Vaisala) frequency + !! at u-points [T-2 ~> s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: slope_y !< Meridional isoneutral slope - real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: N2_v !< Brunt-Vaisala frequency at v-points [s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: N2_v !< Buoyancy (Brunt-Vaisala) frequency + !! at v-points [T-2 ~> s-2] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(VarMix_CS), pointer :: CS !< Variable mixing coefficients ! Local variables real :: S2 ! Interface slope squared [nondim] - real :: N2 ! Brunt-Vaisala frequency [s-1] + real :: N2 ! Positive buoyancy frequency or zero [T-2 ~> s-2] real :: Hup, Hdn ! Thickness from above, below [H ~> m or kg m-2] real :: H_geom ! The geometric mean of Hup*Hdn [H ~> m or kg m-2]. integer :: is, ie, js, je, nz @@ -562,8 +566,8 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) if (CS%debug) then call uvchksum("calc_Visbeck_coeffs slope_[xy]", slope_x, slope_y, G%HI, haloshift=1) - call uvchksum("calc_Visbeck_coeffs N2_u, N2_v", N2_u, N2_v, G%HI) - call uvchksum("calc_Visbeck_coeffs SN_[uv]", CS%SN_u, CS%SN_v, G%HI) + call uvchksum("calc_Visbeck_coeffs N2_u, N2_v", N2_u, N2_v, G%HI, scale=US%s_to_T**2) + call uvchksum("calc_Visbeck_coeffs SN_[uv]", CS%SN_u, CS%SN_v, G%HI, scale=US%s_to_T) endif end subroutine calc_Visbeck_coeffs @@ -589,8 +593,6 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop real :: N2 ! Brunt-Vaisala frequency squared [T-2 ~> s-2] real :: Hup, Hdn ! Thickness from above, below [H ~> m or kg m-2] real :: H_geom ! The geometric mean of Hup*Hdn [H ~> m or kg m-2]. - real :: Z_to_L ! A conversion factor between from units for e to the - ! units for lateral distances. real :: one_meter ! One meter in thickness units [H ~> m or kg m-2]. integer :: is, ie, js, je, nz integer :: i, j, k, kb_max @@ -610,7 +612,6 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop one_meter = 1.0 * GV%m_to_H h_neglect = GV%H_subroundoff H_cutoff = real(2*nz) * (GV%Angstrom_H + h_neglect) - Z_to_L = US%Z_to_m ! To set the length scale based on the deformation radius, use wave_speed to ! calculate the first-mode gravity wave speed and then blend the equatorial @@ -622,12 +623,12 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop if (calculate_slopes) then ! Calculate the interface slopes E_x and E_y and u- and v- points respectively do j=js-1,je+1 ; do I=is-1,ie - E_x(I,j) = Z_to_L*(e(i+1,j,K)-e(i,j,K))*G%IdxCu(I,j) + E_x(I,j) = US%Z_to_L*(e(i+1,j,K)-e(i,j,K))*G%IdxCu(I,j) ! Mask slopes where interface intersects topography if (min(h(I,j,k),h(I+1,j,k)) < H_cutoff) E_x(I,j) = 0. enddo ; enddo do J=js-1,je ; do i=is-1,ie+1 - E_y(i,J) = Z_to_L*(e(i,j+1,K)-e(i,j,K))*G%IdyCv(i,J) + E_y(i,J) = US%Z_to_L*(e(i,j+1,K)-e(i,j,K))*G%IdyCv(i,J) ! Mask slopes where interface intersects topography if (min(h(i,J,k),h(i,J+1,k)) < H_cutoff) E_y(I,j) = 0. enddo ; enddo @@ -678,7 +679,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop !SN_u(I,j) = sqrt( SN_u(I,j) / ( max(G%bathyT(I,j), G%bathyT(I+1,j)) + GV%Angstrom_Z ) )) !The code below behaves better than the line above. Not sure why? AJA if ( min(G%bathyT(I,j), G%bathyT(I+1,j)) > H_cutoff*GV%H_to_Z ) then - CS%SN_u(I,j) = G%mask2dCu(I,j) * US%s_to_T * sqrt( CS%SN_u(I,j) / & + CS%SN_u(I,j) = G%mask2dCu(I,j) * sqrt( CS%SN_u(I,j) / & (max(G%bathyT(I,j), G%bathyT(I+1,j))) ) else CS%SN_u(I,j) = 0.0 @@ -695,7 +696,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop !SN_v(i,J) = sqrt( SN_v(i,J) / ( max(G%bathyT(i,J), G%bathyT(i,J+1)) + GV%Angstrom_Z ) )) !The code below behaves better than the line above. Not sure why? AJA if ( min(G%bathyT(I,j), G%bathyT(I+1,j)) > H_cutoff*GV%H_to_Z ) then - CS%SN_v(i,J) = G%mask2dCv(i,J) * US%s_to_T * sqrt( CS%SN_v(i,J) / & + CS%SN_v(i,J) = G%mask2dCv(i,J) * sqrt( CS%SN_v(i,J) / & (max(G%bathyT(i,J), G%bathyT(i,J+1))) ) else CS%SN_v(I,j) = 0.0 @@ -706,22 +707,23 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop end subroutine calc_slope_functions_using_just_e !> Calculates the Leith Laplacian and bi-harmonic viscosity coefficients -subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_xy_dx, vort_xy_dy) +subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vort_xy_dx, vort_xy_dy) type(VarMix_CS), pointer :: CS !< Variable mixing coefficients type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal flow [m s-1] ! real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional flow [m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] integer, intent(in) :: k !< Layer for which to calculate vorticity magnitude - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: div_xx_dx !< x-derivative of horizontal divergence - !! (d/dx(du/dx + dv/dy)) [m-1 s-1] - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: div_xx_dy !< y-derivative of horizontal divergence - !! (d/dy(du/dx + dv/dy)) [m-1 s-1] + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: div_xx_dx !< x-derivative of horizontal divergence + !! (d/dx(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1] + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: div_xx_dy !< y-derivative of horizontal divergence + !! (d/dy(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1] real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vort_xy_dx !< x-derivative of vertical vorticity - !! (d/dx(dv/dx - du/dy)) [m-1 s-1] + !! (d/dx(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: vort_xy_dy !< y-derivative of vertical vorticity - !! (d/dy(dv/dx - du/dy)) [m-1 s-1] + !! (d/dy(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] ! real, dimension(SZI_(G),SZJ_(G)), intent(out) :: Leith_Kh_h !< Leith Laplacian viscosity !! at h-points [m2 s-1] ! real, dimension(SZIB_(G),SZJB_(G)), intent(out) :: Leith_Kh_q !< Leith Laplacian viscosity @@ -736,25 +738,26 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x ! dudy, & ! Meridional shear of zonal velocity [s-1] ! dvdx ! Zonal shear of meridional velocity [s-1] real, dimension(SZI_(G),SZJB_(G)) :: & -! vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) [m-1 s-1] -! div_xx_dy, & ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) [m-1 s-1] - dslopey_dz, & ! z-derivative of y-slope at v-points [m-1] +! vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] +! div_xx_dy, & ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1] + dslopey_dz, & ! z-derivative of y-slope at v-points [Z-1 ~> m-1] h_at_v, & ! Thickness at v-points [H ~> m or kg m-2] - beta_v, & ! Beta at v-points [m-1 s-1] - grad_vort_mag_v, & ! mag. of vort. grad. at v-points [s-1] - grad_div_mag_v ! mag. of div. grad. at v-points [s-1] + beta_v, & ! Beta at v-points [T-1 L-1 ~> s-1 m-1] + grad_vort_mag_v, & ! Magnitude of vorticity gradient at v-points [T-1 L-1 ~> s-1 m-1] + grad_div_mag_v ! Magnitude of divergence gradient at v-points [T-1 L-1 ~> s-1 m-1] real, dimension(SZIB_(G),SZJ_(G)) :: & -! vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) [m-1 s-1] -! div_xx_dx, & ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) [m-1 s-1] - dslopex_dz, & ! z-derivative of x-slope at u-points (m-1) +! vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] +! div_xx_dx, & ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1] + dslopex_dz, & ! z-derivative of x-slope at u-points [Z-1 ~> m-1] h_at_u, & ! Thickness at u-points [H ~> m or kg m-2] - beta_u, & ! Beta at u-points [m-1 s-1] - grad_vort_mag_u, & ! mag. of vort. grad. at u-points [s-1] - grad_div_mag_u ! mag. of div. grad. at u-points [s-1] + beta_u, & ! Beta at u-points [T-1 L-1 ~> s-1 m-1] + grad_vort_mag_u, & ! Magnitude of vorticity gradient at u-points [T-1 L-1 ~> s-1 m-1] + grad_div_mag_u ! Magnitude of divergence gradient at u-points [T-1 L-1 ~> s-1 m-1] ! real, dimension(SZI_(G),SZJ_(G)) :: div_xx ! Estimate of horizontal divergence at h-points [s-1] ! real :: mod_Leith, DY_dxBu, DX_dyBu, vert_vort_mag - real :: h_at_slope_above, h_at_slope_below, Ih, f + real :: h_at_slope_above, h_at_slope_below, Ih + real :: f ! A copy of the Coriolis parameter [T-1 ~> s-1] integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq,nz real :: inv_PI3 @@ -780,7 +783,7 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x h_at_slope_below = 2. * ( h(i,j,k) * h(i+1,j,k) ) * ( h(i,j,k+1) * h(i+1,j,k+1) ) / & ( ( h(i,j,k) * h(i+1,j,k) ) * ( h(i,j,k+1) + h(i+1,j,k+1) ) & + ( h(i,j,k+1) * h(i+1,j,k+1) ) * ( h(i,j,k) + h(i+1,j,k) ) + GV%H_subroundoff ) - Ih = 1./ ( ( h_at_slope_above + h_at_slope_below + GV%H_subroundoff ) * GV%H_to_m ) + Ih = 1./ ( ( h_at_slope_above + h_at_slope_below + GV%H_subroundoff ) * GV%H_to_Z ) dslopex_dz(I,j) = 2. * ( CS%slope_x(i,j,k) - CS%slope_x(i,j,k+1) ) * Ih h_at_u(I,j) = 2. * ( h_at_slope_above * h_at_slope_below ) * Ih enddo ; enddo @@ -793,7 +796,7 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x h_at_slope_below = 2. * ( h(i,j,k) * h(i,j+1,k) ) * ( h(i,j,k+1) * h(i,j+1,k+1) ) / & ( ( h(i,j,k) * h(i,j+1,k) ) * ( h(i,j,k+1) + h(i,j+1,k+1) ) & + ( h(i,j,k+1) * h(i,j+1,k+1) ) * ( h(i,j,k) + h(i,j+1,k) ) + GV%H_subroundoff ) - Ih = 1./ ( ( h_at_slope_above + h_at_slope_below + GV%H_subroundoff ) * GV%H_to_m ) + Ih = 1./ ( ( h_at_slope_above + h_at_slope_below + GV%H_subroundoff ) * GV%H_to_Z ) dslopey_dz(i,J) = 2. * ( CS%slope_y(i,j,k) - CS%slope_y(i,j,k+1) ) * Ih h_at_v(i,J) = 2. * ( h_at_slope_above * h_at_slope_below ) * Ih enddo ; enddo @@ -801,7 +804,7 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x !### do J=js-1,je ; do i=is-1,Ieq+1 do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 f = 0.5 * ( G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J) ) - vort_xy_dx(i,J) = vort_xy_dx(i,J) - f * & + vort_xy_dx(i,J) = vort_xy_dx(i,J) - f * US%L_to_Z * & ( ( h_at_u(I,j) * dslopex_dz(I,j) + h_at_u(I-1,j+1) * dslopex_dz(I-1,j+1) ) & + ( h_at_u(I-1,j) * dslopex_dz(I-1,j) + h_at_u(I,j+1) * dslopex_dz(I,j+1) ) ) / & ( ( h_at_u(I,j) + h_at_u(I-1,j+1) ) + ( h_at_u(I-1,j) + h_at_u(I,j+1) ) + GV%H_subroundoff) @@ -811,7 +814,7 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 f = 0.5 * ( G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1) ) !### I think that this should be vort_xy_dy(I,j) = vort_xy_dy(I,j) - f * & - vort_xy_dy(I,j) = vort_xy_dx(I,j) - f * & + vort_xy_dy(I,j) = vort_xy_dx(I,j) - f * US%L_to_Z * & ( ( h_at_v(i,J) * dslopey_dz(i,J) + h_at_v(i+1,J-1) * dslopey_dz(i+1,J-1) ) & + ( h_at_v(i,J-1) * dslopey_dz(i,J-1) + h_at_v(i+1,J) * dslopey_dz(i+1,J) ) ) / & ( ( h_at_v(i,J) + h_at_v(i+1,J-1) ) + ( h_at_v(i,J-1) + h_at_v(i+1,J) ) + GV%H_subroundoff) @@ -824,34 +827,38 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x if (CS%use_QG_Leith_GM) then do j=js,je ; do I=is-1,Ieq + !### These expressions are not rotationally symmetric. Add parentheses and regroup, as in: + ! grad_vort_mag_u(I,j) = SQRT(vort_xy_dy(I,j)**2 + (0.25*((vort_xy_dx(i,J) + vort_xy_dx(i+1,J-1)) + + ! (vort_xy_dx(i+1,J) + vort_xy_dx(i,J-1))))**2 ) grad_vort_mag_u(I,j) = SQRT(vort_xy_dy(I,j)**2 + (0.25*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J) & - + vort_xy_dx(i,J-1) + vort_xy_dx(i+1,J-1)))**2) + + vort_xy_dx(i,J-1) + vort_xy_dx(i+1,J-1)))**2) grad_div_mag_u(I,j) = SQRT(div_xx_dx(I,j)**2 + (0.25*(div_xx_dy(i,J) + div_xx_dy(i+1,J) & - + div_xx_dy(i,J-1) + div_xx_dy(i+1,J-1)))**2) + + div_xx_dy(i,J-1) + div_xx_dy(i+1,J-1)))**2) if (CS%use_beta_in_QG_Leith) then beta_u(I,j) = sqrt( (0.5*(G%dF_dx(i,j)+G%dF_dx(i+1,j))**2) + & - (0.5*(G%dF_dy(i,j)+G%dF_dy(i+1,j))**2) ) - CS%KH_u_QG(I,j,k) = MIN(grad_vort_mag_u(I,j) + grad_div_mag_u(I,j), beta_u(I,j)*3) & - * CS%Laplac3_const_u(I,j) * inv_PI3 + (0.5*(G%dF_dy(i,j)+G%dF_dy(i+1,j))**2) ) + CS%KH_u_QG(I,j,k) = MIN(grad_vort_mag_u(I,j) + grad_div_mag_u(I,j), 3.0*beta_u(I,j)) * & + CS%Laplac3_const_u(I,j) * inv_PI3 else - CS%KH_u_QG(I,j,k) = (grad_vort_mag_u(I,j) + grad_div_mag_u(I,j)) & - * CS%Laplac3_const_u(I,j) * inv_PI3 + CS%KH_u_QG(I,j,k) = (grad_vort_mag_u(I,j) + grad_div_mag_u(I,j)) * & + CS%Laplac3_const_u(I,j) * inv_PI3 endif enddo ; enddo do J=js-1,Jeq ; do i=is,ie + !### These expressions are not rotationally symmetric. Add parentheses and regroup. grad_vort_mag_v(i,J) = SQRT(vort_xy_dx(i,J)**2 + (0.25*(vort_xy_dy(I,j) + vort_xy_dy(I-1,j) & - + vort_xy_dy(I,j+1) + vort_xy_dy(I-1,j+1)))**2) + + vort_xy_dy(I,j+1) + vort_xy_dy(I-1,j+1)))**2) grad_div_mag_v(i,J) = SQRT(div_xx_dy(i,J)**2 + (0.25*(div_xx_dx(I,j) + div_xx_dx(I-1,j) & - + div_xx_dx(I,j+1) + div_xx_dx(I-1,j+1)))**2) + + div_xx_dx(I,j+1) + div_xx_dx(I-1,j+1)))**2) if (CS%use_beta_in_QG_Leith) then beta_v(i,J) = sqrt( (0.5*(G%dF_dx(i,j)+G%dF_dx(i,j+1))**2) + & (0.5*(G%dF_dy(i,j)+G%dF_dy(i,j+1))**2) ) - CS%KH_v_QG(i,J,k) = MIN(grad_vort_mag_v(i,J) + grad_div_mag_v(i,J), beta_v(i,J)*3) & - * CS%Laplac3_const_v(i,J) * inv_PI3 + CS%KH_v_QG(i,J,k) = MIN(grad_vort_mag_v(i,J) + grad_div_mag_v(i,J), 3.0*beta_v(i,J)) * & + CS%Laplac3_const_v(i,J) * inv_PI3 else - CS%KH_v_QG(i,J,k) = (grad_vort_mag_v(i,J) + grad_div_mag_v(i,J)) & - * CS%Laplac3_const_v(i,J) * inv_PI3 + CS%KH_v_QG(i,J,k) = (grad_vort_mag_v(i,J) + grad_div_mag_v(i,J)) * & + CS%Laplac3_const_v(i,J) * inv_PI3 endif enddo ; enddo ! post diagnostics @@ -881,8 +888,8 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) logical :: Gill_equatorial_Ld, use_FGNV_streamfn, use_MEKE, in_use real :: MLE_front_length real :: Leith_Lap_const ! The non-dimensional coefficient in the Leith viscosity - real :: grid_sp_u2, grid_sp_u3 - real :: grid_sp_v2, grid_sp_v3 ! Intermediate quantities for Leith metrics + real :: grid_sp_u2, grid_sp_v2 ! Intermediate quantities for Leith metrics [L2 ~> m2] + real :: grid_sp_u3, grid_sp_v3 ! Intermediate quantities for Leith metrics [L3 ~> m3] ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_lateral_mixing_coeffs" ! This module's name. @@ -998,7 +1005,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_smooth, & "A diapycnal diffusivity that is used to interpolate "//& "more sensible values of T & S into thin layers.", & - units="m2 s-1", default=1.0e-6, scale=US%m_to_Z**2) + units="m2 s-1", default=1.0e-6, scale=US%m_to_Z**2*US%T_to_s) endif if (CS%calculate_Eady_growth_rate) then @@ -1006,9 +1013,9 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) allocate(CS%SN_u(IsdB:IedB,jsd:jed)) ; CS%SN_u(:,:) = 0.0 allocate(CS%SN_v(isd:ied,JsdB:JedB)) ; CS%SN_v(:,:) = 0.0 CS%id_SN_u = register_diag_field('ocean_model', 'SN_u', diag%axesCu1, Time, & - 'Inverse eddy time-scale, S*N, at u-points', 's-1') + 'Inverse eddy time-scale, S*N, at u-points', 's-1', conversion=US%s_to_T) CS%id_SN_v = register_diag_field('ocean_model', 'SN_v', diag%axesCv1, Time, & - 'Inverse eddy time-scale, S*N, at v-points', 's-1') + 'Inverse eddy time-scale, S*N, at v-points', 's-1', conversion=US%s_to_T) call get_param(param_file, mdl, "VARMIX_KTOP", CS%VarMix_Ktop, & "The layer number at which to start vertical integration "//& "of S*N for purposes of finding the Eady growth rate.", & @@ -1024,20 +1031,22 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) allocate(CS%L2v(isd:ied,JsdB:JedB)) ; CS%L2v(:,:) = 0.0 if (CS%Visbeck_L_scale<0) then do j=js,je ; do I=is-1,Ieq - CS%L2u(I,j) = CS%Visbeck_L_scale**2*G%areaCu(I,j) + CS%L2u(I,j) = CS%Visbeck_L_scale**2 * G%areaCu(I,j) enddo; enddo do J=js-1,Jeq ; do i=is,ie - CS%L2v(i,J) = CS%Visbeck_L_scale**2*G%areaCv(i,J) + CS%L2v(i,J) = CS%Visbeck_L_scale**2 * G%areaCv(i,J) enddo; enddo else - CS%L2u(:,:) = CS%Visbeck_L_scale**2 - CS%L2v(:,:) = CS%Visbeck_L_scale**2 + CS%L2u(:,:) = US%m_to_L**2*CS%Visbeck_L_scale**2 + CS%L2v(:,:) = US%m_to_L**2*CS%Visbeck_L_scale**2 endif CS%id_L2u = register_diag_field('ocean_model', 'L2u', diag%axesCu1, Time, & - 'Length scale squared for mixing coefficient, at u-points', 'm2') + 'Length scale squared for mixing coefficient, at u-points', & + 'm2', conversion=US%L_to_m**2) CS%id_L2v = register_diag_field('ocean_model', 'L2v', diag%axesCv1, Time, & - 'Length scale squared for mixing coefficient, at v-points', 'm2') + 'Length scale squared for mixing coefficient, at v-points', & + 'm2', conversion=US%L_to_m**2) endif if (CS%use_stored_slopes) then @@ -1120,7 +1129,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) do J=js-1,Jeq ; do I=is-1,Ieq CS%f2_dx2_q(I,J) = (G%dxBu(I,J)**2 + G%dyBu(I,J)**2) * & max(G%CoriolisBu(I,J)**2, absurdly_small_freq**2) - CS%beta_dx2_q(I,J) = oneOrTwo * (G%dxBu(I,J)**2 + G%dyBu(I,J)**2) * (sqrt(0.5 * & + CS%beta_dx2_q(I,J) = oneOrTwo * ((G%dxBu(I,J))**2 + (G%dyBu(I,J))**2) * (sqrt(0.5 * & ( (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & ((G%CoriolisBu(I+1,J)-G%CoriolisBu(I,J)) * G%IdxCv(i+1,J))**2) + & (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & @@ -1130,7 +1139,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) do j=js,je ; do I=is-1,Ieq CS%f2_dx2_u(I,j) = (G%dxCu(I,j)**2 + G%dyCu(I,j)**2) * & max(0.5* (G%CoriolisBu(I,J)**2+G%CoriolisBu(I,J-1)**2), absurdly_small_freq**2) - CS%beta_dx2_u(I,j) = oneOrTwo * (G%dxCu(I,j)**2 + G%dyCu(I,j)**2) * (sqrt( & + CS%beta_dx2_u(I,j) = oneOrTwo * ((G%dxCu(I,j))**2 + (G%dyCu(I,j))**2) * (sqrt( & 0.25*( (((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2 + & ((G%CoriolisBu(I+1,J)-G%CoriolisBu(I,J)) * G%IdxCv(i+1,J))**2) + & (((G%CoriolisBu(I+1,J-1)-G%CoriolisBu(I,J-1)) * G%IdxCv(i+1,J-1))**2 + & @@ -1139,9 +1148,9 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) enddo ; enddo do J=js-1,Jeq ; do i=is,ie - CS%f2_dx2_v(i,J) = (G%dxCv(i,J)**2 + G%dyCv(i,J)**2) * & + CS%f2_dx2_v(i,J) = ((G%dxCv(i,J))**2 + (G%dyCv(i,J))**2) * & max(0.5*(G%CoriolisBu(I,J)**2+G%CoriolisBu(I-1,J)**2), absurdly_small_freq**2) - CS%beta_dx2_v(i,J) = oneOrTwo * (G%dxCv(i,J)**2 + G%dyCv(i,J)**2) * (sqrt( & + CS%beta_dx2_v(i,J) = oneOrTwo * ((G%dxCv(i,J))**2 + (G%dyCv(i,J))**2) * (sqrt( & ((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & 0.25*( (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & ((G%CoriolisBu(I-1,J+1)-G%CoriolisBu(I-1,J)) * G%IdyCu(I-1,j+1))**2) + & @@ -1166,7 +1175,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) max(0.25 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)), & absurdly_small_freq**2) - CS%beta_dx2_h(i,j) = oneOrTwo * (G%dxT(i,j)**2 + G%dyT(i,j)**2) * (sqrt(0.5 * & + CS%beta_dx2_h(i,j) = oneOrTwo * ((G%dxT(i,j))**2 + (G%dyT(i,j))**2) * (sqrt(0.5 * & ( (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & ((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2) + & (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & @@ -1176,7 +1185,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) if (CS%calculate_cg1) then in_use = .true. - allocate(CS%cg1(isd:ied,jsd:jed)); CS%cg1(:,:) = 0.0 + allocate(CS%cg1(isd:ied,jsd:jed)) ; CS%cg1(:,:) = 0.0 call wave_speed_init(CS%wave_speed_CSp, use_ebt_mode=CS%Resoln_use_ebt, mono_N2_depth=N2_filter_depth) endif @@ -1201,18 +1210,19 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) ! register diagnostics CS%id_KH_u_QG = register_diag_field('ocean_model', 'KH_u_QG', diag%axesCuL, Time, & - 'Horizontal viscosity from Leith QG, at u-points', 'm2 s-1') + 'Horizontal viscosity from Leith QG, at u-points', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_KH_v_QG = register_diag_field('ocean_model', 'KH_v_QG', diag%axesCvL, Time, & - 'Horizontal viscosity from Leith QG, at v-points', 'm2 s-1') + 'Horizontal viscosity from Leith QG, at v-points', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) do j=Jsq,Jeq+1 ; do I=is-1,Ieq ! Static factors in the Leith schemes grid_sp_u2 = G%dyCu(I,j)*G%dxCu(I,j) - grid_sp_u3 = grid_sp_u2*sqrt(grid_sp_u2) + grid_sp_u3 = sqrt(grid_sp_u2) CS%Laplac3_const_u(I,j) = Leith_Lap_const * grid_sp_u3 enddo ; enddo do j=js-1,Jeq ; do I=Isq,Ieq+1 ! Static factors in the Leith schemes + !### The second factor here is wrong. It should be G%dxCv(i,J). grid_sp_v2 = G%dyCv(i,J)*G%dxCu(i,J) grid_sp_v3 = grid_sp_v2*sqrt(grid_sp_v2) CS%Laplac3_const_v(i,J) = Leith_Lap_const * grid_sp_v3 diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 546f320136..37ce9f0b79 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -41,16 +41,16 @@ module MOM_mixed_layer_restrat !! [nondim]. This increases with grid spacing^2, up to something !! of order 500. real :: ml_restrat_coef2 !< As for ml_restrat_coef but using the slow filtered MLD [nondim]. - real :: front_length !< If non-zero, is the frontal-length scale [m] used to calculate the + real :: front_length !< If non-zero, is the frontal-length scale [L ~> m] used to calculate the !! upscaling of buoyancy gradients that is otherwise represented !! by the parameter FOX_KEMPER_ML_RESTRAT_COEF. If MLE_FRONT_LENGTH is !! non-zero, it is recommended to set FOX_KEMPER_ML_RESTRAT_COEF=1.0. logical :: MLE_use_PBL_MLD !< If true, use the MLD provided by the PBL parameterization. !! if false, MLE will calculate a MLD based on a density difference !! based on the parameter MLE_DENSITY_DIFF. - real :: MLE_MLD_decay_time !< Time-scale to use in a running-mean when MLD is retreating [s]. - real :: MLE_MLD_decay_time2 !< Time-scale to use in a running-mean when filtered MLD is retreating [s]. - real :: MLE_density_diff !< Density difference used in detecting mixed-layer depth [kgm-3]. + real :: MLE_MLD_decay_time !< Time-scale to use in a running-mean when MLD is retreating [T ~> s]. + real :: MLE_MLD_decay_time2 !< Time-scale to use in a running-mean when filtered MLD is retreating [T ~> s]. + real :: MLE_density_diff !< Density difference used in detecting mixed-layer depth [kg m-3]. real :: MLE_tail_dh !< Fraction by which to extend the mixed-layer restratification !! depth used for a smoother stream function at the base of !! the mixed-layer [nondim]. @@ -94,9 +94,9 @@ subroutine mixedlayer_restrat(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Accumulated zonal mass flux - !! [H m2 ~> m3 or kg] + !! [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Accumulated meridional mass flux - !! [H m2 ~> m3 or kg] + !! [H L2 ~> m3 or kg] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, intent(in) :: dt !< Time increment [s] @@ -109,56 +109,56 @@ subroutine mixedlayer_restrat(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, "Module must be initialized before it is used.") if (GV%nkml>0) then - call mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) + call mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, US%s_to_T*dt, G, GV, US, CS) else - call mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, US, CS) + call mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, US%s_to_T*dt, MLD, VarMix, G, GV, US, CS) endif end subroutine mixedlayer_restrat !> Calculates a restratifying flow in the mixed layer. -subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, VarMix, G, GV, US, CS) +subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt_in_T, MLD_in, VarMix, G, GV, US, CS) ! Arguments type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Accumulated zonal mass flux - !! [H m2 ~> m3 or kg] + !! [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Accumulated meridional mass flux - !! [H m2 ~> m3 or kg] + !! [H L2 ~> m3 or kg] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - real, intent(in) :: dt !< Time increment [s] + real, intent(in) :: dt_in_T !< Time increment [T ~> s] real, dimension(:,:), pointer :: MLD_in !< Mixed layer depth provided by the !! PBL scheme [m] (not H) type(VarMix_CS), pointer :: VarMix !< Container for derived fields type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure ! Local variables - real :: uhml(SZIB_(G),SZJ_(G),SZK_(G)) ! zonal mixed layer transport [H m2 s-1 ~> m3 s-1 or kg s-1] - real :: vhml(SZI_(G),SZJB_(G),SZK_(G)) ! merid mixed layer transport [H m2 s-1 ~> m3 s-1 or kg s-1] + real :: uhml(SZIB_(G),SZJ_(G),SZK_(G)) ! zonal mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: vhml(SZI_(G),SZJB_(G),SZK_(G)) ! merid mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & h_avail ! The volume available for diffusion out of each face of each - ! sublayer of the mixed layer, divided by dt [H m2 s-1 ~> m3 s-1 or kg s-1]. + ! sublayer of the mixed layer, divided by dt [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJ_(G)) :: & MLD_fast, & ! Mixed layer depth actually used in MLE restratification parameterization [H ~> m or kg m-2] htot_fast, & ! The sum of the thicknesses of layers in the mixed layer [H ~> m or kg m-2] - Rml_av_fast, & ! g_Rho0 times the average mixed layer density [m s-2] + Rml_av_fast, & ! g_Rho0 times the average mixed layer density [L2 Z-1 T-2 ~> m s-2] MLD_slow, & ! Mixed layer depth actually used in MLE restratification parameterization [H ~> m or kg m-2] htot_slow, & ! The sum of the thicknesses of layers in the mixed layer [H ~> m or kg m-2] - Rml_av_slow ! g_Rho0 times the average mixed layer density [m s-2] - real :: g_Rho0 ! G_Earth/Rho0 [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1] + Rml_av_slow ! g_Rho0 times the average mixed layer density [L2 Z-1 T-2 ~> m s-2] + real :: g_Rho0 ! G_Earth/Rho0 [m3 L2 Z-1 T-2 kg-1 ~> m4 s-2 kg-1] real :: rho_ml(SZI_(G)) ! Potential density relative to the surface [kg m-3] real :: p0(SZI_(G)) ! A pressure of 0 [Pa] real :: h_vel ! htot interpolated onto velocity points [Z ~> m] (not H). - real :: absf ! absolute value of f, interpolated to velocity points [s-1] - real :: u_star ! surface friction velocity, interpolated to velocity points [Z s-1 ~> m s-1]. - real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer [s-1] - real :: timescale ! mixing growth timescale [s] + real :: absf ! absolute value of f, interpolated to velocity points [T-1 ~> s-1] + real :: u_star ! surface friction velocity, interpolated to velocity points [Z T-1 ~> m s-1]. + real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer [T-1 ~> s-1] + real :: timescale ! mixing growth timescale [T ~> s] real :: h_neglect ! tiny thickness usually lost in roundoff so can be neglected [H ~> m or kg m-2] real :: dz_neglect ! A tiny thickness that is usually lost in roundoff so can be neglected [Z ~> m] - real :: I4dt ! 1/(4 dt) [s-1] + real :: I4dt ! 1/(4 dt) [T-1 ~> s-1] real :: Ihtot,Ihtot_slow! Inverses of the total mixed layer thickness [H-1 ~> m-1 or m2 kg-1] real :: a(SZK_(G)) ! A non-dimensional value relating the overall flux ! magnitudes (uDml & vDml) to the realized flux in a @@ -166,11 +166,11 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! the mixed layer must be 0. real :: b(SZK_(G)) ! As for a(k) but for the slow-filtered MLD real :: uDml(SZIB_(G)) ! The zonal and meridional volume fluxes in the upper - real :: vDml(SZI_(G)) ! half of the mixed layer [H m2 s-1 ~> m3 s-1 or kg s-1]. + real :: vDml(SZI_(G)) ! half of the mixed layer [H L2 T-1 ~> m3 s-1 or kg s-1]. real :: uDml_slow(SZIB_(G)) ! The zonal and meridional volume fluxes in the upper - real :: vDml_slow(SZI_(G)) ! half of the mixed layer [H m2 s-1 ~> m3 s-1 or kg s-1]. + real :: vDml_slow(SZI_(G)) ! half of the mixed layer [H L2 T-1 ~> m3 s-1 or kg s-1]. real :: utimescale_diag(SZIB_(G),SZJ_(G)) ! restratification timescales in the zonal and - real :: vtimescale_diag(SZI_(G),SZJB_(G)) ! meridional directions [s], stored in 2-D arrays + real :: vtimescale_diag(SZI_(G),SZJB_(G)) ! meridional directions [T ~> s], stored in 2-D arrays ! for diagnostic purposes. real :: uDml_diag(SZIB_(G),SZJ_(G)), vDml_diag(SZI_(G),SZJB_(G)) integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz @@ -179,7 +179,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var real, dimension(SZI_(G)) :: pRef_MLD ! A reference pressure for calculating the mixed layer densities [Pa]. real, dimension(SZI_(G)) :: rhoAtK, rho1, d1, pRef_N2 ! Used for N2 real :: aFac, bFac, ddRho - real :: hAtVel, zpa, zpb, dh, res_scaling_fac, I_l_f + real :: hAtVel, zpa, zpb, dh, res_scaling_fac + real :: I_LFront ! The inverse of the frontal length scale [L-1 ~> m-1] logical :: proper_averaging, line_is_empty, keep_going, res_upscale real :: PSI, PSI1, z, BOTTOP, XP, DD ! For the following statement functions @@ -246,8 +247,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var call hchksum(CS%MLD_filtered,'mixed_layer_restrat: MLD_filtered',G%HI,haloshift=1,scale=GV%H_to_m) call hchksum(MLD_in,'mixed_layer_restrat: MLD in',G%HI,haloshift=1) endif - aFac = CS%MLE_MLD_decay_time / ( dt + CS%MLE_MLD_decay_time ) - bFac = dt / ( dt + CS%MLE_MLD_decay_time ) + aFac = CS%MLE_MLD_decay_time / ( dt_in_T + CS%MLE_MLD_decay_time ) + bFac = dt_in_T / ( dt_in_T + CS%MLE_MLD_decay_time ) do j = js-1, je+1 ; do i = is-1, ie+1 ! Expression bFac*MLD_fast(i,j) + aFac*CS%MLD_filtered(i,j) is the time-filtered ! (running mean) of MLD. The max() allows the "running mean" to be reset @@ -263,8 +264,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var call hchksum(CS%MLD_filtered_slow,'mixed_layer_restrat: MLD_filtered_slow',G%HI,haloshift=1,scale=GV%H_to_m) call hchksum(MLD_fast,'mixed_layer_restrat: MLD fast',G%HI,haloshift=1,scale=GV%H_to_m) endif - aFac = CS%MLE_MLD_decay_time2 / ( dt + CS%MLE_MLD_decay_time2 ) - bFac = dt / ( dt + CS%MLE_MLD_decay_time2 ) + aFac = CS%MLE_MLD_decay_time2 / ( dt_in_T + CS%MLE_MLD_decay_time2 ) + bFac = dt_in_T / ( dt_in_T + CS%MLE_MLD_decay_time2 ) do j = js-1, je+1 ; do i = is-1, ie+1 ! Expression bFac*MLD_fast(i,j) + aFac*CS%MLD_filtered(i,j) is the time-filtered ! (running mean) of MLD. The max() allows the "running mean" to be reset @@ -280,14 +281,14 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var uDml(:) = 0.0 ; vDml(:) = 0.0 uDml_slow(:) = 0.0 ; vDml_slow(:) = 0.0 - I4dt = 0.25 / dt - g_Rho0 = GV%g_Earth*US%L_to_m**2*US%s_to_T**2 / GV%Rho0 + I4dt = 0.25 / (dt_in_T) + g_Rho0 = GV%g_Earth / GV%Rho0 h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff*GV%H_to_Z proper_averaging = .not. CS%MLE_use_MLD_ave_bug if (CS%front_length>0.) then res_upscale = .true. - I_l_f = 1./CS%front_length + I_LFront = 1. / CS%front_length else res_upscale = .false. endif @@ -296,7 +297,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var !$OMP parallel default(none) shared(is,ie,js,je,G,GV,US,htot_fast,Rml_av_fast,tv,p0,h,h_avail,& !$OMP h_neglect,g_Rho0,I4dt,CS,uhml,uhtr,dt,vhml,vhtr, & !$OMP utimescale_diag,vtimescale_diag,forces,dz_neglect, & -!$OMP htot_slow,MLD_slow,Rml_av_slow,VarMix,I_l_f, & +!$OMP htot_slow,MLD_slow,Rml_av_slow,VarMix,I_LFront, & !$OMP res_upscale, & !$OMP nz,MLD_fast,uDml_diag,vDml_diag,proper_averaging) & !$OMP private(rho_ml,h_vel,u_star,absf,mom_mixrate,timescale, & @@ -343,10 +344,11 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var enddo if (CS%debug) then - call hchksum(h,'mixed_layer_restrat: h',G%HI,haloshift=1,scale=GV%H_to_m) - call hchksum(forces%ustar,'mixed_layer_restrat: u*',G%HI,haloshift=1,scale=US%Z_to_m*US%s_to_T) - call hchksum(MLD_fast,'mixed_layer_restrat: MLD',G%HI,haloshift=1,scale=GV%H_to_m) - call hchksum(Rml_av_fast,'mixed_layer_restrat: rml',G%HI,haloshift=1, scale=US%m_to_Z) + call hchksum(h,'mixed_layer_restrat: h', G%HI, haloshift=1, scale=GV%H_to_m) + call hchksum(forces%ustar,'mixed_layer_restrat: u*', G%HI, haloshift=1, scale=US%Z_to_m*US%s_to_T) + call hchksum(MLD_fast,'mixed_layer_restrat: MLD', G%HI, haloshift=1, scale=GV%H_to_m) + call hchksum(Rml_av_fast,'mixed_layer_restrat: rml', G%HI, haloshift=1, & + scale=US%m_to_Z*US%L_to_m**2*US%s_to_T**2) endif ! TO DO: @@ -356,11 +358,11 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! U - Component !$OMP do do j=js,je ; do I=is-1,ie - u_star = US%s_to_T*0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) - absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) + u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) + absf = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) ! If needed, res_scaling_fac = min( ds, L_d ) / l_f if (res_upscale) res_scaling_fac = & - ( sqrt( 0.5 * ( G%dxCu(I,j)**2 + G%dyCu(I,j)**2 ) ) * I_l_f ) & + ( sqrt( 0.5 * ( G%dxCu(I,j)**2 + G%dyCu(I,j)**2 ) ) * I_LFront ) & * min( 1., 0.5*( VarMix%Rd_dx_h(i,j) + VarMix%Rd_dx_h(i+1,j) ) ) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) @@ -372,8 +374,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef if (res_upscale) timescale = timescale * res_scaling_fac - uDml(I) = timescale * G%mask2dCu(I,j)*G%dyCu(I,j)* & - G%IdxCu(I,j)*(Rml_av_fast(i+1,j)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H) + uDml(I) = timescale * G%mask2dCu(I,j)*G%dyCu(I,j)*G%IdxCu(I,j) * & + (Rml_av_fast(i+1,j)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H) ! As above but using the slow filtered MLD h_vel = 0.5*((htot_slow(i,j) + htot_slow(i+1,j)) + h_neglect) * GV%H_to_Z mom_mixrate = (0.41*9.8696)*u_star**2 / & @@ -381,8 +383,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef2 if (res_upscale) timescale = timescale * res_scaling_fac - uDml_slow(I) = timescale * G%mask2dCu(I,j)*G%dyCu(I,j)* & - G%IdxCu(I,j)*(Rml_av_slow(i+1,j)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H) + uDml_slow(I) = timescale * G%mask2dCu(I,j)*G%dyCu(I,j)*G%IdxCu(I,j) * & + (Rml_av_slow(i+1,j)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H) if (uDml(I) + uDml_slow(I) == 0.) then do k=1,nz ; uhml(I,j,k) = 0.0 ; enddo @@ -421,7 +423,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var enddo do k=1,nz uhml(I,j,k) = a(k)*uDml(I) + b(k)*uDml_slow(I) - uhtr(I,j,k) = uhtr(I,j,k) + uhml(I,j,k)*dt + uhtr(I,j,k) = uhtr(I,j,k) + uhml(I,j,k)*dt_in_T enddo endif @@ -432,11 +434,11 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! V- component !$OMP do do J=js-1,je ; do i=is,ie - u_star = US%s_to_T*0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) - absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) + u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) + absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) ! If needed, res_scaling_fac = min( ds, L_d ) / l_f if (res_upscale) res_scaling_fac = & - ( sqrt( 0.5 * ( G%dxCv(i,J)**2 + G%dyCv(i,J)**2 ) ) * I_l_f ) & + ( sqrt( 0.5 * ( (G%dxCv(i,J))**2 + (G%dyCv(i,J))**2 ) ) * I_LFront ) & * min( 1., 0.5*( VarMix%Rd_dx_h(i,j) + VarMix%Rd_dx_h(i,j+1) ) ) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) @@ -448,8 +450,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef if (res_upscale) timescale = timescale * res_scaling_fac - vDml(i) = timescale * G%mask2dCv(i,J)*G%dxCv(i,J)* & - G%IdyCv(i,J)*(Rml_av_fast(i,j+1)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H) + vDml(i) = timescale * G%mask2dCv(i,J)*G%dxCv(i,J)*G%IdyCv(i,J) * & + (Rml_av_fast(i,j+1)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H) ! As above but using the slow filtered MLD h_vel = 0.5*((htot_slow(i,j) + htot_slow(i,j+1)) + h_neglect) * GV%H_to_Z mom_mixrate = (0.41*9.8696)*u_star**2 / & @@ -457,8 +459,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef2 if (res_upscale) timescale = timescale * res_scaling_fac - vDml_slow(i) = timescale * G%mask2dCv(i,J)*G%dxCv(i,J)* & - G%IdyCv(i,J)*(Rml_av_slow(i,j+1)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H) + vDml_slow(i) = timescale * G%mask2dCv(i,J)*G%dxCv(i,J)*G%IdyCv(i,J) * & + (Rml_av_slow(i,j+1)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H) if (vDml(i) + vDml_slow(i) == 0.) then do k=1,nz ; vhml(i,J,k) = 0.0 ; enddo @@ -497,7 +499,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var enddo do k=1,nz vhml(i,J,k) = a(k)*vDml(i) + b(k)*vDml_slow(i) - vhtr(i,J,k) = vhtr(i,J,k) + vhml(i,J,k)*dt + vhtr(i,J,k) = vhtr(i,J,k) + vhml(i,J,k)*dt_in_T enddo endif @@ -507,7 +509,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var !$OMP do do j=js,je ; do k=1,nz ; do i=is,ie - h(i,j,k) = h(i,j,k) - dt*G%IareaT(i,j) * & + h(i,j,k) = h(i,j,k) - dt_in_T*G%IareaT(i,j) * & ((uhml(I,j,k) - uhml(I-1,j,k)) + (vhml(i,J,k) - vhml(i,J-1,k))) enddo ; enddo ; enddo !$OMP end parallel @@ -547,40 +549,40 @@ end subroutine mixedlayer_restrat_general !> Calculates a restratifying flow assuming a 2-layer bulk mixed layer. -subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) +subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt_in_T, G, GV, US, CS) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Accumulated zonal mass flux - !! [H m2 ~> m3 or kg] + !! [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Accumulated meridional mass flux - !! [H m2 ~> m3 or kg] + !! [H L2 ~> m3 or kg] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - real, intent(in) :: dt !< Time increment [s] + real, intent(in) :: dt_in_T !< Time increment [T ~> s] type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure ! Local variables - real :: uhml(SZIB_(G),SZJ_(G),SZK_(G)) ! zonal mixed layer transport [H m2 s-1 ~> m3 s-1 or kg s-1] - real :: vhml(SZI_(G),SZJB_(G),SZK_(G)) ! merid mixed layer transport [H m2 s-1 ~> m3 s-1 or kg s-1] + real :: uhml(SZIB_(G),SZJ_(G),SZK_(G)) ! zonal mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: vhml(SZI_(G),SZJB_(G),SZK_(G)) ! merid mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & h_avail ! The volume available for diffusion out of each face of each - ! sublayer of the mixed layer, divided by dt [H m2 s-1 ~> m3 s-1 or kg s-1]. + ! sublayer of the mixed layer, divided by dt [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJ_(G)) :: & htot, & ! The sum of the thicknesses of layers in the mixed layer [H ~> m or kg m-2] - Rml_av ! g_Rho0 times the average mixed layer density [m s-2] - real :: g_Rho0 ! G_Earth/Rho0 [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1] + Rml_av ! g_Rho0 times the average mixed layer density [L2 Z-1 T-2 ~> m s-2] + real :: g_Rho0 ! G_Earth/Rho0 [m3 L2 Z-1 T-2 kg-1 ~> m4 s-2 kg-1] real :: Rho0(SZI_(G)) ! Potential density relative to the surface [kg m-3] real :: p0(SZI_(G)) ! A pressure of 0 [Pa] real :: h_vel ! htot interpolated onto velocity points [Z ~> m]. (The units are not H.) - real :: absf ! absolute value of f, interpolated to velocity points [s-1] - real :: u_star ! surface friction velocity, interpolated to velocity points [Z s-1 ~> m s-1]. - real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer [s-1] - real :: timescale ! mixing growth timescale [s] + real :: absf ! absolute value of f, interpolated to velocity points [T-1 ~> s-1] + real :: u_star ! surface friction velocity, interpolated to velocity points [Z T-1 ~> m s-1]. + real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer [T-1 ~> s-1] + real :: timescale ! mixing growth timescale [T ~> s] real :: h_neglect ! tiny thickness usually lost in roundoff and can be neglected [H ~> m or kg m-2] real :: dz_neglect ! tiny thickness that usually lost in roundoff and can be neglected [Z ~> m] - real :: I4dt ! 1/(4 dt) + real :: I4dt ! 1/(4 dt) [T-1 ~> s-1] real :: I2htot ! Twice the total mixed layer thickness at velocity points [H ~> m or kg m-2] real :: z_topx2 ! depth of the top of a layer at velocity points [H ~> m or kg m-2] real :: hx2 ! layer thickness at velocity points [H ~> m or kg m-2] @@ -589,10 +591,10 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) ! layer. The vertical sum of a() through the pieces of ! the mixed layer must be 0. real :: uDml(SZIB_(G)) ! The zonal and meridional volume fluxes in the upper - real :: vDml(SZI_(G)) ! half of the mixed layer [H m2 s-1 ~> m3 s-1 or kg s-1]. + real :: vDml(SZI_(G)) ! half of the mixed layer [H L2 T-1 ~> m3 s-1 or kg s-1]. real :: utimescale_diag(SZIB_(G),SZJ_(G)) ! The restratification timescales real :: vtimescale_diag(SZI_(G),SZJB_(G)) ! in the zonal and meridional - ! directions [s], stored in 2-D + ! directions [T ~> s], stored in 2-D ! arrays for diagnostic purposes. real :: uDml_diag(SZIB_(G),SZJ_(G)), vDml_diag(SZI_(G),SZJB_(G)) logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. @@ -606,8 +608,8 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) if ((nkml<2) .or. (CS%ml_restrat_coef<=0.0)) return uDml(:) = 0.0 ; vDml(:) = 0.0 - I4dt = 0.25 / dt - g_Rho0 = GV%g_Earth*US%L_to_m**2*US%s_to_T**2 / GV%Rho0 + I4dt = 0.25 / (dt_in_T) + g_Rho0 = GV%g_Earth / GV%Rho0 use_EOS = associated(tv%eqn_of_state) h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff*GV%H_to_Z @@ -653,8 +655,8 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) do j=js,je; do I=is-1,ie h_vel = 0.5*(htot(i,j) + htot(i+1,j)) * GV%H_to_Z - u_star = US%s_to_T*0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) - absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) + u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) + absf = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) ! momentum mixing rate: pi^2*visc/h_ml^2 ! 0.41 is the von Karmen constant, 9.8696 = pi^2. @@ -663,10 +665,10 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef -! timescale = timescale*(2?)*(L_def/L_MLI)*min(EKE/MKE,1.0 + G%dyCv(i,j)**2/L_def**2)) +! timescale = timescale*(2?)*(L_def/L_MLI) * min(EKE/MKE,1.0 + (G%dyCv(i,j)/L_def)**2) - uDml(I) = timescale * G%mask2dCu(I,j)*G%dyCu(I,j)* & - G%IdxCu(I,j)*(Rml_av(i+1,j)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) + uDml(I) = timescale * G%mask2dCu(I,j)*G%dyCu(I,j)*G%IdxCu(I,j) * & + (Rml_av(i+1,j)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) if (uDml(I) == 0) then do k=1,nkml ; uhml(I,j,k) = 0.0 ; enddo @@ -687,7 +689,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) enddo do k=1,nkml uhml(I,j,k) = a(k)*uDml(I) - uhtr(I,j,k) = uhtr(I,j,k) + uhml(I,j,k)*dt + uhtr(I,j,k) = uhtr(I,j,k) + uhml(I,j,k)*dt_in_T enddo endif @@ -700,8 +702,8 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) do J=js-1,je ; do i=is,ie h_vel = 0.5*(htot(i,j) + htot(i,j+1)) * GV%H_to_Z - u_star = US%s_to_T*0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) - absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) + u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) + absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) ! momentum mixing rate: pi^2*visc/h_ml^2 ! 0.41 is the von Karmen constant, 9.8696 = pi^2. @@ -710,16 +712,16 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef -! timescale = timescale*(2?)*(L_def/L_MLI)*min(EKE/MKE,1.0 + G%dyCv(i,j)**2/L_def**2)) +! timescale = timescale*(2?)*(L_def/L_MLI) * min(EKE/MKE,1.0 + (G%dyCv(i,j)/L_def)**2) - vDml(i) = timescale * G%mask2dCv(i,J)*G%dxCv(i,J)* & - G%IdyCv(i,J)*(Rml_av(i,j+1)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) + vDml(i) = timescale * G%mask2dCv(i,J)*G%dxCv(i,J)*G%IdyCv(i,J) * & + (Rml_av(i,j+1)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) if (vDml(i) == 0) then do k=1,nkml ; vhml(i,J,k) = 0.0 ; enddo else I2htot = 1.0 / (htot(i,j) + htot(i,j+1) + h_neglect) z_topx2 = 0.0 - ! a(k) relates the sublayer transport to uDml with a linear profile. + ! a(k) relates the sublayer transport to vDml with a linear profile. ! The sum of a(k) through the mixed layers must be 0. do k=1,nkml hx2 = (h(i,j,k) + h(i,j+1,k) + h_neglect) @@ -733,7 +735,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) enddo do k=1,nkml vhml(i,J,k) = a(k)*vDml(i) - vhtr(i,J,k) = vhtr(i,J,k) + vhml(i,J,k)*dt + vhtr(i,J,k) = vhtr(i,J,k) + vhml(i,J,k)*dt_in_T enddo endif @@ -743,7 +745,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) !$OMP do do j=js,je ; do k=1,nkml ; do i=is,ie - h(i,j,k) = h(i,j,k) - dt*G%IareaT(i,j) * & + h(i,j,k) = h(i,j,k) - dt_in_T*G%IareaT(i,j) * & ((uhml(I,j,k) - uhml(I-1,j,k)) + (vhml(i,J,k) - vhml(i,J-1,k))) enddo ; enddo ; enddo !$OMP end parallel @@ -807,12 +809,11 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, if (.not. mixedlayer_restrat_init) return if (.not.associated(CS)) then - call MOM_error(FATAL, "mixedlayer_restrat_init called without an "// & - "associated control structure.") + call MOM_error(FATAL, "mixedlayer_restrat_init called without an associated control structure.") endif ! Nonsense values to cause problems when these parameters are not used - CS%MLE_MLD_decay_time = -9.e9 + CS%MLE_MLD_decay_time = -9.e9*US%s_to_T CS%MLE_density_diff = -9.e9 CS%MLE_tail_dh = -9.e9 CS%MLE_use_PBL_MLD = .false. @@ -839,7 +840,7 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, "upscaling of buoyancy gradients that is otherwise represented "//& "by the parameter FOX_KEMPER_ML_RESTRAT_COEF. If MLE_FRONT_LENGTH is "//& "non-zero, it is recommended to set FOX_KEMPER_ML_RESTRAT_COEF=1.0.",& - units="m", default=0.0) + units="m", default=0.0, scale=US%m_to_L) call get_param(param_file, mdl, "MLE_USE_PBL_MLD", CS%MLE_use_PBL_MLD, & "If true, the MLE parameterization will use the mixed-layer "//& "depth provided by the active PBL parameterization. If false, "//& @@ -849,12 +850,12 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, "The time-scale for a running-mean filter applied to the mixed-layer "//& "depth used in the MLE restratification parameterization. When "//& "the MLD deepens below the current running-mean the running-mean "//& - "is instantaneously set to the current MLD.", units="s", default=0.) + "is instantaneously set to the current MLD.", units="s", default=0., scale=US%s_to_T) call get_param(param_file, mdl, "MLE_MLD_DECAY_TIME2", CS%MLE_MLD_decay_time2, & "The time-scale for a running-mean filter applied to the filtered "//& "mixed-layer depth used in a second MLE restratification parameterization. "//& "When the MLD deepens below the current running-mean the running-mean "//& - "is instantaneously set to the current MLD.", units="s", default=0.) + "is instantaneously set to the current MLD.", units="s", default=0., scale=US%s_to_T) if (.not. CS%MLE_use_PBL_MLD) then call get_param(param_file, mdl, "MLE_DENSITY_DIFF", CS%MLE_density_diff, & "Density difference used to detect the mixed-layer "//& @@ -876,8 +877,8 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, CS%diag => diag - if (GV%Boussinesq) then ; flux_to_kg_per_s = GV%Rho0 - else ; flux_to_kg_per_s = 1. ; endif + if (GV%Boussinesq) then ; flux_to_kg_per_s = GV%Rho0*US%L_to_m**2*US%s_to_T + else ; flux_to_kg_per_s = US%L_to_m**2*US%s_to_T ; endif CS%id_uhml = register_diag_field('ocean_model', 'uhml', diag%axesCuL, Time, & 'Zonal Thickness Flux to Restratify Mixed Layer', 'kg s-1', conversion=flux_to_kg_per_s, & @@ -886,22 +887,26 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, 'Meridional Thickness Flux to Restratify Mixed Layer', 'kg s-1', conversion=flux_to_kg_per_s, & x_cell_method='sum', v_extensive=.true.) CS%id_urestrat_time = register_diag_field('ocean_model', 'MLu_restrat_time', diag%axesCu1, Time, & - 'Mixed Layer Zonal Restratification Timescale', 's') + 'Mixed Layer Zonal Restratification Timescale', 's', conversion=US%T_to_s) CS%id_vrestrat_time = register_diag_field('ocean_model', 'MLv_restrat_time', diag%axesCv1, Time, & - 'Mixed Layer Meridional Restratification Timescale', 's') + 'Mixed Layer Meridional Restratification Timescale', 's', conversion=US%T_to_s) CS%id_MLD = register_diag_field('ocean_model', 'MLD_restrat', diag%axesT1, Time, & 'Mixed Layer Depth as used in the mixed-layer restratification parameterization', 'm') CS%id_Rml = register_diag_field('ocean_model', 'ML_buoy_restrat', diag%axesT1, Time, & 'Mixed Layer Buoyancy as used in the mixed-layer restratification parameterization', & - 'm s2', conversion=US%m_to_Z) + 'm s2', conversion=US%m_to_Z*US%L_to_m**2*US%s_to_T**2) CS%id_uDml = register_diag_field('ocean_model', 'udml_restrat', diag%axesCu1, Time, & - 'Transport stream function amplitude for zonal restratification of mixed layer', 'm3 s-1') + 'Transport stream function amplitude for zonal restratification of mixed layer', & + 'm3 s-1', conversion=GV%H_to_m*US%L_to_m**2*US%s_to_T) CS%id_vDml = register_diag_field('ocean_model', 'vdml_restrat', diag%axesCv1, Time, & - 'Transport stream function amplitude for meridional restratification of mixed layer', 'm3 s-1') + 'Transport stream function amplitude for meridional restratification of mixed layer', & + 'm3 s-1', conversion=GV%H_to_m*US%L_to_m**2*US%s_to_T) CS%id_uml = register_diag_field('ocean_model', 'uml_restrat', diag%axesCu1, Time, & - 'Surface zonal velocity component of mixed layer restratification', 'm s-1') + 'Surface zonal velocity component of mixed layer restratification', & + 'm s-1', conversion=US%L_T_to_m_s) CS%id_vml = register_diag_field('ocean_model', 'vml_restrat', diag%axesCv1, Time, & - 'Surface meridional velocity component of mixed layer restratification', 'm s-1') + 'Surface meridional velocity component of mixed layer restratification', & + 'm s-1', conversion=US%L_T_to_m_s) ! Rescale variables from restart files if the internal dimensional scalings have changed. if (CS%MLE_MLD_decay_time>0. .or. CS%MLE_MLD_decay_time2>0.) then diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 04d3847e88..2b4cdfadee 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -35,14 +35,14 @@ module MOM_thickness_diffuse !> Control structure for thickness diffusion type, public :: thickness_diffuse_CS ; private - real :: Khth !< Background interface depth diffusivity [m2 s-1] + real :: Khth !< Background interface depth diffusivity [L2 T-1 ~> m2 s-1] real :: Khth_Slope_Cff !< Slope dependence coefficient of Khth [m2 s-1] real :: max_Khth_CFL !< Maximum value of the diffusive CFL for thickness diffusion - real :: Khth_Min !< Minimum value of Khth [m2 s-1] - real :: Khth_Max !< Maximum value of Khth [m2 s-1], or 0 for no max + real :: Khth_Min !< Minimum value of Khth [L2 T-1 ~> m2 s-1] + real :: Khth_Max !< Maximum value of Khth [L2 T-1 ~> m2 s-1], or 0 for no max real :: slope_max !< Slopes steeper than slope_max are limited in some way [nondim]. real :: kappa_smooth !< Vertical diffusivity used to interpolate more - !! sensible values of T & S into thin layers [Z2 s-1 ~> m2 s-1]. + !! sensible values of T & S into thin layers [Z2 T-1 ~> m2 s-1]. logical :: thickness_diffuse !< If true, interfaces heights are diffused. logical :: use_FGNV_streamfn !< If true, use the streamfunction formulation of !! Ferrari et al., 2010, which effectively emphasizes @@ -52,12 +52,12 @@ module MOM_thickness_diffuse real :: FGNV_c_min !< A minimum wave speed used in the Ferrari et al., 2010, !! streamfunction formulation [m s-1]. real :: N2_floor !< A floor for Brunt-Vasaila frequency in the Ferrari et al., 2010, - !! streamfunction formulation [s-2]. + !! streamfunction formulation [T-2 ~> s-2]. logical :: detangle_interfaces !< If true, add 3-d structured interface height !! diffusivities to horizontally smooth jagged layers. real :: detangle_time !< If detangle_interfaces is true, this is the !! timescale over which maximally jagged grid-scale - !! thickness variations are suppressed [s]. This must be + !! thickness variations are suppressed [T ~> s]. This must be !! longer than DT, or 0 (the default) to use DT. integer :: nkml !< number of layers within mixed layer logical :: debug !< write verbose checksums for debugging purposes @@ -68,7 +68,7 @@ module MOM_thickness_diffuse real :: MEKE_GEOMETRIC_alpha!< The nondimensional coefficient governing the efficiency of !! the GEOMETRIC thickness difussion [nondim] real :: MEKE_GEOMETRIC_epsilon !< Minimum Eady growth rate for the GEOMETRIC thickness - !! diffusivity [s-1]. + !! diffusivity [T-1 ~> s-1]. logical :: Use_KH_in_MEKE !< If true, uses the thickness diffusivity calculated here to diffuse MEKE. logical :: GM_src_alt !< If true, use the GM energy conversion form S^2*N^2*kappa rather !! than the streamfunction for the GM source term. @@ -78,8 +78,8 @@ module MOM_thickness_diffuse real, pointer :: diagSlopeY(:,:,:) => NULL() !< Diagnostic: zonal neutral slope [nondim] real, dimension(:,:,:), pointer :: & - KH_u_GME => NULL(), & !< interface height diffusivities in u-columns (m2 s-1) - KH_v_GME => NULL() !< interface height diffusivities in v-columns (m2 s-1) + KH_u_GME => NULL(), & !< interface height diffusivities in u-columns [L2 T-1 ~> m2 s-1] + KH_v_GME => NULL() !< interface height diffusivities in v-columns [L2 T-1 ~> m2 s-1] !>@{ !! Diagnostic identifier @@ -102,9 +102,9 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Accumulated zonal mass flux - !! [m2 H ~> m3 or kg] + !! [L2 H ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Accumulated meridional mass flux - !! [m2 H ~> m3 or kg] + !! [L2 H ~> m3 or kg] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure real, intent(in) :: dt !< Time increment [s] type(MEKE_type), pointer :: MEKE !< MEKE control structure @@ -114,40 +114,41 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp ! Local variables real :: e(SZI_(G), SZJ_(G), SZK_(G)+1) ! heights of interfaces, relative to mean ! sea level [Z ~> m], positive up. - real :: uhD(SZIB_(G), SZJ_(G), SZK_(G)) ! Diffusive u*h fluxes [m2 H s-1 ~> m3 s-1 or kg s-1] - real :: vhD(SZI_(G), SZJB_(G), SZK_(G)) ! Diffusive v*h fluxes [m2 H s-1 ~> m3 s-1 or kg s-1] + real :: uhD(SZIB_(G), SZJ_(G), SZK_(G)) ! Diffusive u*h fluxes [L2 H T-1 ~> m3 s-1 or kg s-1] + real :: vhD(SZI_(G), SZJB_(G), SZK_(G)) ! Diffusive v*h fluxes [L2 H T-1 ~> m3 s-1 or kg s-1] real, dimension(SZIB_(G), SZJ_(G), SZK_(G)+1) :: & - KH_u, & ! interface height diffusivities in u-columns [m2 s-1] + KH_u, & ! interface height diffusivities in u-columns [L2 T-1 ~> m2 s-1] int_slope_u ! A nondimensional ratio from 0 to 1 that gives the relative ! weighting of the interface slopes to that calculated also ! using density gradients at u points. The physically correct ! slopes occur at 0, while 1 is used for numerical closures. real, dimension(SZI_(G), SZJB_(G), SZK_(G)+1) :: & - KH_v, & ! interface height diffusivities in v-columns [m2 s-1] + KH_v, & ! interface height diffusivities in v-columns [L2 T-1 ~> m2 s-1] int_slope_v ! A nondimensional ratio from 0 to 1 that gives the relative ! weighting of the interface slopes to that calculated also ! using density gradients at v points. The physically correct ! slopes occur at 0, while 1 is used for numerical closures. real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: & - KH_t ! diagnosed diffusivity at tracer points [m2 s-1] + KH_t ! diagnosed diffusivity at tracer points [L2 T-1 ~> m2 s-1] real, dimension(SZIB_(G), SZJ_(G)) :: & - KH_u_CFL ! The maximum stable interface height diffusivity at u grid points [m2 s-1] + KH_u_CFL ! The maximum stable interface height diffusivity at u grid points [L2 T-1 ~> m2 s-1] real, dimension(SZI_(G), SZJB_(G)) :: & - KH_v_CFL ! The maximum stable interface height diffusivity at v grid points [m2 s-1] + KH_v_CFL ! The maximum stable interface height diffusivity at v grid points [L2 T-1 ~> m2 s-1] real :: Khth_Loc_u(SZIB_(G), SZJ_(G)) - real :: Khth_Loc(SZIB_(G), SZJB_(G)) ! locally calculated thickness diffusivity [m2 s-1] + real :: Khth_Loc(SZIB_(G), SZJB_(G)) ! locally calculated thickness diffusivity [L2 T-1 ~> m2 s-1] real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. - real, dimension(:,:), pointer :: cg1 => null() !< Wave speed [m s-1] + real, dimension(:,:), pointer :: cg1 => null() !< Wave speed [L T-1 ~> m s-1] + real :: dt_in_T ! Time increment [T ~> s] logical :: use_VarMix, Resoln_scaled, use_stored_slopes, khth_use_ebt_struct, use_Visbeck logical :: use_QG_Leith integer :: i, j, k, is, ie, js, je, nz real :: hu(SZI_(G), SZJ_(G)) ! u-thickness [H ~> m or kg m-2] real :: hv(SZI_(G), SZJ_(G)) ! v-thickness [H ~> m or kg m-2] - real :: KH_u_lay(SZI_(G), SZJ_(G)) ! layer ave thickness diffusivities [m2 s-1] - real :: KH_v_lay(SZI_(G), SZJ_(G)) ! layer ave thickness diffusivities [m2 s-1] + real :: KH_u_lay(SZI_(G), SZJ_(G)) ! layer ave thickness diffusivities [L2 T-1 ~> m2 s-1] + real :: KH_v_lay(SZI_(G), SZJ_(G)) ! layer ave thickness diffusivities [L2 T-1 ~> m2 s-1] if (.not. associated(CS)) call MOM_error(FATAL, "MOM_thickness_diffuse:"// & "Module must be initialized before it is used.") @@ -157,6 +158,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke h_neglect = GV%H_subroundoff + dt_in_T = US%s_to_T*dt if (associated(MEKE)) then if (associated(MEKE%GM_src)) then @@ -183,12 +185,12 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP parallel do default(none) shared(is,ie,js,je,KH_u_CFL,dt,G,CS) do j=js,je ; do I=is-1,ie KH_u_CFL(I,j) = (0.25*CS%max_Khth_CFL) / & - (dt*(G%IdxCu(I,j)*G%IdxCu(I,j) + G%IdyCu(I,j)*G%IdyCu(I,j))) + (dt_in_T * (G%IdxCu(I,j)*G%IdxCu(I,j) + G%IdyCu(I,j)*G%IdyCu(I,j))) enddo ; enddo !$OMP parallel do default(none) shared(is,ie,js,je,KH_v_CFL,dt,G,CS) do j=js-1,je ; do I=is,ie KH_v_CFL(i,J) = (0.25*CS%max_Khth_CFL) / & - (dt*(G%IdxCv(i,J)*G%IdxCv(i,J) + G%IdyCv(i,J)*G%IdyCv(i,J))) + (dt_in_T * (G%IdxCv(i,J)*G%IdxCv(i,J) + G%IdyCv(i,J)*G%IdyCv(i,J))) enddo ; enddo ! Calculates interface heights, e, in [Z ~> m]. @@ -201,14 +203,15 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP int_slope_v,khth_use_ebt_struct) !$OMP do do j=js,je; do I=is-1,ie - Khth_Loc_u(I,j) = CS%Khth + Khth_loc_u(I,j) = CS%Khth enddo ; enddo if (use_VarMix) then !$OMP do if (use_Visbeck) then do j=js,je ; do I=is-1,ie - Khth_Loc_u(I,j) = Khth_Loc_u(I,j) + CS%KHTH_Slope_Cff*VarMix%L2u(I,j)*VarMix%SN_u(I,j) + Khth_loc_u(I,j) = Khth_loc_u(I,j) + & + CS%KHTH_Slope_Cff*VarMix%L2u(I,j) * VarMix%SN_u(I,j) enddo ; enddo endif endif @@ -217,13 +220,13 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP do if (CS%MEKE_GEOMETRIC) then do j=js,je ; do I=is-1,ie - Khth_Loc_u(I,j) = Khth_Loc_u(I,j) + & - G%mask2dCu(I,j) * CS%MEKE_GEOMETRIC_alpha * 0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i+1,j)) / & + Khth_loc_u(I,j) = Khth_loc_u(I,j) + G%mask2dCu(I,j) * CS%MEKE_GEOMETRIC_alpha * & + 0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i+1,j)) / & (VarMix%SN_u(I,j) + CS%MEKE_GEOMETRIC_epsilon) enddo ; enddo else do j=js,je ; do I=is-1,ie - Khth_Loc_u(I,j) = Khth_Loc_u(I,j) + MEKE%KhTh_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i+1,j)) + Khth_loc_u(I,j) = Khth_loc_u(I,j) + MEKE%KhTh_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i+1,j)) enddo ; enddo endif endif ; endif @@ -231,24 +234,24 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp if (Resoln_scaled) then !$OMP do do j=js,je; do I=is-1,ie - Khth_Loc_u(I,j) = Khth_Loc_u(I,j) * VarMix%Res_fn_u(I,j) + Khth_loc_u(I,j) = Khth_loc_u(I,j) * VarMix%Res_fn_u(I,j) enddo ; enddo endif if (CS%Khth_Max > 0) then !$OMP do do j=js,je; do I=is-1,ie - Khth_Loc_u(I,j) = max(CS%Khth_min, min(Khth_Loc_u(I,j),CS%Khth_Max)) + Khth_loc_u(I,j) = max(CS%Khth_Min, min(Khth_loc_u(I,j), CS%Khth_Max)) enddo ; enddo else !$OMP do do j=js,je; do I=is-1,ie - Khth_Loc_u(I,j) = max(CS%Khth_min, Khth_Loc_u(I,j)) + Khth_loc_u(I,j) = max(CS%Khth_Min, Khth_loc_u(I,j)) enddo ; enddo endif !$OMP do do j=js,je; do I=is-1,ie - KH_u(I,j,1) = min(KH_u_CFL(I,j), Khth_Loc_u(I,j)) + KH_u(I,j,1) = min(KH_u_CFL(I,j), Khth_loc_u(I,j)) enddo ; enddo if (khth_use_ebt_struct) then @@ -275,20 +278,20 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP do if (CS%use_GME_thickness_diffuse) then do k=1,nz+1 ; do j=js,je ; do I=is-1,ie - CS%KH_u_GME(I,j,k) = KH_u(I,j,k) + CS%KH_u_GME(I,j,k) = KH_u(I,j,k) enddo ; enddo ; enddo endif !$OMP do do J=js-1,je ; do i=is,ie - Khth_Loc(i,j) = CS%Khth + Khth_loc(i,j) = CS%Khth enddo ; enddo if (use_VarMix) then !$OMP do if (use_Visbeck) then do J=js-1,je ; do i=is,ie - Khth_Loc(i,j) = Khth_Loc(i,j) + CS%KHTH_Slope_Cff*VarMix%L2v(i,J)*VarMix%SN_v(i,J) + Khth_loc(i,j) = Khth_loc(i,j) + CS%KHTH_Slope_Cff*VarMix%L2v(i,J)*VarMix%SN_v(i,J) enddo ; enddo endif endif @@ -296,13 +299,13 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP do if (CS%MEKE_GEOMETRIC) then do j=js-1,je ; do I=is,ie - Khth_Loc(I,j) = Khth_Loc(I,j) + & - G%mask2dCv(i,J) * CS%MEKE_GEOMETRIC_alpha * 0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i,j+1)) / & + Khth_loc(I,j) = Khth_loc(I,j) + G%mask2dCv(i,J) * CS%MEKE_GEOMETRIC_alpha * & + 0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i,j+1)) / & (VarMix%SN_v(i,J) + CS%MEKE_GEOMETRIC_epsilon) enddo ; enddo else do J=js-1,je ; do i=is,ie - Khth_Loc(i,j) = Khth_Loc(i,j) + MEKE%KhTh_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i,j+1)) + Khth_loc(i,j) = Khth_loc(i,j) + MEKE%KhTh_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i,j+1)) enddo ; enddo endif endif ; endif @@ -310,26 +313,26 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp if (Resoln_scaled) then !$OMP do do J=js-1,je ; do i=is,ie - Khth_Loc(i,j) = Khth_Loc(i,j) * VarMix%Res_fn_v(i,J) + Khth_loc(i,j) = Khth_loc(i,j) * VarMix%Res_fn_v(i,J) enddo ; enddo endif if (CS%Khth_Max > 0) then !$OMP do do J=js-1,je ; do i=is,ie - Khth_Loc(i,j) = max(CS%Khth_min, min(Khth_Loc(i,j),CS%Khth_Max)) + Khth_loc(i,j) = max(CS%Khth_Min, min(Khth_loc(i,j), CS%Khth_Max)) enddo ; enddo else !$OMP do do J=js-1,je ; do i=is,ie - Khth_Loc(i,j) = max(CS%Khth_min, Khth_Loc(i,j)) + Khth_loc(i,j) = max(CS%Khth_Min, Khth_loc(i,j)) enddo ; enddo endif if (CS%max_Khth_CFL > 0.0) then !$OMP do do J=js-1,je ; do i=is,ie - KH_v(i,J,1) = min(KH_v_CFL(i,J), Khth_Loc(i,j)) + KH_v(i,J,1) = min(KH_v_CFL(i,J), Khth_loc(i,j)) enddo ; enddo endif @@ -365,6 +368,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP do if (CS%MEKE_GEOMETRIC) then do j=js,je ; do I=is,ie + !### This will not give bitwise rotational symmetry. Add parentheses. MEKE%Kh(i,j) = CS%MEKE_GEOMETRIC_alpha * MEKE%MEKE(i,j) / & (0.25*(VarMix%SN_u(I,j)+VarMix%SN_u(I-1,j)+VarMix%SN_v(i,J)+VarMix%SN_v(i,J-1)) + & CS%MEKE_GEOMETRIC_epsilon) @@ -380,12 +384,12 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP end parallel if (CS%detangle_interfaces) then - call add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV, US, & + call add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt_in_T, G, GV, US, & CS, int_slope_u, int_slope_v) endif if (CS%debug) then - call uvchksum("Kh_[uv]", Kh_u, Kh_v, G%HI,haloshift=0) + call uvchksum("Kh_[uv]", Kh_u, Kh_v, G%HI, haloshift=0, scale=US%L_to_m**2*US%s_to_T) call uvchksum("int_slope_[uv]", int_slope_u, int_slope_v, G%HI, haloshift=0) call hchksum(h, "thickness_diffuse_1 h", G%HI, haloshift=1, scale=GV%H_to_m) call hchksum(e, "thickness_diffuse_1 e", G%HI, haloshift=1, scale=US%Z_to_m) @@ -401,10 +405,10 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp ! Calculate uhD, vhD from h, e, KH_u, KH_v, tv%T/S if (use_stored_slopes) then - call thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV, US, MEKE, CS, & + call thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt_in_T, G, GV, US, MEKE, CS, & int_slope_u, int_slope_v, VarMix%slope_x, VarMix%slope_y) else - call thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV, US, MEKE, CS, & + call thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt_in_T, G, GV, US, MEKE, CS, & int_slope_u, int_slope_v) endif @@ -448,7 +452,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp enddo ; enddo ! diagnose diffusivity at T-point do j=js,je ; do i=is,ie - KH_t(i,j,k) = ((hu(I-1,j)*KH_u_lay(i-1,j)+hu(I,j)*KH_u_lay(I,j)) & + Kh_t(i,j,k) = ((hu(I-1,j)*KH_u_lay(i-1,j)+hu(I,j)*KH_u_lay(I,j)) & +(hv(i,J-1)*KH_v_lay(i,J-1)+hv(i,J)*KH_v_lay(i,J))) & / (hu(I-1,j)+hu(I,j)+hv(i,J-1)+hv(i,J)+h_neglect) enddo ; enddo @@ -458,7 +462,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp MEKE%Kh_diff(:,:) = 0.0 do k=1,nz do j=js,je ; do i=is,ie - MEKE%Kh_diff(i,j) = MEKE%Kh_diff(i,j) + KH_t(i,j,k) * h(i,j,k) + MEKE%Kh_diff(i,j) = MEKE%Kh_diff(i,j) + Kh_t(i,j,k) * h(i,j,k) enddo; enddo enddo @@ -476,15 +480,15 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP parallel do default(none) shared(is,ie,js,je,nz,uhtr,uhD,dt,vhtr,CDp,vhD,h,G,GV) do k=1,nz do j=js,je ; do I=is-1,ie - uhtr(I,j,k) = uhtr(I,j,k) + uhD(I,j,k)*dt + uhtr(I,j,k) = uhtr(I,j,k) + uhD(I,j,k) * dt_in_T if (associated(CDp%uhGM)) CDp%uhGM(I,j,k) = uhD(I,j,k) enddo ; enddo do J=js-1,je ; do i=is,ie - vhtr(i,J,k) = vhtr(i,J,k) + vhD(i,J,k)*dt + vhtr(i,J,k) = vhtr(i,J,k) + vhD(i,J,k) * dt_in_T if (associated(CDp%vhGM)) CDp%vhGM(i,J,k) = vhD(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie - h(i,j,k) = h(i,j,k) - dt * G%IareaT(i,j) * & + h(i,j,k) = h(i,j,k) - dt_in_T * G%IareaT(i,j) * & ((uhD(I,j,k) - uhD(I-1,j,k)) + (vhD(i,J,k) - vhD(i,J-1,k))) if (h(i,j,k) < GV%Angstrom_H) h(i,j,k) = GV%Angstrom_H enddo ; enddo @@ -497,9 +501,9 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp if (CS%debug) then call uvchksum("thickness_diffuse [uv]hD", uhD, vhD, & - G%HI, haloshift=0, scale=GV%H_to_m) + G%HI, haloshift=0, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) call uvchksum("thickness_diffuse [uv]htr", uhtr, vhtr, & - G%HI, haloshift=0, scale=GV%H_to_m) + G%HI, haloshift=0, scale=US%L_to_m**2*GV%H_to_m) call hchksum(h, "thickness_diffuse h", G%HI, haloshift=0, scale=GV%H_to_m) endif @@ -508,7 +512,7 @@ end subroutine thickness_diffuse !> Calculates parameterized layer transports for use in the continuity equation. !! Fluxes are limited to give positive definite thicknesses. !! Called by thickness_diffuse(). -subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV, US, MEKE, & +subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt_in_T, G, GV, US, MEKE, & CS, int_slope_u, int_slope_v, slope_x, slope_y) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure @@ -516,16 +520,16 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface positions [Z ~> m] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: Kh_u !< Thickness diffusivity on interfaces - !! at u points [m2 s-1] + !! at u points [L2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: Kh_v !< Thickness diffusivity on interfaces !! at v points [m2 s-1] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: uhD !< Zonal mass fluxes - !! [H m2 s-1 ~> m3 s-1 or kg s-1] + !! [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: vhD !< Meridional mass fluxes - !! [H m2 s-1 ~> m3 s-1 or kg s-1] - real, dimension(:,:), pointer :: cg1 !< Wave speed [m s-1] - real, intent(in) :: dt !< Time increment [s] + !! [H L2 T-1 ~> m3 s-1 or kg s-1] + real, dimension(:,:), pointer :: cg1 !< Wave speed [L T-1 ~> m s-1] + real, intent(in) :: dt_in_T !< Time increment [T ~> s] type(MEKE_type), pointer :: MEKE !< MEKE control structure type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), optional, intent(in) :: int_slope_u !< Ratio that determine how much of @@ -547,28 +551,28 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV Rho, & ! Density itself [kg m-3], when a nonlinear equation of state is ! not in use. h_avail, & ! The mass available for diffusion out of each face, divided - ! by dt [H m2 s-1 ~> m3 s-1 or kg s-1]. + ! by dt [H L2 T-1 ~> m3 s-1 or kg s-1]. h_frac ! The fraction of the mass in the column above the bottom ! interface of a layer that is within a layer [nondim]. 0 m s-2], ! used for calculating PE release real, dimension(SZIB_(G), SZJ_(G), SZK_(G)+1) :: & Slope_x_PE, & ! 3D array of neutral slopes at u-points, set equal to Slope (below, nondim) - hN2_x_PE ! thickness in m times Brunt-Vaisala freqeuncy at u-points [m s-2] + hN2_x_PE ! thickness in m times Brunt-Vaisala freqeuncy at u-points [L2 Z-1 T-2 ~> m s-2], ! used for calculating PE release real, dimension(SZI_(G), SZJ_(G), SZK_(G)+1) :: & pres, & ! The pressure at an interface [Pa]. - h_avail_rsum ! The running sum of h_avail above an interface [H m2 s-1 ~> m3 s-1 or kg s-1]. + h_avail_rsum ! The running sum of h_avail above an interface [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)) :: & drho_dT_u, & ! The derivative of density with temperature at u points [kg m-3 degC-1] drho_dS_u ! The derivative of density with salinity at u points [kg m-3 ppt-1]. real, dimension(SZI_(G)) :: & drho_dT_v, & ! The derivative of density with temperature at v points [kg m-3 degC-1] drho_dS_v ! The derivative of density with salinity at v points [kg m-3 ppt-1]. - real :: uhtot(SZIB_(G), SZJ_(G)) ! The vertical sum of uhD [H m2 s-1 ~> m3 s-1 or kg s-1]. - real :: vhtot(SZI_(G), SZJB_(G)) ! The vertical sum of vhD [H m2 s-1 ~> m3 s-1 or kg s-1]. + real :: uhtot(SZIB_(G), SZJ_(G)) ! The vertical sum of uhD [H L2 T-1 ~> m3 s-1 or kg s-1]. + real :: vhtot(SZI_(G), SZJB_(G)) ! The vertical sum of vhD [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)) :: & T_u, & ! Temperature on the interface at the u-point [degC]. S_u, & ! Salinity on the interface at the u-point [ppt]. @@ -580,9 +584,9 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real :: Work_u(SZIB_(G), SZJ_(G)) ! The work being done by the thickness real :: Work_v(SZI_(G), SZJB_(G)) ! diffusion integrated over a cell [W]. real :: Work_h ! The work averaged over an h-cell [W m-2]. - real :: PE_release_h ! The amount of potential energy released by GM, averaged over an h-cell [m3 s-3]. + real :: PE_release_h ! The amount of potential energy released by GM averaged over an h-cell [L4 Z-1 T-3 ~> m3 s-3] ! The calculation is equal to h * S^2 * N^2 * kappa_GM. - real :: I4dt ! 1 / 4 dt [s-1]. + real :: I4dt ! 1 / 4 dt [T-1 ~> s-1]. real :: drdiA, drdiB ! Along layer zonal- and meridional- potential density real :: drdjA, drdjB ! gradients in the layers above (A) and below(B) the ! interface times the grid spacing [kg m-3]. @@ -597,26 +601,26 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real :: haA, haB, haL, haR ! Arithmetic mean thicknesses [H ~> m or kg m-2]. real :: dzaL, dzaR ! Temporary thicknesses [Z ~> m]. real :: wtA, wtB, wtL, wtR ! Unscaled weights, with various units. - real :: drdx, drdy ! Zonal and meridional density gradients [kg m-4]. + real :: drdx, drdy ! Zonal and meridional density gradients [kg m-3 L-1 ~> kg m-4]. real :: drdz ! Vertical density gradient [kg m-3 Z-1 ~> kg m-4]. real :: h_harm ! Harmonic mean layer thickness [H ~> m or kg m-2]. - real :: c2_h_u(SZIB_(G), SZK_(G)+1) ! Wave speed squared divided by h at u-points [m2 Z-1 s-2 ~> m s-2]. - real :: c2_h_v(SZI_(G), SZK_(G)+1) ! Wave speed squared divided by h at v-points [m2 Z-1 s-2 ~> m s-2]. - real :: hN2_u(SZIB_(G), SZK_(G)+1) ! Thickness in m times N2 at interfaces above u-points [m2 Z-1 s-2 ~> m s-2]. - real :: hN2_v(SZI_(G), SZK_(G)+1) ! Thickness in m times N2 at interfaces above v-points [m2 Z-1 s-2 ~> m s-2]. + real :: c2_h_u(SZIB_(G), SZK_(G)+1) ! Wave speed squared divided by h at u-points [L2 Z-1 T-2 ~> m s-2]. + real :: c2_h_v(SZI_(G), SZK_(G)+1) ! Wave speed squared divided by h at v-points [L2 Z-1 T-2 ~> m s-2]. + real :: hN2_u(SZIB_(G), SZK_(G)+1) ! Thickness in m times N2 at interfaces above u-points [L2 Z-1 T-2 ~> m s-2]. + real :: hN2_v(SZI_(G), SZK_(G)+1) ! Thickness in m times N2 at interfaces above v-points [L2 Z-1 T-2 ~> m s-2]. real :: Sfn_est ! A preliminary estimate (before limiting) of the overturning - ! streamfunction [Z m2 s-1 ~> m3 s-1]. - real :: Sfn_unlim_u(SZIB_(G), SZK_(G)+1) ! Streamfunction for u-points [Z m2 s-1 ~> m3 s-1]. - real :: Sfn_unlim_v(SZI_(G), SZK_(G)+1) ! Streamfunction for v-points [Z m2 s-1 ~> m3 s-1]. + ! streamfunction [Z L2 T-1 ~> m3 s-1]. + real :: Sfn_unlim_u(SZIB_(G), SZK_(G)+1) ! Streamfunction for u-points [Z L2 T-1 ~> m3 s-1]. + real :: Sfn_unlim_v(SZI_(G), SZK_(G)+1) ! Streamfunction for v-points [Z L2 T-1 ~> m3 s-1]. real :: slope2_Ratio_u(SZIB_(G), SZK_(G)+1) ! The ratio of the slope squared to slope_max squared. real :: slope2_Ratio_v(SZI_(G), SZK_(G)+1) ! The ratio of the slope squared to slope_max squared. - real :: Sfn_in_h ! The overturning streamfunction [H m2 s-1 ~> m3 s-1 or kg s-1] (note that + real :: Sfn_in_h ! The overturning streamfunction [H L2 T-1 ~> m3 s-1 or kg s-1] (note that ! the units are different from other Sfn vars). real :: Sfn_safe ! The streamfunction that goes linearly back to 0 at the surface. This is a - ! good thing to use when the slope is so large as to be meaningless [Z m2 s-1 ~> m3 s-1]. + ! good thing to use when the slope is so large as to be meaningless [Z L2 T-1 ~> m3 s-1]. real :: Slope ! The slope of density surfaces, calculated in a way ! that is always between -1 and 1, nondimensional. - real :: mag_grad2 ! The squared magnitude of the 3-d density gradient [kg2 m-8]. + real :: mag_grad2 ! The squared magnitude of the 3-d density gradient [kg2 m-6 L-2 ~> kg2 m-8]. real :: I_slope_max2 ! The inverse of slope_max squared, nondimensional. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. @@ -624,14 +628,14 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real :: dz_neglect ! A thickness [Z ~> m], that is so small it is usually lost ! in roundoff and can be neglected [Z ~> m]. real :: G_scale ! The gravitational acceleration times some unit conversion - ! factors [m3 Z-1 H-1 s-2 ~> m s-2 or m4 kg-1 s-2]. + ! factors [m3 T Z-1 H-1 s-3 ~> m s-2 or m4 kg-1 s-2]. logical :: use_EOS ! If true, density is calculated from T & S using an ! equation of state. logical :: find_work ! If true, find the change in energy due to the fluxes. integer :: nk_linear ! The number of layers over which the streamfunction goes to 0. - real :: G_rho0 ! g/Rho0 [m5 Z-1 s-2 ~> m4 s-2]. + real :: G_rho0 ! g/Rho0 [L2 m3 Z-1 T-2 ~> m4 s-2]. real :: N2_floor ! A floor for N2 to avoid degeneracy in the elliptic solver - ! times unit conversion factors [s-2 m2 Z-2 ~> s-2] + ! times unit conversion factors [T-2 L2 Z-2 ~> s-2] real, dimension(SZIB_(G), SZJ_(G), SZK_(G)+1) :: diag_sfn_x, diag_sfn_unlim_x ! Diagnostics real, dimension(SZI_(G), SZJB_(G), SZK_(G)+1) :: diag_sfn_y, diag_sfn_unlim_y ! Diagnostics logical :: present_int_slope_u, present_int_slope_v @@ -640,13 +644,13 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV integer :: i, j, k is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke ; IsdB = G%IsdB - I4dt = 0.25 / dt + I4dt = 0.25 / (dt_in_T) I_slope_max2 = 1.0 / (CS%slope_max**2) - G_scale = GV%g_Earth*US%L_to_m**2*US%s_to_T**2 * GV%H_to_m + G_scale = GV%g_Earth*US%L_to_m**2*US%s_to_T**3 * GV%H_to_m h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect**2 dz_neglect = GV%H_subroundoff*GV%H_to_Z - G_rho0 = GV%g_Earth*US%L_to_m**2*US%s_to_T**2 / GV%Rho0 - N2_floor = CS%N2_floor*US%Z_to_m**2 + G_rho0 = GV%g_Earth / GV%Rho0 + N2_floor = CS%N2_floor*US%Z_to_L**2 use_EOS = associated(tv%eqn_of_state) present_int_slope_u = PRESENT(int_slope_u) @@ -666,7 +670,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV find_work = (associated(CS%GMwork) .or. find_work) if (use_EOS) then - call vert_fill_TS(h, tv%T, tv%S, CS%kappa_smooth*dt, T, S, G, GV, 1, larger_h_denom=.true.) + call vert_fill_TS(h, tv%T, tv%S, CS%kappa_smooth*dt_in_T, T, S, G, GV, 1, larger_h_denom=.true.) endif if (CS%use_FGNV_streamfn .and. .not. associated(cg1)) call MOM_error(FATAL, & @@ -808,7 +812,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. - mag_grad2 = drdx**2 + (US%m_to_Z*drdz)**2 + mag_grad2 = drdx**2 + (US%L_to_Z*drdz)**2 if (mag_grad2 > 0.0) then Slope = drdx / sqrt(mag_grad2) slope2_Ratio_u(I,K) = Slope**2 * I_slope_max2 @@ -822,16 +826,16 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! that ignore density gradients along layers. if (present_int_slope_u) then Slope = (1.0 - int_slope_u(I,j,K)) * Slope + & - int_slope_u(I,j,K) * US%Z_to_m*((e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j)) + int_slope_u(I,j,K) * US%Z_to_L*((e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j)) slope2_Ratio_u(I,K) = (1.0 - int_slope_u(I,j,K)) * slope2_Ratio_u(I,K) endif Slope_x_PE(I,j,k) = MIN(Slope,CS%slope_max) - hN2_x_PE(I,j,k) = hN2_u(I,K) * US%m_to_Z + hN2_x_PE(I,j,k) = hN2_u(I,K) if (CS%id_slope_x > 0) CS%diagSlopeX(I,j,k) = Slope ! Estimate the streamfunction at each interface [m3 s-1]. - Sfn_unlim_u(I,K) = -((KH_u(I,j,K)*G%dy_Cu(I,j))*US%m_to_Z*Slope) + Sfn_unlim_u(I,K) = -((KH_u(I,j,K)*G%dy_Cu(I,j))*US%L_to_Z*Slope) ! Avoid moving dense water upslope from below the level of ! the bottom on the receiving side. @@ -857,11 +861,11 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (present_slope_x) then Slope = slope_x(I,j,k) else - Slope = US%Z_to_m*((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) * G%mask2dCu(I,j) + Slope = US%Z_to_L*((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) * G%mask2dCu(I,j) endif if (CS%id_slope_x > 0) CS%diagSlopeX(I,j,k) = Slope - Sfn_unlim_u(I,K) = ((KH_u(I,j,K)*G%dy_Cu(I,j))*US%m_to_Z*Slope) - hN2_u(I,K) = US%L_to_m**2*US%s_to_T**2*GV%g_prime(K) + Sfn_unlim_u(I,K) = ((KH_u(I,j,K)*G%dy_Cu(I,j))*US%L_to_Z*Slope) + hN2_u(I,K) = GV%g_prime(K) endif ! if (use_EOS) else ! if (k > nk_linear) hN2_u(I,K) = N2_floor * dz_neglect @@ -875,7 +879,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV do k=1,nz ; do I=is-1,ie ; if (G%mask2dCu(I,j)>0.) then h_harm = max( h_neglect, & 2. * h(i,j,k) * h(i+1,j,k) / ( ( h(i,j,k) + h(i+1,j,k) ) + h_neglect ) ) - c2_h_u(I,k) = CS%FGNV_scale * ( 0.5*( cg1(i,j) + cg1(i+1,j) ) )**2 / (GV%H_to_Z*h_harm) + c2_h_u(I,k) = CS%FGNV_scale * & + ( 0.5*( cg1(i,j) + cg1(i+1,j) ) )**2 / (GV%H_to_Z*h_harm) endif ; enddo ; enddo ! Solve an elliptic equation for the streamfunction following Ferrari et al., 2010. @@ -909,11 +914,11 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! Make sure that there is enough mass above to allow the streamfunction ! to satisfy the boundary condition of 0 at the surface. - Sfn_in_h = min(max(Sfn_est * GV%Z_to_H, -h_avail_rsum(i,j,K)), h_avail_rsum(i+1,j,K)) + Sfn_in_H = min(max(Sfn_est * GV%Z_to_H, -h_avail_rsum(i,j,K)), h_avail_rsum(i+1,j,K)) ! The actual transport is limited by the mass available in the two ! neighboring grid cells. - uhD(I,j,k) = max(min((Sfn_in_h - uhtot(I,j)), h_avail(i,j,k)), & + uhD(I,j,k) = max(min((Sfn_in_H - uhtot(I,j)), h_avail(i,j,k)), & -h_avail(i+1,j,k)) if (CS%id_sfn_x>0) diag_sfn_x(I,j,K) = diag_sfn_x(I,j,K+1) + uhD(I,j,k) @@ -1057,7 +1062,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. - mag_grad2 = drdy**2 + (US%m_to_Z*drdz)**2 + mag_grad2 = drdy**2 + (US%L_to_Z*drdz)**2 if (mag_grad2 > 0.0) then Slope = drdy / sqrt(mag_grad2) slope2_Ratio_v(i,K) = Slope**2 * I_slope_max2 @@ -1071,16 +1076,16 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! that ignore density gradients along layers. if (present_int_slope_v) then Slope = (1.0 - int_slope_v(i,J,K)) * Slope + & - int_slope_v(i,J,K) * US%Z_to_m*((e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J)) + int_slope_v(i,J,K) * US%Z_to_L*((e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J)) slope2_Ratio_v(i,K) = (1.0 - int_slope_v(i,J,K)) * slope2_Ratio_v(i,K) endif Slope_y_PE(i,J,k) = MIN(Slope,CS%slope_max) - hN2_y_PE(i,J,k) = hN2_v(i,K) * US%m_to_Z + hN2_y_PE(i,J,k) = hN2_v(i,K) if (CS%id_slope_y > 0) CS%diagSlopeY(I,j,k) = Slope ! Estimate the streamfunction at each interface [m3 s-1]. - Sfn_unlim_v(i,K) = -((KH_v(i,J,K)*G%dx_Cv(i,J))*US%m_to_Z*Slope) + Sfn_unlim_v(i,K) = -((KH_v(i,J,K)*G%dx_Cv(i,J))*US%L_to_Z*Slope) ! Avoid moving dense water upslope from below the level of ! the bottom on the receiving side. @@ -1106,11 +1111,11 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (present_slope_y) then Slope = slope_y(i,J,k) else - Slope = US%Z_to_m*((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) * G%mask2dCv(i,J) + Slope = US%Z_to_L*((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) * G%mask2dCv(i,J) endif if (CS%id_slope_y > 0) CS%diagSlopeY(I,j,k) = Slope - Sfn_unlim_v(i,K) = ((KH_v(i,J,K)*G%dx_Cv(i,J))*US%m_to_Z*Slope) - hN2_v(i,K) = US%L_to_m**2*US%s_to_T**2*GV%g_prime(K) + Sfn_unlim_v(i,K) = ((KH_v(i,J,K)*G%dx_Cv(i,J))*US%L_to_Z*Slope) + hN2_v(i,K) = GV%g_prime(K) endif ! if (use_EOS) else ! if (k > nk_linear) hN2_v(i,K) = N2_floor * dz_neglect @@ -1124,7 +1129,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV do k=1,nz ; do i=is,ie ; if (G%mask2dCv(i,J)>0.) then h_harm = max( h_neglect, & 2. * h(i,j,k) * h(i,j+1,k) / ( ( h(i,j,k) + h(i,j+1,k) ) + h_neglect ) ) - c2_h_v(i,k) = CS%FGNV_scale * ( 0.5*( cg1(i,j) + cg1(i,j+1) ) )**2 / (GV%H_to_Z*h_harm) + c2_h_v(i,k) = CS%FGNV_scale * & + ( 0.5*( cg1(i,j) + cg1(i,j+1) ) )**2 / (GV%H_to_Z*h_harm) endif ; enddo ; enddo ! Solve an elliptic equation for the streamfunction following Ferrari et al., 2010. @@ -1158,12 +1164,11 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! Make sure that there is enough mass above to allow the streamfunction ! to satisfy the boundary condition of 0 at the surface. - Sfn_in_h = min(max(Sfn_est * GV%Z_to_H, -h_avail_rsum(i,j,K)), h_avail_rsum(i,j+1,K)) + Sfn_in_H = min(max(Sfn_est * GV%Z_to_H, -h_avail_rsum(i,j,K)), h_avail_rsum(i,j+1,K)) ! The actual transport is limited by the mass available in the two ! neighboring grid cells. - vhD(i,J,k) = max(min((Sfn_in_h - vhtot(i,J)), h_avail(i,j,k)), & - -h_avail(i,j+1,k)) + vhD(i,J,k) = max(min((Sfn_in_H - vhtot(i,J)), h_avail(i,j,k)), -h_avail(i,j+1,k)) if (CS%id_sfn_y>0) diag_sfn_y(i,J,K) = diag_sfn_y(i,J,K+1) + vhD(i,J,k) ! sfn_y(i,J,K) = max(min(Sfn_in_h, vhtot(i,J)+h_avail(i,j,k)), & @@ -1271,16 +1276,16 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! Note that the units of Work_v and Work_u are W, while Work_h is W m-2. Work_h = 0.5 * G%IareaT(i,j) * & ((Work_u(I-1,j) + Work_u(I,j)) + (Work_v(i,J-1) + Work_v(i,J))) - PE_release_h = -0.25*(Kh_u(I,j,k)*(Slope_x_PE(I,j,k)**2) * hN2_x_PE(I,j,k) + & - Kh_u(I-1,j,k)*(Slope_x_PE(I-1,j,k)**2) * hN2_x_PE(I-1,j,k) + & - Kh_v(i,J,k)*(Slope_y_PE(i,J,k)**2) * hN2_y_PE(i,J,k) + & - Kh_v(i,J-1,k)*(Slope_y_PE(i,J-1,k)**2) * hN2_y_PE(i,J-1,k)) + PE_release_h = -0.25*(KH_u(I,j,k)*(Slope_x_PE(I,j,k)**2) * hN2_x_PE(I,j,k) + & + Kh_u(I-1,j,k)*(Slope_x_PE(I-1,j,k)**2) * hN2_x_PE(I-1,j,k) + & + Kh_v(i,J,k)*(Slope_y_PE(i,J,k)**2) * hN2_y_PE(i,J,k) + & + Kh_v(i,J-1,k)*(Slope_y_PE(i,J-1,k)**2) * hN2_y_PE(i,J-1,k)) if (associated(CS%GMwork)) CS%GMwork(i,j) = Work_h if (associated(MEKE)) then ; if (associated(MEKE%GM_src)) then if (CS%GM_src_alt) then - MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + PE_release_h + MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + US%L_to_m**2*US%m_to_Z*PE_release_h else - MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + Work_h + MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + US%m_to_L**2*US%T_to_s**3*Work_h endif endif ; endif !enddo ; enddo ; enddo ; endif @@ -1300,7 +1305,7 @@ subroutine streamfn_solver(nk, c2_h, hN2, sfn) integer, intent(in) :: nk !< Number of layers real, dimension(nk), intent(in) :: c2_h !< Wave speed squared over thickness in layers [m s-2] real, dimension(nk+1), intent(in) :: hN2 !< Thickness times N2 at interfaces [m s-2] - real, dimension(nk+1), intent(inout) :: sfn !< Streamfunction [Z m2 s-1 ~> m3 s-1] or arbitrary units + real, dimension(nk+1), intent(inout) :: sfn !< Streamfunction [Z L2 T-1 ~> m3 s-1] or arbitrary units !! On entry, equals diffusivity times slope. !! On exit, equals the streamfunction. ! Local variables @@ -1329,7 +1334,7 @@ subroutine streamfn_solver(nk, c2_h, hN2, sfn) end subroutine streamfn_solver !> Modifies thickness diffusivities to untangle layer structures -subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV, US, CS, & +subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt_in_T, G, GV, US, CS, & int_slope_u, int_slope_v) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure @@ -1337,15 +1342,15 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface positions [Z ~> m] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kh_u !< Thickness diffusivity on interfaces - !! at u points [m2 s-1] + !! at u points [L2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: Kh_v !< Thickness diffusivity on interfaces - !! at v points [m2 s-1] + !! at v points [L2 T-1 ~> m2 s-1] real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Kh_u_CFL !< Maximum stable thickness diffusivity - !! at u points [m2 s-1] + !! at u points [L2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Kh_v_CFL !< Maximum stable thickness diffusivity - !! at v points [m2 s-1] + !! at v points [L2 T-1 ~> m2 s-1] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure - real, intent(in) :: dt !< Time increment [s] + real, intent(in) :: dt_in_T !< Time increment [T ~> s] type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: int_slope_u !< Ratio that determine how much of !! the isopycnal slopes are taken directly from @@ -1361,10 +1366,10 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! region where the detangling is applied [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: & Kh_lay_u ! The tentative interface height diffusivity for each layer at - ! u points [m2 s-1]. + ! u points [L2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: & Kh_lay_v ! The tentative interface height diffusivity for each layer at - ! v points [m2 s-1]. + ! v points [L2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G)) :: & de_bot ! The distances from the bottom of the region where the ! detangling is applied [H ~> m or kg m-2]. @@ -1377,44 +1382,44 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! normalized by the arithmetic mean thickness. real :: Kh_scale ! A ratio by which Kh_u_CFL is scaled for maximally jagged ! layers [nondim]. - real :: Kh_det ! The detangling diffusivity [m2 s-1]. +! real :: Kh_det ! The detangling diffusivity [m2 s-1]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: I_sl ! The absolute value of the larger in magnitude of the slopes - ! above and below. + ! above and below [L Z-1 ~> nondim]. real :: Rsl ! The ratio of the smaller magnitude slope to the larger ! magnitude one [nondim]. 0 <= Rsl <1. real :: IRsl ! The (limited) inverse of Rsl [nondim]. 1 < IRsl <= 1e9. real :: dH ! The thickness gradient divided by the damping timescale ! and the ratio of the face length to the adjacent cell - ! areas for comparability with the diffusivities [m2 s-1]. - real :: adH ! The absolute value of dH [m2 s-1]. + ! areas for comparability with the diffusivities [L Z T-1 ~> m2 s-1]. + real :: adH ! The absolute value of dH [L Z T-1 ~> m2 s-1]. real :: sign ! 1 or -1, with the same sign as the layer thickness gradient. - real :: sl_K ! The sign-corrected slope of the interface above [nondim]. - real :: sl_Kp1 ! The sign-corrected slope of the interface below [nondim]. - real :: I_sl_K ! The (limited) inverse of sl_K [nondim]. - real :: I_sl_Kp1 ! The (limited) inverse of sl_Kp1 [nondim]. - real :: I_4t ! A quarter of a unit conversion factor divided by - ! the damping timescale [s-1]. + real :: sl_K ! The sign-corrected slope of the interface above [Z L-1 ~> nondim]. + real :: sl_Kp1 ! The sign-corrected slope of the interface below [Z L-1 ~> nondim]. + real :: I_sl_K ! The (limited) inverse of sl_K [L Z-1 ~> nondim]. + real :: I_sl_Kp1 ! The (limited) inverse of sl_Kp1 [L Z-1 ~> nondim]. + real :: I_4t ! A quarter of a flux scaling factor divided by + ! the damping timescale [T-1 ~> s-1]. real :: Fn_R ! A function of Rsl, such that Rsl < Fn_R < 1. real :: denom, I_denom ! A denominator and its inverse, various units. - real :: Kh_min ! A local floor on the diffusivity [m2 s-1]. - real :: Kh_max ! A local ceiling on the diffusivity [m2 s-1]. + ! real :: Kh_min ! A local floor on the diffusivity [m2 s-1]. + real :: Kh_max ! A local ceiling on the diffusivity [L2 T-1 ~> m2 s-1]. real :: wt1, wt2 ! Nondimensional weights. ! Variables used only in testing code. ! real, dimension(SZK_(G)) :: uh_here ! real, dimension(SZK_(G)+1) :: Sfn - real :: dKh ! An increment in the diffusivity [m2 s-1]. + real :: dKh ! An increment in the diffusivity [L2 T-1 ~> m2 s-1]. real, dimension(SZIB_(G),SZK_(G)+1) :: & - Kh_bg, & ! The background (floor) value of Kh [m2 s-1]. - Kh, & ! The tentative value of Kh [m2 s-1]. - Kh_detangle, & ! The detangling diffusivity that could be used [m2 s-1]. + Kh_bg, & ! The background (floor) value of Kh [L2 T-1 ~> m2 s-1]. + Kh, & ! The tentative value of Kh [L2 T-1 ~> m2 s-1]. + Kh_detangle, & ! The detangling diffusivity that could be used [L2 T-1 ~> m2 s-1]. Kh_min_max_p, & ! The smallest ceiling that can be placed on Kh(I,K) - ! based on the value of Kh(I,K+1) [m2 s-1]. + ! based on the value of Kh(I,K+1) [L2 T-1 ~> m2 s-1]. Kh_min_max_m, & ! The smallest ceiling that can be placed on Kh(I,K) - ! based on the value of Kh(I,K-1) [m2 s-1]. + ! based on the value of Kh(I,K-1) [L2 T-1 ~> m2 s-1]. ! The following are variables that define the relationships between ! successive values of Kh. ! Search for Kh that satisfy... @@ -1423,15 +1428,15 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! Kh(I,K) <= Kh_max_m(I,K)*Kh(I,K-1) + Kh0_max_m(I,K) ! Kh(I,K) <= Kh_max_p(I,K)*Kh(I,K+1) + Kh0_max_p(I,K) Kh_min_m , & ! See above [nondim]. - Kh0_min_m , & ! See above [m2 s-1]. + Kh0_min_m , & ! See above [L2 T-1 ~> m2 s-1]. Kh_max_m , & ! See above [nondim]. - Kh0_max_m, & ! See above [m2 s-1]. + Kh0_max_m, & ! See above [L2 T-1 ~> m2 s-1]. Kh_min_p , & ! See above [nondim]. - Kh0_min_p , & ! See above [m2 s-1]. + Kh0_min_p , & ! See above [L2 T-1 ~> m2 s-1]. Kh_max_p , & ! See above [nondim]. - Kh0_max_p ! See above [m2 s-1]. + Kh0_max_p ! See above [L2 T-1 ~> m2 s-1]. real, dimension(SZIB_(G)) :: & - Kh_max_max ! The maximum diffusivity permitted in a column. + Kh_max_max ! The maximum diffusivity permitted in a column [L2 T-1 ~> m2 s-1].. logical, dimension(SZIB_(G)) :: & do_i ! If true, work on a column. integer :: i, j, k, n, ish, jsh, is, ie, js, je, nz, k_top @@ -1443,7 +1448,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! distributing the diffusivities more effectively (with wt1 & wt2), but this ! means that the additions to a single interface can be up to twice as large. Kh_scale = 0.5 - if (CS%detangle_time > dt) Kh_scale = 0.5 * dt / CS%detangle_time + if (CS%detangle_time > dt_in_T) Kh_scale = 0.5 * dt_in_T / CS%detangle_time do j=js-1,je+1 ; do i=is-1,ie+1 de_top(i,j,k_top) = 0.0 ; de_bot(i,j) = 0.0 @@ -1474,7 +1479,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV h1 = max( h(i,j,k), h2 - min(de_bot(i,j), de_top(i,j,k)) ) endif jag_Rat = (h2 - h1)**2 / (h2 + h1 + h_neglect)**2 - Kh_lay_u(I,j,k) = (Kh_scale * Kh_u_CFL(I,j)) * jag_Rat**2 + KH_lay_u(I,j,k) = (Kh_scale * KH_u_CFL(I,j)) * jag_Rat**2 endif ; enddo ; enddo do J=js-1,je ; do i=is,ie ; if (G%mask2dCv(i,J) > 0.0) then @@ -1486,13 +1491,13 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV h1 = max( h(i,j,k), h2 - min(de_bot(i,j), de_top(i,j,k)) ) endif jag_Rat = (h2 - h1)**2 / (h2 + h1 + h_neglect)**2 - Kh_lay_v(i,J,k) = (Kh_scale * Kh_v_CFL(i,J)) * jag_Rat**2 + KH_lay_v(i,J,k) = (Kh_scale * KH_v_CFL(i,J)) * jag_Rat**2 endif ; enddo ; enddo enddo ! Limit the diffusivities - I_4t = US%Z_to_m*Kh_scale / (4.0*dt) + I_4t = Kh_scale / (4.0 * dt_in_T) do n=1,2 if (n==1) then ; jsh = js ; ish = is-1 @@ -1504,19 +1509,19 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV if (n==1) then ! This is a u-column. do i=ish,ie do_i(I) = (G%mask2dCu(I,j) > 0.0) - Kh_max_max(I) = Kh_u_CFL(I,j) + Kh_Max_max(I) = KH_u_CFL(I,j) enddo do K=1,nz+1 ; do i=ish,ie - Kh_bg(I,K) = Kh_u(I,j,K) ; Kh(I,K) = Kh_bg(I,K) + Kh_bg(I,K) = KH_u(I,j,K) ; Kh(I,K) = Kh_bg(I,K) Kh_min_max_p(I,K) = Kh_bg(I,K) ; Kh_min_max_m(I,K) = Kh_bg(I,K) Kh_detangle(I,K) = 0.0 enddo ; enddo else ! This is a v-column. do i=ish,ie - do_i(i) = (G%mask2dCv(i,J) > 0.0) ; Kh_max_max(I) = Kh_v_CFL(i,J) + do_i(i) = (G%mask2dCv(i,J) > 0.0) ; Kh_Max_max(I) = KH_v_CFL(i,J) enddo do K=1,nz+1 ; do i=ish,ie - Kh_bg(I,K) = Kh_v(I,j,K) ; Kh(I,K) = Kh_bg(I,K) + Kh_bg(I,K) = KH_v(I,j,K) ; Kh(I,K) = Kh_bg(I,K) Kh_min_max_p(I,K) = Kh_bg(I,K) ; Kh_min_max_m(I,K) = Kh_bg(I,K) Kh_detangle(I,K) = 0.0 enddo ; enddo @@ -1526,7 +1531,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV do k=k_top,nz ; do i=ish,ie ; if (do_i(i)) then if (n==1) then ! This is a u-column. dH = 0.0 - denom = ((G%IareaT(i+1,j) + G%IareaT(i,j))*G%dy_Cu(I,j)) + denom = ((G%IareaT(i+1,j) + G%IareaT(i,j)) * G%dy_Cu(I,j)) ! This expression uses differences in e in place of h for better ! consistency with the slopes. if (denom > 0.0) & @@ -1535,7 +1540,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! dH = I_4t * (h(i+1,j,k) - h(i,j,k)) / denom adH = abs(dH) - sign = 1.0*US%Z_to_m ; if (dH < 0) sign = -1.0*US%Z_to_m + sign = 1.0 ; if (dH < 0) sign = -1.0 sl_K = sign * (e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j) sl_Kp1 = sign * (e(i+1,j,K+1)-e(i,j,K+1)) * G%IdxCu(I,j) @@ -1547,18 +1552,18 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV if (denom > 0.0) then wt1 = sl_K**2 / denom ; wt2 = sl_Kp1**2 / denom endif - Kh_detangle(I,K) = Kh_detangle(I,K) + wt1*Kh_lay_u(I,j,k) - Kh_detangle(I,K+1) = Kh_detangle(I,K+1) + wt2*Kh_lay_u(I,j,k) + Kh_detangle(I,K) = Kh_detangle(I,K) + wt1*KH_lay_u(I,j,k) + Kh_detangle(I,K+1) = Kh_detangle(I,K+1) + wt2*KH_lay_u(I,j,k) else ! This is a v-column. dH = 0.0 - denom = ((G%IareaT(i,j+1) + G%IareaT(i,j))*G%dx_Cv(I,j)) + denom = ((G%IareaT(i,j+1) + G%IareaT(i,j)) * G%dx_Cv(I,j)) if (denom > 0.0) & dH = I_4t * ((e(i,j+1,K) - e(i,j+1,K+1)) - & (e(i,j,K) - e(i,j,K+1))) / denom ! dH = I_4t * (h(i,j+1,k) - h(i,j,k)) / denom adH = abs(dH) - sign = 1.0*US%Z_to_m ; if (dH < 0) sign = -1.0*US%Z_to_m + sign = 1.0 ; if (dH < 0) sign = -1.0 sl_K = sign * (e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J) sl_Kp1 = sign * (e(i,j+1,K+1)-e(i,j,K+1)) * G%IdyCv(i,J) @@ -1570,8 +1575,8 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV if (denom > 0.0) then wt1 = sl_K**2 / denom ; wt2 = sl_Kp1**2 / denom endif - Kh_detangle(I,K) = Kh_detangle(I,K) + wt1*Kh_lay_v(i,J,k) - Kh_detangle(I,K+1) = Kh_detangle(I,K+1) + wt2*Kh_lay_v(i,J,k) + Kh_detangle(I,K) = Kh_detangle(I,K) + wt1*KH_lay_v(i,J,k) + Kh_detangle(I,K+1) = Kh_detangle(I,K+1) + wt2*KH_lay_v(i,J,k) endif if (adH == 0.0) then @@ -1594,15 +1599,15 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV Fn_R = Rsl if (Kh_max_max(I) > 0) & - Fn_R = min(sqrt(Rsl), Rsl + (adH * I_sl) / Kh_max_max(I)) + Fn_R = min(sqrt(Rsl), Rsl + (adH * I_sl) / (Kh_Max_max(I))) Kh_min_m(I,K+1) = Fn_R ; Kh0_min_m(I,K+1) = 0.0 Kh_max_m(I,K+1) = Rsl ; Kh0_max_m(I,K+1) = adH * I_sl Kh_min_p(I,K) = IRsl ; Kh0_min_p(I,K) = -adH * (I_sl*IRsl) Kh_max_p(I,K) = 1.0/(Fn_R + 1.0e-30) ; Kh0_max_p(I,K) = 0.0 elseif (sl_Kp1 < 0.0) then ! Opposite (nonzero) signs of slopes. - I_sl_K = 1e18 ; if (sl_K > 1e-18) I_sl_K = 1.0 / sl_K - I_sl_Kp1 = 1e18 ; if (-sl_Kp1 > 1e-18) I_sl_Kp1 = -1.0 / sl_Kp1 + I_sl_K = 1e18*US%Z_to_L ; if (sl_K > 1e-18*US%L_to_Z) I_sl_K = 1.0 / sl_K + I_sl_Kp1 = 1e18*US%Z_to_L ; if (-sl_Kp1 > 1e-18*US%L_to_Z) I_sl_Kp1 = -1.0 / sl_Kp1 Kh_min_m(I,K+1) = 0.0 ; Kh0_min_m(I,K+1) = 0.0 Kh_max_m(I,K+1) = - sl_K*I_sl_Kp1 ; Kh0_max_m(I,K+1) = adH*I_sl_Kp1 @@ -1611,9 +1616,9 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! This limit does not use the slope weighting so that potentially ! sharp gradients in diffusivities are not forced to occur. - Kh_max = adH / (sl_K - sl_Kp1) - Kh_min_max_p(I,K) = max(Kh_min_max_p(I,K), Kh_max) - Kh_min_max_m(I,K+1) = max(Kh_min_max_m(I,K+1), Kh_max) + Kh_Max = adH / (sl_K - sl_Kp1) + Kh_min_max_p(I,K) = max(Kh_min_max_p(I,K), Kh_Max) + Kh_min_max_m(I,K+1) = max(Kh_min_max_m(I,K+1), Kh_Max) else ! Both slopes are of the same sign as dH. I_sl = 1.0 / sl_K Rsl = sl_Kp1 * I_sl ! 0 <= Rsl < 1 @@ -1622,7 +1627,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! Rsl <= Fn_R <= 1 Fn_R = Rsl if (Kh_max_max(I) > 0) & - Fn_R = min(sqrt(Rsl), Rsl + (adH * I_sl) / Kh_max_max(I)) + Fn_R = min(sqrt(Rsl), Rsl + (adH * I_sl) / Kh_Max_max(I)) Kh_min_m(I,K+1) = IRsl ; Kh0_min_m(I,K+1) = -adH * (I_sl*IRsl) Kh_max_m(I,K+1) = 1.0/(Fn_R + 1.0e-30) ; Kh0_max_m(I,K+1) = 0.0 @@ -1661,16 +1666,16 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV do K=nz,k_top+1,-1 ; do i=ish,ie ; if (do_i(i)) then Kh(I,k) = max(Kh(I,K), min(Kh_min_p(I,K)*Kh(I,K+1) + Kh0_min_p(I,K), Kh(I,K+1))) - Kh_max = max(Kh_min_max_p(I,K), Kh_max_p(I,K)*Kh(I,K+1) + Kh0_max_p(I,K)) - Kh(I,k) = min(Kh(I,k), Kh_max) + Kh_Max = max(Kh_min_max_p(I,K), Kh_max_p(I,K)*Kh(I,K+1) + Kh0_max_p(I,K)) + Kh(I,k) = min(Kh(I,k), Kh_Max) endif ; enddo ; enddo ! I-loop & k-loop ! All non-zero min constraints on one diffusivity are max constraints on ! another layer, so the min constraints can now be discounted. ! Decrease the diffusivities to satisfy the max constraints. do K=k_top+1,nz ; do i=ish,ie ; if (do_i(i)) then - Kh_max = max(Kh_min_max_m(I,K), Kh_max_m(I,K)*Kh(I,K-1) + Kh0_max_m(I,K)) - if (Kh(I,k) > Kh_max) Kh(I,k) = Kh_Max + Kh_Max = max(Kh_min_max_m(I,K), Kh_max_m(I,K)*Kh(I,K-1) + Kh0_max_m(I,K)) + if (Kh(I,k) > Kh_Max) Kh(I,k) = Kh_Max endif ; enddo ; enddo ! i- and K-loops ! This code tests the solutions... @@ -1684,17 +1689,15 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! Sfn(K) = -Kh(i,K) * (e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j) ! Sfn(K+1) = -Kh(i,K+1) * (e(i+1,j,K+1)-e(i,j,K+1)) * G%IdxCu(I,j) ! uh_here(k) = (Sfn(K) - Sfn(K+1))*G%dy_Cu(I,j) -! if (abs(uh_here(k))*min(G%IareaT(i,j), G%IareaT(i+1,j)) > & +! if (abs(uh_here(k)) * min(G%IareaT(i,j), G%IareaT(i+1,j)) > & ! (1e-10*GV%m_to_H)) then ! if (uh_here(k) * (h(i+1,j,k) - h(i,j,k)) > 0.0) then -! call MOM_error(WARNING, & -! "Corrective u-transport is up the thickness gradient.", .true.) +! call MOM_error(WARNING, "Corrective u-transport is up the thickness gradient.", .true.) ! endif ! if (((h(i,j,k) - 4.0*dt*G%IareaT(i,j)*uh_here(k)) - & ! (h(i+1,j,k) + 4.0*dt*G%IareaT(i+1,j)*uh_here(k))) * & ! (h(i,j,k) - h(i+1,j,k)) < 0.0) then -! call MOM_error(WARNING, & -! "Corrective u-transport is too large.", .true.) +! call MOM_error(WARNING, "Corrective u-transport is too large.", .true.) ! endif ! endif ! endif @@ -1704,7 +1707,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! Sfn(K) = -Kh(i,K) * (e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J) ! Sfn(K+1) = -Kh(i,K+1) * (e(i,j+1,K+1)-e(i,j,K+1)) * G%IdyCv(i,J) ! uh_here(k) = (Sfn(K) - Sfn(K+1))*G%dx_Cv(i,J) -! if (abs(uh_here(K))*min(G%IareaT(i,j), G%IareaT(i,j+1)) > & +! if (abs(uh_here(K)) * min(G%IareaT(i,j), G%IareaT(i,j+1)) > & ! (1e-10*GV%m_to_H)) then ! if (uh_here(K) * (h(i,j+1,k) - h(i,j,k)) > 0.0) then ! call MOM_error(WARNING, & @@ -1726,18 +1729,18 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV if (n==1) then ! This is a u-column. do K=k_top+1,nz ; do i=ish,ie - if (Kh(I,K) > Kh_u(I,j,K)) then - dKh = (Kh(I,K) - Kh_u(I,j,K)) + if (Kh(I,K) > KH_u(I,j,K)) then + dKh = (Kh(I,K) - KH_u(I,j,K)) int_slope_u(I,j,K) = dKh / Kh(I,K) - Kh_u(I,j,K) = Kh(I,K) + KH_u(I,j,K) = Kh(I,K) endif enddo ; enddo else ! This is a v-column. do K=k_top+1,nz ; do i=ish,ie - if (Kh(i,K) > Kh_v(i,J,K)) then - dKh = Kh(i,K) - Kh_v(i,J,K) + if (Kh(i,K) > KH_v(i,J,K)) then + dKh = Kh(i,K) - KH_v(i,J,K) int_slope_v(i,J,K) = dKh / Kh(i,K) - Kh_v(i,J,K) = Kh(i,K) + KH_v(i,J,K) = Kh(i,K) endif enddo ; enddo endif @@ -1761,7 +1764,8 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_thickness_diffuse" ! This module's name. - real :: omega, strat_floor, flux_to_kg_per_s + real :: omega ! The Earth's rotation rate [T-1 ~> s-1] + real :: strat_floor if (associated(CS)) then call MOM_error(WARNING, & @@ -1778,17 +1782,17 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) "coefficient of KHTH.", default=.false.) call get_param(param_file, mdl, "KHTH", CS%Khth, & "The background horizontal thickness diffusivity.", & - units = "m2 s-1", default=0.0) + default=0.0, units="m2 s-1", scale=US%m_to_L**2*US%T_to_s) call get_param(param_file, mdl, "KHTH_SLOPE_CFF", CS%KHTH_Slope_Cff, & "The nondimensional coefficient in the Visbeck formula "//& "for the interface depth diffusivity", units="nondim", & default=0.0) call get_param(param_file, mdl, "KHTH_MIN", CS%KHTH_Min, & "The minimum horizontal thickness diffusivity.", & - units = "m2 s-1", default=0.0) + default=0.0, units="m2 s-1", scale=US%m_to_L**2*US%T_to_s) call get_param(param_file, mdl, "KHTH_MAX", CS%KHTH_Max, & "The maximum horizontal thickness diffusivity.", & - units = "m2 s-1", default=0.0) + default=0.0, units="m2 s-1", scale=US%m_to_L**2*US%T_to_s) call get_param(param_file, mdl, "KHTH_MAX_CFL", CS%max_Khth_CFL, & "The maximum value of the local diffusive CFL ratio that "//& "is permitted for the thickness diffusivity. 1.0 is the "//& @@ -1810,14 +1814,14 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) call get_param(param_file, mdl, "DETANGLE_TIMESCALE", CS%detangle_time, & "A timescale over which maximally jagged grid-scale "//& "thickness variations are suppressed. This must be "//& - "longer than DT, or 0 to use DT.", units = "s", default=0.0) + "longer than DT, or 0 to use DT.", units="s", default=0.0, scale=US%s_to_T) call get_param(param_file, mdl, "KHTH_SLOPE_MAX", CS%slope_max, & "A slope beyond which the calculated isopycnal slope is "//& "not reliable and is scaled away.", units="nondim", default=0.01) call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_smooth, & "A diapycnal diffusivity that is used to interpolate "//& "more sensible values of T & S into thin layers.", & - default=1.0e-6, scale=US%m_to_Z**2) + default=1.0e-6, scale=US%m_to_Z**2*US%T_to_s) call get_param(param_file, mdl, "KHTH_USE_FGNV_STREAMFUNCTION", CS%use_FGNV_streamfn, & "If true, use the streamfunction formulation of "//& "Ferrari et al., 2010, which effectively emphasizes "//& @@ -1836,9 +1840,9 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) "streamfunction formulation, expressed as a fraction of planetary "//& "rotation, OMEGA. This should be tiny but non-zero to avoid degeneracy.", & default=1.e-15, units="nondim", do_not_log=.not.CS%use_FGNV_streamfn) - call get_param(param_file, mdl, "OMEGA",omega, & - "The rotation rate of the earth.", units="s-1", & - default=7.2921e-5, do_not_log=.not.CS%use_FGNV_streamfn) + call get_param(param_file, mdl, "OMEGA", omega, & + "The rotation rate of the earth.", & + default=7.2921e-5, units="s-1", scale=US%T_to_s, do_not_log=.not.CS%use_FGNV_streamfn) if (CS%use_FGNV_streamfn) CS%N2_floor = (strat_floor*omega)**2 call get_param(param_file, mdl, "DEBUG", CS%debug, & "If true, write out verbose debugging data.", & @@ -1854,7 +1858,7 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) call get_param(param_file, mdl, "MEKE_GEOMETRIC_EPSILON", CS%MEKE_GEOMETRIC_epsilon, & "Minimum Eady growth rate used in the calculation of \n"//& - "GEOMETRIC thickness diffusivity.", units="s-1", default=1.0e-7) + "GEOMETRIC thickness diffusivity.", units="s-1", default=1.0e-7, scale=US%T_to_s) call get_param(param_file, mdl, "MEKE_GEOMETRIC_ALPHA", CS%MEKE_GEOMETRIC_alpha, & "The nondimensional coefficient governing the efficiency of the GEOMETRIC \n"//& @@ -1874,16 +1878,15 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) call safe_alloc_ptr(CS%KH_v_GME,G%isd,G%ied,G%JsdB,G%JedB,G%ke+1) endif - if (GV%Boussinesq) then ; flux_to_kg_per_s = GV%Rho0 - else ; flux_to_kg_per_s = 1. ; endif - CS%id_uhGM = register_diag_field('ocean_model', 'uhGM', diag%axesCuL, Time, & - 'Time Mean Diffusive Zonal Thickness Flux', 'kg s-1', & - y_cell_method='sum', v_extensive=.true., conversion=flux_to_kg_per_s) + 'Time Mean Diffusive Zonal Thickness Flux', & + 'kg s-1', conversion=GV%H_to_kg_m2*US%L_to_m**2*US%s_to_T, & + y_cell_method='sum', v_extensive=.true.) if (CS%id_uhGM > 0) call safe_alloc_ptr(CDp%uhGM,G%IsdB,G%IedB,G%jsd,G%jed,G%ke) CS%id_vhGM = register_diag_field('ocean_model', 'vhGM', diag%axesCvL, Time, & - 'Time Mean Diffusive Meridional Thickness Flux', 'kg s-1', & - x_cell_method='sum', v_extensive=.true., conversion=flux_to_kg_per_s) + 'Time Mean Diffusive Meridional Thickness Flux', & + 'kg s-1', conversion=GV%H_to_kg_m2*US%L_to_m**2*US%s_to_T, & + x_cell_method='sum', v_extensive=.true.) if (CS%id_vhGM > 0) call safe_alloc_ptr(CDp%vhGM,G%isd,G%ied,G%JsdB,G%JedB,G%ke) CS%id_GMwork = register_diag_field('ocean_model', 'GMwork', diag%axesT1, Time, & @@ -1894,22 +1897,28 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) if (CS%id_GMwork > 0) call safe_alloc_ptr(CS%GMwork,G%isd,G%ied,G%jsd,G%jed) CS%id_KH_u = register_diag_field('ocean_model', 'KHTH_u', diag%axesCui, Time, & - 'Parameterized mesoscale eddy advection diffusivity at U-point', 'm2 s-1') + 'Parameterized mesoscale eddy advection diffusivity at U-point', & + 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_KH_v = register_diag_field('ocean_model', 'KHTH_v', diag%axesCvi, Time, & - 'Parameterized mesoscale eddy advection diffusivity at V-point', 'm2 s-1') + 'Parameterized mesoscale eddy advection diffusivity at V-point', & + 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_KH_t = register_diag_field('ocean_model', 'KHTH_t', diag%axesTL, Time, & - 'Ocean Tracer Diffusivity due to Parameterized Mesoscale Advection', 'm2 s-1',& + 'Ocean Tracer Diffusivity due to Parameterized Mesoscale Advection', & + 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T, & cmor_field_name='diftrblo', & cmor_long_name='Ocean Tracer Diffusivity due to Parameterized Mesoscale Advection', & cmor_units='m2 s-1', & cmor_standard_name='ocean_tracer_diffusivity_due_to_parameterized_mesoscale_advection') CS%id_KH_u1 = register_diag_field('ocean_model', 'KHTH_u1', diag%axesCu1, Time, & - 'Parameterized mesoscale eddy advection diffusivity at U-points (2-D)', 'm2 s-1') + 'Parameterized mesoscale eddy advection diffusivity at U-points (2-D)', & + 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_KH_v1 = register_diag_field('ocean_model', 'KHTH_v1', diag%axesCv1, Time, & - 'Parameterized mesoscale eddy advection diffusivity at V-points (2-D)', 'm2 s-1') + 'Parameterized mesoscale eddy advection diffusivity at V-points (2-D)', & + 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_KH_t1 = register_diag_field('ocean_model', 'KHTH_t1', diag%axesT1, Time,& - 'Parameterized mesoscale eddy advection diffusivity at T-points (2-D)', 'm2 s-1') + 'Parameterized mesoscale eddy advection diffusivity at T-points (2-D)', & + 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_slope_x = register_diag_field('ocean_model', 'neutral_slope_x', diag%axesCui, Time, & 'Zonal slope of neutral surface', 'nondim') @@ -1918,15 +1927,17 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) 'Meridional slope of neutral surface', 'nondim') if (CS%id_slope_y > 0) call safe_alloc_ptr(CS%diagSlopeY,G%isd,G%ied,G%JsdB,G%JedB,G%ke+1) CS%id_sfn_x = register_diag_field('ocean_model', 'GM_sfn_x', diag%axesCui, Time, & - 'Parameterized Zonal Overturning Streamfunction', 'm3 s-1') + 'Parameterized Zonal Overturning Streamfunction', & + 'm3 s-1', conversion=GV%H_to_m*US%L_to_m**2*US%s_to_T) CS%id_sfn_y = register_diag_field('ocean_model', 'GM_sfn_y', diag%axesCvi, Time, & - 'Parameterized Meridional Overturning Streamfunction', 'm3 s-1') + 'Parameterized Meridional Overturning Streamfunction', & + 'm3 s-1', conversion=GV%H_to_m*US%L_to_m**2*US%s_to_T) CS%id_sfn_unlim_x = register_diag_field('ocean_model', 'GM_sfn_unlim_x', diag%axesCui, Time, & 'Parameterized Zonal Overturning Streamfunction before limiting/smoothing', & - 'm3 s-1', conversion=US%Z_to_m) + 'm3 s-1', conversion=US%Z_to_m*US%L_to_m**2*US%s_to_T) CS%id_sfn_unlim_y = register_diag_field('ocean_model', 'GM_sfn_unlim_y', diag%axesCvi, Time, & 'Parameterized Meridional Overturning Streamfunction before limiting/smoothing', & - 'm3 s-1', conversion=US%Z_to_m) + 'm3 s-1', conversion=US%Z_to_m*US%L_to_m**2*US%s_to_T) end subroutine thickness_diffuse_init @@ -1935,10 +1946,10 @@ subroutine thickness_diffuse_get_KH(CS, KH_u_GME, KH_v_GME, G) type(thickness_diffuse_CS), pointer :: CS !< Control structure for !! this module type(ocean_grid_type), intent(in) :: G !< Grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: KH_u_GME!< interface height - !! diffusivities in u-columns [m2 s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: KH_v_GME!< interface height - !! diffusivities in v-columns [m2 s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: KH_u_GME !< interface height + !! diffusivities at u-faces [L2 T-1 ~> m2 s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: KH_v_GME !< interface height + !! diffusivities at v-faces [L2 T-1 ~> m2 s-1] ! Local variables integer :: i,j,k diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 6a9a23c057..2ff0b3efe1 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -890,8 +890,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Temp !< potential/cons temp [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Salt !< Salinity [ppt] - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Velocity i-component [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Velocity j-component [m s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Velocity i-component [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Velocity j-component [L T-1 ~> m s-1] type(EOS_type), pointer :: EOS !< Equation of state real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity [Z T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: buoyFlux !< Surface buoyancy flux [L2 T-3 ~> m2 s-3] @@ -965,8 +965,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF if (G%mask2dT(i,j)==0.) cycle do k=1,G%ke - U_H(k) = 0.5 * (U(i,j,k)+U(i-1,j,k)) - V_H(k) = 0.5 * (V(i,j,k)+V(i,j-1,k)) + U_H(k) = 0.5 * US%L_T_to_m_s*(u(i,j,k)+u(i-1,j,k)) + V_H(k) = 0.5 * US%L_T_to_m_s*(v(i,j,k)+v(i,j-1,k)) enddo ! things independent of position within the column @@ -1023,8 +1023,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF ! surface averaged fields surfHtemp = surfHtemp + Temp(i,j,ktmp) * delH surfHsalt = surfHsalt + Salt(i,j,ktmp) * delH - surfHu = surfHu + 0.5*(u(i,j,ktmp)+u(i-1,j,ktmp)) * delH - surfHv = surfHv + 0.5*(v(i,j,ktmp)+v(i,j-1,ktmp)) * delH + surfHu = surfHu + 0.5*US%L_T_to_m_s*(u(i,j,ktmp)+u(i-1,j,ktmp)) * delH + surfHv = surfHv + 0.5*US%L_T_to_m_s*(v(i,j,ktmp)+v(i,j-1,ktmp)) * delH if (CS%Stokes_Mixing) then surfHus = surfHus + 0.5*(WAVES%US_x(i,j,ktmp)+WAVES%US_x(i-1,j,ktmp)) * delH surfHvs = surfHvs + 0.5*(WAVES%US_y(i,j,ktmp)+WAVES%US_y(i,j-1,ktmp)) * delH @@ -1041,8 +1041,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF ! vertical shear between present layer and ! surface layer averaged surfU,surfV. ! C-grid average to get Uk and Vk on T-points. - Uk = 0.5*(u(i,j,k)+u(i-1,j,k)) - surfU - Vk = 0.5*(v(i,j,k)+v(i,j-1,k)) - surfV + Uk = 0.5*US%L_T_to_m_s*(u(i,j,k)+u(i-1,j,k)) - surfU + Vk = 0.5*US%L_T_to_m_s*(v(i,j,k)+v(i,j-1,k)) - surfV if (CS%Stokes_Mixing) then ! If momentum is mixed down the Stokes drift gradient, then @@ -1217,15 +1217,15 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF ! hTot = h(i,j,1) ! surfTemp = Temp(i,j,1) ; surfHtemp = surfTemp * hTot ! surfSalt = Salt(i,j,1) ; surfHsalt = surfSalt * hTot - ! surfU = 0.5*(u(i,j,1)+u(i-1,j,1)) ; surfHu = surfU * hTot - ! surfV = 0.5*(v(i,j,1)+v(i,j-1,1)) ; surfHv = surfV * hTot + ! surfU = 0.5*US%L_T_to_m_s*(u(i,j,1)+u(i-1,j,1)) ; surfHu = surfU * hTot + ! surfV = 0.5*US%L_T_to_m_s*(v(i,j,1)+v(i,j-1,1)) ; surfHv = surfV * hTot ! pRef = 0.0 ! do k = 2, G%ke ! ! Recalculate differences with surface layer - ! Uk = 0.5*(u(i,j,k)+u(i-1,j,k)) - surfU - ! Vk = 0.5*(v(i,j,k)+v(i,j-1,k)) - surfV + ! Uk = 0.5*US%L_T_to_m_s*(u(i,j,k)+u(i-1,j,k)) - surfU + ! Vk = 0.5*US%L_T_to_m_s*(v(i,j,k)+v(i,j-1,k)) - surfV ! deltaU2(k) = Uk**2 + Vk**2 ! pRef = pRef + GV%H_to_Pa * h(i,j,k) ! call calculate_density(surfTemp, surfSalt, pRef, rho1, EOS) @@ -1238,8 +1238,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF ! hTot = hTot + delH ! surfHtemp = surfHtemp + Temp(i,j,k) * delH ; surfTemp = surfHtemp / hTot ! surfHsalt = surfHsalt + Salt(i,j,k) * delH ; surfSalt = surfHsalt / hTot - ! surfHu = surfHu + 0.5*(u(i,j,k)+u(i-1,j,k)) * delH ; surfU = surfHu / hTot - ! surfHv = surfHv + 0.5*(v(i,j,k)+v(i,j-1,k)) * delH ; surfV = surfHv / hTot + ! surfHu = surfHu + 0.5*US%L_T_to_m_s*(u(i,j,k)+u(i-1,j,k)) * delH ; surfU = surfHu / hTot + ! surfHv = surfHv + 0.5*US%L_T_to_m_s*(v(i,j,k)+v(i,j-1,k)) * delH ; surfV = surfHv / hTot ! endif ! enddo diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index 6b6bf32bf7..3ab0567db1 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -59,17 +59,18 @@ module MOM_CVMix_shear subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: u_H !< Initial zonal velocity on T points [m s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: v_H !< Initial meridional velocity on T points [m s-1]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: u_H !< Initial zonal velocity on T points [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: v_H !< Initial meridional velocity on T + !! points [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kd !< The vertical diffusivity at each interface !! (not layer!) [Z2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kv !< The vertical viscosity at each interface !! (not layer!) [Z2 T-1 ~> m2 s-1]. - type(CVMix_shear_cs), pointer :: CS !< The control structure returned by a previous call to - !! CVMix_shear_init. + type(CVMix_shear_cs), pointer :: CS !< The control structure returned by a previous + !! call to CVMix_shear_init. ! Local variables integer :: i, j, k, kk, km1 real :: GoRho ! Gravitational acceleration divided by density in MKS units [m4 s-2] @@ -118,8 +119,8 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) do k = 1, G%ke km1 = max(1, k-1) kk = 2*(k-1) - DU = (u_h(i,j,k))-(u_h(i,j,km1)) - DV = (v_h(i,j,k))-(v_h(i,j,km1)) + DU = US%L_T_to_m_s*(u_h(i,j,k) - u_h(i,j,km1)) + DV = US%L_T_to_m_s*(v_h(i,j,k) - v_h(i,j,km1)) DRHO = (GoRho * (rho_1D(kk+1) - rho_1D(kk+2)) ) DZ = ((0.5*(h(i,j,km1) + h(i,j,k))+GV%H_subroundoff)*GV%H_to_m) N2 = DRHO/DZ diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 48287bb86c..cbf42d2b8b 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -119,7 +119,7 @@ module MOM_bulk_mixed_layer real :: Allowed_S_chg !< The amount by which salinity is allowed !! to exceed previous values during detrainment, ppt. - ! These are terms in the mixed layer TKE budget, all in [Z m2 T-3 ~> m3 s-3] except as noted. + ! These are terms in the mixed layer TKE budget, all in [Z L2 T-3 ~> m3 s-3] except as noted. real, allocatable, dimension(:,:) :: & ML_depth, & !< The mixed layer depth [H ~> m or kg m-2]. diag_TKE_wind, & !< The wind source of TKE. @@ -193,10 +193,10 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, intent(inout) :: h_3d !< Layer thickness [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: u_3d !< Zonal velocities interpolated to h points - !! [m s-1]. + !! [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: v_3d !< Zonal velocities interpolated to h points - !! [m s-1]. + !! [L T-1 ~> m s-1]. type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent !! fields have NULL ptrs. @@ -247,8 +247,8 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, R0, & ! The potential density referenced to the surface [kg m-3]. Rcv ! The coordinate variable potential density [kg m-3]. real, dimension(SZI_(G),SZK_(GV)) :: & - u, & ! The zonal velocity [m s-1]. - v, & ! The meridional velocity [m s-1]. + u, & ! The zonal velocity [L T-1 ~> m s-1]. + v, & ! The meridional velocity [L T-1 ~> m s-1]. h_orig, & ! The original thickness [H ~> m or kg m-2]. d_eb, & ! The downward increase across a layer in the entrainment from ! below [H ~> m or kg m-2]. The sign convention is that positive values of @@ -263,9 +263,9 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, h_miss ! The summed absolute mismatch [Z ~> m]. real, dimension(SZI_(G)) :: & TKE, & ! The turbulent kinetic energy available for mixing over a - ! time step [Z m2 T-2 ~> m3 s-2]. + ! time step [Z L2 T-2 ~> m3 s-2]. Conv_En, & ! The turbulent kinetic energy source due to mixing down to - ! the depth of free convection [Z m2 T-2 ~> m3 s-2]. + ! the depth of free convection [Z L2 T-2 ~> m3 s-2]. htot, & ! The total depth of the layers being considered for ! entrainment [H ~> m or kg m-2]. R0_tot, & ! The integrated potential density referenced to the surface @@ -277,7 +277,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, Stot, & ! The integrated salt of layers which are fully entrained ! [H ppt ~> m ppt or ppt kg m-2]. uhtot, & ! The depth integrated zonal and meridional velocities in the - vhtot, & ! mixed layer [H m s-1 ~> m2 s-1 or kg m-1 s-1]. + vhtot, & ! mixed layer [H L T-1 ~> m2 s-1 or kg m-1 s-1]. netMassInOut, & ! The net mass flux (if non-Boussinsq) or volume flux (if ! Boussinesq - i.e. the fresh water flux (P+R-E)) into the @@ -301,7 +301,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, dRcv_dS, & ! Partial derivative of the coordinate variable potential ! density in the mixed layer with salinity [kg m-3 ppt-1]. TKE_river ! The source of turbulent kinetic energy available for mixing - ! at rivermouths [Z m2 T-3 ~> m3 s-3]. + ! at rivermouths [Z L2 T-3 ~> m3 s-3]. real, dimension(max(CS%nsw,1),SZI_(G)) :: & Pen_SW_bnd ! The penetrating fraction of the shortwave heating integrated @@ -320,13 +320,13 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, real, dimension(SZI_(G)) :: & dKE_FC, & ! The change in mean kinetic energy due to free convection - ! [Z m2 T-2 ~> m3 s-2]. + ! [Z L2 T-2 ~> m3 s-2]. h_CA ! The depth to which convective adjustment has gone [H ~> m or kg m-2]. real, dimension(SZI_(G),SZK_(GV)) :: & dKE_CA, & ! The change in mean kinetic energy due to convective - ! adjustment [Z m2 T-2 ~> m3 s-2]. + ! adjustment [Z L2 T-2 ~> m3 s-2]. cTKE ! The turbulent kinetic energy source due to convective - ! adjustment [Z m2 T-2 ~> m3 s-2]. + ! adjustment [Z L2 T-2 ~> m3 s-2]. real, dimension(SZI_(G),SZJ_(G)) :: & Hsfc_max, & ! The thickness of the surface region (mixed and buffer layers) ! after entrainment but before any buffer layer detrainment [Z ~> m]. @@ -514,7 +514,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, ! rivermix_depth = The prescribed depth over which to mix river inflow ! drho_ds = The gradient of density wrt salt at the ambient surface salinity. ! Sriver = 0 (i.e. rivers are assumed to be pure freshwater) - RmixConst = 0.5*CS%rivermix_depth * (US%L_to_m**2*GV%g_Earth*US%m_to_Z) * Irho0**2 + RmixConst = 0.5*CS%rivermix_depth * (GV%g_Earth*US%m_to_Z) * Irho0**2 do i=is,ie TKE_river(i) = max(0.0, RmixConst*dR0_dS(i)* & US%T_to_s*(fluxes%lrunoff(i,j) + fluxes%frunoff(i,j)) * S(i,1)) @@ -544,7 +544,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, R0(:,1:), Rcv(:,1:), eps, & dR0_dT, dRcv_dT, dR0_dS, dRcv_dS, & netMassInOut, netMassOut, Net_heat, Net_salt, & - nsw, Pen_SW_bnd, opacity_band, Conv_en, & + nsw, Pen_SW_bnd, opacity_band, Conv_En, & dKE_FC, j, ksort, G, GV, US, CS, tv, fluxes, dt_in_T, & aggregate_FW_forcing) @@ -573,7 +573,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, T(:,1:), Pen_SW_bnd, eps, ksort, htot, Ttot) if (CS%TKE_diagnostics) then ; do i=is,ie - CS%diag_TKE_mech_decay(i,j) = CS%diag_TKE_mech_decay(i,j) - Idt_diag*TKE(i) + CS%diag_TKE_mech_decay(i,j) = CS%diag_TKE_mech_decay(i,j) - Idt_diag * TKE(i) enddo ; endif if (id_clock_mech>0) call cpu_clock_end(id_clock_mech) @@ -808,9 +808,9 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2]. !! The units of h are referred to as H below. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: u !< Zonal velocities interpolated to h - !! points, m s-1. + !! points [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: v !< Zonal velocities interpolated to h - !! points, m s-1. + !! points [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: T !< Layer temperatures [degC]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: S !< Layer salinities [ppt]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: R0 !< Potential density referenced to @@ -825,10 +825,10 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & !! that will be left in each layer [H ~> m or kg m-2]. real, dimension(SZI_(G),SZK_(GV)), intent(out) :: dKE_CA !< The vertically integrated change in !! kinetic energy due to convective - !! adjustment [Z m2 T-2 ~> m3 s-2]. + !! adjustment [Z L2 T-2 ~> m3 s-2]. real, dimension(SZI_(G),SZK_(GV)), intent(out) :: cTKE !< The buoyant turbulent kinetic energy !! source due to convective adjustment - !! [Z m2 T-2 ~> m3 s-2]. + !! [Z L2 T-2 ~> m3 s-2]. integer, intent(in) :: j !< The j-index to work on. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this module. @@ -853,19 +853,19 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & Stot, & ! The integrated salt of layers which are fully entrained ! [H ppt ~> m ppt or ppt kg m-2]. uhtot, & ! The depth integrated zonal and meridional velocities in - vhtot, & ! the mixed layer [H m s-1 ~> m2 s-1 or kg m-1 s-1]. + vhtot, & ! the mixed layer [H L T-1 ~> m2 s-1 or kg m-1 s-1]. KE_orig, & ! The total mean kinetic energy in the mixed layer before - ! convection, H m2 s-2. + ! convection, [H L2 T-2 ~> H m2 s-2]. h_orig_k1 ! The depth of layer k1 before convective adjustment [H ~> m or kg m-2]. real :: h_ent ! The thickness from a layer that is entrained [H ~> m or kg m-2]. real :: Ih ! The inverse of a thickness [H-1 ~> m-1 or m2 kg-1]. real :: g_H2_2Rho0 ! Half the gravitational acceleration times the square of ! the conversion from H to Z divided by the mean density, - ! in [m5 Z T-2 H-2 kg-1 ~> m4 s-2 kg-1 or m10 s-2 kg-3]. + ! in [L2 Z m3 T-3 H-2 kg-1 ~> m4 s-3 kg-1 or m10 s-3 kg-3]. integer :: is, ie, nz, i, k, k1, nzc, nkmb is = G%isc ; ie = G%iec ; nz = GV%ke - g_H2_2Rho0 = (US%L_to_m**2*GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0) + g_H2_2Rho0 = (GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0) nzc = nz ; if (present(nz_conv)) nzc = nz_conv nkmb = CS%nkml+CS%nkbl @@ -915,7 +915,7 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & Ih = 1.0 / h(i,k1) R0(i,k1) = R0_tot(i) * Ih u(i,k1) = uhtot(i) * Ih ; v(i,k1) = vhtot(i) * Ih - dKE_CA(i,k1) = dKE_CA(i,k1) + GV%H_to_Z * US%T_to_s**2*(CS%bulk_Ri_convective * & + dKE_CA(i,k1) = dKE_CA(i,k1) + GV%H_to_Z * (CS%bulk_Ri_convective * & (KE_orig(i) - 0.5*h(i,k1)*(u(i,k1)**2 + v(i,k1)**2))) Rcv(i,k1) = Rcv_tot(i) * Ih T(i,k1) = Ttot(i) * Ih ; S(i,k1) = Stot(i) * Ih @@ -937,7 +937,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & R0_tot, Rcv_tot, u, v, T, S, R0, Rcv, eps, & dR0_dT, dRcv_dT, dR0_dS, dRcv_dS, & netMassInOut, netMassOut, Net_heat, Net_salt, & - nsw, Pen_SW_bnd, opacity_band, Conv_en, & + nsw, Pen_SW_bnd, opacity_band, Conv_En, & dKE_FC, j, ksort, G, GV, US, CS, tv, fluxes, dt_in_T, & aggregate_FW_forcing) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. @@ -955,17 +955,17 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real, dimension(SZI_(G)), intent(out) :: Stot !< The depth integrated mixed layer salinity !! [ppt H ~> ppt m or ppt kg m-2]. real, dimension(SZI_(G)), intent(out) :: uhtot !< The depth integrated mixed layer zonal - !! velocity, H m s-1. + !! velocity [H L T-1 ~> m2 s-1 or kg m-1 s-1]. real, dimension(SZI_(G)), intent(out) :: vhtot !< The integrated mixed layer meridional - !! velocity, H m s-1. + !! velocity [H L T-1 ~> m2 s-1 or kg m-1 s-1]. real, dimension(SZI_(G)), intent(out) :: R0_tot !< The integrated mixed layer potential density referenced !! to 0 pressure [H kg m-2 ~> kg m-1 or kg2 m-4]. real, dimension(SZI_(G)), intent(out) :: Rcv_tot !< The integrated mixed layer coordinate !! variable potential density [H kg m-2 ~> kg m-1 or kg2 m-4]. real, dimension(SZI_(G),SZK_(GV)), & - intent(in) :: u !< Zonal velocities interpolated to h points, m s-1. + intent(in) :: u !< Zonal velocities interpolated to h points [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZK_(GV)), & - intent(in) :: v !< Zonal velocities interpolated to h points, m s-1. + intent(in) :: v !< Zonal velocities interpolated to h points [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: T !< Layer temperatures [degC]. real, dimension(SZI_(G),SZK_(GV)), & @@ -1004,10 +1004,10 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! band [degC H ~> degC m or degC kg m-2]. real, dimension(max(nsw,1),SZI_(G),SZK_(GV)), intent(in) :: opacity_band !< The opacity in each band of !! penetrating shortwave radiation [H-1 ~> m-1 or m2 kg-1]. - real, dimension(SZI_(G)), intent(out) :: Conv_en !< The buoyant turbulent kinetic energy source - !! due to free convection [Z m2 T-2 ~> m3 s-2]. + real, dimension(SZI_(G)), intent(out) :: Conv_En !< The buoyant turbulent kinetic energy source + !! due to free convection [Z L2 T-2 ~> m3 s-2]. real, dimension(SZI_(G)), intent(out) :: dKE_FC !< The vertically integrated change in kinetic - !! energy due to free convection [Z m2 T-2 ~> m3 s-2]. + !! energy due to free convection [Z L2 T-2 ~> m3 s-2]. integer, intent(in) :: j !< The j-index to work on. integer, dimension(SZI_(G),SZK_(GV)), & intent(in) :: ksort !< The density-sorted k-indices. @@ -1053,7 +1053,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & ! h_ent between iterations [H ~> m or kg m-2]. real :: g_H2_2Rho0 ! Half the gravitational acceleration times the square of ! the conversion from H to Z divided by the mean density, - ! [m7 T-2 Z-1 H-2 kg-1 ~> m4 s-2 kg-1 or m10 s-2 kg-3]. + ! [L2 Z m3 T-3 H-2 kg-1 ~> m4 s-3 kg-1 or m10 s-3 kg-3]. real :: Angstrom ! The minimum layer thickness [H ~> m or kg m-2]. real :: opacity ! The opacity converted to inverse thickness units [H-1 ~> m-1 or m2 kg-1] real :: sum_Pen_En ! The potential energy change due to penetrating @@ -1068,7 +1068,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & Angstrom = GV%Angstrom_H C1_3 = 1.0/3.0 ; C1_6 = 1.0/6.0 - g_H2_2Rho0 = (US%L_to_m**2*GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0) + g_H2_2Rho0 = (GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0) Idt = 1.0 / dt_in_T is = G%isc ; ie = G%iec ; nz = GV%ke @@ -1286,12 +1286,14 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & if (htot(i) > 0.0) & dKE_FC(i) = dKE_FC(i) + CS%bulk_Ri_convective * 0.5 * & ((GV%H_to_Z*h_ent) / (htot(i)*(h_ent+htot(i)))) * & - US%T_to_s**2*((uhtot(i)-u(i,k)*htot(i))**2 + (vhtot(i)-v(i,k)*htot(i))**2) + ((uhtot(i)-u(i,k)*htot(i))**2 + (vhtot(i)-v(i,k)*htot(i))**2) htot(i) = htot(i) + h_ent h(i,k) = h(i,k) - h_ent d_eb(i,k) = d_eb(i,k) - h_ent uhtot(i) = u(i,k)*h_ent ; vhtot(i) = v(i,k)*h_ent + !### I think that the line above should instead be: + ! uhtot(i) = uhtot(i) + h_ent*u(i,k) ; vhtot(i) = vhtot(i) + h_ent*v(i,k) endif @@ -1317,25 +1319,25 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, !! possible forcing fields. Unused fields !! have NULL ptrs. real, dimension(SZI_(G)), intent(inout) :: Conv_En !< The buoyant turbulent kinetic energy source - !! due to free convection [Z m2 T-2 ~> m3 s-2]. + !! due to free convection [Z L2 T-2 ~> m3 s-2]. real, dimension(SZI_(G)), intent(in) :: dKE_FC !< The vertically integrated change in !! kinetic energy due to free convection - !! [Z m2 T-2 ~> m3 s-2]. + !! [Z L2 T-2 ~> m3 s-2]. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: cTKE !< The buoyant turbulent kinetic energy !! source due to convective adjustment - !! [Z m2 T-2 ~> m3 s-2]. + !! [Z L2 T-2 ~> m3 s-2]. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: dKE_CA !< The vertically integrated change in !! kinetic energy due to convective - !! adjustment [Z m2 T-2 ~> m3 s-2]. + !! adjustment [Z L2 T-2 ~> m3 s-2]. real, dimension(SZI_(G)), intent(out) :: TKE !< The turbulent kinetic energy available for !! mixing over a time step [Z m2 T-2 ~> m3 s-2]. real, dimension(SZI_(G)), intent(out) :: Idecay_len_TKE !< The inverse of the vertical decay !! scale for TKE [H-1 ~> m-1 or m2 kg-1]. real, dimension(SZI_(G)), intent(in) :: TKE_river !< The source of turbulent kinetic energy !! available for driving mixing at river mouths - !! [Z m2 T-3 ~> m3 s-3]. + !! [Z L2 T-3 ~> m3 s-3]. real, dimension(2,SZI_(G)), intent(out) :: cMKE !< Coefficients of HpE and HpE^2 in !! calculating the denominator of MKE_rate, !! [H-1 ~> m-1 or m2 kg-1] and [H-2 ~> m-2 or m4 kg-2]. @@ -1351,13 +1353,13 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, ! convection to drive mechanical entrainment. ! Local variables - real :: dKE_conv ! The change in mean kinetic energy due to all convection [Z m2 T-2 ~> m3 s-2]. + real :: dKE_conv ! The change in mean kinetic energy due to all convection [Z L2 T-2 ~> m3 s-2]. real :: nstar_FC ! The effective efficiency with which the energy released by ! free convection is converted to TKE, often ~0.2 [nondim]. real :: nstar_CA ! The effective efficiency with which the energy released by ! convective adjustment is converted to TKE, often ~0.2 [nondim]. real :: TKE_CA ! The potential energy released by convective adjustment if - ! that release is positive [Z m2 T-2 ~> m3 s-2]. + ! that release is positive [Z L2 T-2 ~> m3 s-2]. real :: MKE_rate_CA ! MKE_rate for convective adjustment [nondim], 0 to 1. real :: MKE_rate_FC ! MKE_rate for free convection [nondim], 0 to 1. real :: totEn_Z ! The total potential energy released by convection, [Z3 T-2 ~> m3 s-2]. @@ -1366,7 +1368,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, real :: absf ! The absolute value of f averaged to thickness points [T-1 ~> s-1]. real :: U_star ! The friction velocity [Z T-1 ~> m s-1]. real :: absf_Ustar ! The absolute value of f divided by U_star [Z-1 ~> m-1]. - real :: wind_TKE_src ! The surface wind source of TKE [Z m2 T-3 ~> m3 s-3]. + real :: wind_TKE_src ! The surface wind source of TKE [Z L2 T-3 ~> m3 s-3]. real :: diag_wt ! The ratio of the current timestep to the diagnostic ! timestep (which may include 2 calls) [nondim]. integer :: is, ie, nz, i @@ -1418,7 +1420,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, if (Conv_En(i) < 0.0) Conv_En(i) = 0.0 if (cTKE(i,1) > 0.0) then ; TKE_CA = cTKE(i,1) ; else ; TKE_CA = 0.0 ; endif if ((htot(i) >= h_CA(i)) .or. (TKE_CA == 0.0)) then - totEn_Z = US%m_to_Z**2 * (Conv_En(i) + TKE_CA) + totEn_Z = US%L_to_Z**2 * (Conv_En(i) + TKE_CA) if (totEn_Z > 0.0) then nstar_FC = CS%nstar * totEn_Z / (totEn_Z + 0.2 * & @@ -1430,14 +1432,14 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, else ! This reconstructs the Buoyancy flux within the topmost htot of water. if (Conv_En(i) > 0.0) then - totEn_Z = US%m_to_Z**2 * (Conv_En(i) + TKE_CA * (htot(i) / h_CA(i)) ) + totEn_Z = US%L_to_Z**2 * (Conv_En(i) + TKE_CA * (htot(i) / h_CA(i)) ) nstar_FC = CS%nstar * totEn_Z / (totEn_Z + 0.2 * & sqrt(0.5 * dt_in_T * (absf*(htot(i)*GV%H_to_Z))**3 * totEn_Z)) else nstar_FC = CS%nstar endif - totEn_Z = US%m_to_Z**2 * (Conv_En(i) + TKE_CA) + totEn_Z = US%L_to_Z**2 * (Conv_En(i) + TKE_CA) if (TKE_CA > 0.0) then nstar_CA = CS%nstar * totEn_Z / (totEn_Z + 0.2 * & sqrt(0.5 * dt_in_T * (absf*(h_CA(i)*GV%H_to_Z))**3 * totEn_Z)) @@ -1462,7 +1464,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, dKE_conv = dKE_CA(i,1) * MKE_rate_CA + dKE_FC(i) * MKE_rate_FC ! At this point, it is assumed that cTKE is positive and stored in TKE_CA! ! Note: Removed factor of 2 in u*^3 terms. - TKE(i) = (dt_in_T*CS%mstar)*((US%Z_to_m**2*(U_star*U_Star*U_Star))*exp_kh) + & + TKE(i) = (dt_in_T*CS%mstar)*((US%Z_to_L**2*(U_star*U_Star*U_Star))*exp_kh) + & (exp_kh * dKE_conv + nstar_FC*Conv_En(i) + nstar_CA * TKE_CA) if (CS%do_rivermix) then ! Add additional TKE at river mouths @@ -1470,7 +1472,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, endif if (CS%TKE_diagnostics) then - wind_TKE_src = CS%mstar*(US%Z_to_m**2*U_star*U_Star*U_Star) * diag_wt + wind_TKE_src = CS%mstar*(US%Z_to_L**2*U_star*U_Star*U_Star) * diag_wt CS%diag_TKE_wind(i,j) = CS%diag_TKE_wind(i,j) + & ( wind_TKE_src + TKE_river(i) * diag_wt ) CS%diag_TKE_RiBulk(i,j) = CS%diag_TKE_RiBulk(i,j) + dKE_conv*Idt_diag @@ -1508,17 +1510,17 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real, dimension(SZI_(G)), intent(inout) :: Stot !< The depth integrated mixed layer salinity !! [ppt H ~> ppt m or ppt kg m-2]. real, dimension(SZI_(G)), intent(inout) :: uhtot !< The depth integrated mixed layer zonal - !! velocity, H m s-1. + !! velocity [H L T-1 ~> m2 s-1 or kg m-1 s-1]. real, dimension(SZI_(G)), intent(inout) :: vhtot !< The integrated mixed layer meridional - !! velocity, H m s-1. + !! velocity [H L T-1 ~> m2 s-1 or kg m-1 s-1]. real, dimension(SZI_(G)), intent(inout) :: R0_tot !< The integrated mixed layer potential density !! referenced to 0 pressure [H kg m-3 ~> kg m-2 or kg2 m-5]. real, dimension(SZI_(G)), intent(inout) :: Rcv_tot !< The integrated mixed layer coordinate variable !! potential density [H kg m-3 ~> kg m-2 or kg2 m-5]. real, dimension(SZI_(G),SZK_(GV)), & - intent(in) :: u !< Zonal velocities interpolated to h points, m s-1. + intent(in) :: u !< Zonal velocities interpolated to h points [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZK_(GV)), & - intent(in) :: v !< Zonal velocities interpolated to h points, m s-1. + intent(in) :: v !< Zonal velocities interpolated to h points [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: T !< Layer temperatures [degC]. real, dimension(SZI_(G),SZK_(GV)), & @@ -1575,22 +1577,22 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real :: HpE ! The current thickness plus entrainment [H ~> m or kg m-2]. real :: g_H_2Rho0 ! Half the gravitational acceleration times the ! conversion from H to m divided by the mean density, - ! in [m5 T-2 H-1 kg-1 ~> m4 s-2 kg-1 or m7 s-2 kg-2]. + ! in [L2 m3 T-2 H-1 kg-1 ~> m4 s-2 kg-1 or m7 s-2 kg-2]. real :: TKE_full_ent ! The TKE remaining if a layer is fully entrained - ! [Z m2 T-2 ~> m3 s-2]. + ! [Z L2 T-2 ~> m3 s-2]. real :: dRL ! Work required to mix water from the next layer - ! across the mixed layer [m2 T-2 ~> m2 s-2]. + ! across the mixed layer [L2 T-2 ~> L2 s-2]. real :: Pen_En_Contrib ! Penetrating SW contributions to the changes in - ! TKE, divided by layer thickness in m [m2 T2 ~> m2 s-2]. - real :: Cpen1 ! A temporary variable [m2 T-2 ~> m2 s-2]. + ! TKE, divided by layer thickness in m [L2 T2 ~> m2 s-2]. + real :: Cpen1 ! A temporary variable [L2 T-2 ~> m2 s-2]. real :: dMKE ! A temporary variable related to the release of mean - ! kinetic energy [H Z m2 T-2 ~> m4 s-2 or kg m s-2] - real :: TKE_ent ! The TKE that remains if h_ent were entrained [Z m2 T-2 ~> m3 s-2]. + ! kinetic energy [H Z L2 T-2 ~> m4 s-2 or kg m s-2] + real :: TKE_ent ! The TKE that remains if h_ent were entrained [Z L2 T-2 ~> m3 s-2]. real :: TKE_ent1 ! The TKE that would remain, without considering the - ! release of mean kinetic energy [Z m2 T-2 ~> m3 s-2]. - real :: dTKE_dh ! The partial derivative of TKE with h_ent [Z m2 T-2 H-1 ~> m2 s-2 or m5 s-2 kg-1]. + ! release of mean kinetic energy [Z L2 T-2 ~> m3 s-2]. + real :: dTKE_dh ! The partial derivative of TKE with h_ent [Z L2 T-2 H-1 ~> m2 s-2 or m5 s-2 kg-1]. real :: Pen_dTKE_dh_Contrib ! The penetrating shortwave contribution to - ! dTKE_dh [m2 T-2 ~> m2 s-2]. + ! dTKE_dh [L2 T-2 ~> m2 s-2]. real :: EF4_val ! The result of EF4() (see later) [H-1 ~> m-1 or m2 kg-1]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. @@ -1609,7 +1611,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & integer :: is, ie, nz, i, k, ks, itt, n C1_3 = 1.0/3.0 ; C1_6 = 1.0/6.0 ; C1_24 = 1.0/24.0 - g_H_2Rho0 = (US%L_to_m**2*GV%g_Earth * GV%H_to_Z) / (2.0 * GV%Rho0) + g_H_2Rho0 = (GV%g_Earth * GV%H_to_Z) / (2.0 * GV%Rho0) Hmix_min = CS%Hmix_min h_neglect = GV%H_subroundoff is = G%isc ; ie = G%iec ; nz = GV%ke @@ -1622,7 +1624,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & h_avail = h(i,k) - eps(i,k) if ((h_avail > 0.) .and. ((TKE(i) > 0.) .or. (htot(i) < Hmix_min))) then dRL = g_H_2Rho0 * (R0(i,k)*htot(i) - R0_tot(i) ) - dMKE = (GV%H_to_Z * CS%bulk_Ri_ML) * 0.5 * US%T_to_s**2 * & + dMKE = (GV%H_to_Z * CS%bulk_Ri_ML) * 0.5 * & ((uhtot(i)-u(i,k)*htot(i))**2 + (vhtot(i)-v(i,k)*htot(i))**2) ! Find the TKE that would remain if the entire layer were entrained. @@ -1677,7 +1679,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & if (CS%TKE_diagnostics) then E_HxHpE = h_ent / ((htot(i)+h_neglect)*(htot(i)+h_ent+h_neglect)) CS%diag_TKE_mech_decay(i,j) = CS%diag_TKE_mech_decay(i,j) + & - Idt_diag * ((exp_kh-1.0)*TKE(i) + (h_ent*GV%H_to_Z)*dRL*(1.0-f1_kh) + & + Idt_diag * ((exp_kh-1.0)* TKE(i) + (h_ent*GV%H_to_Z)*dRL*(1.0-f1_kh) + & MKE_rate*dMKE*(EF4_val-E_HxHpE)) CS%diag_TKE_mixing(i,j) = CS%diag_TKE_mixing(i,j) - & Idt_diag*(GV%H_to_Z*h_ent)*dRL @@ -1689,7 +1691,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & TKE(i) = TKE_full_ent !### The minimum TKE value in this line may be problematically small. - if (TKE(i) <= 0.0) TKE(i) = 1.0e-150*US%T_to_s**2*US%m_to_Z + if (TKE(i) <= 0.0) TKE(i) = 1.0e-150*US%m_to_Z*US%m_s_to_L_T**2 else ! The layer is only partially entrained. The amount that will be ! entrained is determined iteratively. No further layers will be @@ -1748,7 +1750,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & Cpen1*((1.0-SW_trans) - opacity*(htot(i) + h_ent)*SW_trans) endif ; enddo ! (Pen_SW_bnd(n,i) > 0.0) - TKE_ent1 = exp_kh*TKE(i) - (h_ent*GV%H_to_Z)*(dRL*f1_kh + Pen_En_Contrib) + TKE_ent1 = exp_kh* TKE(i) - (h_ent*GV%H_to_Z)*(dRL*f1_kh + Pen_En_Contrib) EF4_val = EF4(htot(i)+h_neglect,h_ent,Idecay_len_TKE(i),dEF4_dh) HpE = htot(i)+h_ent MKE_rate = 1.0/(1.0 + (cMKE(1,i)*HpE + cMKE(2,i)*HpE**2)) @@ -1790,7 +1792,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & E_HxHpE = h_ent / ((htot(i)+h_neglect)*(HpE+h_neglect)) CS%diag_TKE_mech_decay(i,j) = CS%diag_TKE_mech_decay(i,j) + & - Idt_diag * ((exp_kh-1.0)*TKE(i) + (h_ent*GV%H_to_Z)*dRL*(1.0-f1_kh) + & + Idt_diag * ((exp_kh-1.0)* TKE(i) + (h_ent*GV%H_to_Z)*dRL*(1.0-f1_kh) + & dMKE*MKE_rate*(EF4_val-E_HxHpE)) CS%diag_TKE_mixing(i,j) = CS%diag_TKE_mixing(i,j) - & Idt_diag*(h_ent*GV%H_to_Z)*dRL @@ -2291,7 +2293,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea ! rho_0*g [H2 ~> m2 or kg2 m-4]. real :: dPE_det, dPE_merge ! The energy required to mix the detrained water ! into the buffer layer or the merge the two - ! buffer layers [kg H2 Z T-2 m-3 ~> J m-2 or J kg2 m-8]. + ! buffer layers [kg H2 Z T-2 L-2 m-1 ~> J m-2 or J kg2 m-8]. real :: h_from_ml ! The amount of additional water that must be ! drawn from the mixed layer [H ~> m or kg m-2]. @@ -2330,8 +2332,8 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea ! [degC ppt-1] and [ppt degC-1]. real :: I_denom ! A work variable with units of [ppt2 m6 kg-2]. - real :: g_2 ! 1/2 g_Earth [m2 Z-1 T-2 ~> m s-2]. - real :: Rho0xG ! Rho0 times G_Earth [kg m-1 Z-1 T-2 ~> kg m-2 s-2]. + real :: g_2 ! 1/2 g_Earth [L2 Z-1 T-2 ~> m s-2]. + real :: Rho0xG ! Rho0 times G_Earth [kg L2 m-3 Z-1 T-2 ~> kg m-2 s-2]. real :: I2Rho0 ! 1 / (2 Rho0) [m3 kg-1]. real :: Idt_H2 ! The square of the conversion from thickness to Z ! divided by the time step [Z2 H-2 T-1 ~> s-1 or m6 kg-2 s-1]. @@ -2340,7 +2342,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. - real :: s1en ! A work variable [H2 kg m T-3 ~> kg m3 s-3 or kg3 m-3 s-3]. + real :: s1en ! A work variable [H2 L2 kg m-1 T-3 ~> kg m3 s-3 or kg3 m-3 s-3]. real :: s1, s2, bh0 ! Work variables [H ~> m or kg m-2]. real :: s3sq ! A work variable [H2 ~> m2 or kg2 m-4]. real :: I_ya, b1 ! Nondimensional work variables. @@ -2359,8 +2361,8 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea kb1 = CS%nkml+1; kb2 = CS%nkml+2 nkmb = CS%nkml+CS%nkbl h_neglect = GV%H_subroundoff - g_2 = 0.5 * US%L_to_m**2*GV%g_Earth - Rho0xG = GV%Rho0 * US%L_to_m**2*GV%g_Earth + g_2 = 0.5 * GV%g_Earth + Rho0xG = GV%Rho0 * GV%g_Earth Idt_H2 = GV%H_to_Z**2 / dt_diag I2Rho0 = 0.5 / GV%Rho0 Angstrom = GV%Angstrom_H @@ -3146,10 +3148,10 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea real :: dt_Time ! The timestep divided by the detrainment timescale [nondim]. real :: g_H2_2Rho0dt ! Half the gravitational acceleration times the square of the ! conversion from H to m divided by the mean density times the time - ! step [m7 T-3 Z-1 H-2 kg-1 ~> m4 s-3 kg-1 or m10 s-3 kg-3]. + ! step [L2 Z m3 T-3 H-2 kg-1 ~> m4 s-3 kg-1 or m10 s-3 kg-3]. real :: g_H2_2dt ! Half the gravitational acceleration times the square of the - ! conversion from H to m divided by the diagnostic time step - ! [m4 Z-1 H-2 T-3 ~> m s-3 or m7 kg-2 s-3]. + ! conversion from H to Z divided by the diagnostic time step + ! [L2 Z H-2 T-3 ~> m s-3 or m7 kg-2 s-3]. logical :: splittable_BL(SZI_(G)), orthogonal_extrap real :: x1 @@ -3161,8 +3163,8 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea "CS%nkbl must be 1 in mixedlayer_detrain_1.") dt_Time = dt_in_T / CS%BL_detrain_time - g_H2_2Rho0dt = (US%L_to_m**2*GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0 * dt_diag) - g_H2_2dt = (US%L_to_m**2*GV%g_Earth * GV%H_to_Z**2) / (2.0 * dt_diag) + g_H2_2Rho0dt = (GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0 * dt_diag) + g_H2_2dt = (GV%g_Earth * GV%H_to_Z**2) / (2.0 * dt_diag) ! Move detrained water into the buffer layer. do k=1,CS%nkml @@ -3579,28 +3581,34 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) CS%id_ML_depth = register_diag_field('ocean_model', 'h_ML', diag%axesT1, & Time, 'Surface mixed layer depth', 'm') CS%id_TKE_wind = register_diag_field('ocean_model', 'TKE_wind', diag%axesT1, & - Time, 'Wind-stirring source of mixed layer TKE', 'm3 s-3', conversion=US%Z_to_m*US%T_to_s**3) + Time, 'Wind-stirring source of mixed layer TKE', & + 'm3 s-3', conversion=US%Z_to_m*US%L_to_m**2*US%T_to_s**3) CS%id_TKE_RiBulk = register_diag_field('ocean_model', 'TKE_RiBulk', diag%axesT1, & - Time, 'Mean kinetic energy source of mixed layer TKE', 'm3 s-3', conversion=US%Z_to_m*US%T_to_s**3) + Time, 'Mean kinetic energy source of mixed layer TKE', & + 'm3 s-3', conversion=US%Z_to_m*US%L_to_m**2*US%T_to_s**3) CS%id_TKE_conv = register_diag_field('ocean_model', 'TKE_conv', diag%axesT1, & Time, 'Convective source of mixed layer TKE', 'm3 s-3', conversion=US%Z_to_m*US%T_to_s**3) CS%id_TKE_pen_SW = register_diag_field('ocean_model', 'TKE_pen_SW', diag%axesT1, & Time, 'TKE consumed by mixing penetrative shortwave radation through the mixed layer', & - 'm3 s-3', conversion=US%Z_to_m) + 'm3 s-3', conversion=US%Z_to_m*US%L_to_m**2*US%T_to_s**3) CS%id_TKE_mixing = register_diag_field('ocean_model', 'TKE_mixing', diag%axesT1, & - Time, 'TKE consumed by mixing that deepens the mixed layer', 'm3 s-3', conversion=US%Z_to_m*US%T_to_s**3) + Time, 'TKE consumed by mixing that deepens the mixed layer', & + 'm3 s-3', conversion=US%Z_to_m*US%L_to_m**2*US%T_to_s**3) CS%id_TKE_mech_decay = register_diag_field('ocean_model', 'TKE_mech_decay', diag%axesT1, & - Time, 'Mechanical energy decay sink of mixed layer TKE', 'm3 s-3', conversion=US%Z_to_m*US%T_to_s**3) + Time, 'Mechanical energy decay sink of mixed layer TKE', & + 'm3 s-3', conversion=US%Z_to_m*US%L_to_m**2*US%T_to_s**3) CS%id_TKE_conv_decay = register_diag_field('ocean_model', 'TKE_conv_decay', diag%axesT1, & - Time, 'Convective energy decay sink of mixed layer TKE', 'm3 s-3', conversion=US%Z_to_m*US%T_to_s**3) + Time, 'Convective energy decay sink of mixed layer TKE', & + 'm3 s-3', conversion=US%Z_to_m*US%L_to_m**2*US%T_to_s**3) CS%id_TKE_conv_s2 = register_diag_field('ocean_model', 'TKE_conv_s2', diag%axesT1, & - Time, 'Spurious source of mixed layer TKE from sigma2', 'm3 s-3', conversion=US%Z_to_m*US%T_to_s**3) + Time, 'Spurious source of mixed layer TKE from sigma2', & + 'm3 s-3', conversion=US%Z_to_m*US%L_to_m**2*US%T_to_s**3) CS%id_PE_detrain = register_diag_field('ocean_model', 'PE_detrain', diag%axesT1, & Time, 'Spurious source of potential energy from mixed layer detrainment', & - 'W m-2', conversion=US%Z_to_m*US%T_to_s**3) + 'W m-2', conversion=US%Z_to_m*US%L_to_m**2*US%T_to_s**3) CS%id_PE_detrain2 = register_diag_field('ocean_model', 'PE_detrain2', diag%axesT1, & Time, 'Spurious source of potential energy from mixed layer only detrainment', & - 'W m-2', conversion=US%Z_to_m*US%T_to_s**3) + 'W m-2', conversion=US%Z_to_m*US%L_to_m**2*US%T_to_s**3) CS%id_h_mismatch = register_diag_field('ocean_model', 'h_miss_ML', diag%axesT1, & Time, 'Summed absolute mismatch in entrainment terms', 'm', conversion=US%Z_to_m) CS%id_Hsfc_used = register_diag_field('ocean_model', 'Hs_used', diag%axesT1, & diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index ca6185aa5d..96652a9f45 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -551,9 +551,10 @@ end subroutine triDiagTS !> This subroutine calculates u_h and v_h (velocities at thickness !! points), optionally using the entrainment amounts passed in as arguments. -subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, ea, eb) +subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, US, ea, eb) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: u !< The zonal velocity [m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -581,7 +582,7 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, ea, eb) real :: a_n(SZI_(G)), a_s(SZI_(G)) ! Fractional weights of the neighboring real :: a_e(SZI_(G)), a_w(SZI_(G)) ! velocity points, ~1/2 in the open ! ocean, nondimensional. - real :: s, Idenom + real :: sum_area, Idenom logical :: mix_vertically integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -597,20 +598,20 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, ea, eb) !$OMP private(s,Idenom,a_w,a_e,a_s,a_n,b_denom_1,b1,d1,c1) do j=js,je do i=is,ie - s = G%areaCu(I-1,j)+G%areaCu(I,j) - if (s>0.0) then - Idenom = sqrt(0.5*G%IareaT(i,j)/s) - a_w(i) = G%areaCu(I-1,j)*Idenom - a_e(i) = G%areaCu(I,j)*Idenom + sum_area = G%areaCu(I-1,j) + G%areaCu(I,j) + if (sum_area>0.0) then + Idenom = sqrt(0.5*G%IareaT(i,j) / sum_area) + a_w(i) = G%areaCu(I-1,j) * Idenom + a_e(i) = G%areaCu(I,j) * Idenom else a_w(i) = 0.0 ; a_e(i) = 0.0 endif - s = G%areaCv(i,J-1)+G%areaCv(i,J) - if (s>0.0) then - Idenom = sqrt(0.5*G%IareaT(i,j)/s) - a_s(i) = G%areaCv(i,J-1)*Idenom - a_n(i) = G%areaCv(i,J)*Idenom + sum_area = G%areaCv(i,J-1) + G%areaCv(i,J) + if (sum_area>0.0) then + Idenom = sqrt(0.5*G%IareaT(i,j) / sum_area) + a_s(i) = G%areaCv(i,J-1) * Idenom + a_n(i) = G%areaCv(i,J) * Idenom else a_s(i) = 0.0 ; a_n(i) = 0.0 endif diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 989bb19ed2..e6f644d210 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -121,7 +121,7 @@ module MOM_diabatic_driver !! shear and ePBL diffusivities are used. integer :: nMode = 1 !< Number of baroclinic modes to consider real :: uniform_test_cg !< Uniform group velocity of internal tide - !! for testing internal tides [m s-1] (BDM) + !! for testing internal tides [L T-1 ~> m s-1] logical :: useALEalgorithm !< If true, use the ALE algorithm rather than layered !! isopycnal/stacked shallow water mode. This logical !! passed by argument to diabatic_driver_init. @@ -259,8 +259,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [m s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs @@ -315,10 +315,10 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & dt_in_T = dt * US%s_to_T if (CS%debug) then - call MOM_state_chksum("Start of diabatic ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("Start of diabatic ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("Start of diabatic", fluxes, G, US, haloshift=0) endif - if (CS%debugConservation) call MOM_state_stats('Start of diabatic', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('Start of diabatic', u, v, h, tv%T, tv%S, G, GV, US) if (CS%debug_energy_req) & call diapyc_energy_req_test(h, dt_in_T, tv, G, GV, US, CS%diapyc_en_rec_CSp) @@ -352,7 +352,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif call disable_averaging(CS%diag) endif ! associated(tv%T) .AND. associated(tv%frazil) - if (CS%debugConservation) call MOM_state_stats('1st make_frazil', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('1st make_frazil', u, v, h, tv%T, tv%S, G, GV, US) if (CS%use_int_tides) then @@ -371,7 +371,6 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (showCallTree) call callTree_waypoint("done with propagate_int_tide (diabatic)") endif ! end CS%use_int_tides - if (CS%useALEalgorithm .and. CS%use_legacy_diabatic) then call diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & G, GV, US, CS, Waves) @@ -384,7 +383,6 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif - call cpu_clock_begin(id_clock_pass) if (associated(visc%Kv_shear)) & call pass_var(visc%Kv_shear, G%Domain, To_All+Omit_Corners, halo=1) @@ -414,7 +412,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif if (showCallTree) call callTree_waypoint("done with 2nd make_frazil (diabatic)") - if (CS%debugConservation) call MOM_state_stats('2nd make_frazil', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('2nd make_frazil', u, v, h, tv%T, tv%S, G, GV, US) call disable_averaging(CS%diag) endif ! endif for frazil @@ -438,7 +436,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif call disable_averaging(CS%diag) - if (CS%debugConservation) call MOM_state_stats('leaving diabatic', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('leaving diabatic', u, v, h, tv%T, tv%S, G, GV, US) end subroutine diabatic @@ -451,8 +449,8 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [m s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs @@ -489,7 +487,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim dSV_dS, & ! The partial derivative of specific volume with salinity [m3 kg-1 ppt-1]. cTKE, & ! convective TKE requirements for each layer [kg m-3 Z3 T-2 ~> J m-2]. u_h, & ! zonal and meridional velocities at thickness points after - v_h ! entrainment [m s-1] + v_h ! entrainment [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G)) :: & Rcv_ml, & ! coordinate density of mixed layer, used for applying sponges SkinBuoyFlux! 2d surface buoyancy flux [Z2 T-3 ~> m2 s-3], used by ePBL @@ -578,7 +576,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call geothermal(h, tv, dt, eatr, ebtr, G, GV, CS%geothermal_CSp, halo=CS%halo_TS_diff) call cpu_clock_end(id_clock_geothermal) if (showCallTree) call callTree_waypoint("geothermal (diabatic)") - if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G, GV, US) endif ! Whenever thickness changes let the diag manager know, target grids @@ -591,17 +589,17 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (associated(CS%optics)) & call set_pen_shortwave(CS%optics, fluxes, G, GV, CS%diabatic_aux_CSp, CS%opacity_CSp, CS%tracer_flow_CSp) - if (CS%debug) call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, haloshift=0) + if (CS%debug) call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, US, haloshift=0) if (CS%use_kappa_shear .or. CS%use_CVMix_shear) then if (CS%use_geothermal) then - call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, eatr, ebtr) + call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, US, eatr, ebtr) if (CS%debug) then call hchksum(eatr, "after find_uv_at_h eatr",G%HI, scale=GV%H_to_m) call hchksum(ebtr, "after find_uv_at_h ebtr",G%HI, scale=GV%H_to_m) endif else - call find_uv_at_h(u, v, h, u_h, v_h, G, GV) + call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) endif if (showCallTree) call callTree_waypoint("done with find_uv_at_h (diabatic)") endif @@ -609,8 +607,8 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call cpu_clock_begin(id_clock_set_diffusivity) ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S and visc%TKE_turb ! Also changes: visc%Kd_shear, visc%Kv_shear and visc%Kv_slow - call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt_in_T, G, GV, US, & - CS%set_diff_CSp, Kd_lay, Kd_int) + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, & + visc, dt_in_T, G, GV, US, CS%set_diff_CSp, Kd_lay, Kd_int) call cpu_clock_end(id_clock_set_diffusivity) if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") @@ -638,7 +636,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim endif if (CS%debug) then - call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after set_diffusivity ", tv, G) call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) @@ -701,7 +699,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call cpu_clock_end(id_clock_kpp) if (showCallTree) call callTree_waypoint("done with KPP_calculate (diabatic)") if (CS%debug) then - call MOM_state_chksum("after KPP", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after KPP", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after KPP", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after KPP", tv, G) call hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) @@ -725,10 +723,10 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, CS%KPP_NLTscalar, CS%KPP_salt_flux, dt, tv%S) call cpu_clock_end(id_clock_kpp) if (showCallTree) call callTree_waypoint("done with KPP_applyNonLocalTransport (diabatic)") - if (CS%debugConservation) call MOM_state_stats('KPP_applyNonLocalTransport', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('KPP_applyNonLocalTransport', u, v, h, tv%T, tv%S, G, GV, US) if (CS%debug) then - call MOM_state_chksum("after KPP_applyNLT ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after KPP_applyNLT ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after KPP_applyNLT ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G) endif @@ -744,7 +742,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call cpu_clock_end(id_clock_differential_diff) if (showCallTree) call callTree_waypoint("done with differential_diffuse_T_S (diabatic)") - if (CS%debugConservation) call MOM_state_stats('differential_diffuse_T_S', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('differential_diffuse_T_S', u, v, h, tv%T, tv%S, G, GV, US) ! increment heat and salt diffusivity. ! CS%useKPP==.true. already has extra_T and extra_S included @@ -804,7 +802,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (CS%debug) then call MOM_forcing_chksum("after calc_entrain ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after calc_entrain ", tv, G) - call MOM_state_chksum("after calc_entrain ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after calc_entrain ", u, v, h, G, GV, US, haloshift=0) call hchksum(ea_s, "after calc_entrain ea_s", G%HI, haloshift=0, scale=GV%H_to_m) call hchksum(eb_s, "after calc_entrain eb_s", G%HI, haloshift=0, scale=GV%H_to_m) endif @@ -842,9 +840,9 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call hchksum(dSV_dS, "after applyBoundaryFluxes dSV_dS",G%HI,haloshift=0) endif - call find_uv_at_h(u, v, h, u_h, v_h, G, GV) + call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) call energetic_PBL(h, u_h, v_h, tv, fluxes, dt_in_T, Kd_ePBL, G, GV, US, & - CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) + CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, Hml(:,:), G, US) @@ -912,10 +910,10 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (CS%debug) then call MOM_forcing_chksum("after applyBoundaryFluxes ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after applyBoundaryFluxes ", tv, G) - call MOM_state_chksum("after applyBoundaryFluxes ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after applyBoundaryFluxes ", u, v, h, G, GV, US, haloshift=0) endif if (showCallTree) call callTree_waypoint("done with applyBoundaryFluxes (diabatic)") - if (CS%debugConservation) call MOM_state_stats('applyBoundaryFluxes', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('applyBoundaryFluxes', u, v, h, tv%T, tv%S, G, GV, US) ! Update h according to divergence of the difference between ! ea and eb. We keep a record of the original h in hold. @@ -946,12 +944,12 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim endif if (CS%debug) then - call MOM_state_chksum("after negative check ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after negative check ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after negative check ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after negative check ", tv, G) endif if (showCallTree) call callTree_waypoint("done with h=ea-eb (diabatic)") - if (CS%debugConservation) call MOM_state_stats('h=ea-eb', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('h=ea-eb', u, v, h, tv%T, tv%S, G, GV, US) ! calculate change in temperature & salinity due to dia-coordinate surface diffusion if (associated(tv%T)) then @@ -1036,10 +1034,10 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim endif ! endif corresponding to if (associated(tv%T)) - if (CS%debugConservation) call MOM_state_stats('triDiagTS', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('triDiagTS', u, v, h, tv%T, tv%S, G, GV, US) if (CS%debug) then - call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, US, haloshift=0) call MOM_thermovar_chksum("after mixed layer ", tv, G) endif @@ -1190,7 +1188,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call cpu_clock_end(id_clock_sponge) if (CS%debug) then - call MOM_state_chksum("apply_sponge ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("apply_sponge ", u, v, h, G, GV, US, haloshift=0) call MOM_thermovar_chksum("apply_sponge ", tv, G) endif endif ! CS%use_sponge @@ -1234,8 +1232,8 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [m s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs @@ -1272,7 +1270,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, dSV_dS, & ! The partial derivative of specific volume with salinity [m3 kg-1 ppt-1]. cTKE, & ! convective TKE requirements for each layer [kg m-3 Z3 T-2 ~> J m-2]. u_h, & ! zonal and meridional velocities at thickness points after - v_h ! entrainment [m s-1] + v_h ! entrainment [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G)) :: & Rcv_ml, & ! coordinate density of mixed layer, used for applying sponges SkinBuoyFlux! 2d surface buoyancy flux [Z2 T-3 ~> m2 s-3], used by ePBL @@ -1363,7 +1361,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call geothermal(h, tv, dt, eatr, ebtr, G, GV, CS%geothermal_CSp, halo=CS%halo_TS_diff) call cpu_clock_end(id_clock_geothermal) if (showCallTree) call callTree_waypoint("geothermal (diabatic)") - if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G, GV, US) endif ! Whenever thickness changes let the diag manager know, target grids @@ -1376,17 +1374,17 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, if (associated(CS%optics)) & call set_pen_shortwave(CS%optics, fluxes, G, GV, CS%diabatic_aux_CSp, CS%opacity_CSp, CS%tracer_flow_CSp) - if (CS%debug) call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, haloshift=0) + if (CS%debug) call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, US, haloshift=0) if (CS%use_kappa_shear .or. CS%use_CVMix_shear) then if (CS%use_geothermal) then - call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, eatr, ebtr) + call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, US, eatr, ebtr) if (CS%debug) then call hchksum(eatr, "after find_uv_at_h eatr",G%HI, scale=GV%H_to_m) call hchksum(ebtr, "after find_uv_at_h ebtr",G%HI, scale=GV%H_to_m) endif else - call find_uv_at_h(u, v, h, u_h, v_h, G, GV) + call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) endif if (showCallTree) call callTree_waypoint("done with find_uv_at_h (diabatic)") endif @@ -1394,13 +1392,13 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call cpu_clock_begin(id_clock_set_diffusivity) ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S and visc%TKE_turb ! Also changes: visc%Kd_shear, visc%Kv_shear and visc%Kv_slow - call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt_in_T, G, GV, US, & - CS%set_diff_CSp, Kd_lay, Kd_int) + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, & + visc, dt_in_T, G, GV, US,CS%set_diff_CSp, Kd_lay, Kd_int) call cpu_clock_end(id_clock_set_diffusivity) if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") if (CS%debug) then - call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after set_diffusivity ", tv, G) call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) @@ -1466,7 +1464,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call cpu_clock_end(id_clock_kpp) if (showCallTree) call callTree_waypoint("done with KPP_calculate (diabatic)") if (CS%debug) then - call MOM_state_chksum("after KPP", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after KPP", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after KPP", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after KPP", tv, G) call hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) @@ -1490,10 +1488,10 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, CS%KPP_NLTscalar, CS%KPP_salt_flux, dt, tv%S) call cpu_clock_end(id_clock_kpp) if (showCallTree) call callTree_waypoint("done with KPP_applyNonLocalTransport (diabatic)") - if (CS%debugConservation) call MOM_state_stats('KPP_applyNonLocalTransport', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('KPP_applyNonLocalTransport', u, v, h, tv%T, tv%S, G, GV, US) if (CS%debug) then - call MOM_state_chksum("after KPP_applyNLT ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after KPP_applyNLT ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after KPP_applyNLT ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G) endif @@ -1509,7 +1507,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call cpu_clock_end(id_clock_differential_diff) if (showCallTree) call callTree_waypoint("done with differential_diffuse_T_S (diabatic)") - if (CS%debugConservation) call MOM_state_stats('differential_diffuse_T_S', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('differential_diffuse_T_S', u, v, h, tv%T, tv%S, G, GV, US) ! increment heat and salt diffusivity. ! CS%useKPP==.true. already has extra_T and extra_S included @@ -1559,7 +1557,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, skinbuoyflux(:,:) = 0.0 call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, US, dt, fluxes, CS%optics, & - optics_nbands(CS%optics), h, tv, CS%aggregate_FW_forcing, CS%evap_CFL_limit, & + optics_nbands(CS%optics), h, tv, CS%aggregate_FW_forcing, CS%evap_CFL_limit, & CS%minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, SkinBuoyFlux=SkinBuoyFlux) if (CS%debug) then @@ -1572,9 +1570,9 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call hchksum(dSV_dS, "after applyBoundaryFluxes dSV_dS",G%HI,haloshift=0) endif - call find_uv_at_h(u, v, h, u_h, v_h, G, GV) + call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) call energetic_PBL(h, u_h, v_h, tv, fluxes, dt_in_T, Kd_ePBL, G, GV, US, & - CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) + CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, Hml(:,:), G, US) @@ -1630,13 +1628,13 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, if (CS%debug) then call MOM_forcing_chksum("after applyBoundaryFluxes ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after applyBoundaryFluxes ", tv, G) - call MOM_state_chksum("after applyBoundaryFluxes ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after applyBoundaryFluxes ", u, v, h, G, GV, US, haloshift=0) endif if (showCallTree) call callTree_waypoint("done with applyBoundaryFluxes (diabatic)") - if (CS%debugConservation) call MOM_state_stats('applyBoundaryFluxes', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('applyBoundaryFluxes', u, v, h, tv%T, tv%S, G, GV, US) if (showCallTree) call callTree_waypoint("done with h=ea-eb (diabatic)") - if (CS%debugConservation) call MOM_state_stats('h=ea-eb', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('h=ea-eb', u, v, h, tv%T, tv%S, G, GV, US) ! calculate change in temperature & salinity due to dia-coordinate surface diffusion if (associated(tv%T)) then @@ -1718,10 +1716,10 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, endif ! endif corresponding to if (associated(tv%T)) - if (CS%debugConservation) call MOM_state_stats('triDiagTS', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('triDiagTS', u, v, h, tv%T, tv%S, G, GV, US) if (CS%debug) then - call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, US, haloshift=0) call MOM_thermovar_chksum("after mixed layer ", tv, G) endif @@ -1859,7 +1857,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call cpu_clock_end(id_clock_sponge) if (CS%debug) then - call MOM_state_chksum("apply_sponge ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("apply_sponge ", u, v, h, G, GV, US, haloshift=0) call MOM_thermovar_chksum("apply_sponge ", tv, G) endif endif ! CS%use_sponge @@ -1913,8 +1911,8 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [m s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs @@ -1946,7 +1944,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e dSV_dS, & ! The partial derivative of specific volume with salinity [m3 kg-1 ppt-1]. cTKE, & ! convective TKE requirements for each layer [kg m-3 Z3 T-2 ~> J m-2]. u_h, & ! zonal and meridional velocities at thickness points after - v_h ! entrainment [m s-1] + v_h ! entrainment [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G)) :: & Rcv_ml, & ! coordinate density of mixed layer, used for applying sponges SkinBuoyFlux! 2d surface buoyancy flux [Z2 T-3 ~> m2 s-3], used by ePBL @@ -2014,6 +2012,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e real :: Ent_int ! The diffusive entrainment rate at an interface [H ~> m or kg m-2] real :: dt_mix ! The amount of time over which to apply mixing [T ~> s] real :: Idt ! The inverse time step [s-1] + real :: Idt_accel ! The inverse time step times rescaling factors [T-1 ~> s-1] real :: dt_in_T ! The time step converted to T units [T ~> s] integer :: dir_flag ! An integer encoding the directions in which to do halo updates. @@ -2053,7 +2052,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call geothermal(h, tv, dt, eaml, ebml, G, GV, CS%geothermal_CSp, halo=CS%halo_TS_diff) call cpu_clock_end(id_clock_geothermal) if (showCallTree) call callTree_waypoint("geothermal (diabatic)") - if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G, GV, US) endif ! Whenever thickness changes let the diag manager know, target grids @@ -2077,7 +2076,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! Monin-Obukhov depth or minimum mixed layer depth. ! (4) Uses any remaining TKE to drive mixed layer entrainment. ! (5) Possibly splits buffer layer into two isopycnal layers (when using isopycnal coordinate) - call find_uv_at_h(u, v, h, u_h, v_h, G, GV) + call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) call cpu_clock_begin(id_clock_mixedlayer) if (CS%ML_mix_first < 1.0) then @@ -2105,25 +2104,25 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call adjust_salt(h, tv, G, GV, CS%diabatic_aux_CSp) call cpu_clock_end(id_clock_mixedlayer) if (CS%debug) then - call MOM_state_chksum("After mixedlayer ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("After mixedlayer ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("After mixedlayer", fluxes, G, US, haloshift=0) endif if (showCallTree) call callTree_waypoint("done with 1st bulkmixedlayer (diabatic)") - if (CS%debugConservation) call MOM_state_stats('1st bulkmixedlayer', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('1st bulkmixedlayer', u, v, h, tv%T, tv%S, G, GV, US) endif endif if (CS%debug) & - call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, US, haloshift=0) if (CS%use_kappa_shear .or. CS%use_CVMix_shear) then if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then - call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, eaml, ebml) + call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, US, eaml, ebml) if (CS%debug) then call hchksum(eaml, "after find_uv_at_h eaml",G%HI, scale=GV%H_to_m) call hchksum(ebml, "after find_uv_at_h ebml",G%HI, scale=GV%H_to_m) endif else - call find_uv_at_h(u, v, h, u_h, v_h, G, GV) + call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) endif if (showCallTree) call callTree_waypoint("done with find_uv_at_h (diabatic)") endif @@ -2136,13 +2135,13 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (associated(tv%T)) call pass_var(tv%S, G%Domain, halo=CS%halo_TS_diff, complete=.false.) call pass_var(h, G%domain, halo=CS%halo_TS_diff, complete=.true.) endif - call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt_in_T, G, GV, US, & - CS%set_diff_CSp, Kd_lay, Kd_int) + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, & + visc, dt_in_T, G, GV, US, CS%set_diff_CSp, Kd_lay, Kd_int) call cpu_clock_end(id_clock_set_diffusivity) if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") if (CS%debug) then - call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after set_diffusivity ", tv, G) call hchksum(Kd_lay, "after set_diffusivity Kd_lay", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) @@ -2217,7 +2216,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call cpu_clock_end(id_clock_kpp) if (showCallTree) call callTree_waypoint("done with KPP_calculate (diabatic)") if (CS%debug) then - call MOM_state_chksum("after KPP", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after KPP", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after KPP", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after KPP", tv, G) call hchksum(Kd_lay, "after KPP Kd_lay", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) @@ -2250,10 +2249,10 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, CS%KPP_NLTscalar, CS%KPP_salt_flux, dt, tv%S) call cpu_clock_end(id_clock_kpp) if (showCallTree) call callTree_waypoint("done with KPP_applyNonLocalTransport (diabatic)") - if (CS%debugConservation) call MOM_state_stats('KPP_applyNonLocalTransport', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('KPP_applyNonLocalTransport', u, v, h, tv%T, tv%S, G, GV, US) if (CS%debug) then - call MOM_state_chksum("after KPP_applyNLT ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after KPP_applyNLT ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after KPP_applyNLT ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G) endif @@ -2267,7 +2266,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call differential_diffuse_T_S(h, tv, visc, dt_in_T, G, GV) call cpu_clock_end(id_clock_differential_diff) if (showCallTree) call callTree_waypoint("done with differential_diffuse_T_S (diabatic)") - if (CS%debugConservation) call MOM_state_stats('differential_diffuse_T_S', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('differential_diffuse_T_S', u, v, h, tv%T, tv%S, G, GV, US) ! increment heat and salt diffusivity. ! CS%useKPP==.true. already has extra_T and extra_S included @@ -2297,7 +2296,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (CS%debug) then call MOM_forcing_chksum("after calc_entrain ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after calc_entrain ", tv, G) - call MOM_state_chksum("after calc_entrain ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after calc_entrain ", u, v, h, G, GV, US, haloshift=0) call hchksum(ea, "after calc_entrain ea", G%HI, haloshift=0, scale=GV%H_to_m) call hchksum(eb, "after calc_entrain eb", G%HI, haloshift=0, scale=GV%H_to_m) endif @@ -2346,12 +2345,12 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call diag_update_remap_grids(CS%diag) if (CS%debug) then - call MOM_state_chksum("after negative check ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after negative check ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after negative check ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after negative check ", tv, G) endif if (showCallTree) call callTree_waypoint("done with h=ea-eb (diabatic)") - if (CS%debugConservation) call MOM_state_stats('h=ea-eb', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('h=ea-eb', u, v, h, tv%T, tv%S, G, GV, US) ! Here, T and S are updated according to ea and eb. ! If using the bulk mixed layer, T and S are also updated @@ -2443,7 +2442,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call cpu_clock_end(id_clock_tridiag) endif ! endif for associated(T) - if (CS%debugConservation) call MOM_state_stats('BML tridiag', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('BML tridiag', u, v, h, tv%T, tv%S, G, GV, US) if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then ! The mixed layer code has already been called, but there is some needed @@ -2469,8 +2468,8 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! (4) Uses any remaining TKE to drive mixed layer entrainment. ! (5) Possibly splits the buffer layer into two isopycnal layers. - call find_uv_at_h(u, v, hold, u_h, v_h, G, GV, ea, eb) - if (CS%debug) call MOM_state_chksum("find_uv_at_h1 ", u, v, h, G, GV, haloshift=0) + call find_uv_at_h(u, v, hold, u_h, v_h, G, GV, US, ea, eb) + if (CS%debug) call MOM_state_chksum("find_uv_at_h1 ", u, v, h, G, GV, US, haloshift=0) dt_mix = min(dt_in_T, dt_in_T*(1.0 - CS%ML_mix_first)) call cpu_clock_begin(id_clock_mixedlayer) @@ -2494,7 +2493,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call cpu_clock_end(id_clock_mixedlayer) if (showCallTree) call callTree_waypoint("done with 2nd bulkmixedlayer (diabatic)") - if (CS%debugConservation) call MOM_state_stats('2nd bulkmixedlayer', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('2nd bulkmixedlayer', u, v, h, tv%T, tv%S, G, GV, US) endif else ! following block for when NOT using BULKMIXEDLAYER @@ -2544,12 +2543,12 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (showCallTree) call callTree_waypoint("done with triDiagTS (diabatic)") endif ! endif corresponding to if (associated(tv%T)) - if (CS%debugConservation) call MOM_state_stats('triDiagTS', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('triDiagTS', u, v, h, tv%T, tv%S, G, GV, US) endif ! endif for the BULKMIXEDLAYER block if (CS%debug) then - call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, US, haloshift=0) call MOM_thermovar_chksum("after mixed layer ", tv, G) call hchksum(ea, "after mixed layer ea", G%HI, scale=GV%H_to_m) call hchksum(eb, "after mixed layer eb", G%HI, scale=GV%H_to_m) @@ -2559,7 +2558,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call regularize_layers(h, tv, dt, ea, eb, G, GV, CS%regularize_layers_CSp) call cpu_clock_end(id_clock_remap) if (showCallTree) call callTree_waypoint("done with regularize_layers (diabatic)") - if (CS%debugConservation) call MOM_state_stats('regularize_layers', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('regularize_layers', u, v, h, tv%T, tv%S, G, GV, US) ! Whenever thickness changes let the diag manager know, as the ! target grids for vertical remapping may need to be regenerated. @@ -2696,7 +2695,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e endif call cpu_clock_end(id_clock_sponge) if (CS%debug) then - call MOM_state_chksum("apply_sponge ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("apply_sponge ", u, v, h, G, GV, US, haloshift=0) call MOM_thermovar_chksum("apply_sponge ", tv, G) endif endif ! CS%use_sponge @@ -2763,12 +2762,13 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! advection on velocity field. It is assumed that water leaves ! or enters the ocean with the surface velocity. if (CS%debug) then - call MOM_state_chksum("before u/v tridiag ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("before u/v tridiag ", u, v, h, G, GV, US, haloshift=0) call hchksum(ea, "before u/v tridiag ea",G%HI, scale=GV%H_to_m) call hchksum(eb, "before u/v tridiag eb",G%HI, scale=GV%H_to_m) call hchksum(hold, "before u/v tridiag hold",G%HI, scale=GV%H_to_m) endif call cpu_clock_begin(id_clock_tridiag) + Idt_accel = 1.0 / dt_in_T !$OMP parallel do default(shared) private(hval,b1,d1,c1,eaval) do j=js,je do I=Isq,Ieq @@ -2790,16 +2790,16 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e do k=nz-1,1,-1 ; do I=Isq,Ieq u(I,j,k) = u(I,j,k) + c1(I,k+1)*u(I,j,k+1) if (associated(ADp%du_dt_dia)) & - ADp%du_dt_dia(I,j,k) = (u(I,j,k) - ADp%du_dt_dia(I,j,k)) * Idt + ADp%du_dt_dia(I,j,k) = (u(I,j,k) - ADp%du_dt_dia(I,j,k)) * Idt_accel enddo ; enddo if (associated(ADp%du_dt_dia)) then do I=Isq,Ieq - ADp%du_dt_dia(I,j,nz) = (u(I,j,nz)-ADp%du_dt_dia(I,j,nz)) * Idt + ADp%du_dt_dia(I,j,nz) = (u(I,j,nz)-ADp%du_dt_dia(I,j,nz)) * Idt_accel enddo endif enddo if (CS%debug) then - call MOM_state_chksum("aft 1st loop tridiag ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("aft 1st loop tridiag ", u, v, h, G, GV, US, haloshift=0) endif !$OMP parallel do default(shared) private(hval,b1,d1,c1,eaval) do J=Jsq,Jeq @@ -2822,17 +2822,17 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e do k=nz-1,1,-1 ; do i=is,ie v(i,J,k) = v(i,J,k) + c1(i,k+1)*v(i,J,k+1) if (associated(ADp%dv_dt_dia)) & - ADp%dv_dt_dia(i,J,k) = (v(i,J,k) - ADp%dv_dt_dia(i,J,k)) * Idt + ADp%dv_dt_dia(i,J,k) = (v(i,J,k) - ADp%dv_dt_dia(i,J,k)) * Idt_accel enddo ; enddo if (associated(ADp%dv_dt_dia)) then do i=is,ie - ADp%dv_dt_dia(i,J,nz) = (v(i,J,nz)-ADp%dv_dt_dia(i,J,nz)) * Idt + ADp%dv_dt_dia(i,J,nz) = (v(i,J,nz)-ADp%dv_dt_dia(i,J,nz)) * Idt_accel enddo endif enddo call cpu_clock_end(id_clock_tridiag) if (CS%debug) then - call MOM_state_chksum("after u/v tridiag ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after u/v tridiag ", u, v, h, G, GV, US, haloshift=0) endif call disable_averaging(CS%diag) @@ -3298,7 +3298,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di "that will be calculated.", default=1, do_not_log=.true.) call get_param(param_file, mdl, "UNIFORM_TEST_CG", CS%uniform_test_cg, & "If positive, a uniform group velocity of internal tide for test case", & - default=-1., units="m s-1") + default=-1., units="m s-1", scale=US%m_s_to_L_T) endif call get_param(param_file, mdl, "MASSLESS_MATCH_TARGETS", & @@ -3382,9 +3382,9 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di if (CS%id_wd > 0) call safe_alloc_ptr(CDp%diapyc_vel,isd,ied,jsd,jed,nz+1) CS%id_dudt_dia = register_diag_field('ocean_model','dudt_dia',diag%axesCuL,Time, & - 'Zonal Acceleration from Diapycnal Mixing', 'm s-2') + 'Zonal Acceleration from Diapycnal Mixing', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_dvdt_dia = register_diag_field('ocean_model','dvdt_dia',diag%axesCvL,Time, & - 'Meridional Acceleration from Diapycnal Mixing', 'm s-2') + 'Meridional Acceleration from Diapycnal Mixing', 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%use_int_tides) then CS%id_cg1 = register_diag_field('ocean_model','cn1', diag%axesT1, & @@ -3442,9 +3442,9 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di ! diagnostics for values prior to diabatic and prior to ALE CS%id_u_predia = register_diag_field('ocean_model', 'u_predia', diag%axesCuL, Time, & - 'Zonal velocity before diabatic forcing', 'm s-1') + 'Zonal velocity before diabatic forcing', 'm s-1', conversion=US%L_T_to_m_s) CS%id_v_predia = register_diag_field('ocean_model', 'v_predia', diag%axesCvL, Time, & - 'Meridional velocity before diabatic forcing', 'm s-1') + 'Meridional velocity before diabatic forcing', 'm s-1', conversion=US%L_T_to_m_s) CS%id_h_predia = register_diag_field('ocean_model', 'h_predia', diag%axesTL, Time, & 'Layer Thickness before diabatic forcing', thickness_units, v_extensive=.true.) CS%id_e_predia = register_diag_field('ocean_model', 'e_predia', diag%axesTi, Time, & diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 485ae1e942..b486e1e2ca 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -247,10 +247,10 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS intent(inout) :: h_3d !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: u_3d !< Zonal velocities interpolated to h points - !! [m s-1]. + !! [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: v_3d !< Zonal velocities interpolated to h points - !! [m s-1]. + !! [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: dSV_dT !< The partial derivative of in-situ specific !! volume with potential temperature @@ -323,8 +323,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS TKE_forced_2d, & ! A 2-d slice of TKE_forced [kg m-3 Z3 T-2 ~> J m-2]. dSV_dT_2d, & ! A 2-d slice of dSV_dT [m3 kg-1 degC-1]. dSV_dS_2d, & ! A 2-d slice of dSV_dS [m3 kg-1 ppt-1]. - u_2d, & ! A 2-d slice of the zonal velocity [m s-1]. - v_2d ! A 2-d slice of the meridional velocity [m s-1]. + u_2d, & ! A 2-d slice of the zonal velocity [L T-1 ~> m s-1]. + v_2d ! A 2-d slice of the meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZK_(GV)+1) :: & Kd_2d ! A 2-d version of the diapycnal diffusivity [Z2 T-1 ~> m2 s-1]. real, dimension(SZK_(GV)) :: & @@ -334,8 +334,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS dSV_dT_1d, & ! The partial derivatives of specific volume with temperature [m3 kg-1 degC-1]. dSV_dS_1d, & ! The partial derivatives of specific volume with salinity [m3 kg-1 ppt-1]. TKE_forcing, & ! Forcing of the TKE in the layer coming from TKE_forced [kg m-3 Z3 T-2 ~> J m-2]. - u, & ! The zonal velocity [m s-1]. - v ! The meridional velocity [m s-1]. + u, & ! The zonal velocity [L T-1 ~> m s-1]. + v ! The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZK_(GV)+1) :: & Kd, & ! The diapycnal diffusivity [Z2 T-1 ~> m2 s-1]. mixvel, & ! A turbulent mixing veloxity [Z T-1 ~> m s-1]. @@ -607,7 +607,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs ! of conv_PErel is available to drive mixing. real :: htot ! The total depth of the layers above an interface [H ~> m or kg m-2]. real :: uhtot ! The depth integrated zonal and meridional velocities in the - real :: vhtot ! layers above [H m s-1 ~> m2 s-1 or kg m-1 s-1]. + real :: vhtot ! layers above [H L T-1 ~> m2 s-1 or kg m-1 s-1]. real :: Idecay_len_TKE ! The inverse of a turbulence decay length scale [H-1 ~> m-1 or m2 kg-1]. real :: h_sum ! The total thickness of the water column [H ~> m or kg m-2]. @@ -1085,7 +1085,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs if ((CS%MKE_to_TKE_effic > 0.0) .and. (htot*h(k) > 0.0)) then ! This is the energy that would be available from homogenizing the ! velocities between layer k and the layers above. - dMKE_max = (US%m_to_Z**3*US%T_to_s**2)*(GV%H_to_kg_m2 * CS%MKE_to_TKE_effic) * 0.5 * & + dMKE_max = (US%L_to_Z**2*US%m_to_Z*GV%H_to_kg_m2 * CS%MKE_to_TKE_effic) * 0.5 * & (h(k) / ((htot + h(k))*htot)) * & ((uhtot-u(k)*htot)**2 + (vhtot-v(k)*htot)**2) ! A fraction (1-exp(Kddt_h*MKE2_Hharm)) of this energy would be diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 15f1116190..10fe37da89 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -35,6 +35,10 @@ module MOM_geothermal type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. + integer :: id_internal_heat_heat_tendency = -1 !< ID for diagnostic of heat tendency + integer :: id_internal_heat_temp_tendency = -1 !< ID for diagnostic of temperature tendency + integer :: id_internal_heat_h_tendency = -1 !< ID for diagnostic of thickness tendency + end type geothermal_CS contains @@ -100,6 +104,17 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) real :: Irho_cp ! inverse of heat capacity per unit layer volume ! [degC H m2 J-1 ~> degC m3 J-1 or degC kg J-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: T_old ! Temperature of each layer + ! before any heat is added, + ! for diagnostics [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_old ! Thickness of each layer + ! before any heat is added, + ! for diagnostics [m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: work_3d ! Scratch variable used to + ! calculate change in heat + ! due to geothermal + real :: Idt ! inverse of the timestep [s-1] + logical :: do_i(SZI_(G)) integer :: i, j, k, is, ie, js, je, nz, k2, i2 integer :: isj, iej, num_start, num_left, nkmb, k_tgt @@ -119,6 +134,7 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) Angstrom = GV%Angstrom_H H_neglect = GV%H_subroundoff p_ref(:) = tv%P_Ref + Idt = 1.0 / dt if (.not.associated(tv%T)) call MOM_error(FATAL, "MOM geothermal: "//& "Geothermal heating can only be applied if T & S are state variables.") @@ -175,6 +191,18 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) do k=nz,1,-1 do i=isj,iej ; if (do_i(i)) then + ! Save temperature and thickness before any changes are made (for diagnostic) + if (CS%id_internal_heat_h_tendency > 0 & + .or. CS%id_internal_heat_heat_tendency > 0 & + .or. CS%id_internal_heat_temp_tendency > 0 ) then + h_old(i,j,k) = h(i,j,k) + endif + if (CS%id_internal_heat_heat_tendency > 0 & + .or. CS%id_internal_heat_temp_tendency > 0) then + T_old(i,j,k) = tv%T(i,j,k) + endif + + if (h(i,j,k) > Angstrom) then if ((h(i,j,k)-Angstrom) >= h_geo_rem(i)) then h_heated = h_geo_rem(i) @@ -294,6 +322,12 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) ! endif endif endif + + ! Calculate heat tendency due to addition and transfer of internal heat + if (CS%id_internal_heat_heat_tendency > 0) then + work_3d(i,j,k) = ((GV%H_to_kg_m2 * tv%C_p) * Idt) * (h(i,j,k) * tv%T(i,j,k) - h_old(i,j,k) * T_old(i,j,k)) + endif + endif ; enddo if (num_left <= 0) exit enddo ! k-loop @@ -304,6 +338,23 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) enddo ; endif enddo ! j-loop + ! Post diagnostic of 3D tendencies (heat, temperature, and thickness) due to internal heat + if (CS%id_internal_heat_heat_tendency > 0) then + call post_data(CS%id_internal_heat_heat_tendency, work_3d, CS%diag, alt_h = h_old) + endif + if (CS%id_internal_heat_temp_tendency > 0) then + do j=js,je; do i=is,ie; do k=nz,1,-1 + work_3d(i,j,k) = Idt * (tv%T(i,j,k) - T_old(i,j,k)) + enddo; enddo; enddo + call post_data(CS%id_internal_heat_temp_tendency, work_3d, CS%diag, alt_h = h_old) + endif + if (CS%id_internal_heat_h_tendency > 0) then + do j=js,je; do i=is,ie; do k=nz,1,-1 + work_3d(i,j,k) = Idt * (h(i,j,k) - h_old(i,j,k)) + enddo; enddo; enddo + call post_data(CS%id_internal_heat_h_tendency, work_3d, CS%diag, alt_h = h_old) + endif + ! do i=is,ie ; do j=js,je ! resid(i,j) = tv%internal_heat(i,j) - resid(i,j) - GV%H_to_kg_m2 * & ! (G%mask2dT(i,j) * (CS%geo_heat(i,j) * (dt*Irho_cp))) @@ -392,6 +443,20 @@ subroutine geothermal_init(Time, G, param_file, diag, CS) x_cell_method='mean', y_cell_method='mean', area_cell_method='mean') if (id > 0) call post_data(id, CS%geo_heat, diag, .true.) + ! Diagnostic for tendencies due to internal heat (in 3d) + CS%id_internal_heat_heat_tendency=register_diag_field('ocean_model', & + 'internal_heat_heat_tendency', diag%axesTL, Time, & + 'Heat tendency (in 3D) due to internal (geothermal) sources', & + 'W m-2', v_extensive = .true.) + CS%id_internal_heat_temp_tendency=register_diag_field('ocean_model', & + 'internal_heat_temp_tendency', diag%axesTL, Time, & + 'Temperature tendency (in 3D) due to internal (geothermal) sources', & + 'degC s-1', v_extensive = .true.) + CS%id_internal_heat_h_tendency=register_diag_field('ocean_model', & + 'internal_heat_h_tendency', diag%axesTL, Time, & + 'Thickness tendency (in 3D) due to internal (geothermal) sources', & + 'm OR kg m-2', v_extensive = .true.) + end subroutine geothermal_init !> Clean up and deallocate memory associated with the geothermal heating module. diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index 2f51d22b91..79c1b744f0 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -75,8 +75,8 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< The zonal velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< The meridional velocity [m s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to the !! thermodynamic fields diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 547840732d..f5343f86e2 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -98,9 +98,9 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: u_in !< Initial zonal velocity [m s-1]. (Intent in) + intent(in) :: u_in !< Initial zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: v_in !< Initial meridional velocity [m s-1]. + intent(in) :: v_in !< Initial meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any @@ -189,7 +189,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & do j=js,je do k=1,nz ; do i=is,ie h_2d(i,k) = h(i,j,k)*GV%H_to_Z - u_2d(i,k) = u_in(i,j,k)*US%m_s_to_L_T ; v_2d(i,k) = v_in(i,j,k)*US%m_s_to_L_T + u_2d(i,k) = u_in(i,j,k) ; v_2d(i,k) = v_in(i,j,k) enddo ; enddo if (use_temperature) then ; do k=1,nz ; do i=is,ie T_2d(i,k) = tv%T(i,j,k) ; S_2d(i,k) = tv%S(i,j,k) @@ -361,9 +361,9 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: u_in !< Initial zonal velocity [m s-1]. (Intent in) + intent(in) :: u_in !< Initial zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(in) :: v_in !< Initial meridional velocity [m s-1]. + intent(in) :: v_in !< Initial meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & @@ -462,13 +462,11 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ ! Interpolate the various quantities to the corners, using masks. do k=1,nz ; do I=IsB,IeB - u_2d(I,k) = US%m_s_to_L_T * & - (u_in(I,j,k) * (G%mask2dCu(I,j) * (h(i,j,k) + h(i+1,j,k))) + & + u_2d(I,k) = (u_in(I,j,k) * (G%mask2dCu(I,j) * (h(i,j,k) + h(i+1,j,k))) + & u_in(I,j+1,k) * (G%mask2dCu(I,j+1) * (h(i,j+1,k) + h(i+1,j+1,k))) ) / & ((G%mask2dCu(I,j) * (h(i,j,k) + h(i+1,j,k)) + & G%mask2dCu(I,j+1) * (h(i,j+1,k) + h(i+1,j+1,k))) + GV%H_subroundoff) - v_2d(I,k) = US%m_s_to_L_T * & - (v_in(i,J,k) * (G%mask2dCv(i,J) * (h(i,j,k) + h(i,j+1,k))) + & + v_2d(I,k) = (v_in(i,J,k) * (G%mask2dCv(i,J) * (h(i,j,k) + h(i,j+1,k))) + & v_in(i+1,J,k) * (G%mask2dCv(i+1,J) * (h(i+1,j,k) + h(i+1,j+1,k))) ) / & ((G%mask2dCv(i,J) * (h(i,j,k) + h(i,j+1,k)) + & G%mask2dCv(i+1,J) * (h(i+1,j,k) + h(i+1,j+1,k))) + GV%H_subroundoff) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index dee3422a7a..7d118bc00a 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -208,15 +208,15 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt_in_T, type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u_h !< Zonal velocity interpolated to h points [m s-1]. + intent(in) :: u_h !< Zonal velocity interpolated to h points [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: v_h !< Meridional velocity interpolated to h points [m s-1]. + intent(in) :: v_h !< Meridional velocity interpolated to h points [L T-1 ~> m s-1]. type(thermo_var_ptrs), intent(inout) :: tv !< Structure with pointers to thermodynamic !! fields. Out is for tv%TempxPmE. type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes @@ -493,7 +493,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt_in_T, call add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, G, GV, US, CS, & Kd_lay, Kd_int, dd%Kd_BBL) else - call add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & + call add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & maxTKE, kb, G, GV, US, CS, Kd_lay, Kd_int, dd%Kd_BBL) endif endif @@ -530,8 +530,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt_in_T, enddo ! j-loop if (CS%debug) then - call hchksum(Kd_lay ,"Kd_lay", G%HI, haloshift=0, & - scale=US%Z2_T_to_m2_s) + call hchksum(Kd_lay ,"Kd_lay", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) if (CS%useKappaShear) call hchksum(visc%Kd_shear, "Turbulent Kd", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) @@ -1106,9 +1105,9 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1] + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1] + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available @@ -1262,8 +1261,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & else ; TKE_to_layer = 0.0 ; endif ! TKE_Ray has been initialized to 0 above. - if (Rayleigh_drag) TKE_Ray = 0.5*CS%BBL_effic * G%IareaT(i,j) * & - US%m_to_Z**2 * US%T_to_s**2 * & + if (Rayleigh_drag) TKE_Ray = 0.5*CS%BBL_effic * US%L_to_Z**2 * G%IareaT(i,j) * & ((G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2 + & G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2) + & (G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + & @@ -1342,9 +1340,9 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< u component of flow [m s-1] + intent(in) :: u !< u component of flow [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< v component of flow [m s-1] + intent(in) :: v !< v component of flow [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available @@ -1443,8 +1441,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & ! Add in additional energy input from bottom-drag against slopes (sides) if (Rayleigh_drag) TKE_remaining = TKE_remaining + & - US%m_to_Z**2 * US%T_to_s**2 * & - 0.5*CS%BBL_effic * G%IareaT(i,j) * & + 0.5*CS%BBL_effic * US%L_to_Z**2 * G%IareaT(i,j) * & ((G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2 + & G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2) + & (G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + & @@ -1643,9 +1640,9 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1] + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1] + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes @@ -1661,15 +1658,15 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) ! integrated thickness in the BBL [Z ~> m]. real, dimension(SZIB_(G)) :: & - uhtot, & ! running integral of u in the BBL [Z m s-1 ~> m2 s-1] + uhtot, & ! running integral of u in the BBL [Z L T-1 ~> m2 s-1] ustar, & ! bottom boundary layer turbulence speed [Z T-1 ~> m s-1]. - u2_bbl ! square of the mean zonal velocity in the BBL [m2 s-2] + u2_bbl ! square of the mean zonal velocity in the BBL [L2 T-2 ~> m2 s-2] - real :: vhtot(SZI_(G)) ! running integral of v in the BBL [Z m s-1 ~> m2 s-1] + real :: vhtot(SZI_(G)) ! running integral of v in the BBL [Z L T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJB_(G)) :: & vstar, & ! ustar at at v-points [Z T-1 ~> m s-1]. - v2_bbl ! square of average meridional velocity in BBL [m2 s-2] + v2_bbl ! square of average meridional velocity in BBL [L2 T-2 ~> m2 s-2] real :: cdrag_sqrt ! square root of the drag coefficient [nondim] real :: hvel ! thickness at velocity points [Z ~> m]. @@ -1764,7 +1761,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) G%areaCu(I,j)*(ustar(I)*ustar(I))) + & (G%areaCv(i,J-1)*(vstar(i,J-1)*vstar(i,J-1)) + & G%areaCv(i,J)*(vstar(i,J)*vstar(i,J))) ) ) - visc%TKE_BBL(i,j) = US%T_to_s**2 * US%m_to_Z**2 * & + visc%TKE_BBL(i,j) = US%L_to_Z**2 * & (((G%areaCu(I-1,j)*(ustar(I-1)*u2_bbl(I-1)) + & G%areaCu(I,j) * (ustar(I)*u2_bbl(I))) + & (G%areaCv(i,J-1)*(vstar(i,J-1)*v2_bbl(i,J-1)) + & diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 641415893c..92466266b8 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -47,7 +47,7 @@ module MOM_set_visc real :: c_Smag !< The Laplacian Smagorinsky coefficient for !! calculating the drag in channels. real :: drag_bg_vel !< An assumed unresolved background velocity for - !! calculating the bottom drag [m s-1]. + !! calculating the bottom drag [L T-1 ~> m s-1]. real :: BBL_thick_min !< The minimum bottom boundary layer thickness [H ~> m or kg m-2]. !! This might be Kv / (cdrag * drag_bg_vel) to give !! Kv as the minimum near-bottom viscosity. @@ -111,9 +111,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any @@ -171,7 +171,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! Rho0 divided by G_Earth and the conversion ! from m to thickness units [H kg m-3 ~> kg m-2 or kg2 m-5]. real :: cdrag_sqrt_Z ! Square root of the drag coefficient, times a unit conversion - ! factor from lateral lengths to vertical depths [Z m-1 ~> 1]. + ! factor from lateral lengths to vertical depths [Z L-1 ~> 1]. real :: cdrag_sqrt ! Square root of the drag coefficient [nondim]. real :: oldfn ! The integrated energy required to ! entrain up to the bottom of the layer, @@ -191,12 +191,12 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) real :: hwtot ! Sum of the thicknesses used to calculate ! the near-bottom velocity magnitude [H ~> m or kg m-2]. real :: hutot ! Running sum of thicknesses times the - ! velocity magnitudes [H m s-1 ~> m2 s-1 or kg m-1 s-1]. + ! velocity magnitudes [H T T-1 ~> m2 s-1 or kg m-1 s-1]. real :: Thtot ! Running sum of thickness times temperature [degC H ~> degC m or degC kg m-2]. real :: Shtot ! Running sum of thickness times salinity [ppt H ~> ppt m or ppt kg m-2]. real :: hweight ! The thickness of a layer that is within Hbbl ! of the bottom [H ~> m or kg m-2]. - real :: v_at_u, u_at_v ! v at a u point or vice versa [m s-1]. + real :: v_at_u, u_at_v ! v at a u point or vice versa [L T-1 ~> m s-1]. real :: Rho0x400_G ! 400*Rho0/G_Earth, times unit conversion factors ! [kg T2 H m-3 Z-2 ~> kg s2 m-4 or kg2 s2 m-7]. ! The 400 is a constant proposed by Killworth and Edwards, 1999. @@ -231,9 +231,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) real :: Vol_quit ! The volume error below which to quit iterating [H ~> m or kg m-2]. real :: Vol_tol ! A volume error tolerance [H ~> m or kg m-2]. real :: L(SZK_(G)+1) ! The fraction of the full cell width that is open at - ! the depth of each interface, nondimensional. + ! the depth of each interface [nondim]. real :: L_direct ! The value of L above volume Vol_direct [nondim]. - real :: L_max, L_min ! Upper and lower bounds on the correct value for L. + real :: L_max, L_min ! Upper and lower bounds on the correct value for L [nondim]. real :: Vol_err_max ! The volume errors for the upper and lower bounds on real :: Vol_err_min ! the correct value for L [H ~> m or kg m-2]. real :: Vol_0 ! A deeper volume with known width L0 [H ~> m or kg m-2]. @@ -246,7 +246,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) real :: ustH ! ustar converted to units of H T-1 [H T-1 ~> m s-1 or kg m-2 s-1]. real :: root ! A temporary variable [H T-1 ~> m s-1 or kg m-2 s-1]. - real :: Cell_width ! The transverse width of the velocity cell [m]. + real :: Cell_width ! The transverse width of the velocity cell [L ~> m]. real :: Rayleigh ! A nondimensional value that is multiplied by the layer's ! velocity magnitude to give the Rayleigh drag velocity, times ! a lateral to vertical distance conversion factor [Z L-1 ~> 1]. @@ -282,7 +282,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) endif ; endif if (CS%debug) then - call uvchksum("Start set_viscous_BBL [uv]", u, v, G%HI, haloshift=1) + call uvchksum("Start set_viscous_BBL [uv]", u, v, G%HI, haloshift=1, scale=US%L_T_to_m_s) call hchksum(h,"Start set_viscous_BBL h", G%HI, haloshift=1, scale=GV%H_to_m) if (associated(tv%T)) call hchksum(tv%T, "Start set_viscous_BBL T", G%HI, haloshift=1) if (associated(tv%S)) call hchksum(tv%S, "Start set_viscous_BBL S", G%HI, haloshift=1) @@ -293,7 +293,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) U_bg_sq = CS%drag_bg_vel * CS%drag_bg_vel cdrag_sqrt = sqrt(CS%cdrag) - cdrag_sqrt_Z = US%m_to_Z * sqrt(CS%cdrag) + cdrag_sqrt_Z = US%L_to_Z * sqrt(CS%cdrag) K2 = max(nkmb+1, 2) ! With a linear drag law, the friction velocity is already known. @@ -521,9 +521,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) enddo ! end of k loop if (.not.CS%linear_drag .and. (hwtot > 0.0)) then - ustar(i) = cdrag_sqrt_Z*US%T_to_s*hutot/hwtot + ustar(i) = cdrag_sqrt_Z*hutot/hwtot else - ustar(i) = cdrag_sqrt_Z*US%T_to_s*CS%drag_bg_vel + ustar(i) = cdrag_sqrt_Z*CS%drag_bg_vel endif if (use_BBL_EOS) then ; if (hwtot > 0.0) then @@ -533,7 +533,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) endif ; endif endif ; enddo else - do i=is,ie ; ustar(i) = cdrag_sqrt_Z*US%T_to_s*CS%drag_bg_vel ; enddo + do i=is,ie ; ustar(i) = cdrag_sqrt_Z*CS%drag_bg_vel ; enddo endif ! Not linear_drag if (use_BBL_EOS) then @@ -822,7 +822,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) endif ! Determine the drag contributing to the bottom boundary layer - ! and the Raleigh drag that acting on each layer. + ! and the Raleigh drag that acts on each layer. if (L(K) > L(K+1)) then if (vol_below < bbl_thick) then BBL_frac = (1.0-vol_below/bbl_thick)**2 @@ -834,9 +834,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) if (m==1) then ; Cell_width = G%dy_Cu(I,j) else ; Cell_width = G%dx_Cv(i,J) ; endif gam = 1.0 - L(K+1)/L(K) - Rayleigh = US%m_to_Z * CS%cdrag * (L(K)-L(K+1)) * (1.0-BBL_frac) * & + Rayleigh = US%L_to_Z * CS%cdrag * (L(K)-L(K+1)) * (1.0-BBL_frac) * & (12.0*CS%c_Smag*h_vel_pos) / (12.0*CS%c_Smag*h_vel_pos + & - GV%m_to_H * CS%cdrag * gam*(1.0-gam)*(1.0-1.5*gam) * L(K)**2 * Cell_width) + US%L_to_Z*GV%Z_to_H * CS%cdrag * gam*(1.0-gam)*(1.0-1.5*gam) * L(K)**2 * Cell_width) else ! This layer feels no drag. Rayleigh = 0.0 endif @@ -844,13 +844,13 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) if (m==1) then if (Rayleigh > 0.0) then v_at_u = set_v_at_u(v, h, G, i, j, k, mask_v, OBC) - visc%Ray_u(I,j,k) = Rayleigh*US%T_to_s*sqrt(u(I,j,k)*u(I,j,k) + & + visc%Ray_u(I,j,k) = Rayleigh*sqrt(u(I,j,k)*u(I,j,k) + & v_at_u*v_at_u + U_bg_sq) else ; visc%Ray_u(I,j,k) = 0.0 ; endif else if (Rayleigh > 0.0) then u_at_v = set_u_at_v(u, h, G, i, j, k, mask_u, OBC) - visc%Ray_v(i,J,k) = Rayleigh*US%T_to_s*sqrt(v(i,J,k)*v(i,J,k) + & + visc%Ray_v(i,J,k) = Rayleigh*sqrt(v(i,J,k)*v(i,J,k) + & u_at_v*u_at_v + U_bg_sq) else ; visc%Ray_v(i,J,k) = 0.0 ; endif endif @@ -913,7 +913,7 @@ end subroutine set_viscous_BBL function set_v_at_u(v, h, G, i, j, k, mask2dCv, OBC) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1] + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] integer, intent(in) :: i !< The i-index of the u-location to work on. @@ -922,7 +922,8 @@ function set_v_at_u(v, h, G, i, j, k, mask2dCv, OBC) real, dimension(SZI_(G),SZJB_(G)),& intent(in) :: mask2dCv !< A multiplicative mask of the v-points type(ocean_OBC_type), pointer :: OBC !< A pointer to an open boundary condition structure - real :: set_v_at_u !< The retur value of v at u points [m s-1]. + real :: set_v_at_u !< The return value of v at u points points in the + !! same units as u, i.e. [L T-1 ~> m s-1] or other units. ! This subroutine finds a thickness-weighted value of v at the u-points. real :: hwt(0:1,-1:0) ! Masked weights used to average u onto v [H ~> m or kg m-2]. @@ -956,7 +957,7 @@ end function set_v_at_u function set_u_at_v(u, h, G, i, j, k, mask2dCu, OBC) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1] + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1] or other units. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] integer, intent(in) :: i !< The i-index of the u-location to work on. @@ -965,7 +966,8 @@ function set_u_at_v(u, h, G, i, j, k, mask2dCu, OBC) real, dimension(SZIB_(G),SZJ_(G)), & intent(in) :: mask2dCu !< A multiplicative mask of the u-points type(ocean_OBC_type), pointer :: OBC !< A pointer to an open boundary condition structure - real :: set_u_at_v !< The return value of u at v points [m s-1]. + real :: set_u_at_v !< The return value of u at v points in the + !! same units as u, i.e. [L T-1 ~> m s-1] or other units. ! This subroutine finds a thickness-weighted value of u at the v-points. real :: hwt(-1:0,0:1) ! Masked weights used to average u onto v [H ~> m or kg m-2]. @@ -1005,9 +1007,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available @@ -1022,6 +1024,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri logical, optional, intent(in) :: symmetrize !< If present and true, do extra calculations !! of those values in visc that would be !! calculated with symmetric memory. + ! Local variables real, dimension(SZIB_(G)) :: & htot, & ! The total depth of the layers being that are within the @@ -1034,7 +1037,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri ! [H kg m-3 ~> kg m-2 or kg2 m-5]. Rhtot is only used if no ! equation of state is used. uhtot, & ! The depth integrated zonal and meridional velocities within - vhtot, & ! the surface mixed layer [H m s-1 ~> m2 s-1 or kg m-1 s-1]. + vhtot, & ! the surface mixed layer [H L T-1 ~> m2 s-1 or kg m-1 s-1]. Idecay_len_TKE, & ! The inverse of a turbulence decay length scale [H-1 ~> m-1 or m2 kg-1]. dR_dT, & ! Partial derivative of the density at the base of layer nkml ! (roughly the base of the mixed layer) with temperature [kg m-3 degC-1]. @@ -1064,7 +1067,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri real :: hwtot ! Sum of the thicknesses used to calculate ! the near-bottom velocity magnitude [H ~> m or kg m-2]. real :: hutot ! Running sum of thicknesses times the - ! velocity magnitudes [H m s-1 ~> m2 s-1 or kg m-1 s-1]. + ! velocity magnitudes [H L T-1 ~> m2 s-1 or kg m-1 s-1]. real :: hweight ! The thickness of a layer that is within Hbbl ! of the bottom [H ~> m or kg m-2]. real :: tbl_thick_Z ! The thickness of the top boundary layer [Z ~> m]. @@ -1075,8 +1078,8 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri real :: S_lay ! The layer salinity at velocity points [ppt]. real :: Rlay ! The layer potential density at velocity points [kg m-3]. real :: Rlb ! The potential density of the layer below [kg m-3]. - real :: v_at_u ! The meridonal velocity at a zonal velocity point [m s-1]. - real :: u_at_v ! The zonal velocity at a meridonal velocity point [m s-1]. + real :: v_at_u ! The meridonal velocity at a zonal velocity point [L T-1 ~> m s-1]. + real :: u_at_v ! The zonal velocity at a meridonal velocity point [L T-1 ~> m s-1]. real :: gHprime ! The mixed-layer internal gravity wave speed squared, based ! on the mixed layer thickness and density difference across ! the base of the mixed layer [L2 T-2 ~> m2 s-2]. @@ -1091,7 +1094,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri ! Rho0 divided by G_Earth and the conversion ! from m to thickness units [H kg m-3 ~> kg m-2 or kg2 m-5]. real :: cdrag_sqrt_Z ! Square root of the drag coefficient, times a unit conversion - ! factor from lateral lengths to vertical depths [Z m-1 ~> 1]. + ! factor from lateral lengths to vertical depths [Z L-1 ~> 1]. real :: cdrag_sqrt ! Square root of the drag coefficient [nondim]. real :: oldfn ! The integrated energy required to ! entrain up to the bottom of the layer, @@ -1102,7 +1105,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri ! the present layer [H ~> m or kg m-2]. real :: U_bg_sq ! The square of an assumed background velocity, for ! calculating the mean magnitude near the top for use in - ! the quadratic surface drag [m2 s-2]. + ! the quadratic surface drag [L2 T-2 ~> m2 s-2]. real :: h_tiny ! A very small thickness [H ~> m or kg m-2]. Layers that are less than ! h_tiny can not be the deepest in the viscous mixed layer. real :: absf ! The absolute value of f averaged to velocity points [T-1 ~> s-1]. @@ -1134,7 +1137,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri Rho0x400_G = 400.0*(GV%Rho0/(US%L_to_Z**2 * GV%g_Earth)) * GV%Z_to_H U_bg_sq = CS%drag_bg_vel * CS%drag_bg_vel cdrag_sqrt = sqrt(CS%cdrag) - cdrag_sqrt_Z = US%m_to_Z * sqrt(CS%cdrag) + cdrag_sqrt_Z = US%L_to_Z * sqrt(CS%cdrag) OBC => CS%OBC use_EOS = associated(tv%eqn_of_state) @@ -1202,8 +1205,8 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri do_i(I) = .true. ; do_any = .true. k_massive(I) = nkml Thtot(I) = 0.0 ; Shtot(I) = 0.0 ; Rhtot(i) = 0.0 - uhtot(I) = dt_Rho0 * forces%taux(I,j) - vhtot(I) = 0.25 * dt_Rho0 * ((forces%tauy(i,J) + forces%tauy(i+1,J-1)) + & + uhtot(I) = US%m_s_to_L_T*dt_Rho0 * forces%taux(I,j) + vhtot(I) = 0.25 * US%m_s_to_L_T*dt_Rho0 * ((forces%tauy(i,J) + forces%tauy(i+1,J-1)) + & (forces%tauy(i,J-1) + forces%tauy(i+1,J))) if (CS%omega_frac >= 1.0) then ; absf = 2.0*CS%omega ; else @@ -1239,7 +1242,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri I_2hlay = 1.0 / (h(i,j,k) + h(i+1,j,k)) v_at_u = 0.5 * (h(i,j,k) * (v(i,J,k) + v(i,J-1,k)) + & h(i+1,j,k) * (v(i+1,J,k) + v(i+1,J-1,k))) * I_2hlay - Uh2 = US%m_s_to_L_T**2*((uhtot(I) - htot(I)*u(I,j,k))**2 + (vhtot(I) - htot(I)*v_at_u)**2) + Uh2 = ((uhtot(I) - htot(I)*u(I,j,k))**2 + (vhtot(I) - htot(I)*v_at_u)**2) if (use_EOS) then T_lay = (h(i,j,k)*tv%T(i,j,k) + h(i+1,j,k)*tv%T(i+1,j,k)) * I_2hlay @@ -1336,9 +1339,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri enddo ; endif if ((.not.CS%linear_drag) .and. (hwtot > 0.0)) then - ustar(I) = cdrag_sqrt_Z*US%T_to_s*hutot/hwtot + ustar(I) = cdrag_sqrt_Z * hutot/hwtot else - ustar(I) = cdrag_sqrt_Z*US%T_to_s*CS%drag_bg_vel + ustar(I) = cdrag_sqrt_Z * CS%drag_bg_vel endif if (use_EOS) then ; if (hwtot > 0.0) then @@ -1437,8 +1440,8 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri do_i(i) = .true. ; do_any = .true. k_massive(i) = nkml Thtot(i) = 0.0 ; Shtot(i) = 0.0 ; Rhtot(i) = 0.0 - vhtot(i) = dt_Rho0 * forces%tauy(i,J) - uhtot(i) = 0.25 * dt_Rho0 * ((forces%taux(I,j) + forces%taux(I-1,j+1)) + & + vhtot(i) = US%m_s_to_L_T*dt_Rho0 * forces%tauy(i,J) + uhtot(i) = 0.25 * US%m_s_to_L_T*dt_Rho0 * ((forces%taux(I,j) + forces%taux(I-1,j+1)) + & (forces%taux(I-1,j) + forces%taux(I,j+1))) if (CS%omega_frac >= 1.0) then ; absf = 2.0*CS%omega ; else @@ -1476,7 +1479,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri I_2hlay = 1.0 / (h(i,j,k) + h(i,j+1,k)) u_at_v = 0.5 * (h(i,j,k) * (u(I-1,j,k) + u(I,j,k)) + & h(i,j+1,k) * (u(I-1,j+1,k) + u(I,j+1,k))) * I_2hlay - Uh2 = US%m_s_to_L_T**2*((uhtot(I) - htot(I)*u_at_v)**2 + (vhtot(I) - htot(I)*v(i,J,k))**2) + Uh2 = ((uhtot(I) - htot(I)*u_at_v)**2 + (vhtot(I) - htot(I)*v(i,J,k))**2) if (use_EOS) then T_lay = (h(i,j,k)*tv%T(i,j,k) + h(i,j+1,k)*tv%T(i,j+1,k)) * I_2hlay @@ -1573,9 +1576,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri enddo ; endif if (.not.CS%linear_drag) then ; if (hwtot > 0.0) then - ustar(i) = cdrag_sqrt_Z*US%T_to_s*hutot/hwtot + ustar(i) = cdrag_sqrt_Z * hutot/hwtot else - ustar(i) = cdrag_sqrt_Z*US%T_to_s*CS%drag_bg_vel + ustar(i) = cdrag_sqrt_Z * CS%drag_bg_vel endif ; endif if (use_EOS) then ; if (hwtot > 0.0) then @@ -1922,7 +1925,7 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS "LINEAR_DRAG) or an unresolved velocity that is "//& "combined with the resolved velocity to estimate the "//& "velocity magnitude. DRAG_BG_VEL is only used when "//& - "BOTTOMDRAGLAW is defined.", units="m s-1", default=0.0) + "BOTTOMDRAGLAW is defined.", units="m s-1", default=0.0, scale=US%m_s_to_L_T) call get_param(param_file, mdl, "BBL_USE_EOS", CS%BBL_use_EOS, & "If true, use the equation of state in determining the "//& "properties of the bottom boundary layer. Otherwise use "//& diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 2c01823302..1bed36e75e 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -46,9 +46,9 @@ module MOM_vert_friction real :: Kvbbl !< The vertical viscosity in the bottom boundary !! layer [Z2 T-1 ~> m2 s-1]. - real :: maxvel !< Velocity components greater than maxvel are truncated [m s-1]. + real :: maxvel !< Velocity components greater than maxvel are truncated [L T-1 ~> m s-1]. real :: vel_underflow !< Velocity components smaller than vel_underflow - !! are set to 0 [m s-1]. + !! are set to 0 [L T-1 ~> m s-1]. logical :: CFL_based_trunc !< If true, base truncations on CFL numbers, not !! absolute velocities. real :: CFL_trunc !< Velocity components will be truncated when they @@ -148,9 +148,9 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: u !< Zonal velocity [m s-1] + intent(inout) :: u !< Zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(inout) :: v !< Meridional velocity [m s-1] + intent(inout) :: v !< Meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces @@ -162,9 +162,11 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & type(cont_diag_ptrs), intent(inout) :: CDp !< Continuity equation terms type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure real, dimension(SZIB_(G),SZJ_(G)), & - optional, intent(out) :: taux_bot !< Zonal bottom stress from ocean to rock [kg Z s-2 m-2 ~> Pa] + optional, intent(out) :: taux_bot !< Zonal bottom stress from ocean to + !! rock [kg L Z T-2 m-3 ~> Pa] real, dimension(SZI_(G),SZJB_(G)), & - optional, intent(out) :: tauy_bot !< Meridional bottom stress from ocean to rock [kg Z s-2 m-2 ~> Pa] + optional, intent(out) :: tauy_bot !< Meridional bottom stress from ocean to + !! rock [kg L Z T-2 m-3 ~> Pa] type(wave_parameters_CS), & optional, pointer :: Waves !< Container for wave/Stokes information @@ -183,8 +185,9 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & real :: Hmix ! The mixed layer thickness over which stress ! is applied with direct_stress [H ~> m or kg m-2]. real :: I_Hmix ! The inverse of Hmix [H-1 ~> m-1 or m2 kg-1]. - real :: Idt ! The inverse of the time step [s-1]. - real :: dt_Rho0 ! The time step divided by the mean density [s m3 kg-1]. + real :: dt_in_T ! The timestep [T ~> s] + real :: Idt ! The inverse of the time step [T-1 ~> s-1]. + real :: dt_Rho0 ! The time step divided by the mean density [L s2 H m T-1 kg-1 ~> s m3 kg-1 or s]. real :: Rho0 ! A density used to convert drag laws into stress in Pa [kg m-3]. real :: dt_Z_to_H ! The time step times the conversion from Z to the ! units of thickness - [T H Z-1 ~> s or s kg m-3]. @@ -192,10 +195,10 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: stress ! The surface stress times the time step, divided - ! by the density [m2 s-1]. + ! by the density [H L T-1 ~> m2 s-1 or kg m-1 s-1]. real :: zDS, hfr, h_a ! Temporary variables used with direct_stress. real :: surface_stress(SZIB_(G))! The same as stress, unless the wind stress - ! stress is applied as a body force [m2 s-1]. + ! stress is applied as a body force [H L T-1 ~> m2 s-1 or kg m-1 s-1]. logical :: do_i(SZIB_(G)) logical :: DoStokesMixing @@ -211,11 +214,12 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & Hmix = CS%Hmix_stress I_Hmix = 1.0 / Hmix endif - dt_Rho0 = dt/GV%H_to_kg_m2 - dt_Z_to_H = US%s_to_T*dt*GV%Z_to_H + dt_in_T = US%s_to_T*dt + dt_Rho0 = US%m_s_to_L_T*US%T_to_s * dt_in_T / GV%H_to_kg_m2 + dt_Z_to_H = dt_in_T*GV%Z_to_H Rho0 = GV%Rho0 h_neglect = GV%H_subroundoff - Idt = 1.0 / dt + Idt = 1.0 / dt_in_T !Check if Stokes mixing allowed if requested (present and associated) DoStokesMixing=.false. @@ -239,7 +243,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & ! When mixing down Eulerian current + Stokes drift add before calling solver if (DoStokesMixing) then ; do k=1,nz ; do I=Isq,Ieq - if (do_i(I)) u(I,j,k) = u(I,j,k) + Waves%Us_x(I,j,k) + if (do_i(I)) u(I,j,k) = u(I,j,k) + US%m_s_to_L_T*Waves%Us_x(I,j,k) enddo ; enddo ; endif if (associated(ADp%du_dt_visc)) then ; do k=1,nz ; do I=Isq,Ieq @@ -318,21 +322,21 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & enddo ; enddo ; endif if (associated(visc%taux_shelf)) then ; do I=Isq,Ieq - visc%taux_shelf(I,j) = -Rho0*US%s_to_T*CS%a1_shelf_u(I,j)*u(I,j,1) ! - u_shelf? + visc%taux_shelf(I,j) = -Rho0*US%L_T2_to_m_s2*CS%a1_shelf_u(I,j)*u(I,j,1) ! - u_shelf? enddo ; endif if (PRESENT(taux_bot)) then do I=Isq,Ieq - taux_bot(I,j) = Rho0 * (u(I,j,nz)*US%s_to_T*CS%a_u(I,j,nz+1)) + taux_bot(I,j) = Rho0 * (u(I,j,nz)*CS%a_u(I,j,nz+1)) enddo if (CS%Channel_drag) then ; do k=1,nz ; do I=Isq,Ieq - taux_bot(I,j) = taux_bot(I,j) + Rho0 * (US%s_to_T*Ray(I,k)*u(I,j,k)) + taux_bot(I,j) = taux_bot(I,j) + Rho0 * (Ray(I,k)*u(I,j,k)) enddo ; enddo ; endif endif ! When mixing down Eulerian current + Stokes drift subtract after calling solver if (DoStokesMixing) then ; do k=1,nz ; do I=Isq,Ieq - if (do_i(I)) u(I,j,k) = u(I,j,k) - Waves%Us_x(I,j,k) + if (do_i(I)) u(I,j,k) = u(I,j,k) - US%m_s_to_L_T*Waves%Us_x(I,j,k) enddo ; enddo ; endif enddo ! end u-component j loop @@ -347,7 +351,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & ! When mixing down Eulerian current + Stokes drift add before calling solver if (DoStokesMixing) then ; do k=1,nz ; do i=is,ie - if (do_i(i)) v(i,j,k) = v(i,j,k) + Waves%Us_y(i,j,k) + if (do_i(i)) v(i,j,k) = v(i,j,k) + US%m_s_to_L_T*Waves%Us_y(i,j,k) enddo ; enddo ; endif if (associated(ADp%dv_dt_visc)) then ; do k=1,nz ; do i=is,ie @@ -399,21 +403,21 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & enddo ; enddo ; endif if (associated(visc%tauy_shelf)) then ; do i=is,ie - visc%tauy_shelf(i,J) = -Rho0*US%s_to_T*CS%a1_shelf_v(i,J)*v(i,J,1) ! - v_shelf? + visc%tauy_shelf(i,J) = -Rho0*US%L_T2_to_m_s2*CS%a1_shelf_v(i,J)*v(i,J,1) ! - v_shelf? enddo ; endif if (present(tauy_bot)) then do i=is,ie - tauy_bot(i,J) = Rho0 * (v(i,J,nz)*US%s_to_T*CS%a_v(i,J,nz+1)) + tauy_bot(i,J) = Rho0 * (v(i,J,nz)*CS%a_v(i,J,nz+1)) enddo if (CS%Channel_drag) then ; do k=1,nz ; do i=is,ie - tauy_bot(i,J) = tauy_bot(i,J) + Rho0 * (US%s_to_T*Ray(i,k)*v(i,J,k)) + tauy_bot(i,J) = tauy_bot(i,J) + Rho0 * (Ray(i,k)*v(i,J,k)) enddo ; enddo ; endif endif ! When mixing down Eulerian current + Stokes drift subtract after calling solver if (DoStokesMixing) then ; do k=1,nz ; do i=is,ie - if (do_i(i)) v(i,J,k) = v(i,J,k) - Waves%Us_y(i,J,k) + if (do_i(i)) v(i,J,k) = v(i,J,k) - US%m_s_to_L_T*Waves%Us_y(i,J,k) enddo ; enddo ; endif enddo ! end of v-component J loop @@ -568,9 +572,9 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: u !< Zonal velocity [m s-1] + intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(in) :: v !< Meridional velocity [m s-1] + intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces @@ -1004,13 +1008,10 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) enddo ! end of v-point j loop if (CS%debug) then - call uvchksum("vertvisc_coef h_[uv]", CS%h_u, & - CS%h_v, G%HI,haloshift=0, scale=GV%H_to_m*US%s_to_T) - call uvchksum("vertvisc_coef a_[uv]", CS%a_u, & - CS%a_v, G%HI, haloshift=0, scale=US%Z_to_m*US%s_to_T) + call uvchksum("vertvisc_coef h_[uv]", CS%h_u, CS%h_v, G%HI, haloshift=0, scale=GV%H_to_m) + call uvchksum("vertvisc_coef a_[uv]", CS%a_u, CS%a_v, G%HI, haloshift=0, scale=US%Z_to_m*US%s_to_T) if (allocated(hML_u) .and. allocated(hML_v)) & - call uvchksum("vertvisc_coef hML_[uv]", hML_u, hML_v, & - G%HI, haloshift=0, scale=GV%H_to_m) + call uvchksum("vertvisc_coef hML_[uv]", hML_u, hML_v, G%HI, haloshift=0, scale=GV%H_to_m) endif ! Offer diagnostic fields for averaging. @@ -1311,9 +1312,9 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: u !< Zonal velocity [m s-1] + intent(inout) :: u !< Zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(inout) :: v !< Meridional velocity [m s-1] + intent(inout) :: v !< Meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(accel_diag_ptrs), intent(in) :: ADp !< Acceleration diagnostic pointers @@ -1326,13 +1327,14 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS ! Local variables real :: maxvel ! Velocities components greater than maxvel - real :: truncvel ! are truncated to truncvel, both [m s-1]. + real :: truncvel ! are truncated to truncvel, both [L T-1 ~> m s-1]. + real :: dt_in_T ! The timestep [T ~> s] real :: CFL ! The local CFL number. real :: H_report ! A thickness below which not to report truncations. real :: dt_Rho0 ! The timestep divided by the Boussinesq density [s m3 kg-1]. - real :: vel_report(SZIB_(G),SZJB_(G)) - real :: u_old(SZIB_(G),SZJ_(G),SZK_(G)) - real :: v_old(SZI_(G),SZJB_(G),SZK_(G)) + real :: vel_report(SZIB_(G),SZJB_(G)) ! The velocity to report [L T-1 ~> m s-1] + real :: u_old(SZIB_(G),SZJ_(G),SZK_(G)) ! The previous u-velocity [L T-1 ~> m s-1] + real :: v_old(SZI_(G),SZJB_(G),SZK_(G)) ! The previous v-velocity [L T-1 ~> m s-1] logical :: trunc_any, dowrite(SZIB_(G),SZJB_(G)) integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -1341,6 +1343,7 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS maxvel = CS%maxvel truncvel = 0.9*maxvel H_report = 6.0 * GV%Angstrom_H + dt_in_T = US%s_to_T*dt dt_Rho0 = dt / GV%Rho0 if (len_trim(CS%u_trunc_file) > 0) then @@ -1349,13 +1352,13 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS trunc_any = .false. do I=Isq,Ieq ; dowrite(I,j) = .false. ; enddo if (CS%CFL_based_trunc) then - do I=Isq,Ieq ; vel_report(i,j) = 3.0e8 ; enddo ! Speed of light default. + do I=Isq,Ieq ; vel_report(i,j) = 3.0e8*US%m_s_to_L_T ; enddo ! Speed of light default. do k=1,nz ; do I=Isq,Ieq if (abs(u(I,j,k)) < CS%vel_underflow) u(I,j,k) = 0.0 if (u(I,j,k) < 0.0) then - CFL = (-u(I,j,k) * dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) + CFL = (-u(I,j,k) * dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) else - CFL = (u(I,j,k) * dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) + CFL = (u(I,j,k) * dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i,j)) endif if (CFL > CS%CFL_trunc) trunc_any = .true. if (CFL > CS%CFL_report) then @@ -1379,11 +1382,11 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS if (trunc_any) then ; if (CS%CFL_based_trunc) then do k=1,nz ; do I=Isq,Ieq - if ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then - u(I,j,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i+1,j) / (dt * G%dy_Cu(I,j))) + if ((u(I,j,k) * (dt_in_T * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then + u(I,j,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i+1,j) / (dt_in_T * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then - u(I,j,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt * G%dy_Cu(I,j))) + elseif ((u(I,j,k) * (dt_in_T * G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then + u(I,j,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt_in_T * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo @@ -1399,11 +1402,11 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS !$OMP parallel do default(none) shared(nz,js,je,Isq,Ieq,u,dt,G,CS,h,H_report) do k=1,nz ; do j=js,je ; do I=Isq,Ieq if (abs(u(I,j,k)) < CS%vel_underflow) then ; u(I,j,k) = 0.0 - elseif ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then - u(I,j,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i+1,j) / (dt * G%dy_Cu(I,j))) + elseif ((u(I,j,k) * (dt_in_T * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then + u(I,j,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i+1,j) / (dt_in_T * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then - u(I,j,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt * G%dy_Cu(I,j))) + elseif ((u(I,j,k) * (dt_in_T * G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then + u(I,j,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt_in_T * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo ; enddo @@ -1434,13 +1437,13 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS trunc_any = .false. do i=is,ie ; dowrite(i,J) = .false. ; enddo if (CS%CFL_based_trunc) then - do i=is,ie ; vel_report(i,J) = 3.0e8 ; enddo ! Speed of light default. + do i=is,ie ; vel_report(i,J) = 3.0e8*US%m_s_to_L_T ; enddo ! Speed of light default. do k=1,nz ; do i=is,ie if (abs(v(i,J,k)) < CS%vel_underflow) v(i,J,k) = 0.0 if (v(i,J,k) < 0.0) then - CFL = (-v(i,J,k) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) + CFL = (-v(i,J,k) * dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) else - CFL = (v(i,J,k) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) + CFL = (v(i,J,k) * dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j)) endif if (CFL > CS%CFL_trunc) trunc_any = .true. if (CFL > CS%CFL_report) then @@ -1464,11 +1467,11 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS if (trunc_any) then ; if (CS%CFL_based_trunc) then do k=1,nz; do i=is,ie - if ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then - v(i,J,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (dt * G%dx_Cv(i,J))) + if ((v(i,J,k) * (dt_in_T * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then + v(i,J,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (dt_in_T * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then - v(i,J,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt * G%dx_Cv(i,J))) + elseif ((v(i,J,k) * (dt_in_T * G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then + v(i,J,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt_in_T * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo @@ -1484,11 +1487,11 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS !$OMP parallel do default(shared) do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie if (abs(v(i,J,k)) < CS%vel_underflow) then ; v(i,J,k) = 0.0 - elseif ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then - v(i,J,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (dt * G%dx_Cv(i,J))) + elseif ((v(i,J,k) * (dt_in_T * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then + v(i,J,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (dt_in_T * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then - v(i,J,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt * G%dx_Cv(i,J))) + elseif ((v(i,J,k) * (dt_in_T * G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then + v(i,J,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt_in_T * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo ; enddo @@ -1642,7 +1645,7 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & "but LINEAR_DRAG is not.", units="m", fail_if_missing=.true., scale=GV%m_to_H) call get_param(param_file, mdl, "MAXVEL", CS%maxvel, & "The maximum velocity allowed before the velocity "//& - "components are truncated.", units="m s-1", default=3.0e8) + "components are truncated.", units="m s-1", default=3.0e8, scale=US%m_s_to_L_T) call get_param(param_file, mdl, "CFL_BASED_TRUNCATIONS", CS%CFL_based_trunc, & "If true, base truncations on the CFL number, and not an "//& "absolute speed.", default=.true.) @@ -1686,7 +1689,7 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & "A negligibly small velocity magnitude below which velocity "//& "components are set to 0. A reasonable value might be "//& "1e-30 m/s, which is less than an Angstrom divided by "//& - "the age of the universe.", units="m s-1", default=0.0) + "the age of the universe.", units="m s-1", default=0.0, scale=US%m_s_to_L_T) ALLOC_(CS%a_u(IsdB:IedB,jsd:jed,nz+1)) ; CS%a_u(:,:,:) = 0.0 ALLOC_(CS%h_u(IsdB:IedB,jsd:jed,nz)) ; CS%h_u(:,:,:) = 0.0 @@ -1721,18 +1724,18 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & 'Mixed Layer Thickness at Meridional Velocity Points for Viscosity', thickness_units) CS%id_du_dt_visc = register_diag_field('ocean_model', 'du_dt_visc', diag%axesCuL, & - Time, 'Zonal Acceleration from Vertical Viscosity', 'm s-2') + Time, 'Zonal Acceleration from Vertical Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_du_dt_visc > 0) call safe_alloc_ptr(ADp%du_dt_visc,IsdB,IedB,jsd,jed,nz) CS%id_dv_dt_visc = register_diag_field('ocean_model', 'dv_dt_visc', diag%axesCvL, & - Time, 'Meridional Acceleration from Vertical Viscosity', 'm s-2') + Time, 'Meridional Acceleration from Vertical Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_dv_dt_visc > 0) call safe_alloc_ptr(ADp%dv_dt_visc,isd,ied,JsdB,JedB,nz) CS%id_taux_bot = register_diag_field('ocean_model', 'taux_bot', diag%axesCu1, & Time, 'Zonal Bottom Stress from Ocean to Earth', 'Pa', & - conversion=US%Z_to_m) + conversion=US%L_T2_to_m_s2*US%Z_to_m) CS%id_tauy_bot = register_diag_field('ocean_model', 'tauy_bot', diag%axesCv1, & Time, 'Meridional Bottom Stress from Ocean to Earth', 'Pa', & - conversion=US%Z_to_m) + conversion=US%L_T2_to_m_s2*US%Z_to_m) if ((len_trim(CS%u_trunc_file) > 0) .or. (len_trim(CS%v_trunc_file) > 0)) & call PointAccel_init(MIS, Time, G, param_file, diag, dirs, CS%PointAccel_CSp) diff --git a/src/tracer/MOM_OCMIP2_CFC.F90 b/src/tracer/MOM_OCMIP2_CFC.F90 index 7d9ed5f0a4..0268c04f17 100644 --- a/src/tracer/MOM_OCMIP2_CFC.F90 +++ b/src/tracer/MOM_OCMIP2_CFC.F90 @@ -528,7 +528,7 @@ function OCMIP2_CFC_stock(h, stocks, G, GV, CS, names, units, stock_index) stocks(1) = 0.0 ; stocks(2) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie - mass = G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k) + mass = G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k) stocks(1) = stocks(1) + CS%CFC11(i,j,k) * mass stocks(2) = stocks(2) + CS%CFC12(i,j,k) * mass enddo ; enddo ; enddo diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index 7c25f5711a..d12897038f 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -492,7 +492,7 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, ! call generic_tracer_source(tv%T,tv%S,rho_dzt,dzt,Hml,G%isd,G%jsd,1,dt,& - G%areaT,get_diag_time_end(CS%diag),& + G%US%L_to_m**2*G%areaT, get_diag_time_end(CS%diag), & optics%nbands, optics%max_wavelength_band, optics%sw_pen_band, optics%opacity_band, & internal_heat=tv%internal_heat, frunoff=fluxes%frunoff, sosga=sosga) @@ -594,7 +594,7 @@ function MOM_generic_tracer_stock(h, stocks, G, GV, CS, names, units, stock_inde tr_ptr => tr_field(:,:,:,1) do k=1,nz ; do j=js,je ; do i=is,ie stocks(m) = stocks(m) + tr_ptr(i,j,k) * & - (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) + (G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k)) enddo ; enddo ; enddo stocks(m) = GV%H_to_kg_m2 * stocks(m) diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index deeb9529ee..a13eace934 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -22,6 +22,7 @@ module MOM_neutral_diffusion use MOM_remapping, only : extract_member_remapping_CS, build_reconstructions_1d use MOM_remapping, only : average_value_ppoly, remappingSchemesDoc, remappingDefaultScheme use MOM_tracer_registry, only : tracer_registry_type, tracer_type +use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type use polynomial_functions, only : evaluation_polynomial, first_derivative_polynomial use PPM_functions, only : PPM_reconstruction, PPM_boundary_extrapolation @@ -407,15 +408,16 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, h, T, S, CS) end subroutine neutral_diffusion_calc_coeffs !> Update tracer concentration due to neutral diffusion; layer thickness unchanged by this update. -subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, CS) +subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Coef_x !< dt * Kh * dy / dx at u-points [m2] - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Coef_y !< dt * Kh * dx / dy at v-points [m2] + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Coef_x !< dt * Kh * dy / dx at u-points [L2 ~> m2] + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Coef_y !< dt * Kh * dx / dy at v-points [L2 ~> m2] real, intent(in) :: dt !< Tracer time step * I_numitts !! (I_numitts in tracer_hordiff) type(tracer_registry_type), pointer :: Reg !< Tracer registry + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(neutral_diffusion_CS), pointer :: CS !< Neutral diffusion control structure ! Local variables diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index 37f66987c0..d553af730d 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -63,17 +63,17 @@ subroutine update_h_horizontal_flux(G, GV, uhtr, vhtr, h_pre, h_new) do k = 1, nz do i=is-1,ie+1 ; do j=js-1,je+1 - h_new(i,j,k) = max(0.0, G%areaT(i,j)*h_pre(i,j,k) + & + h_new(i,j,k) = max(0.0, G%US%L_to_m**2*G%areaT(i,j)*h_pre(i,j,k) + & ((uhtr(I-1,j,k) - uhtr(I,j,k)) + (vhtr(i,J-1,k) - vhtr(i,J,k)))) ! In the case that the layer is now dramatically thinner than it was previously, ! add a bit of mass to avoid truncation errors. This will lead to ! non-conservation of tracers h_new(i,j,k) = h_new(i,j,k) + & - max(GV%Angstrom_H, 1.0e-13*h_new(i,j,k) - G%areaT(i,j)*h_pre(i,j,k)) + max(GV%Angstrom_H, 1.0e-13*h_new(i,j,k) - G%US%L_to_m**2*G%areaT(i,j)*h_pre(i,j,k)) ! Convert back to thickness - h_new(i,j,k) = h_new(i,j,k)/G%areaT(i,j) + h_new(i,j,k) = h_new(i,j,k) / (G%US%L_to_m**2*G%areaT(i,j)) enddo ; enddo enddo @@ -189,10 +189,10 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre) ! in a given cell and scale it back if it would deplete a layer do k = 1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 - hvol = h_pre(i,j,k)*G%areaT(i,j) + hvol = h_pre(i,j,k)*G%US%L_to_m**2*G%areaT(i,j) pos_flux = max(0.0,-uh(I-1,j,k)) + max(0.0, -vh(i,J-1,k)) + & max(0.0, uh(I,j,k)) + max(0.0, vh(i,J,k)) + & - max(0.0, top_flux(i,j,k)*G%areaT(i,j)) + max(0.0, bottom_flux(i,j,k)*G%areaT(i,j)) + max(0.0, top_flux(i,j,k)*G%US%L_to_m**2*G%areaT(i,j)) + max(0.0, bottom_flux(i,j,k)*G%US%L_to_m**2*G%areaT(i,j)) if (pos_flux>hvol .and. pos_flux>0.0) then scale_factor = ( hvol )/pos_flux*max_off_cfl @@ -294,7 +294,7 @@ subroutine distribute_residual_uh_barotropic(G, GV, hvol, uh) endif ! Calculate and check that column integrated transports match the original to ! within the tolerance limit - uh_neglect = GV%Angstrom_H*min(G%areaT(i,j),G%areaT(i+1,j)) + uh_neglect = GV%Angstrom_H*min(G%US%L_to_m**2*G%areaT(i,j),G%US%L_to_m**2*G%areaT(i+1,j)) if ( abs(sum(uh2d(I,:))-uh2d_sum(I)) > uh_neglect) & call MOM_error(WARNING,"Column integral of uh does not match after "//& "barotropic redistribution") @@ -364,7 +364,7 @@ subroutine distribute_residual_vh_barotropic(G, GV, hvol, vh) endif ! Calculate and check that column integrated transports match the original to ! within the tolerance limit - vh_neglect = GV%Angstrom_H*min(G%areaT(i,j),G%areaT(i,j+1)) + vh_neglect = GV%Angstrom_H*min(G%US%L_to_m**2*G%areaT(i,j),G%US%L_to_m**2*G%areaT(i,j+1)) if ( abs(sum(vh2d(J,:))-vh2d_sum(J)) > vh_neglect) then call MOM_error(WARNING,"Column integral of vh does not match after "//& "barotropic redistribution") @@ -409,7 +409,7 @@ subroutine distribute_residual_uh_upwards(G, GV, hvol, uh) enddo ; enddo do k=1,nz ; do i=is-1,ie+1 ! Subtract just a little bit of thickness to avoid roundoff errors - h2d(i,k) = hvol(i,j,k)-min_h*G%areaT(i,j) + h2d(i,k) = hvol(i,j,k)-min_h*G%US%L_to_m**2*G%areaT(i,j) enddo ; enddo do i=is-1,ie @@ -460,7 +460,7 @@ subroutine distribute_residual_uh_upwards(G, GV, hvol, uh) ! Calculate and check that column integrated transports match the original to ! within the tolerance limit - uh_neglect = GV%Angstrom_H*min(G%areaT(i,j),G%areaT(i+1,j)) + uh_neglect = GV%Angstrom_H*min(G%US%L_to_m**2*G%areaT(i,j),G%US%L_to_m**2*G%areaT(i+1,j)) if (abs(uh_col - sum(uh2d(I,:)))>uh_neglect) then call MOM_error(WARNING,"Column integral of uh does not match after "//& "upwards redistribution") @@ -506,7 +506,7 @@ subroutine distribute_residual_vh_upwards(G, GV, hvol, vh) vh2d(J,k) = vh(i,J,k) enddo ; enddo do k=1,nz ; do j=js-1,je+1 - h2d(j,k) = hvol(i,j,k)-min_h*G%areaT(i,j) + h2d(j,k) = hvol(i,j,k)-min_h*G%US%L_to_m**2*G%areaT(i,j) enddo ; enddo do j=js-1,je @@ -558,7 +558,7 @@ subroutine distribute_residual_vh_upwards(G, GV, hvol, vh) ! Calculate and check that column integrated transports match the original to ! within the tolerance limit - vh_neglect = GV%Angstrom_H*min(G%areaT(i,j),G%areaT(i,j+1)) + vh_neglect = GV%Angstrom_H*min(G%US%L_to_m**2*G%areaT(i,j),G%US%L_to_m**2*G%areaT(i,j+1)) if ( ABS(vh_col-SUM(vh2d(J,:))) > vh_neglect) then call MOM_error(WARNING,"Column integral of vh does not match after "//& "upwards redistribution") diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index 8278e57264..bd482e241b 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -33,6 +33,7 @@ module MOM_offline_main use MOM_tracer_diabatic, only : applyTracerBoundaryFluxesInOut use MOM_tracer_flow_control, only : tracer_flow_control_CS, call_tracer_column_fns, call_tracer_stocks use MOM_tracer_registry, only : tracer_registry_type, MOM_tracer_chksum, MOM_tracer_chkinv +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type @@ -67,6 +68,8 @@ module MOM_offline_main !< Pointer to a structure containing metrics and related information type(verticalGrid_type), pointer :: GV => NULL() !< Pointer to structure containing information about the vertical grid + type(unit_scale_type), pointer :: US => NULL() + !< structure containing various unit conversion factors type(optics_type), pointer :: optics => NULL() !< Pointer to the optical properties type type(diabatic_aux_CS), pointer :: diabatic_aux_CSp => NULL() @@ -319,7 +322,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock do iter=1,CS%num_off_iter do k=1,nz ; do j=js,je ; do i=is,ie - h_vol(i,j,k) = h_new(i,j,k)*G%areaT(i,j) + h_vol(i,j,k) = h_new(i,j,k) * G%US%L_to_m**2*G%areaT(i,j) h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo @@ -330,7 +333,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock call MOM_tracer_chkinv(debug_msg, G, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif - call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, CS%dt_offline, G, GV, & + call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, CS%dt_offline, G, GV, CS%US, & CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=1, & uhr_out=uhtr, vhr_out=vhtr, h_out=h_new, x_first_in=x_before_y) @@ -339,7 +342,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock ! Update the new layer thicknesses after one round of advection has happened do k=1,nz ; do j=js,je ; do i=is,ie - h_new(i,j,k) = h_new(i,j,k)/G%areaT(i,j) + h_new(i,j,k) = h_new(i,j,k) / (G%US%L_to_m**2*G%areaT(i,j)) enddo ; enddo ; enddo if (MODULO(iter,CS%off_ale_mod)==0) then @@ -480,7 +483,7 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) ! Calculate the layer volumes at beginning of redistribute do k=1,nz ; do j=js,je ; do i=is,ie - h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) + h_vol(i,j,k) = h_pre(i,j,k)*G%US%L_to_m**2*G%areaT(i,j) enddo ; enddo ; enddo call pass_var(h_vol,G%Domain) call pass_vector(uhtr,vhtr,G%Domain) @@ -501,7 +504,7 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) call distribute_residual_uh_upwards(G, GV, h_vol, uhtr) endif - call advect_tracer(h_pre, uhtr, vhtr, CS%OBC, CS%dt_offline, G, GV, & + call advect_tracer(h_pre, uhtr, vhtr, CS%OBC, CS%dt_offline, G, GV, CS%US, & CS%tracer_adv_CSp, CS%tracer_Reg, h_prev_opt = h_pre, max_iter_in=1, & h_out=h_new, uhr_out=uhr, vhr_out=vhr, x_first_in=x_before_y) @@ -514,7 +517,7 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) uhtr(I,j,k) = uhr(I,j,k) vhtr(i,J,k) = vhr(i,J,k) h_vol(i,j,k) = h_new(i,j,k) - h_new(i,j,k) = h_new(i,j,k)/G%areaT(i,j) + h_new(i,j,k) = h_new(i,j,k) / (G%US%L_to_m**2*G%areaT(i,j)) h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo @@ -525,7 +528,7 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) ! Calculate the layer volumes at beginning of redistribute do k=1,nz ; do j=js,je ; do i=is,ie - h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) + h_vol(i,j,k) = h_pre(i,j,k)*G%US%L_to_m**2*G%areaT(i,j) enddo ; enddo ; enddo call pass_var(h_vol,G%Domain) call pass_vector(uhtr,vhtr,G%Domain) @@ -546,7 +549,7 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) call distribute_residual_uh_barotropic(G, GV, h_vol, uhtr) endif - call advect_tracer(h_pre, uhtr, vhtr, CS%OBC, CS%dt_offline, G, GV, & + call advect_tracer(h_pre, uhtr, vhtr, CS%OBC, CS%dt_offline, G, GV, CS%US, & CS%tracer_adv_CSp, CS%tracer_Reg, h_prev_opt = h_pre, max_iter_in=1, & h_out=h_new, uhr_out=uhr, vhr_out=vhr, x_first_in=x_before_y) @@ -559,7 +562,7 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) uhtr(I,j,k) = uhr(I,j,k) vhtr(i,J,k) = vhr(i,J,k) h_vol(i,j,k) = h_new(i,j,k) - h_new(i,j,k) = h_new(i,j,k)/G%areaT(i,j) + h_new(i,j,k) = h_new(i,j,k) / (G%US%L_to_m**2*G%areaT(i,j)) h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo @@ -625,8 +628,8 @@ real function remaining_transport_sum(CS, uhtr, vhtr) remaining_transport_sum = 0. do k=1,nz; do j=js,je ; do i=is,ie - uh_neglect = h_min*MIN(CS%G%areaT(i,j),CS%G%areaT(i+1,j)) - vh_neglect = h_min*MIN(CS%G%areaT(i,j),CS%G%areaT(i,j+1)) + uh_neglect = h_min*CS%G%US%L_to_m**2*MIN(CS%G%areaT(i,j),CS%G%areaT(i+1,j)) + vh_neglect = h_min*CS%G%US%L_to_m**2*MIN(CS%G%areaT(i,j),CS%G%areaT(i,j+1)) if (ABS(uhtr(I,j,k))>uh_neglect) then remaining_transport_sum = remaining_transport_sum + ABS(uhtr(I,j,k)) endif @@ -914,9 +917,9 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, ! Second zonal and meridional advection call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new) do k = 1, nz ; do i = is-1, ie+1 ; do j=js-1, je+1 - h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) + h_vol(i,j,k) = h_pre(i,j,k)*G%US%L_to_m**2*G%areaT(i,j) enddo ; enddo ; enddo - call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & + call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, CS%US, & CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=30, x_first_in=x_before_y) ! Done with horizontal so now h_pre should be h_new @@ -931,9 +934,9 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, ! First zonal and meridional advection call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new) do k = 1, nz ; do i = is-1, ie+1 ; do j=js-1, je+1 - h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) + h_vol(i,j,k) = h_pre(i,j,k)*G%US%L_to_m**2*G%areaT(i,j) enddo ; enddo ; enddo - call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & + call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, CS%US, & CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=30, x_first_in=x_before_y) ! Done with horizontal so now h_pre should be h_new @@ -1268,13 +1271,14 @@ end subroutine insert_offline_main !> Initializes the control structure for offline transport and reads in some of the ! run time parameters from MOM_input -subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV) +subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV, US) type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(offline_transport_CS), pointer :: CS !< Offline control structure type(diabatic_CS), intent(in) :: diabatic_CSp !< The diabatic control structure type(ocean_grid_type), target, intent(in) :: G !< ocean grid structure type(verticalGrid_type), target, intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), target, intent(in) :: US !< A dimensional unit scaling type character(len=40) :: mdl = "offline_transport" character(len=20) :: redistribute_method @@ -1296,6 +1300,9 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV) allocate(CS) call log_version(param_file, mdl,version, "This module allows for tracers to be run offline") + ! Determining the internal unit scaling factors for this run. + CS%US => US + ! Parse MOM_input for offline control call get_param(param_file, mdl, "OFFLINEDIR", CS%offlinedir, & "Input directory where the offline fields can be found", fail_if_missing = .true.) diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 906c6d8be2..0e4c867253 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -1,5 +1,4 @@ -!> This program contains the subroutines that advect tracers -!! along coordinate surfaces. +!> This module contains the subroutines that advect tracers along coordinate surfaces. module MOM_tracer_advect ! This file is part of MOM6. See LICENSE.md for the license. @@ -17,6 +16,7 @@ module MOM_tracer_advect use MOM_open_boundary, only : OBC_DIRECTION_W, OBC_DIRECTION_N, OBC_DIRECTION_S use MOM_open_boundary, only : OBC_segment_type use MOM_tracer_registry, only : tracer_registry_type, tracer_type +use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type implicit none ; private @@ -47,18 +47,19 @@ module MOM_tracer_advect !> This routine time steps the tracer concentration using a !! monotonic, conservative, weakly diffusive scheme. -subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, & +subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & h_prev_opt, max_iter_in, x_first_in, uhr_out, vhr_out, h_out) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h_end !< layer thickness after advection [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: uhtr !< accumulated volume/mass flux through zonal face [H m2 ~> m3 or kg] + intent(in) :: uhtr !< accumulated volume/mass flux through zonal face [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: vhtr !< accumulated volume/mass flux through merid face [H m2 ~> m3 or kg] + intent(in) :: vhtr !< accumulated volume/mass flux through merid face [H L2 ~> m3 or kg] type(ocean_OBC_type), pointer :: OBC !< specifies whether, where, and what OBCs are used real, intent(in) :: dt !< time increment [s] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(tracer_advect_CS), pointer :: CS !< control structure for module type(tracer_registry_type), pointer :: Reg !< pointer to tracer registry real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -68,25 +69,25 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, & !! first in the x- or y-direction. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: uhr_out !< accumulated volume/mass flux through zonal face - !! [H m2 ~> m3 or kg] + !! [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(out) :: vhr_out !< accumulated volume/mass flux through merid face - !! [H m2 ~> m3 or kg] + !! [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: h_out !< layer thickness before advection [H ~> m or kg m-2] type(tracer_type) :: Tr(MAX_FIELDS_) ! The array of registered tracers real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - hprev ! cell volume at the end of previous tracer change [H m2 ~> m3 or kg] + hprev ! cell volume at the end of previous tracer change [H L2 ~> m3 or kg] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: & - uhr ! The remaining zonal thickness flux [H m2 ~> m3 or kg] + uhr ! The remaining zonal thickness flux [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: & - vhr ! The remaining meridional thickness fluxes [H m2 ~> m3 or kg] + vhr ! The remaining meridional thickness fluxes [H L2 ~> m3 or kg] real :: uh_neglect(SZIB_(G),SZJ_(G)) ! uh_neglect and vh_neglect are the real :: vh_neglect(SZI_(G),SZJB_(G)) ! magnitude of remaining transports that - ! can be simply discarded [H m2 ~> m3 or kg]. + ! can be simply discarded [H L2 ~> m3 or kg]. - real :: landvolfill ! An arbitrary? nonzero cell volume [H m2 ~> m3 or kg]. + real :: landvolfill ! An arbitrary? nonzero cell volume [H L2 ~> m3 or kg]. real :: Idt ! 1/dt [s-1]. logical :: domore_u(SZJ_(G),SZK_(G)) ! domore__ indicate whether there is more logical :: domore_v(SZJB_(G),SZK_(G)) ! advection to be done in the corresponding @@ -143,10 +144,10 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, & ! calculations on them, even though they are never used. !$OMP do - do k = 1, nz - do j = jsd, jed; do i = IsdB, IedB; uhr(i,j,k) = 0.0; enddo ; enddo - do j = jsdB, jedB; do i = Isd, Ied; vhr(i,j,k) = 0.0; enddo ; enddo - do j = jsd, jed; do i = Isd, Ied; hprev(i,j,k) = 0.0; enddo ; enddo + do k=1,nz + do j=jsd,jed ; do I=IsdB,IedB ; uhr(I,j,k) = 0.0 ; enddo ; enddo + do J=jsdB,jedB ; do i=Isd,Ied ; vhr(i,J,k) = 0.0 ; enddo ; enddo + do j=jsd,jed ; do i=Isd,Ied ; hprev(i,j,k) = 0.0 ; enddo ; enddo domore_k(k)=1 ! Put the remaining (total) thickness fluxes into uhr and vhr. do j=js,je ; do I=is-1,ie ; uhr(I,j,k) = uhtr(I,j,k) ; enddo ; enddo @@ -155,15 +156,15 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, & ! This loop reconstructs the thickness field the last time that the ! tracers were updated, probably just after the diabatic forcing. A useful ! diagnostic could be to compare this reconstruction with that older value. - do i=is,ie ; do j=js,je - hprev(i,j,k) = max(0.0, G%areaT(i,j)*h_end(i,j,k) + & - ((uhr(I,j,k) - uhr(I-1,j,k)) + (vhr(i,J,k) - vhr(i,J-1,k)))) + do i=is,ie ; do j=js,je + hprev(i,j,k) = max(0.0, G%areaT(i,j)*h_end(i,j,k) + & + ((uhr(I,j,k) - uhr(I-1,j,k)) + (vhr(i,J,k) - vhr(i,J-1,k)))) ! In the case that the layer is now dramatically thinner than it was previously, ! add a bit of mass to avoid truncation errors. This will lead to ! non-conservation of tracers - hprev(i,j,k) = hprev(i,j,k) + & - max(0.0, 1.0e-13*hprev(i,j,k) - G%areaT(i,j)*h_end(i,j,k)) - enddo ; enddo + hprev(i,j,k) = hprev(i,j,k) + & + max(0.0, 1.0e-13*hprev(i,j,k) - G%areaT(i,j)*h_end(i,j,k)) + enddo ; enddo else do i=is,ie ; do j=js,je hprev(i,j,k) = h_prev_opt(i,j,k) @@ -264,11 +265,11 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, & ! First, advect zonally. call advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & - isv, iev, jsv-stencil, jev+stencil, k, G, GV, CS%usePPM, CS%useHuynh) + isv, iev, jsv-stencil, jev+stencil, k, G, GV, US, CS%usePPM, CS%useHuynh) ! Next, advect meridionally. call advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & - isv, iev, jsv, jev, k, G, GV, CS%usePPM, CS%useHuynh) + isv, iev, jsv, jev, k, G, GV, US, CS%usePPM, CS%useHuynh) domore_k(k) = 0 do j=jsv-stencil,jev+stencil ; if (domore_u(j,k)) domore_k(k) = 1 ; enddo @@ -278,11 +279,11 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, & ! First, advect meridionally. call advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & - isv-stencil, iev+stencil, jsv, jev, k, G, GV, CS%usePPM, CS%useHuynh) + isv-stencil, iev+stencil, jsv, jev, k, G, GV, US, CS%usePPM, CS%useHuynh) ! Next, advect zonally. call advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & - isv, iev, jsv, jev, k, G, GV, CS%usePPM, CS%useHuynh) + isv, iev, jsv, jev, k, G, GV, US, CS%usePPM, CS%useHuynh) domore_k(k) = 0 do j=jsv,jev ; if (domore_u(j,k)) domore_k(k) = 1 ; enddo @@ -325,16 +326,16 @@ end subroutine advect_tracer !> This subroutine does 1-d flux-form advection in the zonal direction using !! a monotonic piecewise linear scheme. subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & - is, ie, js, je, k, G, GV, usePPM, useHuynh) + is, ie, js, je, k, G, GV, US, usePPM, useHuynh) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(tracer_type), dimension(ntr), intent(inout) :: Tr !< The array of registered tracers to work on real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: hprev !< cell volume at the end of previous - !! tracer change [H m2 ~> m3 or kg] + !! tracer change [H L2 ~> m3 or kg] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhr !< accumulated volume/mass flux through - !! the zonal face [H m2 ~> m3 or kg] + !! the zonal face [H L2 ~> m3 or kg] real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: uh_neglect !< A tiny zonal mass flux that can - !! be neglected [H m2 ~> m3 or kg] + !! be neglected [H L2 ~> m3 or kg] type(ocean_OBC_type), pointer :: OBC !< specifies whether, where, and what OBCs are used logical, dimension(SZJ_(G),SZK_(G)), intent(inout) :: domore_u !< If true, there is more advection to be !! done in this u-row @@ -345,6 +346,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & integer, intent(in) :: js !< The starting tracer j-index to work on integer, intent(in) :: je !< The ending tracer j-index to work on integer, intent(in) :: k !< The k-level to work on + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type logical, intent(in) :: usePPM !< If true, use PPM instead of PLM logical, intent(in) :: useHuynh !< If true, use the Huynh scheme !! for PPM interface values @@ -352,20 +354,21 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & real, dimension(SZI_(G),ntr) :: & slope_x ! The concentration slope per grid point [conc]. real, dimension(SZIB_(G),ntr) :: & - flux_x ! The tracer flux across a boundary [H m2 conc ~> m3 conc or kg conc]. + flux_x ! The tracer flux across a boundary [H L2 conc ~> m3 conc or kg conc]. real, dimension(SZI_(G),ntr) :: & T_tmp ! The copy of the tracer concentration at constant i,k [H m2 conc ~> m3 conc or kg conc]. + real :: maxslope ! The maximum concentration slope per grid point ! consistent with monotonicity [conc]. real :: hup, hlos ! hup is the upwind volume, hlos is the ! part of that volume that might be lost ! due to advection out the other side of - ! the grid box, both in [H m2 ~> m3 or kg]. + ! the grid box, both in [H L2 ~> m3 or kg]. real :: uhh(SZIB_(G)) ! The zonal flux that occurs during the - ! current iteration [H m2 ~> m3 or kg]. + ! current iteration [H L2 ~> m3 or kg]. real, dimension(SZIB_(G)) :: & - hlst, & ! Work variable [H m2 ~> m3 or kg]. - Ihnew, & ! Work variable [H-1 m-2 ~> m-3 or kg-1]. + hlst, & ! Work variable [H L2 ~> m3 or kg]. + Ihnew, & ! Work variable [H-1 L-2 ~> m-3 or kg-1]. CFL ! A nondimensional work variable [nondim]. real :: min_h ! The minimum thickness that can be realized during ! any of the passes [H ~> m or kg m-2]. @@ -424,7 +427,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & ! make a copy of the tracers in case values need to be overridden for OBCs do m = 1,ntr - do i=is-stencil,ie+stencil + do i=G%isd,G%ied T_tmp(i,m) = Tr(m)%t(i,j,k) enddo enddo @@ -623,6 +626,46 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & enddo endif + if (OBC%open_u_BCs_exist_globally) then + do n=1,OBC%number_of_segments + segment=>OBC%segment(n) + I = segment%HI%IsdB + if (segment%is_E_or_W .and. (j >= segment%HI%jsd .and. j<= segment%HI%jed)) then + if (segment%specified) cycle + if (.not. associated(segment%tr_Reg)) cycle + ishift=0 ! ishift+I corresponds to the nearest interior tracer cell index + idir=1 ! idir switches the sign of the flow so that positive is into the reservoir + if (segment%direction == OBC_DIRECTION_W) then + ishift = 1 + idir = -1 + endif + ! update the reservoir tracer concentration implicitly + ! using Backward-Euler timestep + do m=1,ntr + if (associated(segment%tr_Reg%Tr(m)%tres)) then + uhh(I) = uhr(I,j,k) + u_L_in = max(idir*uhh(I)*segment%Tr_InvLscale3_in,0.) + u_L_out = min(idir*uhh(I)*segment%Tr_InvLscale3_out,0.) + fac1 = 1.0+dt*(u_L_in-u_L_out) + segment%tr_Reg%Tr(m)%tres(I,j,k) = (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(I,j,k) + & + dt*(u_L_in*Tr(m)%t(I+ishift,j,k) - & + u_L_out*segment%tr_Reg%Tr(m)%t(I,j,k))) + endif + enddo + + ! Tracer fluxes are set to prescribed values only for inflows from masked areas. + if ((uhr(I,j,k) > 0.0) .and. (G%mask2dT(i,j) < 0.5) .or. & + (uhr(I,j,k) < 0.0) .and. (G%mask2dT(i+1,j) < 0.5)) then + uhh(I) = uhr(I,j,k) + do m=1,ntr + if (associated(segment%tr_Reg%Tr(m)%tres)) then + flux_x(I,m) = uhh(I)*segment%tr_Reg%Tr(m)%tres(I,j,k) + else; flux_x(I,m) = uhh(I)*segment%tr_Reg%Tr(m)%OBC_inflow_conc; endif + enddo + endif + endif + enddo + endif endif ; endif ! Calculate new tracer concentration in each cell after accounting @@ -657,17 +700,18 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & ! diagnostics if (associated(Tr(m)%ad_x)) then ; do i=is,ie ; if (do_i(i)) then - Tr(m)%ad_x(I,j,k) = Tr(m)%ad_x(I,j,k) + flux_x(I,m)*Idt + Tr(m)%ad_x(I,j,k) = Tr(m)%ad_x(I,j,k) + US%L_to_m**2*flux_x(I,m)*Idt endif ; enddo ; endif if (associated(Tr(m)%ad2d_x)) then ; do i=is,ie ; if (do_i(i)) then - Tr(m)%ad2d_x(I,j) = Tr(m)%ad2d_x(I,j) + flux_x(I,m)*Idt + Tr(m)%ad2d_x(I,j) = Tr(m)%ad2d_x(I,j) + US%L_to_m**2*flux_x(I,m)*Idt endif ; enddo ; endif ! diagnose convergence of flux_x (do not use the Ihnew(i) part of the logic). ! division by areaT to get into W/m2 for heat and kg/(s*m2) for salt. if (associated(Tr(m)%advection_xy)) then do i=is,ie ; if (do_i(i)) then - Tr(m)%advection_xy(i,j,k) = Tr(m)%advection_xy(i,j,k) - (flux_x(I,m) - flux_x(I-1,m)) * Idt * G%IareaT(i,j) + Tr(m)%advection_xy(i,j,k) = Tr(m)%advection_xy(i,j,k) - (flux_x(I,m) - flux_x(I-1,m)) * & + Idt * G%IareaT(i,j) endif ; enddo endif @@ -680,16 +724,16 @@ end subroutine advect_x !> This subroutine does 1-d flux-form advection using a monotonic piecewise !! linear scheme. subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & - is, ie, js, je, k, G, GV, usePPM, useHuynh) + is, ie, js, je, k, G, GV, US, usePPM, useHuynh) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(tracer_type), dimension(ntr), intent(inout) :: Tr !< The array of registered tracers to work on real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: hprev !< cell volume at the end of previous - !! tracer change [H m2 ~> m3 or kg] + !! tracer change [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhr !< accumulated volume/mass flux through - !! the meridional face [H m2 ~> m3 or kg] + !! the meridional face [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vh_neglect !< A tiny meridional mass flux that can - !! be neglected [H m2 ~> m3 or kg] + !! be neglected [H L2 ~> m3 or kg] type(ocean_OBC_type), pointer :: OBC !< specifies whether, where, and what OBCs are used logical, dimension(SZJB_(G),SZK_(G)), intent(inout) :: domore_v !< If true, there is more advection to be !! done in this v-row @@ -700,6 +744,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & integer, intent(in) :: js !< The starting tracer j-index to work on integer, intent(in) :: je !< The ending tracer j-index to work on integer, intent(in) :: k !< The k-level to work on + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type logical, intent(in) :: usePPM !< If true, use PPM instead of PLM logical, intent(in) :: useHuynh !< If true, use the Huynh scheme !! for PPM interface values @@ -710,18 +755,17 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & flux_y ! The tracer flux across a boundary [H m2 conc ~> m3 conc or kg conc]. real, dimension(SZI_(G),ntr,SZJB_(G)) :: & T_tmp ! The copy of the tracer concentration at constant i,k [H m2 conc ~> m3 conc or kg conc]. - real :: maxslope ! The maximum concentration slope per grid point ! consistent with monotonicity [conc]. real :: vhh(SZI_(G),SZJB_(G)) ! The meridional flux that occurs during the - ! current iteration [H m2 ~> m3 or kg]. + ! current iteration [H L2 ~> m3 or kg]. real :: hup, hlos ! hup is the upwind volume, hlos is the ! part of that volume that might be lost ! due to advection out the other side of - ! the grid box, both in [H m2 ~> m3 or kg]. + ! the grid box, both in [H L2 ~> m3 or kg]. real, dimension(SZIB_(G)) :: & - hlst, & ! Work variable [H m2 ~> m3 or kg]. - Ihnew, & ! Work variable [H-1 m-2 ~> m-3 or kg-1]. + hlst, & ! Work variable [H L2 ~> m3 or kg]. + Ihnew, & ! Work variable [H-1 L-2 ~> m-3 or kg-1]. CFL ! A nondimensional work variable. real :: min_h ! The minimum thickness that can be realized during ! any of the passes [H ~> m or kg m-2]. @@ -790,9 +834,9 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & ! make a copy of the tracers in case values need to be overridden for OBCs - do j=js-stencil,je+stencil ; if (do_j_tr(j)) then ; do m=1,ntr ; do i=is,ie + do j=G%jsd,G%jed; do m=1,ntr; do i=G%isd,G%ied T_tmp(i,m,j) = Tr(m)%t(i,j,k) - enddo ; enddo ; endif ; enddo + enddo ; enddo ; enddo ! loop through open boundaries and recalculate flux terms if (associated(OBC)) then ; if (OBC%OBC_pe) then @@ -989,6 +1033,45 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & endif enddo endif + + if (OBC%open_v_BCs_exist_globally) then + do n=1,OBC%number_of_segments + segment=>OBC%segment(n) + if (segment%specified) cycle + if (.not. associated(segment%tr_Reg)) cycle + if (segment%is_N_or_S .and. (J >= segment%HI%JsdB .and. J<= segment%HI%JedB)) then + jshift = 0 ; jdir = 1 + if (segment%direction == OBC_DIRECTION_S) then + jshift = 1 ; jdir = -1 + endif + do i=segment%HI%isd,segment%HI%ied + ! update the reservoir tracer concentration implicitly + ! using Backward-Euler timestep + do m=1,ntr + if (associated(segment%tr_Reg%Tr(m)%tres)) then + vhh(i,J)=vhr(i,J,k) + v_L_in = max(jdir*vhh(i,J)*segment%Tr_InvLscale3_in,0.) + v_L_out = min(jdir*vhh(i,J)*segment%Tr_InvLscale3_out,0.) + fac1 = 1.0 + dt*(v_L_in-v_L_out) + segment%tr_Reg%Tr(m)%tres(i,J,k) = (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(i,J,k) + & + dt*v_L_in*Tr(m)%t(i,j+jshift,k) - & + dt*v_L_out*segment%tr_Reg%Tr(m)%t(i,j,k)) + endif + enddo + ! Tracer fluxes are set to prescribed values only for inflows from masked areas. + if ((vhr(i,J,k) > 0.0) .and. (G%mask2dT(i,j) < 0.5) .or. & + (vhr(i,J,k) < 0.0) .and. (G%mask2dT(i,j+1) < 0.5)) then + vhh(i,J) = vhr(i,J,k) + do m=1,ntr + if (associated(segment%tr_Reg%Tr(m)%t)) then + flux_y(i,m,J) = vhh(i,J)*segment%tr_Reg%Tr(m)%tres(i,J,k) + else ; flux_y(i,m,J) = vhh(i,J)*segment%tr_Reg%Tr(m)%OBC_inflow_conc ; endif + enddo + endif + enddo + endif + enddo + endif endif; endif else ! not domore_v. @@ -1026,25 +1109,24 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & ! diagnostics if (associated(Tr(m)%ad_y)) then ; do i=is,ie ; if (do_i(i)) then - Tr(m)%ad_y(i,J,k) = Tr(m)%ad_y(i,J,k) + flux_y(i,m,J)*Idt + Tr(m)%ad_y(i,J,k) = Tr(m)%ad_y(i,J,k) + US%L_to_m**2*flux_y(i,m,J)*Idt endif ; enddo ; endif if (associated(Tr(m)%ad2d_y)) then ; do i=is,ie ; if (do_i(i)) then - Tr(m)%ad2d_y(i,J) = Tr(m)%ad2d_y(i,J) + flux_y(i,m,J)*Idt + Tr(m)%ad2d_y(i,J) = Tr(m)%ad2d_y(i,J) + US%L_to_m**2*flux_y(i,m,J)*Idt endif ; enddo ; endif ! diagnose convergence of flux_y and add to convergence of flux_x. ! division by areaT to get into W/m2 for heat and kg/(s*m2) for salt. if (associated(Tr(m)%advection_xy)) then do i=is,ie ; if (do_i(i)) then - Tr(m)%advection_xy(i,j,k) = Tr(m)%advection_xy(i,j,k) - (flux_y(i,m,J) - flux_y(i,m,J-1))* Idt * G%IareaT(i,j) + Tr(m)%advection_xy(i,j,k) = Tr(m)%advection_xy(i,j,k) - (flux_y(i,m,J) - flux_y(i,m,J-1))* Idt * & + G%IareaT(i,j) endif ; enddo endif - enddo endif ; enddo ! End of j-loop. - end subroutine advect_y !> Initialize lateral tracer advection module @@ -1057,8 +1139,8 @@ subroutine tracer_advect_init(Time, G, param_file, diag, CS) integer, save :: init_calls = 0 -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_tracer_advect" ! This module's name. character(len=256) :: mesg ! Message for error messages. diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 261d8d1315..098a647ec8 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -23,6 +23,7 @@ module MOM_tracer_hor_diff use MOM_neutral_diffusion, only : neutral_diffusion_CS use MOM_neutral_diffusion, only : neutral_diffusion_calc_coeffs, neutral_diffusion use MOM_tracer_registry, only : tracer_registry_type, tracer_type, MOM_tracer_chksum +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type @@ -94,7 +95,7 @@ module MOM_tracer_hor_diff !! using the diffusivity in CS%KhTr, or using space-dependent diffusivity. !! Multiple iterations are used (if necessary) so that there is no limit !! on the acceptable time increment. -subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_flag, read_khdt_x, read_khdt_y) +subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online_flag, read_khdt_x, read_khdt_y) type(ocean_grid_type), intent(inout) :: G !< Grid type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2] @@ -102,6 +103,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla type(MEKE_type), pointer :: MEKE !< MEKE type type(VarMix_CS), pointer :: VarMix !< Variable mixing type type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(tracer_hor_diff_CS), pointer :: CS !< module control structure type(tracer_registry_type), pointer :: Reg !< registered tracers type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available @@ -123,25 +125,25 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla real, dimension(SZI_(G),SZJ_(G)) :: & Ihdxdy, & ! The inverse of the volume or mass of fluid in a layer in a - ! grid cell [H-1 m-2 ~> m-3 or kg-1]. - Kh_h, & ! The tracer diffusivity averaged to tracer points [m2 s-1]. + ! grid cell [H-1 L-2 ~> m-3 or kg-1]. + Kh_h, & ! The tracer diffusivity averaged to tracer points [L2 T-1 ~> m2 s-1]. CFL, & ! A diffusive CFL number for each cell [nondim]. dTr ! The change in a tracer's concentration, in units of concentration [Conc]. real, dimension(SZIB_(G),SZJ_(G)) :: & khdt_x, & ! The value of Khtr*dt times the open face width divided by - ! the distance between adjacent tracer points [m2]. + ! the distance between adjacent tracer points [L2 ~> m2]. Coef_x, & ! The coefficients relating zonal tracer differences - ! to time-integrated fluxes [H m2 ~> m3 or kg]. - Kh_u ! Tracer mixing coefficient at u-points [m2 s-1]. + ! to time-integrated fluxes [H L2 ~> m3 or kg]. + Kh_u ! Tracer mixing coefficient at u-points [L2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJB_(G)) :: & khdt_y, & ! The value of Khtr*dt times the open face width divided by - ! the distance between adjacent tracer points [m2]. + ! the distance between adjacent tracer points [L2]. Coef_y, & ! The coefficients relating meridional tracer differences - ! to time-integrated fluxes [H m2 ~> m3 or kg]. - Kh_v ! Tracer mixing coefficient at u-points [m2 s-1]. + ! to time-integrated fluxes [H L2 ~> m3 or kg]. + Kh_v ! Tracer mixing coefficient at u-points [L2 T-1 ~> m2 s-1]. - real :: khdt_max ! The local limiting value of khdt_x or khdt_y [m2]. + real :: khdt_max ! The local limiting value of khdt_x or khdt_y [L2 ~> m2]. real :: max_CFL ! The global maximum of the diffusive CFL number. logical :: use_VarMix, Resoln_scaled, do_online, use_Eady integer :: S_idx, T_idx ! Indices for temperature and salinity if needed @@ -152,7 +154,8 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla real :: Idt ! The inverse of the time step [s-1]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. - real :: Kh_loc ! The local value of Kh [m2 s-1]. + real :: Kh_loc ! The local value of Kh [L2 T-1 ~> m2 s-1]. + real :: dt_in_T ! The timestep [T ~> s] real :: Res_Fn ! The local value of the resolution function [nondim]. real :: Rd_dx ! The local value of deformation radius over grid-spacing [nondim]. real :: normalize ! normalization used for diagnostic Kh_h; diffusivity averaged to h-points. @@ -173,6 +176,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla call cpu_clock_begin(id_clock_diffuse) ntr = Reg%ntr + dt_in_T = US%s_to_T*dt Idt = 1.0/dt h_neglect = GV%H_subroundoff @@ -210,14 +214,14 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla Kh_loc = CS%KhTr if (use_Eady) Kh_loc = Kh_loc + CS%KhTr_Slope_Cff*VarMix%L2u(I,j)*VarMix%SN_u(I,j) if (associated(MEKE%Kh)) & - Kh_Loc = Kh_Loc + MEKE%KhTr_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i+1,j)) + Kh_loc = Kh_loc + MEKE%KhTr_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i+1,j)) if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) if (Resoln_scaled) & - Kh_Loc = Kh_Loc * 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i+1,j)) + Kh_loc = Kh_loc * 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i+1,j)) Kh_u(I,j) = max(Kh_loc, CS%KhTr_min) if (CS%KhTr_passivity_coeff>0.) then ! Apply passivity Rd_dx=0.5*( VarMix%Rd_dx_h(i,j)+VarMix%Rd_dx_h(i+1,j) ) ! Rd/dx at u-points - Kh_loc=Kh_u(I,j)*max( CS%KhTr_passivity_min, CS%KhTr_passivity_coeff*Rd_dx ) + Kh_loc = Kh_u(I,j)*max( CS%KhTr_passivity_min, CS%KhTr_passivity_coeff*Rd_dx ) if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) ! Re-apply max Kh_u(I,j) = max(Kh_loc, CS%KhTr_min) ! Re-apply min endif @@ -227,14 +231,14 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla Kh_loc = CS%KhTr if (use_Eady) Kh_loc = Kh_loc + CS%KhTr_Slope_Cff*VarMix%L2v(i,J)*VarMix%SN_v(i,J) if (associated(MEKE%Kh)) & - Kh_Loc = Kh_Loc + MEKE%KhTr_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i,j+1)) + Kh_loc = Kh_loc + MEKE%KhTr_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i,j+1)) if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) if (Resoln_scaled) & - Kh_Loc = Kh_Loc * 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i,j+1)) + Kh_loc = Kh_loc * 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i,j+1)) Kh_v(i,J) = max(Kh_loc, CS%KhTr_min) if (CS%KhTr_passivity_coeff>0.) then ! Apply passivity - Rd_dx=0.5*( VarMix%Rd_dx_h(i,j)+VarMix%Rd_dx_h(i,j+1) ) ! Rd/dx at v-points - Kh_loc=Kh_v(I,j)*max( CS%KhTr_passivity_min, CS%KhTr_passivity_coeff*Rd_dx ) + Rd_dx = 0.5*( VarMix%Rd_dx_h(i,j)+VarMix%Rd_dx_h(i,j+1) ) ! Rd/dx at v-points + Kh_loc = Kh_v(i,J)*max( CS%KhTr_passivity_min, CS%KhTr_passivity_coeff*Rd_dx ) if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) ! Re-apply max Kh_v(i,J) = max(Kh_loc, CS%KhTr_min) ! Re-apply min endif @@ -242,48 +246,48 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - khdt_x(I,j) = dt*(Kh_u(I,j)*(G%dy_Cu(I,j)*G%IdxCu(I,j))) + khdt_x(I,j) = dt_in_T*(Kh_u(I,j)*(G%dy_Cu(I,j)*G%IdxCu(I,j))) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - khdt_y(i,J) = dt*(Kh_v(i,J)*(G%dx_Cv(i,J)*G%IdyCv(i,J))) + khdt_y(i,J) = dt_in_T*(Kh_v(i,J)*(G%dx_Cv(i,J)*G%IdyCv(i,J))) enddo ; enddo elseif (Resoln_scaled) then !$OMP parallel do default(shared) private(Res_fn) do j=js,je ; do I=is-1,ie Res_fn = 0.5 * (VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i+1,j)) Kh_u(I,j) = max(CS%KhTr * Res_fn, CS%KhTr_min) - khdt_x(I,j) = dt*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) * Res_fn + khdt_x(I,j) = dt_in_T*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) * Res_fn enddo ; enddo !$OMP parallel do default(shared) private(Res_fn) do J=js-1,je ; do i=is,ie Res_fn = 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i,j+1)) Kh_v(i,J) = max(CS%KhTr * Res_fn, CS%KhTr_min) - khdt_y(i,J) = dt*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) * Res_fn + khdt_y(i,J) = dt_in_T*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) * Res_fn enddo ; enddo else ! Use a simple constant diffusivity. if (CS%id_KhTr_u > 0) then !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie Kh_u(I,j) = CS%KhTr - khdt_x(I,j) = dt*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) + khdt_x(I,j) = dt_in_T*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) enddo ; enddo else !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - khdt_x(I,j) = dt*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) + khdt_x(I,j) = dt_in_T*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) enddo ; enddo endif if (CS%id_KhTr_v > 0) then !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie Kh_v(i,J) = CS%KhTr - khdt_y(i,J) = dt*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) + khdt_y(i,J) = dt_in_T*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) enddo ; enddo else !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - khdt_y(i,J) = dt*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) + khdt_y(i,J) = dt_in_T*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) enddo ; enddo endif endif ! VarMix @@ -296,7 +300,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla if (khdt_x(I,j) > khdt_max) then khdt_x(I,j) = khdt_max if (dt*(G%dy_Cu(I,j)*G%IdxCu(I,j)) > 0.0) & - Kh_u(I,j) = khdt_x(I,j) / (dt*(G%dy_Cu(I,j)*G%IdxCu(I,j))) + Kh_u(I,j) = khdt_x(I,j) / (dt_in_T*(G%dy_Cu(I,j)*G%IdxCu(I,j))) endif enddo ; enddo else @@ -313,7 +317,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla if (khdt_y(i,J) > khdt_max) then khdt_y(i,J) = khdt_max if (dt*(G%dx_Cv(i,J)*G%IdyCv(i,J)) > 0.0) & - Kh_v(i,J) = khdt_y(i,J) / (dt*(G%dx_Cv(i,J)*G%IdyCv(i,J))) + Kh_v(i,J) = khdt_y(i,J) / (dt_in_T*(G%dx_Cv(i,J)*G%IdyCv(i,J))) endif enddo ; enddo else @@ -328,13 +332,13 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla else ! .not. do_online !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - khdt_x(I,j) = read_khdt_x(I,j) + khdt_x(I,j) = US%m_to_L**2*read_khdt_x(I,j) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - khdt_y(i,J) = read_khdt_y(i,J) + khdt_y(i,J) = US%m_to_L**2*read_khdt_y(i,J) enddo ; enddo - call pass_vector(khdt_x,khdt_y,G%Domain) + call pass_vector(khdt_x, khdt_y, G%Domain) endif ! do_online if (CS%check_diffusive_CFL) then @@ -401,7 +405,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla if (itt>1) then ! Update halos for subsequent iterations call do_group_pass(CS%pass_t, G%Domain, clock=id_clock_pass) endif - call neutral_diffusion(G, GV, h, Coef_x, Coef_y, I_numitts*dt, Reg, CS%neutral_diffusion_CSp) + call neutral_diffusion(G, GV, h, Coef_x, Coef_y, I_numitts*dt, Reg, US, CS%neutral_diffusion_CSp) enddo ! itt else ! following if not using neutral diffusion, but instead along-surface diffusion @@ -445,19 +449,19 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla Coef_y(i,J) * (Reg%Tr(m)%t(i,j,k) - Reg%Tr(m)%t(i,j+1,k)))) enddo ; enddo if (associated(Reg%Tr(m)%df_x)) then ; do j=js,je ; do I=G%IscB,G%IecB - Reg%Tr(m)%df_x(I,j,k) = Reg%Tr(m)%df_x(I,j,k) + Coef_x(I,j) * & + Reg%Tr(m)%df_x(I,j,k) = Reg%Tr(m)%df_x(I,j,k) + US%L_to_m**2*Coef_x(I,j) * & (Reg%Tr(m)%t(i,j,k) - Reg%Tr(m)%t(i+1,j,k))*Idt enddo ; enddo ; endif if (associated(Reg%Tr(m)%df_y)) then ; do J=G%JscB,G%JecB ; do i=is,ie - Reg%Tr(m)%df_y(i,J,k) = Reg%Tr(m)%df_y(i,J,k) + Coef_y(i,J) * & + Reg%Tr(m)%df_y(i,J,k) = Reg%Tr(m)%df_y(i,J,k) + US%L_to_m**2*Coef_y(i,J) * & (Reg%Tr(m)%t(i,j,k) - Reg%Tr(m)%t(i,j+1,k))*Idt enddo ; enddo ; endif if (associated(Reg%Tr(m)%df2d_x)) then ; do j=js,je ; do I=G%IscB,G%IecB - Reg%Tr(m)%df2d_x(I,j) = Reg%Tr(m)%df2d_x(I,j) + Coef_x(I,j) * & + Reg%Tr(m)%df2d_x(I,j) = Reg%Tr(m)%df2d_x(I,j) + US%L_to_m**2*Coef_x(I,j) * & (Reg%Tr(m)%t(i,j,k) - Reg%Tr(m)%t(i+1,j,k))*Idt enddo ; enddo ; endif if (associated(Reg%Tr(m)%df2d_y)) then ; do J=G%JscB,G%JecB ; do i=is,ie - Reg%Tr(m)%df2d_y(i,J) = Reg%Tr(m)%df2d_y(i,J) + Coef_y(i,J) * & + Reg%Tr(m)%df2d_y(i,J) = Reg%Tr(m)%df2d_y(i,J) + US%L_to_m**2*Coef_y(i,J) * & (Reg%Tr(m)%t(i,j,k) - Reg%Tr(m)%t(i,j+1,k))*Idt enddo ; enddo ; endif do j=js,je ; do i=is,ie @@ -518,10 +522,10 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla if (CS%debug) then call uvchksum("After tracer diffusion khdt_[xy]", khdt_x, khdt_y, & - G%HI, haloshift=0, symmetric=.true.) + G%HI, haloshift=0, symmetric=.true., scale=US%L_to_m**2) if (CS%use_neutral_diffusion) then call uvchksum("After tracer diffusion Coef_[xy]", Coef_x, Coef_y, & - G%HI, haloshift=0, symmetric=.true.) + G%HI, haloshift=0, symmetric=.true., scale=US%L_to_m**2) endif endif @@ -544,8 +548,12 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & real, intent(in) :: dt !< time step type(tracer_type), intent(inout) :: Tr(:) !< tracer array integer, intent(in) :: ntr !< number of tracers - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: khdt_epi_x !< needs a comment - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: khdt_epi_y !< needs a comment + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: khdt_epi_x !< Zonal epipycnal diffusivity times + !! a time step and the ratio of the open face width over + !! the distance between adjacent tracer points [L2 ~> m2] + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: khdt_epi_y !< Meridional epipycnal diffusivity times + !! a time step and the ratio of the open face width over + !! the distance between adjacent tracer points [L2 ~> m2] type(tracer_hor_diff_CS), intent(inout) :: CS !< module control structure type(thermo_var_ptrs), intent(in) :: tv !< thermodynamic structure integer, intent(in) :: num_itts !< number of iterations (usually=1) @@ -574,7 +582,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & k0b_Rv, k0a_Rv ! in each pair of mixing at v-faces. real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: & - tr_flux_conv ! The flux convergence of tracers [conc H m2 ~> conc m3 or conc kg] + tr_flux_conv ! The flux convergence of tracers [conc H L2 ~> conc m3 or conc kg] real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: Tr_flux_3d, Tr_adj_vert_L, Tr_adj_vert_R real, dimension(SZI_(G), SZK_(G), SZJ_(G)) :: & @@ -618,12 +626,12 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & real :: Tr_Ra, Tr_Rb ! associated with a pairing [Conc] real :: Tr_av_L ! The average tracer concentrations on the left and right real :: Tr_av_R ! sides of a pairing [Conc]. - real :: Tr_flux ! The tracer flux from left to right in a pair [conc H m2 ~> conc m3 or conc kg]. + real :: Tr_flux ! The tracer flux from left to right in a pair [conc H L2 ~> conc m3 or conc kg]. real :: Tr_adj_vert ! A downward vertical adjustment to Tr_flux between the - ! two cells that make up one side of the pairing [conc H m2 ~> conc m3 or conc kg]. + ! two cells that make up one side of the pairing [conc H L2 ~> conc m3 or conc kg]. real :: h_L, h_R ! Thicknesses to the left and right [H ~> m or kg m-2]. real :: wt_a, wt_b ! Fractional weights of layers above and below [nondim]. - real :: vol ! A cell volume or mass [H m2 ~> m3 or kg]. + real :: vol ! A cell volume or mass [H L2 ~> m3 or kg]. logical, dimension(SZK_(G)) :: & left_set, & ! If true, the left or right point determines the density of right_set ! of the trio. If densities are exactly equal, both are true. @@ -1334,7 +1342,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & tr_flux_conv(i,j,kLb) = tr_flux_conv(i,j,kLb) - (wt_b*Tr_flux_3d(i,j,k) - Tr_adj_vert_L(i,j,k)) endif if (deep_wt_Rv(J)%p(i,k) >= 1.0) then - tr_flux_conv(i,j+1,kRb) = tr_flux_conv(i,j+1,kRb) + tr_flux_3d(i,j,k) + tr_flux_conv(i,j+1,kRb) = tr_flux_conv(i,j+1,kRb) + Tr_flux_3d(i,j,k) else kRa = k0a_Rv(J)%p(i,k) wt_b = deep_wt_Rv(J)%p(i,k) ; wt_a = 1.0 - wt_b @@ -1375,9 +1383,10 @@ end subroutine tracer_epipycnal_ML_diff !> Initialize lateral tracer diffusion module -subroutine tracer_hor_diff_init(Time, G, param_file, diag, EOS, CS) +subroutine tracer_hor_diff_init(Time, G, US, param_file, diag, EOS, CS) type(time_type), target, intent(in) :: Time !< current model time type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(diag_ctrl), target, intent(inout) :: diag !< diagnostic control type(EOS_type), target, intent(in) :: EOS !< Equation of state CS type(param_file_type), intent(in) :: param_file !< parameter file @@ -1401,7 +1410,7 @@ subroutine tracer_hor_diff_init(Time, G, param_file, diag, EOS, CS) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "KHTR", CS%KhTr, & "The background along-isopycnal tracer diffusivity.", & - units="m2 s-1", default=0.0) + units="m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s) call get_param(param_file, mdl, "KHTR_SLOPE_CFF", CS%KhTr_Slope_Cff, & "The scaling coefficient for along-isopycnal tracer "//& "diffusivity using a shear-based (Visbeck-like) "//& @@ -1409,10 +1418,10 @@ subroutine tracer_hor_diff_init(Time, G, param_file, diag, EOS, CS) units="nondim", default=0.0) call get_param(param_file, mdl, "KHTR_MIN", CS%KhTr_Min, & "The minimum along-isopycnal tracer diffusivity.", & - units="m2 s-1", default=0.0) + units="m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s) call get_param(param_file, mdl, "KHTR_MAX", CS%KhTr_Max, & "The maximum along-isopycnal tracer diffusivity.", & - units="m2 s-1", default=0.0) + units="m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s) call get_param(param_file, mdl, "KHTR_PASSIVITY_COEFF", CS%KhTr_passivity_coeff, & "The coefficient that scales deformation radius over "//& "grid-spacing in passivity, where passivity is the ratio "//& @@ -1463,19 +1472,19 @@ subroutine tracer_hor_diff_init(Time, G, param_file, diag, EOS, CS) CS%id_CFL = -1 CS%id_KhTr_u = register_diag_field('ocean_model', 'KHTR_u', diag%axesCu1, Time, & - 'Epipycnal tracer diffusivity at zonal faces of tracer cell', 'm2 s-1') + 'Epipycnal tracer diffusivity at zonal faces of tracer cell', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_KhTr_v = register_diag_field('ocean_model', 'KHTR_v', diag%axesCv1, Time, & - 'Epipycnal tracer diffusivity at meridional faces of tracer cell', 'm2 s-1') - CS%id_KhTr_h = register_diag_field('ocean_model', 'KHTR_h', diag%axesT1, Time,& - 'Epipycnal tracer diffusivity at tracer cell center', 'm2 s-1', & + 'Epipycnal tracer diffusivity at meridional faces of tracer cell', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) + CS%id_KhTr_h = register_diag_field('ocean_model', 'KHTR_h', diag%axesT1, Time, & + 'Epipycnal tracer diffusivity at tracer cell center', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T, & cmor_field_name='diftrelo', & cmor_standard_name= 'ocean_tracer_epineutral_laplacian_diffusivity', & cmor_long_name = 'Ocean Tracer Epineutral Laplacian Diffusivity') CS%id_khdt_x = register_diag_field('ocean_model', 'KHDT_x', diag%axesCu1, Time, & - 'Epipycnal tracer diffusivity operator at zonal faces of tracer cell', 'm2') + 'Epipycnal tracer diffusivity operator at zonal faces of tracer cell', 'm2', conversion=US%L_to_m**2) CS%id_khdt_y = register_diag_field('ocean_model', 'KHDT_y', diag%axesCv1, Time, & - 'Epipycnal tracer diffusivity operator at meridional faces of tracer cell', 'm2') + 'Epipycnal tracer diffusivity operator at meridional faces of tracer cell', 'm2', conversion=US%L_to_m**2) if (CS%check_diffusive_CFL) then CS%id_CFL = register_diag_field('ocean_model', 'CFL_lateral_diff', diag%axesT1, Time,& 'Grid CFL number for lateral/neutral tracer diffusion', 'nondim') diff --git a/src/tracer/MOM_tracer_registry.F90 b/src/tracer/MOM_tracer_registry.F90 index cbaf18d983..4680c058b4 100644 --- a/src/tracer/MOM_tracer_registry.F90 +++ b/src/tracer/MOM_tracer_registry.F90 @@ -738,7 +738,7 @@ subroutine MOM_tracer_chkinv(mesg, G, h, Tr, ntr) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke do m=1,ntr do k=1,nz ; do j=js,je ; do i=is,ie - tr_inv(i,j,k) = Tr(m)%t(i,j,k)*h(i,j,k)*G%areaT(i,j)*G%mask2dT(i,j) + tr_inv(i,j,k) = Tr(m)%t(i,j,k)*h(i,j,k)*G%US%L_to_m**2*G%areaT(i,j)*G%mask2dT(i,j) enddo ; enddo ; enddo total_inv = reproducing_sum(tr_inv, is+(1-G%isd), ie+(1-G%isd), js+(1-G%jsd), je+(1-G%jsd)) if (is_root_pe()) write(0,'(A,1X,A5,1X,ES25.16,1X,A)') "h-point: inventory", Tr(m)%name, total_inv, mesg diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90 index 4db1e9dacd..12fd1e08a1 100644 --- a/src/tracer/advection_test_tracer.F90 +++ b/src/tracer/advection_test_tracer.F90 @@ -381,7 +381,7 @@ function advection_test_stock(h, stocks, G, GV, CS, names, units, stock_index) stocks(m) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie stocks(m) = stocks(m) + CS%tr(i,j,k,m) * & - (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) + (G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k)) enddo ; enddo ; enddo stocks(m) = GV%H_to_kg_m2 * stocks(m) enddo diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index 946a5f981f..e712686521 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -320,7 +320,7 @@ function boundary_impulse_stock(h, stocks, G, GV, CS, names, units, stock_index) stocks(m) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie stocks(m) = stocks(m) + CS%tr(i,j,k,m) * & - (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) + (G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k)) enddo ; enddo ; enddo stocks(m) = GV%H_to_kg_m2 * stocks(m) enddo diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index 39e250da65..92f8491a49 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -360,7 +360,7 @@ function dye_stock(h, stocks, G, GV, CS, names, units, stock_index) stocks(m) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie stocks(m) = stocks(m) + CS%tr(i,j,k,m) * & - (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) + (G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k)) enddo ; enddo ; enddo stocks(m) = GV%H_to_kg_m2 * stocks(m) enddo diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90 index d59fddbcba..35975bccb0 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -407,7 +407,7 @@ function ideal_age_stock(h, stocks, G, GV, CS, names, units, stock_index) stocks(m) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie stocks(m) = stocks(m) + CS%tr(i,j,k,m) * & - (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) + (G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k)) enddo ; enddo ; enddo stocks(m) = GV%H_to_kg_m2 * stocks(m) enddo diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index 7730b8f12e..09fab89b70 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -384,7 +384,7 @@ subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS if (k>0) then k=min(k,k_max) ! Only insert k or first layer with interface 10 m above bottom CS%tr(i,j,k,m) = CS%tr(i,j,k,m) + CS%oil_source_rate*dt / & - ((h_new(i,j,k)+GV%H_subroundoff) * G%areaT(i,j) ) + ((h_new(i,j,k)+GV%H_subroundoff) * G%US%L_to_m**2*G%areaT(i,j) ) elseif (k<0) then h_total=GV%H_subroundoff do k=1, nz @@ -392,7 +392,7 @@ subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS enddo do k=1, nz CS%tr(i,j,k,m) = CS%tr(i,j,k,m) + CS%oil_source_rate*dt/(h_total & - * G%areaT(i,j) ) + * G%US%L_to_m**2*G%areaT(i,j) ) enddo endif enddo @@ -441,7 +441,7 @@ function oil_stock(h, stocks, G, GV, CS, names, units, stock_index) stocks(m) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie stocks(m) = stocks(m) + CS%tr(i,j,k,m) * & - (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) + (G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k)) enddo ; enddo ; enddo stocks(m) = GV%H_to_kg_m2 * stocks(m) enddo diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90 index ea3ccb8928..af4c1e9659 100644 --- a/src/tracer/pseudo_salt_tracer.F90 +++ b/src/tracer/pseudo_salt_tracer.F90 @@ -286,7 +286,7 @@ function pseudo_salt_stock(h, stocks, G, GV, CS, names, units, stock_index) stocks(1) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie stocks(1) = stocks(1) + CS%diff(i,j,k) * & - (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) + (G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k)) enddo ; enddo ; enddo stocks(1) = GV%H_to_kg_m2 * stocks(1) diff --git a/src/tracer/tracer_example.F90 b/src/tracer/tracer_example.F90 index 9b36254206..aa9d34c4e1 100644 --- a/src/tracer/tracer_example.F90 +++ b/src/tracer/tracer_example.F90 @@ -393,7 +393,7 @@ function USER_tracer_stock(h, stocks, G, GV, CS, names, units, stock_index) stocks(m) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie stocks(m) = stocks(m) + CS%tr(i,j,k,m) * & - (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) + (G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k)) enddo ; enddo ; enddo stocks(m) = GV%H_to_kg_m2 * stocks(m) enddo diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index a9a5be3d42..ddffbab1be 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -471,7 +471,7 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) z = -G%bathyT(i,j) do k = nz,1,-1 z = z + 0.5 * GV%H_to_Z * h(i,j,k) ! Position of the center of layer k - S(i,j,k) = 34.0 - 1.0 * (z/G%max_depth) + S(i,j,k) = 34.0 - 1.0 * (z / (G%max_depth)) if ( ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon < dome2d_west_sponge_width ) & S(i,j,k) = S_ref + S_range z = z + 0.5 * GV%H_to_Z * h(i,j,k) ! Position of the interface k diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 73d2f7905b..7a2a6bfd90 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -269,7 +269,7 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) ! inner edge of the inflow. real :: g_prime_tot ! The reduced gravity across all layers [L2 Z-1 T-2 ~> m s-2]. real :: Def_Rad ! The deformation radius, based on fluid of - ! thickness D_edge, in the same units as lat. + ! thickness D_edge, in the same units as lat [m]. real :: Ri_trans ! The shear Richardson number in the transition ! region of the specified shear profile. character(len=40) :: mdl = "DOME_set_OBC_data" ! This subroutine's name. @@ -292,7 +292,7 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) g_prime_tot = (GV%g_Earth / GV%Rho0)*2.0 Def_Rad = US%L_to_m*sqrt(D_edge*g_prime_tot) / (1.0e-4*US%T_to_s * 1000.0) - tr_0 = (-D_edge*sqrt(D_edge*g_prime_tot)*0.5e3*US%s_to_T*US%L_to_m*Def_Rad) * GV%Z_to_H + tr_0 = (-D_edge*sqrt(D_edge*g_prime_tot)*0.5e3*US%m_to_L*Def_Rad) * GV%Z_to_H if (OBC%number_of_segments /= 1) then call MOM_error(WARNING, 'Error in DOME OBC segment setup', .true.) @@ -317,7 +317,7 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) y2 = (2.0*Ri_trans*rsb + Ri_trans + 2.0)/(2.0 - Ri_trans) tr_k = tr_0 * (2.0/(Ri_trans*(2.0-Ri_trans))) * & ((log(y1)+1.0)/y1 - (log(y2)+1.0)/y2) - v_k = -US%L_T_to_m_s*sqrt(D_edge*g_prime_tot)*log((2.0 + Ri_trans*(1.0 + 2.0*rc)) / & + v_k = -sqrt(D_edge*g_prime_tot)*log((2.0 + Ri_trans*(1.0 + 2.0*rc)) / & (2.0 - Ri_trans)) if (k == nz) tr_k = tr_k + tr_0 * (2.0/(Ri_trans*(2.0+Ri_trans))) * & log((2.0+Ri_trans)/(2.0-Ri_trans)) diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index 60fd96d900..c211341493 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -256,7 +256,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) cff = sqrt(GV%g_Earth * 0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j))) val2 = fac * exp(- US%T_to_s*CS%F_0 * US%m_to_L*y / cff) segment%eta(I,j) = val2 * cos(omega * time_sec) - segment%normal_vel_bt(I,j) = US%L_T_to_m_s * (val2 * (val1 * cff * cosa / & + segment%normal_vel_bt(I,j) = (val2 * (val1 * cff * cosa / & (0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j)))) ) else ! Not rotated yet @@ -264,17 +264,16 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) segment%normal_vel_bt(I,j) = 0.0 if (segment%nudged) then do k=1,nz - segment%nudged_normal_vel(I,j,k) = fac * lambda / CS%F_0 * & + segment%nudged_normal_vel(I,j,k) = US%m_s_to_L_T * fac * lambda / CS%F_0 * & exp(- lambda * y) * cos(PI * CS%mode * (k - 0.5) / nz) * & cos(omega * time_sec) enddo elseif (segment%specified) then do k=1,nz - segment%normal_vel(I,j,k) = fac * lambda / CS%F_0 * & + segment%normal_vel(I,j,k) = US%m_s_to_L_T * fac * lambda / CS%F_0 * & exp(- lambda * y) * cos(PI * CS%mode * (k - 0.5) / nz) * & cos(omega * time_sec) - segment%normal_trans(I,j,k) = segment%normal_vel(I,j,k) * & - h(i+1,j,k) * G%dyCu(I,j) + segment%normal_trans(I,j,k) = segment%normal_vel(I,j,k) * h(i+1,j,k) * G%dyCu(I,j) enddo endif endif @@ -288,14 +287,14 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) if (CS%answers_2018) then ! Problem: val2 & cff could be functions of space, but are not set in this loop. if (CS%mode == 0) then ; do k=1,nz - segment%tangential_vel(I,J,k) = US%L_T_to_m_s * (val2 * (val1 * cff * sina / & + segment%tangential_vel(I,J,k) = (val2 * (val1 * cff * sina / & (0.25 * (G%bathyT(i+1,j) + G%bathyT(i,j) + G%bathyT(i+1,j+1) + G%bathyT(i,j+1))) )) enddo ; endif else cff =sqrt(GV%g_Earth * 0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j))) val2 = fac * exp(- US%T_to_s*CS%F_0 * US%m_to_L*y / cff) if (CS%mode == 0) then ; do k=1,nz - segment%tangential_vel(I,J,k) = US%L_T_to_m_s * (val1 * val2 * cff * sina) / & + segment%tangential_vel(I,J,k) = (val1 * val2 * cff * sina) / & ( 0.25*((G%bathyT(i,j) + G%bathyT(i+1,j+1)) + (G%bathyT(i+1,j) + G%bathyT(i,j+1))) ) enddo ; endif @@ -322,15 +321,14 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) segment%normal_vel_bt(i,J) = 0.0 if (segment%nudged) then do k=1,nz - segment%nudged_normal_vel(i,J,k) = fac * lambda / CS%F_0 * & + segment%nudged_normal_vel(i,J,k) = US%m_s_to_L_T*fac * lambda / CS%F_0 * & exp(- lambda * y) * cos(PI * CS%mode * (k - 0.5) / nz) * cosa enddo elseif (segment%specified) then do k=1,nz - segment%normal_vel(i,J,k) = fac * lambda / CS%F_0 * & + segment%normal_vel(i,J,k) = US%m_s_to_L_T*fac * lambda / CS%F_0 * & exp(- lambda * y) * cos(PI * CS%mode * (k - 0.5) / nz) * cosa - segment%normal_trans(i,J,k) = segment%normal_vel(i,J,k) * & - h(i,j+1,k) * G%dxCv(i,J) + segment%normal_trans(i,J,k) = segment%normal_vel(i,J,k) * h(i,j+1,k) * G%dxCv(i,J) enddo endif endif @@ -344,14 +342,14 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) if (CS%answers_2018) then ! Problem: val2 & cff could be functions of space, but are not set in this loop. if (CS%mode == 0) then ; do k=1,nz - segment%tangential_vel(I,J,k) = US%L_T_to_m_s * (val2 * (val1 * cff * sina / & + segment%tangential_vel(I,J,k) = (val2 * (val1 * cff * sina / & (0.25*(G%bathyT(i+1,j) + G%bathyT(i,j) + G%bathyT(i+1,j+1) + G%bathyT(i,j+1))))) enddo ; endif else cff = sqrt(GV%g_Earth * 0.5 * (G%bathyT(i,j+1) + G%bathyT(i,j))) val2 = fac * exp(- 0.5 * (G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) * US%m_to_L*y / cff) if (CS%mode == 0) then ; do k=1,nz - segment%tangential_vel(I,J,k) = US%L_T_to_m_s * ((val1 * val2 * cff * sina) / & + segment%tangential_vel(I,J,k) = ((val1 * val2 * cff * sina) / & ( 0.25*((G%bathyT(i,j) + G%bathyT(i+1,j+1)) + (G%bathyT(i+1,j) + G%bathyT(i,j+1))) )) enddo ; endif endif diff --git a/src/user/MOM_controlled_forcing.F90 b/src/user/MOM_controlled_forcing.F90 index 3ba4f0c376..cbfce62f39 100644 --- a/src/user/MOM_controlled_forcing.F90 +++ b/src/user/MOM_controlled_forcing.F90 @@ -20,6 +20,7 @@ module MOM_controlled_forcing use MOM_time_manager, only : time_type, operator(+), operator(/), operator(-) use MOM_time_manager, only : get_date, set_date use MOM_time_manager, only : time_type_to_real, real_to_time +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface implicit none ; private @@ -78,7 +79,7 @@ module MOM_controlled_forcing !> This subroutine calls any of the other subroutines in this file !! that are needed to specify the current surface forcing fields. subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_precip, & - day_start, dt, G, CS) + day_start, dt, G, US, CS) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: SST_anom !< The sea surface temperature !! anomalies [degC]. @@ -96,6 +97,7 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec type(time_type), intent(in) :: day_start !< Start time of the fluxes. real, intent(in) :: dt !< Length of time over which these !! fluxes will be applied [s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(ctrl_forcing_CS), pointer :: CS !< A pointer to the control structure !! returned by a previous call to !! ctrl_forcing_init. @@ -146,12 +148,12 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec do j=js,je ; do i=is,ie CS%heat_0(i,j) = CS%heat_0(i,j) + dt_heat_rate * ( & -CS%lam_heat*G%mask2dT(i,j)*SST_anom(i,j) + & - (G%IareaT(i,j) * ((flux_heat_x(I-1,j) - flux_heat_x(I,j)) + & + (US%m_to_L**2*G%IareaT(i,j) * ((flux_heat_x(I-1,j) - flux_heat_x(I,j)) + & (flux_heat_y(i,J-1) - flux_heat_y(i,J))) ) ) CS%precip_0(i,j) = CS%precip_0(i,j) + dt_prec_rate * ( & CS%lam_prec * G%mask2dT(i,j)*(SSS_anom(i,j) / SSS_mean(i,j)) + & - (G%IareaT(i,j) * ((flux_prec_x(I-1,j) - flux_prec_x(I,j)) + & + (US%m_to_L**2*G%IareaT(i,j) * ((flux_prec_x(I-1,j) - flux_prec_x(I,j)) + & (flux_prec_y(i,J-1) - flux_prec_y(i,J))) ) ) virt_heat(i,j) = virt_heat(i,j) + CS%heat_0(i,j) @@ -330,13 +332,13 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec do j=js,je ; do i=is,ie CS%heat_cyc(i,j,m_u1) = CS%heat_cyc(i,j,m_u1) + dt1_heat_rate * ( & -CS%lam_cyc_heat*(CS%avg_SST_anom(i,j,m_u2) - CS%avg_SST_anom(i,j,m_u1)) + & - (G%IareaT(i,j) * ((flux_heat_x(I-1,j) - flux_heat_x(I,j)) + & + (US%m_to_L**2*G%IareaT(i,j) * ((flux_heat_x(I-1,j) - flux_heat_x(I,j)) + & (flux_heat_y(i,J-1) - flux_heat_y(i,J))) ) ) CS%precip_cyc(i,j,m_u1) = CS%precip_cyc(i,j,m_u1) + dt1_prec_rate * ( & CS%lam_cyc_prec * (CS%avg_SSS_anom(i,j,m_u2) - CS%avg_SSS_anom(i,j,m_u1)) / & (0.5*(CS%avg_SSS(i,j,m_u2) + CS%avg_SSS(i,j,m_u1))) + & - (G%IareaT(i,j) * ((flux_prec_x(I-1,j) - flux_prec_x(I,j)) + & + (US%m_to_L**2*G%IareaT(i,j) * ((flux_prec_x(I-1,j) - flux_prec_x(I,j)) + & (flux_prec_y(i,J-1) - flux_prec_y(i,J))) ) ) enddo ; enddo endif @@ -355,13 +357,13 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec do j=js,je ; do i=is,ie CS%heat_cyc(i,j,m_u2) = CS%heat_cyc(i,j,m_u2) + dt1_heat_rate * ( & -CS%lam_cyc_heat*(CS%avg_SST_anom(i,j,m_u3) - CS%avg_SST_anom(i,j,m_u2)) + & - (G%IareaT(i,j) * ((flux_heat_x(I-1,j) - flux_heat_x(I,j)) + & + (US%m_to_L**2*G%IareaT(i,j) * ((flux_heat_x(I-1,j) - flux_heat_x(I,j)) + & (flux_heat_y(i,J-1) - flux_heat_y(i,J))) ) ) CS%precip_cyc(i,j,m_u2) = CS%precip_cyc(i,j,m_u2) + dt1_prec_rate * ( & CS%lam_cyc_prec * (CS%avg_SSS_anom(i,j,m_u3) - CS%avg_SSS_anom(i,j,m_u2)) / & (0.5*(CS%avg_SSS(i,j,m_u3) + CS%avg_SSS(i,j,m_u2))) + & - (G%IareaT(i,j) * ((flux_prec_x(I-1,j) - flux_prec_x(I,j)) + & + (US%m_to_L**2*G%IareaT(i,j) * ((flux_prec_x(I-1,j) - flux_prec_x(I,j)) + & (flux_prec_y(i,J-1) - flux_prec_y(i,J))) ) ) enddo ; enddo endif diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index af17bb87a5..29e049c9b6 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -51,7 +51,7 @@ subroutine Phillips_initialize_thickness(h, G, GV, US, param_file, just_read_par real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface, positive upward [Z ~> m] real :: jet_width ! The width of the zonal-mean jet [km] real :: jet_height ! The interface height scale associated with the zonal-mean jet [Z ~> m] - real :: y_2 + real :: y_2 ! The y-position relative to the center of the domain [km] real :: half_strat ! The fractional depth where the stratification is centered [nondim] real :: half_depth ! The depth where the stratification is centered [Z ~> m] logical :: just_read ! If true, just read parameters but set nothing. @@ -120,18 +120,22 @@ end subroutine Phillips_initialize_thickness subroutine Phillips_initialize_velocity(u, v, G, GV, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & + intent(out) :: u !< i-component of velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & + intent(out) :: v !< j-component of velocity [L T-1 ~> m s-1] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: u !< i-component of velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: v !< j-component of velocity [m s-1] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for modelparameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. - real :: jet_width, jet_height, x_2, y_2 - real :: velocity_amplitude, pi + real :: jet_width ! The width of the zonal-mean jet [km] + real :: jet_height ! The interface height scale associated with the zonal-mean jet [Z ~> m] + real :: x_2 ! The x-position relative to the center of the domain [nondim] + real :: y_2 ! The y-position relative to the center of the domain [km] or [nondim] + real :: velocity_amplitude ! The amplitude of velocity perturbations [L T-1 ~> m s-1] + real :: pi ! The ratio of the circumference of a circle to its diameter [nondim] integer :: i, j, k, is, ie, js, je, nz, m logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: mdl = "Phillips_initialize_velocity" ! This subroutine's name. @@ -142,7 +146,7 @@ subroutine Phillips_initialize_velocity(u, v, G, GV, US, param_file, just_read_p if (.not.just_read) call log_version(param_file, mdl, version) call get_param(param_file, mdl, "VELOCITY_IC_PERTURB_AMP", velocity_amplitude, & "The magnitude of the initial velocity perturbation.", & - units="m s-1", default=0.001, do_not_log=just_read) + units="m s-1", default=0.001, scale=US%m_s_to_L_T, do_not_log=just_read) call get_param(param_file, mdl, "JET_WIDTH", jet_width, & "The width of the zonal-mean jet.", units="km", & fail_if_missing=.not.just_read, do_not_log=just_read) @@ -163,12 +167,12 @@ subroutine Phillips_initialize_velocity(u, v, G, GV, US, param_file, just_read_p y_2 = G%geoLatCu(I,j) - G%south_lat - 0.5*G%len_lat ! This uses d/d y_2 atan(y_2 / jet_width) ! u(I,j,k) = u(I,j,k+1) + (1e-3 * jet_height / & -! (jet_width * (1.0 + (y_2 / jet_width)**2))) * & -! (2.0 * US%L_to_m**2*US%s_to_T**2*GV%g_prime(K+1) * US%T_to_s / (G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1))) +! (US%m_to_L*jet_width * (1.0 + (y_2 / jet_width)**2))) * & +! (2.0 * GV%g_prime(K+1) / (G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1))) ! This uses d/d y_2 tanh(y_2 / jet_width) - u(I,j,k) = u(I,j,k+1) + (1e-3 * (jet_height / jet_width) * & + u(I,j,k) = u(I,j,k+1) + (1e-3 * (jet_height / (US%m_to_L*jet_width)) * & (sech(y_2 / jet_width))**2 ) * & - (2.0 * US%L_to_m**2*US%s_to_T**2*GV%g_prime(K+1) * US%T_to_s / (G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1))) + (2.0 * GV%g_prime(K+1) / (G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1))) enddo ; enddo ; enddo do k=1,nz ; do j=js,je ; do I=is-1,ie diff --git a/src/user/RGC_initialization.F90 b/src/user/RGC_initialization.F90 index f0000dc03d..d5f2bb608b 100644 --- a/src/user/RGC_initialization.F90 +++ b/src/user/RGC_initialization.F90 @@ -44,9 +44,8 @@ module RGC_initialization contains -!> Sets up the the inverse restoration time (Idamp), and -! the values towards which the interface heights and an arbitrary -! number of tracers should be restored within each sponge. +!> Sets up the the inverse restoration time, and the values towards which the interface heights, +!! velocities and tracers should be restored within the sponges for the RGC test case. subroutine RGC_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -55,8 +54,10 @@ subroutine RGC_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) !! fields, potential temperature and !! salinity or mixed layer density. !! Absent fields have NULL ptrs. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< u velocity. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< v velocity. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + target, intent(in) :: u !< Array with the u velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + target, intent(in) :: v !< Array with the v velocity [L T-1 ~> m s-1] type(param_file_type), intent(in) :: PF !< A structure indicating the !! open file to parse for model !! parameter values. @@ -67,12 +68,12 @@ subroutine RGC_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) ! Local variables real :: T(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for temp real :: S(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for salt - real :: U1(SZIB_(G), SZJ_(G), SZK_(G)) ! A temporary array for u - real :: V1(SZI_(G), SZJB_(G), SZK_(G)) ! A temporary array for v + real :: U1(SZIB_(G),SZJ_(G),SZK_(G)) ! A temporary array for u [L T-1 ~> m s-1] + real :: V1(SZI_(G),SZJB_(G),SZK_(G)) ! A temporary array for v [L T-1 ~> m s-1] real :: RHO(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for RHO real :: tmp(SZI_(G),SZJ_(G)) ! A temporary array for tracers. real :: h(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for thickness at h points - real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate at h points, in s-1. + real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate at h points [s-1]. real :: TNUDG ! Nudging time scale, days real :: pres(SZI_(G)) ! An array of the reference pressure, in Pa real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! @@ -118,9 +119,9 @@ subroutine RGC_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) call get_param(PF, mod, "MINIMUM_DEPTH", min_depth, & "The minimum depth of the ocean.", units="m", default=0.0) - if (associated(CSp)) call MOM_error(FATAL, & + if (associated(CSp)) call MOM_error(FATAL, & "RGC_initialize_sponges called with an associated control structure.") - if (associated(ACSp)) call MOM_error(FATAL, & + if (associated(ACSp)) call MOM_error(FATAL, & "RGC_initialize_sponges called with an associated ALE-sponge control structure.") ! Here the inverse damping time, in s-1, is set. Set Idamp to 0 ! @@ -128,61 +129,61 @@ subroutine RGC_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) ! will automatically set up the sponges only where Idamp is positive! ! and mask2dT is 1. - do i=is,ie; do j=js,je - if (G%geoLonT(i,j) <= lensponge) then - dummy1 = -(G%geoLonT(i,j))/lensponge + 1.0 - !damp = 1.0/TNUDG * max(0.0,dummy1) - damp = 0.0 - !write(*,*)'1st, G%geoLonT(i,j), damp',G%geoLonT(i,j), damp + do i=is,ie ; do j=js,je + if (G%geoLonT(i,j) <= lensponge) then + dummy1 = -(G%geoLonT(i,j))/lensponge + 1.0 + !damp = 1.0/TNUDG * max(0.0,dummy1) + damp = 0.0 + !write(*,*)'1st, G%geoLonT(i,j), damp',G%geoLonT(i,j), damp - elseif (G%geoLonT(i,j) >= (lenlon - lensponge) .AND. G%geoLonT(i,j) <= lenlon) then + elseif (G%geoLonT(i,j) >= (lenlon - lensponge) .AND. G%geoLonT(i,j) <= lenlon) then - ! 1 / day - dummy1=(G%geoLonT(i,j)-(lenlon - lensponge))/(lensponge) - damp = (1.0/TNUDG) * max(0.0,dummy1) +! 1 / day + dummy1=(G%geoLonT(i,j)-(lenlon - lensponge))/(lensponge) + damp = (1.0/TNUDG) * max(0.0,dummy1) - else ; damp=0.0 - endif + else ; damp=0.0 + endif - ! convert to 1 / seconds - if (G%bathyT(i,j) > min_depth) then - Idamp(i,j) = damp/86400.0 - else ; Idamp(i,j) = 0.0 ; endif - enddo ; enddo +! convert to 1 / seconds + if (G%bathyT(i,j) > min_depth) then + Idamp(i,j) = damp/86400.0 + else ; Idamp(i,j) = 0.0 ; endif + enddo ; enddo - ! 1) Read eta, salt and temp from IC file - call get_param(PF, mod, "INPUTDIR", inputdir, default=".") - inputdir = slasher(inputdir) + ! 1) Read eta, salt and temp from IC file + call get_param(PF, mod, "INPUTDIR", inputdir, default=".") + inputdir = slasher(inputdir) ! GM: get two different files, one with temp and one with salt values ! this is work around to avoid having wrong values near the surface ! because of the FIT_SALINITY option. To get salt values right in the ! sponge, FIT_SALINITY=False. The oposite is true for temp. One can ! combined the *correct* temp and salt values in one file instead. - call get_param(PF, mod, "RGC_SPONGE_FILE", state_file, & + call get_param(PF, mod, "RGC_SPONGE_FILE", state_file, & "The name of the file with temps., salts. and interfaces to \n"// & " damp toward.", fail_if_missing=.true.) - call get_param(PF, mod, "SPONGE_PTEMP_VAR", temp_var, & + call get_param(PF, mod, "SPONGE_PTEMP_VAR", temp_var, & "The name of the potential temperature variable in \n"//& "SPONGE_STATE_FILE.", default="Temp") - call get_param(PF, mod, "SPONGE_SALT_VAR", salt_var, & + call get_param(PF, mod, "SPONGE_SALT_VAR", salt_var, & "The name of the salinity variable in \n"//& "SPONGE_STATE_FILE.", default="Salt") - call get_param(PF, mod, "SPONGE_ETA_VAR", eta_var, & + call get_param(PF, mod, "SPONGE_ETA_VAR", eta_var, & "The name of the interface height variable in \n"//& "SPONGE_STATE_FILE.", default="eta") - call get_param(PF, mod, "SPONGE_H_VAR", h_var, & + call get_param(PF, mod, "SPONGE_H_VAR", h_var, & "The name of the layer thickness variable in \n"//& "SPONGE_STATE_FILE.", default="h") - !read temp and eta - filename = trim(inputdir)//trim(state_file) - if (.not.file_exists(filename, G%Domain)) & - call MOM_error(FATAL, " RGC_initialize_sponges: Unable to open "//trim(filename)) - call read_data(filename,temp_var,T(:,:,:), domain=G%Domain%mpp_domain) - call read_data(filename,salt_var,S(:,:,:), domain=G%Domain%mpp_domain) + !read temp and eta + filename = trim(inputdir)//trim(state_file) + if (.not.file_exists(filename, G%Domain)) & + call MOM_error(FATAL, " RGC_initialize_sponges: Unable to open "//trim(filename)) + call read_data(filename,temp_var,T(:,:,:), domain=G%Domain%mpp_domain) + call read_data(filename,salt_var,S(:,:,:), domain=G%Domain%mpp_domain) - if (use_ALE) then + if (use_ALE) then call read_data(filename,h_var,h(:,:,:), domain=G%Domain%mpp_domain) call pass_var(h, G%domain) @@ -199,37 +200,37 @@ subroutine RGC_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) endif if (sponge_uv) then - U1(:,:,:) = 0.0; V1(:,:,:) = 0.0 - call set_up_ALE_sponge_vel_field(U1,V1,G,u,v,ACSp) + U1(:,:,:) = 0.0; V1(:,:,:) = 0.0 + call set_up_ALE_sponge_vel_field(U1,V1,G,u,v,ACSp) endif - else ! layer mode + else ! layer mode - !read eta - call read_data(filename,eta_var,eta(:,:,:), domain=G%Domain%mpp_domain) + !read eta + call read_data(filename,eta_var,eta(:,:,:), domain=G%Domain%mpp_domain) - ! Set the inverse damping rates so that the model will know where to - ! apply the sponges, along with the interface heights. - call initialize_sponge(Idamp, eta, G, PF, CSp, GV) + ! Set the inverse damping rates so that the model will know where to + ! apply the sponges, along with the interface heights. + call initialize_sponge(Idamp, eta, G, PF, CSp, GV) - if ( GV%nkml>0 ) then - ! This call to set_up_sponge_ML_density registers the target values of the - ! mixed layer density, which is used in determining which layers can be - ! inflated without causing static instabilities. - do i=is-1,ie ; pres(i) = tv%P_Ref ; enddo + if ( GV%nkml>0 ) then + ! This call to set_up_sponge_ML_density registers the target values of the + ! mixed layer density, which is used in determining which layers can be + ! inflated without causing static instabilities. + do i=is-1,ie ; pres(i) = tv%P_Ref ; enddo - do j=js,je - call calculate_density(T(:,j,1), S(:,j,1), pres, tmp(:,j), & - is, ie-is+1, tv%eqn_of_state) - enddo + do j=js,je + call calculate_density(T(:,j,1), S(:,j,1), pres, tmp(:,j), & + is, ie-is+1, tv%eqn_of_state) + enddo - call set_up_sponge_ML_density(tmp, G, CSp) - endif + call set_up_sponge_ML_density(tmp, G, CSp) + endif - ! Apply sponge in tracer fields - call set_up_sponge_field(T, tv%T, G, nz, CSp) - call set_up_sponge_field(S, tv%S, G, nz, CSp) + ! Apply sponge in tracer fields + call set_up_sponge_field(T, tv%T, G, nz, CSp) + call set_up_sponge_field(S, tv%S, G, nz, CSp) endif diff --git a/src/user/Rossby_front_2d_initialization.F90 b/src/user/Rossby_front_2d_initialization.F90 index 9676464330..b991fa95bc 100644 --- a/src/user/Rossby_front_2d_initialization.F90 +++ b/src/user/Rossby_front_2d_initialization.F90 @@ -163,13 +163,13 @@ end subroutine Rossby_front_initialize_temperature_salinity subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: u !< i-component of velocity [m s-1] + intent(out) :: u !< i-component of velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: v !< j-component of velocity [m s-1] + intent(out) :: v !< j-component of velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G), SZK_(G)), & intent(in) :: h !< Thickness [H ~> m or kg m-2] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call @@ -214,7 +214,7 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, US, param_file, just zi = zi - hAtU ! Bottom interface position zc = zi - 0.5*hAtU ! Position of middle of cell zm = max( zc + Dml, 0. ) ! Height above bottom of mixed layer - u(I,j,k) = US%L_T_to_m_s * dUdT * Ty * zm ! Thermal wind starting at base of ML + u(I,j,k) = dUdT * Ty * zm ! Thermal wind starting at base of ML enddo enddo ; enddo diff --git a/src/user/dyed_channel_initialization.F90 b/src/user/dyed_channel_initialization.F90 index 61f8183275..da4751b3fa 100644 --- a/src/user/dyed_channel_initialization.F90 +++ b/src/user/dyed_channel_initialization.F90 @@ -162,9 +162,9 @@ subroutine dyed_channel_update_flow(OBC, CS, G, Time) jsd = segment%HI%jsd ; jed = segment%HI%jed IsdB = segment%HI%IsdB ; IedB = segment%HI%IedB if (CS%frequency == 0.0) then - flow = CS%zonal_flow + flow = G%US%m_s_to_L_T*CS%zonal_flow else - flow = CS%zonal_flow + CS%tidal_amp * cos(2 * PI * CS%frequency * time_sec) + flow = G%US%m_s_to_L_T*CS%zonal_flow + CS%tidal_amp * cos(2 * PI * CS%frequency * time_sec) endif do k=1,G%ke do j=jsd,jed ; do I=IsdB,IedB diff --git a/src/user/shelfwave_initialization.F90 b/src/user/shelfwave_initialization.F90 index cd80514bea..928c8ae223 100644 --- a/src/user/shelfwave_initialization.F90 +++ b/src/user/shelfwave_initialization.F90 @@ -170,9 +170,9 @@ subroutine shelfwave_set_OBC_data(OBC, CS, G, h, Time) cos_wt = cos(ll*x - omega*time_sec) sin_ky = sin(kk * y) cos_ky = cos(kk * y) - segment%normal_vel_bt(I,j) = my_amp * exp(- alpha * y) * cos_wt * & + segment%normal_vel_bt(I,j) = G%US%m_s_to_L_T*my_amp * exp(- alpha * y) * cos_wt * & (alpha * sin_ky + kk * cos_ky) -! segment%tangential_vel_bt(I,j) = my_amp * ll * exp(- alpha * y) * sin_wt * sin_ky +! segment%tangential_vel_bt(I,j) = G%US%m_s_to_L_T*my_amp * ll * exp(- alpha * y) * sin_wt * sin_ky ! segment%vorticity_bt(I,j) = my_amp * exp(- alpha * y) * cos_wt * sin_ky& ! (ll*ll + kk*kk + alpha*alpha) enddo ; enddo diff --git a/src/user/soliton_initialization.F90 b/src/user/soliton_initialization.F90 index 033a8f0e52..4351060fb8 100644 --- a/src/user/soliton_initialization.F90 +++ b/src/user/soliton_initialization.F90 @@ -63,14 +63,20 @@ end subroutine soliton_initialize_thickness !> Initialization of u and v in the equatorial Rossby soliton test -subroutine soliton_initialize_velocity(u, v, h, G) - type(ocean_grid_type), intent(in) :: G !< Grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: u !< i-component of velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: v !< j-component of velocity [m s-1] +subroutine soliton_initialize_velocity(u, v, h, G, US) + type(ocean_grid_type), intent(in) :: G !< Grid structure + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: u !< i-component of velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: v !< j-component of velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Thickness [H ~> m or kg m-2] - - real :: x, y, x0, y0 - real :: val1, val2, val3, val4 + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + + ! Local variables + real :: x, x0 ! Positions in the same units as geoLonT. + real :: y, y0 ! Positions in the same units as geoLatT. + real :: val1 ! A zonal decay scale in the inverse of the units of geoLonT. + real :: val2 ! An overall velocity amplitude [L T-1 ~> m s-1] + real :: val3 ! A decay factor [nondim] + real :: val4 ! The local velocity amplitude [L T-1 ~> m s-1] integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -78,7 +84,7 @@ subroutine soliton_initialize_velocity(u, v, h, G) x0 = 2.0*G%len_lon/3.0 y0 = 0.0 val1 = 0.395 - val2 = 0.771*(val1*val1) + val2 = US%m_s_to_L_T * 0.771*(val1*val1) v(:,:,:) = 0.0 u(:,:,:) = 0.0 diff --git a/src/user/supercritical_initialization.F90 b/src/user/supercritical_initialization.F90 index f12378c3d9..19aacab72d 100644 --- a/src/user/supercritical_initialization.F90 +++ b/src/user/supercritical_initialization.F90 @@ -31,7 +31,7 @@ subroutine supercritical_set_OBC_data(OBC, G, param_file) type(param_file_type), intent(in) :: param_file !< Parameter file structure ! Local variables character(len=40) :: mdl = "supercritical_set_OBC_data" ! This subroutine's name. - real :: zonal_flow + real :: zonal_flow ! Inflow speed [L T-1 ~> m s-1] integer :: i, j, k, l integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB type(OBC_segment_type), pointer :: segment => NULL() ! pointer to segment type list @@ -41,7 +41,7 @@ subroutine supercritical_set_OBC_data(OBC, G, param_file) call get_param(param_file, mdl, "SUPERCRITICAL_ZONAL_FLOW", zonal_flow, & "Constant zonal flow imposed at upstream open boundary.", & - units="m/s", default=8.57) + units="m/s", default=8.57, scale=G%US%m_s_to_L_T) do l=1, OBC%number_of_segments segment => OBC%segment(l) diff --git a/src/user/tidal_bay_initialization.F90 b/src/user/tidal_bay_initialization.F90 index 161ad25c11..67999fff40 100644 --- a/src/user/tidal_bay_initialization.F90 +++ b/src/user/tidal_bay_initialization.F90 @@ -98,7 +98,7 @@ subroutine tidal_bay_set_OBC_data(OBC, CS, G, h, Time) do j=segment%HI%jsc,segment%HI%jec ; do I=segment%HI%IscB,segment%HI%IecB if (OBC%segnum_u(I,j) /= OBC_NONE) then do k=1,nz - my_area(1,j) = my_area(1,j) + h(I,j,k)*G%dyCu(I,j) + my_area(1,j) = my_area(1,j) + h(I,j,k)*G%US%L_to_m*G%dyCu(I,j) enddo endif enddo ; enddo @@ -110,7 +110,7 @@ subroutine tidal_bay_set_OBC_data(OBC, CS, G, h, Time) if (.not. segment%on_pe) cycle - segment%normal_vel_bt(:,:) = my_flux/total_area + segment%normal_vel_bt(:,:) = G%US%m_s_to_L_T*my_flux/total_area segment%eta(:,:) = cff enddo ! end segment loop diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index bcf1942cad..64f4f84247 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -106,10 +106,11 @@ subroutine USER_initialize_thickness(h, G, GV, param_file, just_read_params) end subroutine USER_initialize_thickness !> initialize velocities. -subroutine USER_initialize_velocity(u, v, G, param_file, just_read_params) +subroutine USER_initialize_velocity(u, v, G, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. - real, dimension(SZIB_(G), SZJ_(G), SZK_(G)), intent(out) :: u !< i-component of velocity [m s-1] - real, dimension(SZI_(G), SZJB_(G), SZK_(G)), intent(out) :: v !< j-component of velocity [m/s] + real, dimension(SZIB_(G), SZJ_(G), SZK_(G)), intent(out) :: u !< i-component of velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G), SZJB_(G), SZK_(G)), intent(out) :: v !< j-component of velocity [L T-1 ~> m s-1] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model !! parameter values.