From 50b850d6198e7c37d0c45fb1380b1a123fcb7f40 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 13 Jul 2018 17:20:28 -0400 Subject: [PATCH 001/174] Corrected two openMP directives Corrected openMP directives in two places, so MOM6 now compiles with openMP enabled. The variable local_strain had recently been added to horizontal_viscosity, but it was omitted from an openMP directive. A recent change had left an incomplete openMP directive around KPP_get_BLD in diabatic. All solutions (at least without openMP on) are bitwise identical. --- .../lateral/MOM_hor_visc.F90 | 22 +++++++++---------- .../vertical/MOM_diabatic_driver.F90 | 3 ++- 2 files changed, 13 insertions(+), 12 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 2a166bac09..3be015faa4 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -316,17 +316,17 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, ! Toggle whether to use a Laplacian viscosity derived from MEKE use_MEKE_Ku = associated(MEKE%Ku) -!$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 Kh_h,Ah_h,Kh_q,Ah_q,diffu,apply_OBC,OBC,diffv, & -!$OMP find_FrictWork,FrictWork,use_MEKE_Ku,MEKE, & -!$OMP mod_Leith, legacy_bound) & -!$OMP private(u0, v0, sh_xx, str_xx, visc_bound_rem, & -!$OMP sh_xy, str_xy, Ah, Kh, AhSm, KhSm, dvdx, dudy, & -!$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,KhLth, & -!$OMP div_xx, div_xx_dx, div_xx_dy, & -!$OMP Shear_mag, h2uq, h2vq, hq, Kh_scale, hrat_min) + !$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 Kh_h,Ah_h,Kh_q,Ah_q,diffu,apply_OBC,OBC,diffv, & + !$OMP find_FrictWork,FrictWork,use_MEKE_Ku,MEKE, & + !$OMP mod_Leith, legacy_bound) & + !$OMP private(u0, v0, sh_xx, str_xx, visc_bound_rem, & + !$OMP sh_xy, str_xy, Ah, Kh, AhSm, KhSm, dvdx, dudy, & + !$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,KhLth, & + !$OMP div_xx, div_xx_dx, div_xx_dy, local_strain, & + !$OMP Shear_mag, h2uq, h2vq, hq, Kh_scale, hrat_min) do k=1,nz ! The following are the forms of the horizontal tension and horizontal diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 8a16e79ecd..188ba9c8f3 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -610,10 +610,11 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call KPP_calculate(CS%KPP_CSp, G, GV, h, fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, & Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves) -!$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,Kd_int,visc,CS,G,Kd_heat,Hml) if (associated(Hml)) then + !$OMP parallel default(shared) call KPP_get_BLD(CS%KPP_CSp, Hml(:,:), G) + !$OMP end parallel call pass_var(Hml, G%domain, halo=1) endif From ad3961c2dfed77b5525dbf5ce67ba0b1b15bda2c Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Sun, 15 Jul 2018 12:07:37 -0800 Subject: [PATCH 002/174] Time-filter on oblique OBCs. - also set default OBC vorticity, strain to freeslip. --- src/core/MOM_open_boundary.F90 | 101 +++++++++++++++++++++++++-------- 1 file changed, 78 insertions(+), 23 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 38a945233b..3c9343d1c4 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -156,6 +156,8 @@ module MOM_open_boundary !! for normal velocity real, pointer, dimension(:,:,:) :: ry_normal=>NULL() !< The tangential value for radiation coeff !! for normal velocity + 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). real, pointer, dimension(:,:,:) :: nudged_tangential_vel=>NULL() !< The layer velocity tangential to the OB segment @@ -237,6 +239,7 @@ module MOM_open_boundary type(OBC_registry_type), pointer :: OBC_Reg => NULL() !< Registry type for boundaries real, pointer, dimension(:,:,:) :: rx_normal => NULL() !< Array storage for restarts real, pointer, dimension(:,:,:) :: ry_normal => NULL() !< Array storage for restarts + real, pointer, dimension(:,:,:) :: cff_normal => NULL() !< Array storage for restarts real :: silly_h !< A silly value of thickness outside of the domain that !! can be used to test the independence of the OBCs to !! this external data, in m. @@ -315,7 +318,7 @@ subroutine open_boundary_config(G, param_file, OBC) call get_param(param_file, mdl, "OBC_FREESLIP_VORTICITY", OBC%freeslip_vorticity, & "If true, sets the normal gradient of tangential velocity to\n"// & "zero in the relative vorticity on open boundaries. This cannot\n"// & - "be true if another OBC_XXX_VORTICITY option is True.", default=.false.) + "be true if another OBC_XXX_VORTICITY option is True.", default=.true.) call get_param(param_file, mdl, "OBC_COMPUTED_VORTICITY", OBC%computed_vorticity, & "If true, uses the external values of tangential velocity\n"// & "in the relative vorticity on open boundaries. This cannot\n"// & @@ -339,7 +342,7 @@ subroutine open_boundary_config(G, param_file, OBC) call get_param(param_file, mdl, "OBC_FREESLIP_STRAIN", OBC%freeslip_strain, & "If true, sets the normal gradient of tangential velocity to\n"// & "zero in the strain use in the stress tensor on open boundaries. This cannot\n"// & - "be true if another OBC_XXX_STRAIN option is True.", default=.false.) + "be true if another OBC_XXX_STRAIN option is True.", default=.true.) call get_param(param_file, mdl, "OBC_COMPUTED_STRAIN", OBC%computed_strain, & "If true, sets the normal gradient of tangential velocity to\n"// & "zero in the strain use in the stress tensor on open boundaries. This cannot\n"// & @@ -431,7 +434,7 @@ subroutine open_boundary_config(G, param_file, OBC) ! if (open_boundary_query(OBC, needs_ext_seg_data=.true.)) & call initialize_segment_data(G, OBC, param_file) - if (open_boundary_query(OBC, apply_Flather_OBC=.true.)) then + if (open_boundary_query(OBC, apply_open_OBC=.true.)) then call get_param(param_file, mdl, "OBC_RADIATION_MAX", OBC%rx_max, & "The maximum magnitude of the baroclinic radiation \n"//& "velocity (or speed of characteristics). This is only \n"//& @@ -1499,6 +1502,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) real :: rx_max, ry_max ! coefficients for radiation real :: rx_new, rx_avg ! coefficients for radiation real :: ry_new, ry_avg ! coefficients for radiation + real :: cff_new, cff_avg ! denominator in oblique real, pointer, dimension(:,:,:) :: rx_tangential=>NULL() real, pointer, dimension(:,:,:) :: ry_tangential=>NULL() real, parameter :: eps = 1.0e-20 @@ -1540,6 +1544,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) do j=segment%HI%jsd,segment%HI%jed segment%rx_normal(I,j,k) = OBC%rx_normal(I,j,k) segment%ry_normal(I,j,k) = OBC%ry_normal(I,j,k) + segment%cff_normal(I,j,k) = OBC%cff_normal(I,j,k) enddo enddo elseif (segment%is_N_or_S .and. segment%oblique) then @@ -1548,6 +1553,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) do i=segment%HI%isd,segment%HI%ied segment%rx_normal(i,J,k) = OBC%rx_normal(i,J,k) segment%ry_normal(i,J,k) = OBC%ry_normal(i,J,k) + segment%cff_normal(i,J,k) = OBC%cff_normal(i,J,k) enddo enddo endif @@ -1588,11 +1594,21 @@ 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 - Cx = dhdt*dhdx - cff = max(dhdx*dhdx + dhdy*dhdy, eps) - Cy = min(cff,max(dhdt*dhdy,-cff)) - segment%normal_vel(I,j,k) = ((cff*u_new(I,j,k) + Cx*u_new(I-1,j,k)) - & - (max(Cy,0.0)*segment%grad_normal(J-1,2,k) + min(Cy,0.0)*segment%grad_normal(J,2,k))) / (cff + Cx) + rx_new = dhdt*dhdx + cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) + ry_new = min(cff,max(dhdt*dhdy,-cff)) + 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 + segment%rx_normal(I,j,k) = rx_avg + 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) + OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) + OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) + OBC%cff_normal(I,j,k) = segment%cff_normal(I,j,k) elseif (segment%gradient) then segment%normal_vel(I,j,k) = u_new(I-1,j,k) endif @@ -1698,11 +1714,21 @@ 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 - Cx = dhdt*dhdx - cff = max(dhdx*dhdx + dhdy*dhdy, eps) - Cy = min(cff,max(dhdt*dhdy,-cff)) - segment%normal_vel(I,j,k) = ((cff*u_new(I,j,k) + Cx*u_new(I+1,j,k)) - & - (max(Cy,0.0)*segment%grad_normal(J-1,2,k) + min(Cy,0.0)*segment%grad_normal(J,2,k))) / (cff + Cx) + rx_new = dhdt*dhdx + cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) + ry_new = min(cff,max(dhdt*dhdy,-cff)) + 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 + segment%rx_normal(I,j,k) = rx_avg + 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) + OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) + OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) + OBC%cff_normal(I,j,k) = segment%cff_normal(I,j,k) elseif (segment%gradient) then segment%normal_vel(I,j,k) = u_new(I+1,j,k) endif @@ -1809,11 +1835,21 @@ 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 - Cy = dhdt*dhdy - cff = max(dhdx*dhdx + dhdy*dhdy, eps) - Cx = min(cff,max(dhdt*dhdx,-cff)) - segment%normal_vel(i,J,k) = ((cff*v_new(i,J,k) + Cy*v_new(i,J-1,k)) - & - (max(Cx,0.0)*segment%grad_normal(I-1,2,k) + min(Cx,0.0)*segment%grad_normal(I,2,k))) / (cff + Cy) + ry_new = dhdt*dhdy + cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) + rx_new = min(cff,max(dhdt*dhdx,-cff)) + 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 + segment%rx_normal(I,j,k) = rx_avg + 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) + OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) + OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) + OBC%cff_normal(i,J,k) = segment%cff_normal(i,J,k) elseif (segment%gradient) then segment%normal_vel(i,J,k) = v_new(i,J-1,k) endif @@ -1920,11 +1956,21 @@ 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 - Cy = dhdt*dhdy - cff = max(dhdx*dhdx + dhdy*dhdy, eps) - Cx = min(cff,max(dhdt*dhdx,-cff)) - segment%normal_vel(i,J,k) = ((cff*v_new(i,J,k) + Cy*v_new(i,J+1,k)) - & - (max(Cx,0.0)*segment%grad_normal(I-1,2,k) + min(Cx,0.0)*segment%grad_normal(I,2,k))) / (cff + Cy) + ry_new = dhdt*dhdy + cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) + rx_new = min(cff,max(dhdt*dhdx,-cff)) + 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 + segment%rx_normal(I,j,k) = rx_avg + 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) + OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) + OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) + OBC%cff_normal(i,J,k) = segment%cff_normal(i,J,k) elseif (segment%gradient) then segment%normal_vel(i,J,k) = v_new(i,J+1,k) endif @@ -2286,6 +2332,7 @@ subroutine allocate_OBC_segment_data(OBC, segment) allocate(segment%grad_normal(JsdB:JedB,2,OBC%ke)); segment%grad_normal(:,:,:) = 0.0 allocate(segment%rx_normal(IsdB:IedB,jsd:jed,OBC%ke)); segment%rx_normal(:,:,:)=0.0 allocate(segment%ry_normal(IsdB:IedB,jsd:jed,OBC%ke)); segment%ry_normal(:,:,:)=0.0 + allocate(segment%cff_normal(IsdB:IedB,jsd:jed,OBC%ke)); segment%cff_normal(:,:,:)=0.0 endif endif @@ -2321,6 +2368,7 @@ subroutine allocate_OBC_segment_data(OBC, segment) allocate(segment%grad_normal(IsdB:IedB,2,OBC%ke)); segment%grad_normal(:,:,:) = 0.0 allocate(segment%rx_normal(isd:ied,JsdB:JedB,OBC%ke)); segment%rx_normal(:,:,:)=0.0 allocate(segment%ry_normal(isd:ied,JsdB:JedB,OBC%ke)); segment%ry_normal(:,:,:)=0.0 + allocate(segment%cff_normal(isd:ied,JsdB:JedB,OBC%ke)); segment%cff_normal(:,:,:)=0.0 endif endif @@ -2341,6 +2389,7 @@ subroutine deallocate_OBC_segment_data(OBC, segment) if (associated (segment%eta)) deallocate(segment%eta) if (associated (segment%rx_normal)) deallocate(segment%rx_normal) if (associated (segment%ry_normal)) deallocate(segment%ry_normal) + if (associated (segment%cff_normal)) deallocate(segment%cff_normal) if (associated (segment%normal_vel)) deallocate(segment%normal_vel) if (associated (segment%normal_vel_bt)) deallocate(segment%normal_vel_bt) if (associated (segment%normal_trans)) deallocate(segment%normal_trans) @@ -3473,6 +3522,12 @@ subroutine open_boundary_register_restarts(HI, GV, OBC_CS,restart_CSp) vd = var_desc("ry_normal","m s-1", "Normal Phase Speed for NS OBCs",'v','L') call register_restart_field(OBC_CS%ry_normal, vd, .true., restart_CSp) endif + if (OBC_CS%oblique_BCs_exist_globally) then + allocate(OBC_CS%cff_normal(HI%IsdB:HI%IedB,HI%jsdB:HI%jedB,GV%ke)) + OBC_CS%cff_normal(:,:,:) = 0.0 + vd = var_desc("cff_normal","m s-1", "denominator for oblique OBCs",'q','L') + call register_restart_field(OBC_CS%cff_normal, vd, .true., restart_CSp) + endif end subroutine open_boundary_register_restarts From 12410a1ec688b88fb34bf2e6b3c39eaa3e315397 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Wed, 18 Jul 2018 16:15:58 -0800 Subject: [PATCH 003/174] Fix nudging with oblique OBCs. --- src/core/MOM_open_boundary.F90 | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 3c9343d1c4..259714e984 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -1613,7 +1613,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) segment%normal_vel(I,j,k) = u_new(I-1,j,k) endif if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then - if (dhdt*dhdx < 0.0) then + ! dhdt gets set to 0 on inflow in oblique case + if (dhdt*dhdx <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out @@ -1733,7 +1734,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) segment%normal_vel(I,j,k) = u_new(I+1,j,k) endif if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then - if (dhdt*dhdx < 0.0) then + ! dhdt gets set to 0. on inflow in oblique case + if (dhdt*dhdx <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out @@ -1854,7 +1856,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) segment%normal_vel(i,J,k) = v_new(i,J-1,k) endif if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then - if (dhdt*dhdy < 0.0) then + ! dhdt gets set to 0 on inflow in oblique case + if (dhdt*dhdx <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out @@ -1975,7 +1978,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) segment%normal_vel(i,J,k) = v_new(i,J+1,k) endif if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then - if (dhdt*dhdy < 0.0) then + ! dhdt gets set to 0 on inflow in oblique case + if (dhdt*dhdx <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out From e0ca46b0728d14a7fffd6d661a74c5199a7c310e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 20 Jul 2018 17:47:16 -0400 Subject: [PATCH 004/174] +Added stress_mag to ice_ocean_boundary_type Added a new element, stress_mag, with the time-mean of the magnitude of the wind stresses at tracer points, to the ice_ocean_boundary_type. It is not yet being used, so all answers are bitwise identical. --- config_src/coupled_driver/MOM_surface_forcing.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 19a0ddbf86..02b54daefe 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -166,6 +166,7 @@ module MOM_surface_forcing real, pointer, dimension(:,:) :: fprec =>NULL() !< mass flux of frozen precip (kg/m2/s) real, pointer, dimension(:,:) :: runoff =>NULL() !< mass flux of liquid runoff (kg/m2/s) real, pointer, dimension(:,:) :: calving =>NULL() !< mass flux of frozen runoff (kg/m2/s) + real, pointer, dimension(:,:) :: stress_mag =>NULL() !< The time-mean magnitude of the stress on the ocean (Pa) real, pointer, dimension(:,:) :: ustar_berg =>NULL() !< frictional velocity beneath icebergs (m/s) real, pointer, dimension(:,:) :: area_berg =>NULL() !< area covered by icebergs(m2/m2) real, pointer, dimension(:,:) :: mass_berg =>NULL() !< mass of icebergs(kg/m2) From 8d794eff5ccd57d26d481b7bceea6f097c90c99a Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Wed, 1 Aug 2018 10:51:18 -0800 Subject: [PATCH 005/174] Adding OBLIQUE_TAN and OBLIQUE_GRAD options. --- src/core/MOM_open_boundary.F90 | 454 +++++++++++++++++++++++++++++++-- 1 file changed, 438 insertions(+), 16 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 259714e984..de8c2fe174 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -112,6 +112,10 @@ module MOM_open_boundary logical :: radiation_grad !< If true, 1D Orlanksi radiation boundary conditions are applied to !! dudv and dvdx. logical :: oblique !< Oblique waves supported at radiation boundary. + logical :: oblique_tan !< If true, 2D radiation boundary conditions are applied to + !! tangential flows. + logical :: oblique_grad !< If true, 2D radiation boundary conditions are applied to + !! dudv and dvdx. logical :: nudged !< Optional supplement to radiation boundary. logical :: nudged_tan !< Optional supplement to nudge tangential velocity. logical :: nudged_grad !< Optional supplement to nudge normal gradient of tangential velocity. @@ -151,7 +155,11 @@ module MOM_open_boundary !! the OB segment (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 (m s-1) + !! segment (s-1) + real, pointer, dimension(:,:,:) :: grad_tan=>NULL() !< The gradient of the tangential flow along the + !! segment (s-1) + real, pointer, dimension(:,:,:) :: grad_gradient=>NULL() !< The gradient of the gradient of tangential flow along the + !! segment (m-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 @@ -397,6 +405,8 @@ subroutine open_boundary_config(G, param_file, OBC) OBC%segment(l)%radiation_tan = .false. OBC%segment(l)%radiation_grad = .false. OBC%segment(l)%oblique = .false. + OBC%segment(l)%oblique_tan = .false. + OBC%segment(l)%oblique_grad = .false. OBC%segment(l)%nudged = .false. OBC%segment(l)%nudged_tan = .false. OBC%segment(l)%nudged_grad = .false. @@ -818,6 +828,13 @@ subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_y) OBC%segment(l_seg)%open = .true. OBC%oblique_BCs_exist_globally = .true. OBC%open_u_BCs_exist_globally = .true. + elseif (trim(action_str(a_loop)) == 'OBLIQUE_TAN') then + OBC%segment(l_seg)%oblique = .true. + OBC%segment(l_seg)%oblique_tan = .true. + OBC%oblique_BCs_exist_globally = .true. + elseif (trim(action_str(a_loop)) == 'OBLIQUE_GRAD') then + OBC%segment(l_seg)%oblique = .true. + OBC%segment(l_seg)%oblique_grad = .true. elseif (trim(action_str(a_loop)) == 'NUDGED') then OBC%segment(l_seg)%nudged = .true. OBC%nudged_u_BCs_exist_globally = .true. @@ -871,6 +888,10 @@ subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_y) OBC%segment(l_seg)%Je_obc = Je_obc call allocate_OBC_segment_data(OBC, OBC%segment(l_seg)) + if (OBC%segment(l_seg)%oblique .and. OBC%segment(l_seg)%radiation) & + call MOM_error(FATAL, "MOM_open_boundary.F90, setup_u_point_obc:\n"//& + "Orlanski and Oblique OBC options cannot be used together on one segment.") + end subroutine setup_u_point_obc !> Parse an OBC_SEGMENT_%%% string starting with "J=" and configure placement and type of OBC accordingly @@ -931,6 +952,13 @@ subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_x) OBC%segment(l_seg)%open = .true. OBC%oblique_BCs_exist_globally = .true. OBC%open_v_BCs_exist_globally = .true. + elseif (trim(action_str(a_loop)) == 'OBLIQUE_TAN') then + OBC%segment(l_seg)%oblique = .true. + OBC%segment(l_seg)%oblique_tan = .true. + OBC%oblique_BCs_exist_globally = .true. + elseif (trim(action_str(a_loop)) == 'OBLIQUE_GRAD') then + OBC%segment(l_seg)%oblique = .true. + OBC%segment(l_seg)%oblique_grad = .true. elseif (trim(action_str(a_loop)) == 'NUDGED') then OBC%segment(l_seg)%nudged = .true. OBC%nudged_v_BCs_exist_globally = .true. @@ -984,6 +1012,10 @@ subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_x) OBC%segment(l_seg)%Je_obc = J_obc call allocate_OBC_segment_data(OBC, OBC%segment(l_seg)) + if (OBC%segment(l_seg)%oblique .and. OBC%segment(l_seg)%radiation) & + call MOM_error(FATAL, "MOM_open_boundary.F90, setup_v_point_obc:\n"//& + "Orlanski and Oblique OBC options cannot be used together on one segment.") + end subroutine setup_v_point_obc !> Parse an OBC_SEGMENT_%%% string @@ -1505,6 +1537,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) real :: cff_new, cff_avg ! denominator in oblique real, pointer, dimension(:,:,:) :: rx_tangential=>NULL() real, pointer, dimension(:,:,:) :: ry_tangential=>NULL() + real, pointer, dimension(:,:,:) :: cff_tangential=>NULL() real, parameter :: eps = 1.0e-20 type(OBC_segment_type), pointer :: segment => NULL() integer :: i, j, k, is, ie, js, je, nz, n @@ -1606,6 +1639,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) 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) + ! 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) OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) OBC%cff_normal(I,j,k) = segment%cff_normal(I,j,k) @@ -1642,7 +1677,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) endif if (segment%nudged_tan) then do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB - if (rx_tangential(I,J,k) < 0.0) then + ! dhdt gets set to 0 on inflow in oblique case + if (rx_tangential(I,J,k) <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out @@ -1672,7 +1708,77 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) endif if (segment%nudged_grad) then do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB - if (rx_tangential(I,J,k) < 0.0) then + ! dhdt gets set to 0 on inflow in oblique case + if (rx_tangential(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_grad(I,J,k) = (1 - gamma_2) * segment%tangential_grad(I,J,k) + & + gamma_2 * segment%nudged_tangential_grad(I,J,k) + enddo ; enddo + endif + deallocate(rx_tangential) + endif + if (segment%oblique_tan .or. segment%oblique_grad) then + I=segment%HI%IsdB + allocate(rx_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + allocate(ry_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + allocate(cff_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + do k=1,nz + rx_tangential(I,segment%HI%JsdB,k) = segment%rx_normal(I,segment%HI%jsd,k) + rx_tangential(I,segment%HI%JedB,k) = segment%rx_normal(I,segment%HI%jed,k) + ry_tangential(I,segment%HI%JsdB,k) = segment%ry_normal(I,segment%HI%jsd,k) + ry_tangential(I,segment%HI%JedB,k) = segment%ry_normal(I,segment%HI%jed,k) + cff_tangential(I,segment%HI%JsdB,k) = segment%cff_normal(I,segment%HI%jsd,k) + cff_tangential(I,segment%HI%JedB,k) = segment%cff_normal(I,segment%HI%jed,k) + do J=segment%HI%JsdB+1,segment%HI%JedB-1 + rx_tangential(I,J,k) = 0.5*(segment%rx_normal(I,j,k) + segment%rx_normal(I,j+1,k)) + ry_tangential(I,J,k) = 0.5*(segment%ry_normal(I,j,k) + segment%ry_normal(I,j+1,k)) + cff_tangential(I,J,k) = 0.5*(segment%cff_normal(I,j,k) + segment%cff_normal(I,j+1,k)) + enddo + enddo + if (segment%oblique_tan) then + do k=1,nz ; do J=segment%HI%JsdB+1,segment%HI%JedB-1 + 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*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) + enddo ; enddo + endif + if (segment%nudged_tan) then + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + ! dhdt gets set to 0 on inflow in oblique case + if (rx_tangential(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + 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) + enddo ; enddo + endif + if (segment%oblique_grad) then + Js_obc = max(segment%HI%JsdB,G%jsd+1) + Je_obc = min(segment%HI%JedB,G%jed-1) + do k=1,nz ; do J=segment%HI%JsdB+1,segment%HI%JedB-1 + 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) + enddo ; enddo + endif + if (segment%nudged_grad) then + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + ! dhdt gets set to 0 on inflow in oblique case + if (rx_tangential(I,J,k) <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out @@ -1683,6 +1789,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) enddo ; enddo endif deallocate(rx_tangential) + deallocate(ry_tangential) + deallocate(cff_tangential) endif endif @@ -1727,6 +1835,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) 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) + ! 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) OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) OBC%cff_normal(I,j,k) = segment%cff_normal(I,j,k) @@ -1758,12 +1868,13 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) if (segment%radiation_tan) then do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB rx_avg = rx_tangential(I,J,k) - segment%tangential_vel(I,J,k) = (v_new(I+1,J,k) + rx_avg*v_new(I+2,J,k)) / (1.0+rx_avg) + segment%tangential_vel(I,J,k) = (v_new(i+1,J,k) + rx_avg*v_new(i+2,J,k)) / (1.0+rx_avg) enddo ; enddo endif if (segment%nudged_tan) then do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB - if (rx_tangential(I,J,k) < 0.0) then + ! dhdt gets set to 0 on inflow in oblique case + if (rx_tangential(I,J,k) <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out @@ -1793,7 +1904,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) endif if (segment%nudged_grad) then do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB - if (rx_tangential(I,J,k) < 0.0) then + ! dhdt gets set to 0 on inflow in oblique case + if (rx_tangential(I,J,k) <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out @@ -1805,6 +1917,77 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) endif deallocate(rx_tangential) endif + if (segment%oblique_tan .or. segment%oblique_grad) then + I=segment%HI%IsdB + allocate(rx_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + allocate(ry_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + allocate(cff_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + do k=1,nz + rx_tangential(I,segment%HI%JsdB,k) = segment%rx_normal(I,segment%HI%jsd,k) + rx_tangential(I,segment%HI%JedB,k) = segment%rx_normal(I,segment%HI%jed,k) + ry_tangential(I,segment%HI%JsdB,k) = segment%ry_normal(I,segment%HI%jsd,k) + ry_tangential(I,segment%HI%JedB,k) = segment%ry_normal(I,segment%HI%jed,k) + cff_tangential(I,segment%HI%JsdB,k) = segment%cff_normal(I,segment%HI%jsd,k) + cff_tangential(I,segment%HI%JedB,k) = segment%cff_normal(I,segment%HI%jed,k) + do J=segment%HI%JsdB+1,segment%HI%JedB-1 + rx_tangential(I,J,k) = 0.5*(segment%rx_normal(I,j,k) + segment%rx_normal(I,j+1,k)) + ry_tangential(I,J,k) = 0.5*(segment%ry_normal(I,j,k) + segment%ry_normal(I,j+1,k)) + cff_tangential(I,J,k) = 0.5*(segment%cff_normal(I,j,k) + segment%cff_normal(I,j+1,k)) + enddo + enddo + if (segment%oblique_tan) then + do k=1,nz ; do J=segment%HI%JsdB+1,segment%HI%JedB-1 + 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*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) + enddo ; enddo + endif + if (segment%nudged_tan) then + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + ! dhdt gets set to 0 on inflow in oblique case + if (rx_tangential(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + 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) + enddo ; enddo + endif + if (segment%oblique_grad) then + Js_obc = max(segment%HI%JsdB,G%jsd+1) + Je_obc = min(segment%HI%JedB,G%jed-1) + do k=1,nz ; do J=segment%HI%JsdB+1,segment%HI%JedB-1 + 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) + enddo ; enddo + endif + if (segment%nudged_grad) then + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + ! dhdt gets set to 0 on inflow in oblique case + if (rx_tangential(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_grad(I,J,k) = (1 - gamma_2) * segment%tangential_grad(I,J,k) + & + gamma_2 * segment%nudged_tangential_grad(I,J,k) + enddo ; enddo + endif + deallocate(rx_tangential) + deallocate(ry_tangential) + deallocate(cff_tangential) + endif endif if (segment%direction == OBC_DIRECTION_N) then @@ -1849,6 +2032,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) 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) + ! 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) OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) OBC%cff_normal(i,J,k) = segment%cff_normal(i,J,k) @@ -1857,7 +2042,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) endif if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then ! dhdt gets set to 0 on inflow in oblique case - if (dhdt*dhdx <= 0.0) then + if (dhdt*dhdy <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out @@ -1885,7 +2070,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) endif if (segment%nudged_tan) then do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB - if (rx_tangential(I,J,k) < 0.0) then + ! dhdt gets set to 0 on inflow in oblique case + if (rx_tangential(I,J,k) <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out @@ -1909,13 +2095,14 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) ! else ! rx_avg = 0.0 ! endif - segment%tangential_grad(I,J,k) = ((u_new(I,j,k) - u_new(I-1,j,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 if (segment%nudged_grad) then do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB - if (rx_tangential(I,J,k) < 0.0) then + ! dhdt gets set to 0 on inflow in oblique case + if (ry_tangential(I,J,k) <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out @@ -1927,9 +2114,79 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) endif deallocate(rx_tangential) endif + if (segment%oblique_tan .or. segment%oblique_grad) then + J=segment%HI%JsdB + allocate(rx_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + allocate(ry_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + allocate(cff_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + do k=1,nz + rx_tangential(segment%HI%IsdB,J,k) = segment%ry_normal(segment%HI%isd,J,k) + rx_tangential(segment%HI%IedB,J,k) = segment%ry_normal(segment%HI%ied,J,k) + ry_tangential(segment%HI%IsdB,J,k) = segment%rx_normal(segment%HI%isd,J,k) + ry_tangential(segment%HI%IedB,J,k) = segment%rx_normal(segment%HI%ied,J,k) + cff_tangential(segment%HI%IsdB,J,k) = segment%cff_normal(segment%HI%isd,J,k) + cff_tangential(segment%HI%IedB,J,k) = segment%cff_normal(segment%HI%ied,J,k) + do I=segment%HI%IsdB+1,segment%HI%IedB-1 + rx_tangential(I,J,k) = 0.5*(segment%ry_normal(i,J,k) + segment%ry_normal(i+1,J,k)) + ry_tangential(I,J,k) = 0.5*(segment%rx_normal(i,J,k) + segment%rx_normal(i+1,J,k)) + cff_tangential(I,J,k) = 0.5*(segment%cff_normal(i,J,k) + segment%cff_normal(i+1,J,k)) + enddo + enddo + if (segment%oblique_tan) then + do k=1,nz ; do I=segment%HI%IsdB+1,segment%HI%IedB-1 + 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,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) + enddo ; enddo + endif + if (segment%nudged_tan) then + do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB + ! dhdt gets set to 0 on inflow in oblique case + if (ry_tangential(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + 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) + enddo ; enddo + endif + if (segment%oblique_grad) then + Is_obc = max(segment%HI%IsdB,G%isd+1) + Ie_obc = min(segment%HI%IedB,G%ied-1) + do k=1,nz ; do I=segment%HI%IsdB+1,segment%HI%IedB-1 + 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) + enddo ; enddo + endif + if (segment%nudged_grad) then + do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB + ! dhdt gets set to 0 on inflow in oblique case + if (ry_tangential(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_grad(I,J,k) = (1 - gamma_2) * segment%tangential_grad(I,J,k) + & + gamma_2 * segment%nudged_tangential_grad(I,J,k) + enddo ; enddo + endif + deallocate(rx_tangential) + deallocate(ry_tangential) + deallocate(cff_tangential) + endif endif - if (segment%direction == OBC_DIRECTION_S) then J=segment%HI%JsdB if (J>G%HI%JecB) cycle @@ -1971,6 +2228,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) 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) + ! 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) OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) OBC%cff_normal(i,J,k) = segment%cff_normal(i,J,k) @@ -1979,7 +2238,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) endif if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then ! dhdt gets set to 0 on inflow in oblique case - if (dhdt*dhdx <= 0.0) then + if (dhdt*dhdy <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out @@ -2007,7 +2266,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) endif if (segment%nudged_tan) then do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB - if (rx_tangential(I,J,k) < 0.0) then + ! dhdt gets set to 0 on inflow in oblique case + if (rx_tangential(I,J,k) <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out @@ -2037,7 +2297,77 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) endif if (segment%nudged_grad) then do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB - if (rx_tangential(I,J,k) < 0.0) then + ! dhdt gets set to 0 on inflow in oblique case + if (ry_tangential(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_grad(I,J,k) = (1 - gamma_2) * segment%tangential_grad(I,J,k) + & + gamma_2 * segment%nudged_tangential_grad(I,J,k) + enddo ; enddo + endif + deallocate(rx_tangential) + endif + if (segment%oblique_tan .or. segment%oblique_grad) then + J=segment%HI%JsdB + allocate(rx_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + allocate(ry_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + allocate(cff_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + do k=1,nz + rx_tangential(segment%HI%IsdB,J,k) = segment%ry_normal(segment%HI%isd,J,k) + rx_tangential(segment%HI%IedB,J,k) = segment%ry_normal(segment%HI%ied,J,k) + ry_tangential(segment%HI%IsdB,J,k) = segment%rx_normal(segment%HI%isd,J,k) + ry_tangential(segment%HI%IedB,J,k) = segment%rx_normal(segment%HI%ied,J,k) + cff_tangential(segment%HI%IsdB,J,k) = segment%cff_normal(segment%HI%isd,J,k) + cff_tangential(segment%HI%IedB,J,k) = segment%cff_normal(segment%HI%ied,J,k) + do I=segment%HI%IsdB+1,segment%HI%IedB-1 + rx_tangential(I,J,k) = 0.5*(segment%ry_normal(i,J,k) + segment%ry_normal(i+1,J,k)) + ry_tangential(I,J,k) = 0.5*(segment%rx_normal(i,J,k) + segment%rx_normal(i+1,J,k)) + cff_tangential(I,J,k) = 0.5*(segment%cff_normal(i,J,k) + segment%cff_normal(i+1,J,k)) + enddo + enddo + if (segment%oblique_tan) then + do k=1,nz ; do I=segment%HI%IsdB+1,segment%HI%IedB-1 + 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) + enddo ; enddo + endif + if (segment%nudged_tan) then + do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB + ! dhdt gets set to 0 on inflow in oblique case + if (ry_tangential(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + 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) + enddo ; enddo + endif + if (segment%oblique_grad) then + Is_obc = max(segment%HI%IsdB,G%isd+1) + Ie_obc = min(segment%HI%IedB,G%ied-1) + do k=1,nz ; do I=segment%HI%IsdB+1,segment%HI%IedB-1 + 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) + enddo ; enddo + endif + if (segment%nudged_grad) then + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + ! dhdt gets set to 0 on inflow in oblique case + if (ry_tangential(I,J,k) <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out @@ -2048,6 +2378,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) enddo ; enddo endif deallocate(rx_tangential) + deallocate(ry_tangential) + deallocate(cff_tangential) endif endif enddo @@ -2144,6 +2476,24 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) segment%grad_normal(J,2,k) = (uvel(I,j+1,k)-uvel(I,j,k)) * G%mask2dBu(I,J) enddo enddo + if (segment%oblique_tan) then + do k=1,G%ke + do J=max(segment%HI%jsd, G%HI%jsd+1),min(segment%HI%jed, G%HI%jed-1) + segment%grad_tan(j,1,k) = (vvel(i-1,J,k)-vvel(i-1,J-1,k)) * G%mask2dT(i-1,j) + segment%grad_tan(j,2,k) = (vvel(i,J,k)-vvel(i,J-1,k)) * G%mask2dT(i,j) + enddo + enddo + endif + if (segment%oblique_grad) then + do k=1,G%ke + do J=max(segment%HI%jsd, G%HI%jsd+1),min(segment%HI%jed, G%HI%jed-1) + segment%grad_gradient(j,1,k) = (((vvel(i-1,J,k) - vvel(i-2,J,k))*G%IdxBu(I-2,J)) - & + (vvel(i-1,J-1,k) - vvel(i-2,J-1,k))*G%IdxBu(I-2,J-1)) * G%mask2dCu(I-1,j) + segment%grad_gradient(j,2,k) = (((vvel(i,J,k) - vvel(i-1,J,k))*G%IdxBu(I-1,J)) - & + (vvel(i,J-1,k) - vvel(i-1,J-1,k))*G%IdxBu(I-1,J-1)) * G%mask2dCu(I,j) + enddo + enddo + endif else ! western segment I=segment%HI%isdB do k=1,G%ke @@ -2152,6 +2502,24 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) segment%grad_normal(J,2,k) = (uvel(I,j+1,k)-uvel(I,j,k)) * G%mask2dBu(I,J) enddo enddo + if (segment%oblique_tan) then + do k=1,G%ke + do J=max(segment%HI%jsd, G%HI%jsd+1),min(segment%HI%jed, G%HI%jed-1) + segment%grad_tan(j,1,k) = (vvel(i+2,J,k)-vvel(i+2,J-1,k)) * G%mask2dT(i+2,j) + segment%grad_tan(j,2,k) = (vvel(i+1,J,k)-vvel(i+1,J-1,k)) * G%mask2dT(i+1,j) + enddo + enddo + endif + if (segment%oblique_grad) then + do k=1,G%ke + do J=max(segment%HI%jsd, G%HI%jsd+1),min(segment%HI%jed, G%HI%jed-1) + segment%grad_gradient(j,1,k) = (((vvel(i+3,J,k) - vvel(i+2,J,k))*G%IdxBu(I+2,J)) - & + (vvel(i+3,J-1,k) - vvel(i+2,J-1,k))*G%IdxBu(I+2,J-1)) * G%mask2dCu(I+2,j) + segment%grad_gradient(j,2,k) = (((vvel(i+2,J,k) - vvel(i+1,J,k))*G%IdxBu(I+1,J)) - & + (vvel(i+2,J-1,k) - vvel(i+1,J-1,k))*G%IdxBu(I+1,J-1)) * G%mask2dCu(I+1,j) + enddo + enddo + endif endif elseif (segment%is_N_or_S) then if (segment%direction == OBC_DIRECTION_N) then @@ -2162,6 +2530,24 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) segment%grad_normal(I,2,k) = (vvel(i+1,J,k)-vvel(i,J,k)) * G%mask2dBu(I,J) enddo enddo + if (segment%oblique_tan) then + do k=1,G%ke + do I=max(segment%HI%isd, G%HI%isd+1),min(segment%HI%ied, G%HI%ied-1) + segment%grad_tan(i,1,k) = (uvel(I,j-1,k)-uvel(I-1,j-1,k)) * G%mask2dT(i,j-1) + segment%grad_tan(i,2,k) = (uvel(I,j,k)-uvel(I-1,j,k)) * G%mask2dT(i,j) + enddo + enddo + endif + 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) + 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)) - & + (uvel(I-1,j,k) - uvel(I-1,j-1,k))*G%IdyBu(I-1,J-1)) * G%mask2dCv(i,J) + enddo + enddo + endif else ! south segment J=segment%HI%jsdB do k=1,G%ke @@ -2170,6 +2556,24 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) segment%grad_normal(I,2,k) = (vvel(i+1,J,k)-vvel(i,J,k)) * G%mask2dBu(I,J) enddo enddo + if (segment%oblique_tan) then + do k=1,G%ke + do I=max(segment%HI%isd, G%HI%isd+1),min(segment%HI%ied, G%HI%ied-1) + segment%grad_tan(i,1,k) = (uvel(I,j+2,k)-uvel(I-1,j+2,k)) * G%mask2dT(i,j+2) + segment%grad_tan(i,2,k) = (uvel(I,j+1,k)-uvel(I-1,j+1,k)) * G%mask2dT(i,j+1) + enddo + enddo + endif + 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) + 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)) - & + (uvel(I-1,j+2,k) - uvel(I-1,j+1,k))*G%IdyBu(I-1,J+1)) * G%mask2dCv(i,J+1) + enddo + enddo + endif endif endif @@ -2329,7 +2733,8 @@ subroutine allocate_OBC_segment_data(OBC, segment) if (segment%nudged_grad) then allocate(segment%nudged_tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%nudged_tangential_grad(:,:,:)=0.0 endif - if (OBC%specified_vorticity .or. OBC%specified_strain .or. segment%radiation_grad) then + if (OBC%specified_vorticity .or. OBC%specified_strain .or. segment%radiation_grad .or. & + segment%oblique_grad) then allocate(segment%tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%tangential_grad(:,:,:)=0.0 endif if (segment%oblique) then @@ -2338,6 +2743,12 @@ subroutine allocate_OBC_segment_data(OBC, segment) allocate(segment%ry_normal(IsdB:IedB,jsd:jed,OBC%ke)); segment%ry_normal(:,:,:)=0.0 allocate(segment%cff_normal(IsdB:IedB,jsd:jed,OBC%ke)); segment%cff_normal(:,:,:)=0.0 endif + if (segment%oblique_tan) then + allocate(segment%grad_tan(jsd:jed,2,OBC%ke)); segment%grad_tan(:,:,:) = 0.0 + endif + if (segment%oblique_grad) then + allocate(segment%grad_gradient(jsd:jed,2,OBC%ke)); segment%grad_gradient(:,:,:) = 0.0 + endif endif if (segment%is_N_or_S) then @@ -2365,7 +2776,8 @@ subroutine allocate_OBC_segment_data(OBC, segment) if (segment%nudged_grad) then allocate(segment%nudged_tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%nudged_tangential_grad(:,:,:)=0.0 endif - if (OBC%specified_vorticity .or. OBC%specified_strain .or. segment%radiation_grad) then + if (OBC%specified_vorticity .or. OBC%specified_strain .or. segment%radiation_grad .or. & + segment%oblique_grad) then allocate(segment%tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%tangential_grad(:,:,:)=0.0 endif if (segment%oblique) then @@ -2374,6 +2786,12 @@ subroutine allocate_OBC_segment_data(OBC, segment) allocate(segment%ry_normal(isd:ied,JsdB:JedB,OBC%ke)); segment%ry_normal(:,:,:)=0.0 allocate(segment%cff_normal(isd:ied,JsdB:JedB,OBC%ke)); segment%cff_normal(:,:,:)=0.0 endif + if (segment%oblique_tan) then + allocate(segment%grad_tan(isd:ied,2,OBC%ke)); segment%grad_tan(:,:,:) = 0.0 + endif + if (segment%oblique_grad) then + allocate(segment%grad_gradient(isd:ied,2,OBC%ke)); segment%grad_gradient(:,:,:) = 0.0 + endif endif end subroutine allocate_OBC_segment_data @@ -2394,12 +2812,16 @@ subroutine deallocate_OBC_segment_data(OBC, segment) if (associated (segment%rx_normal)) deallocate(segment%rx_normal) if (associated (segment%ry_normal)) deallocate(segment%ry_normal) if (associated (segment%cff_normal)) deallocate(segment%cff_normal) + if (associated (segment%grad_normal)) deallocate(segment%grad_normal) + if (associated (segment%grad_tan)) deallocate(segment%grad_tan) + if (associated (segment%grad_gradient)) deallocate(segment%grad_gradient) if (associated (segment%normal_vel)) deallocate(segment%normal_vel) if (associated (segment%normal_vel_bt)) deallocate(segment%normal_vel_bt) if (associated (segment%normal_trans)) deallocate(segment%normal_trans) if (associated (segment%nudged_normal_vel)) deallocate(segment%nudged_normal_vel) if (associated (segment%tangential_vel)) deallocate(segment%tangential_vel) if (associated (segment%nudged_tangential_vel)) deallocate(segment%nudged_tangential_vel) + if (associated (segment%nudged_tangential_grad)) deallocate(segment%nudged_tangential_grad) if (associated (segment%tangential_grad)) deallocate(segment%tangential_grad) if (associated (segment%tr_Reg)) call segment_tracer_registry_end(segment%tr_Reg) From c95d513194bade848ba75a460bd63ba5a6c9cc5b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 3 Aug 2018 03:18:31 -0400 Subject: [PATCH 006/174] +Use stress_mag to set ustar Added code to use IOB%stress_mag to set ustar if is allocated. The code to set stress_mag in SIS2 is equivalent to that in MOM6, so the answers are currently unchanged if this new option is used. Also rearranged the code setting the wind stresses, ustar, and other forcing fields so they are more logically grouped. All answers are bitwise identical in test cases, but there are new options to allow the sea-ice or coupler to set ustar differently. --- .../coupled_driver/MOM_surface_forcing.F90 | 133 ++++++++++-------- 1 file changed, 72 insertions(+), 61 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 02b54daefe..693a200c18 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -324,7 +324,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & ! ocean model, rather than using haloless arrays, in which case the last line ! would be: ( (/isd,is,ie,ied/), (/jsd,js,je,jed/)) - if (CS%allow_flux_adjustments) then fluxes%heat_added(:,:)=0.0 fluxes%salt_flux_added(:,:)=0.0 @@ -576,7 +575,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a !! previous call to surface_forcing_init. - + ! Local variables real, dimension(SZIB_(G),SZJB_(G)) :: & taux_at_q, & ! Zonal wind stresses at q points (Pa) tauy_at_q ! Meridional wind stresses at q points (Pa) @@ -611,7 +610,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) isr = is-isd+1 ; ier = ie-isd+1 ; jsr = js-jsd+1 ; jer = je-jsd+1 i0 = is - isc_bnd ; j0 = js - jsc_bnd - Irho0 = 1.0/CS%Rho0 + Irho0 = 1.0/CS%Rho0 ! allocation and initialization if this is the first time that this ! mechanical forcing type has been used. @@ -638,6 +637,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) if ( (associated(IOB%area_berg) .and. (.not. associated(forces%area_berg))) .or. & (associated(IOB%mass_berg) .and. (.not. associated(forces%mass_berg))) ) & call allocate_mech_forcing(G, forces, iceberg=.true.) + if (associated(IOB%ice_rigidity)) then rigidity_at_h(:,:) = 0.0 call safe_alloc_ptr(forces%rigidity_ice_u,IsdB,IedB,jsd,jed) @@ -672,41 +672,16 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) wind_stagger = CS%wind_stagger if ((IOB%wind_stagger == AGRID) .or. (IOB%wind_stagger == BGRID_NE) .or. & (IOB%wind_stagger == CGRID_NE)) wind_stagger = IOB%wind_stagger + + ! Set surface momentum stress related fields as a function of staggering. if (wind_stagger == BGRID_NE) then ! This is necessary to fill in the halo points. taux_at_q(:,:) = 0.0 ; tauy_at_q(:,:) = 0.0 - endif - if (wind_stagger == AGRID) then - ! This is necessary to fill in the halo points. - taux_at_h(:,:) = 0.0 ; tauy_at_h(:,:) = 0.0 - endif - - ! obtain fluxes from IOB; note the staggering of indices - do j=js,je ; do i=is,ie - if (associated(IOB%area_berg)) & - forces%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j) - - if (associated(IOB%mass_berg)) & - forces%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j) - - if (associated(IOB%ice_rigidity)) & - rigidity_at_h(i,j) = IOB%ice_rigidity(i-i0,j-j0) * G%mask2dT(i,j) - - if (wind_stagger == BGRID_NE) then + ! obtain fluxes from IOB; note the staggering of indices + do j=js,je ; do i=is,ie if (associated(IOB%u_flux)) taux_at_q(I,J) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier if (associated(IOB%v_flux)) tauy_at_q(I,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier - elseif (wind_stagger == AGRID) then - if (associated(IOB%u_flux)) taux_at_h(i,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier - if (associated(IOB%v_flux)) tauy_at_h(i,j) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier - else ! C-grid wind stresses. - if (associated(IOB%u_flux)) forces%taux(I,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier - if (associated(IOB%v_flux)) forces%tauy(i,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier - endif - - enddo ; enddo - - ! surface momentum stress related fields as function of staggering - if (wind_stagger == BGRID_NE) then + enddo ; enddo if (G%symmetric) & call fill_symmetric_edges(taux_at_q, tauy_at_q, G%Domain, stagger=BGRID_NE) call pass_vector(taux_at_q, tauy_at_q, G%Domain, stagger=BGRID_NE, halo=1) @@ -727,25 +702,14 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) (G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) enddo ; enddo - ! ustar is required for the bulk mixed layer formulation. The background value - ! of 0.02 Pa is a relatively small value intended to give reasonable behavior - ! in regions of very weak winds. - + elseif (wind_stagger == AGRID) then + ! This is necessary to fill in the halo points. + taux_at_h(:,:) = 0.0 ; tauy_at_h(:,:) = 0.0 + ! obtain fluxes from IOB; note the staggering of indices do j=js,je ; do i=is,ie - tau_mag = 0.0 ; gustiness = CS%gust_const - if (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + & - (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0) then - tau_mag = sqrt(((G%mask2dBu(I,J)*(taux_at_q(I,J)**2 + tauy_at_q(I,J)**2) + & - G%mask2dBu(I-1,J-1)*(taux_at_q(I-1,J-1)**2 + tauy_at_q(I-1,J-1)**2)) + & - (G%mask2dBu(I,J-1)*(taux_at_q(I,J-1)**2 + tauy_at_q(I,J-1)**2) + & - G%mask2dBu(I-1,J)*(taux_at_q(I-1,J)**2 + tauy_at_q(I-1,J)**2)) ) / & - ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) - if (CS%read_gust_2d) gustiness = CS%gust(i,j) - endif - forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*tau_mag) + if (associated(IOB%u_flux)) taux_at_h(i,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier + if (associated(IOB%v_flux)) tauy_at_h(i,j) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier enddo ; enddo - - elseif (wind_stagger == AGRID) then call pass_vector(taux_at_h, tauy_at_h, G%Domain, To_All+Omit_Corners, & stagger=AGRID, halo=1) @@ -765,25 +729,61 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) (G%mask2dT(i,j) + G%mask2dT(i,j+1)) enddo ; enddo + else ! C-grid wind stresses. do j=js,je ; do i=is,ie - gustiness = CS%gust_const - if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) - forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & - sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)) + if (associated(IOB%u_flux)) forces%taux(I,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier + if (associated(IOB%v_flux)) forces%tauy(i,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier enddo ; enddo - - else ! C-grid wind stresses. if (G%symmetric) & call fill_symmetric_edges(forces%taux, forces%tauy, G%Domain) call pass_vector(forces%taux, forces%tauy, G%Domain, halo=1) + endif ! endif for wind stress fields + ! Set surface friction velocity directly or as a function of staggering. + ! ustar is required for the bulk mixed layer formulation and other turbulent mixing + ! parametizations. The background gustiness (for example with a relatively small value + ! of 0.02 Pa) is intended to give reasonable behavior in regions of very weak winds. + if (associated(IOB%stress_mag)) then + do j=js,je ; do i=is,ie + gustiness = CS%gust_const + !### SIMPLIFY THE TREATMENT OF GUSTINESS! + if (CS%read_gust_2d) then + if ((wind_stagger == CGRID_NE) .or. & + ((wind_stagger == AGRID) .and. (G%mask2dT(i,j) > 0)) .or. & + ((wind_stagger == BGRID_NE) .and. & + (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + & + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0)) ) & + gustiness = CS%gust(i,j) + endif + forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*IOB%stress_mag(i-i0,j-j0)) + enddo ; enddo + elseif (wind_stagger == BGRID_NE) then + do j=js,je ; do i=is,ie + tau_mag = 0.0 ; gustiness = CS%gust_const + if (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + & + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0) then + tau_mag = sqrt(((G%mask2dBu(I,J)*(taux_at_q(I,J)**2 + tauy_at_q(I,J)**2) + & + G%mask2dBu(I-1,J-1)*(taux_at_q(I-1,J-1)**2 + tauy_at_q(I-1,J-1)**2)) + & + (G%mask2dBu(I,J-1)*(taux_at_q(I,J-1)**2 + tauy_at_q(I,J-1)**2) + & + G%mask2dBu(I-1,J)*(taux_at_q(I-1,J)**2 + tauy_at_q(I-1,J)**2)) ) / & + ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) + if (CS%read_gust_2d) gustiness = CS%gust(i,j) + endif + forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*tau_mag) + enddo ; enddo + elseif (wind_stagger == AGRID) then + do j=js,je ; do i=is,ie + gustiness = CS%gust_const + if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) + forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & + sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)) + enddo ; enddo + else ! C-grid wind stresses. do j=js,je ; do i=is,ie - taux2 = 0.0 + taux2 = 0.0 ; tauy2 = 0.0 if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0) & taux2 = (G%mask2dCu(I-1,j)*forces%taux(I-1,j)**2 + & G%mask2dCu(I,j)*forces%taux(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) - - tauy2 = 0.0 if ((G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) > 0) & tauy2 = (G%mask2dCv(i,J-1)*forces%tauy(i,J-1)**2 + & G%mask2dCv(i,J)*forces%tauy(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) @@ -794,11 +794,22 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) forces%ustar(i,j) = sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) endif enddo ; enddo + endif ! endif for wind friction velocity fields - endif ! endif for wind related fields + ! Obtain optional ice-berg related fluxes from the IOB type: + if (associated(IOB%area_berg)) then ; do j=js,je ; do i=is,ie + forces%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j) + enddo ; enddo ; endif - ! sea ice related dynamic fields + if (associated(IOB%mass_berg)) then ; do j=js,je ; do i=is,ie + forces%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j) + enddo ; enddo ; endif + + ! Obtain sea ice related dynamic fields if (associated(IOB%ice_rigidity)) then + do j=js,je ; do i=is,ie + rigidity_at_h(i,j) = IOB%ice_rigidity(i-i0,j-j0) * G%mask2dT(i,j) + enddo ; enddo call pass_var(rigidity_at_h, G%Domain, halo=1) do I=is-1,ie ; do j=js,je forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + & From e1762f57d14e4f01ce2bc9b63fa42818163618fc Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 3 Aug 2018 12:49:41 -0400 Subject: [PATCH 007/174] +Added extract_IOB_stresses Added a new subroutine, extract_IOB_stresses, to obtain the wind stresses and friction velocities from the ice-ocean-boundary type into simple arrays that are provided as optional arguments. All answers are bitwise identical. --- .../coupled_driver/MOM_surface_forcing.F90 | 209 ++++++++++++++++++ 1 file changed, 209 insertions(+) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 693a200c18..996455d26c 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -856,6 +856,215 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) call cpu_clock_end(id_clock_forcing) end subroutine convert_IOB_to_forces + +!> This subroutine extracts the wind stresses and related fields like ustar from an +!! Ice_ocean_boundary_type into optional argument arrays, including changes of units, sign +!! conventions, and putting the fields into arrays with MOM-standard sized halos. +subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, ustar, gustless_ustar) + type(ice_ocean_boundary_type), & + target, intent(in) :: IOB !< An ice-ocean boundary type with fluxes to drive + !! the ocean in a coupled model + integer, dimension(4), intent(in) :: index_bounds !< The i- and j- size of the arrays in IOB. + type(time_type), intent(in) :: Time !< The time of the fluxes, used for interpolating the + !! salinity to the right time, when it is being restored. + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a + !! previous call to surface_forcing_init. + real, dimension(SZIB_(G),SZJ_(G)), & + optional, intent(out) :: taux !< The zonal wind stresses on a C-grid, in Pa. + real, dimension(SZI_(G),SZJB_(G)), & + optional, intent(out) :: tauy !< The meridional wind stresses on a C-grid, in Pa. + real, dimension(SZI_(G),SZJ_(G)), & + optional, intent(out) :: ustar !< The surface friction velocity, in m s-1. + real, dimension(SZI_(G),SZJ_(G)), & + optional, intent(out) :: gustless_ustar !< The surface friction velocity without + !! any contributions from gustiness, in m s-1. + + ! Local variables + real, dimension(SZIB_(G),SZJ_(G)) :: & + taux_at_u ! Zonal wind stresses at u points (Pa) + real, dimension(SZI_(G),SZJB_(G)) :: & + tauy_at_v ! Meridional wind stresses at V points (Pa) + real, dimension(SZIB_(G),SZJB_(G)) :: & + taux_at_q, & ! Zonal wind stresses at q points (Pa) + tauy_at_q ! Meridional wind stresses at q points (Pa) + + real, dimension(SZI_(G),SZJ_(G)) :: & + taux_at_h, & ! Zonal wind stresses at h points (Pa) + tauy_at_h ! Meridional wind stresses at h points (Pa) + + real :: gustiness ! unresolved gustiness that contributes to ustar (Pa) + real :: Irho0 ! inverse of the mean density in (m^3/kg) + real :: taux2, tauy2 ! squared wind stresses (Pa^2) + real :: tau_mag ! magnitude of the wind stress (Pa) + + logical :: do_ustar, do_gustless + integer :: wind_stagger ! AGRID, BGRID_NE, or CGRID_NE (integers from MOM_domains) + integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq, i0, j0 + integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, isr, ier, jsr, jer + integer :: isc_bnd, iec_bnd, jsc_bnd, jec_bnd + + call cpu_clock_begin(id_clock_forcing) + + isc_bnd = index_bounds(1) ; iec_bnd = index_bounds(2) + jsc_bnd = index_bounds(3) ; jec_bnd = index_bounds(4) + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB + isr = is-isd+1 ; ier = ie-isd+1 ; jsr = js-jsd+1 ; jer = je-jsd+1 + i0 = is - isc_bnd ; j0 = js - jsc_bnd + + Irho0 = 1.0/CS%Rho0 + + do_ustar = present(ustar) ; do_gustless = present(gustless_ustar) + + wind_stagger = CS%wind_stagger + if ((IOB%wind_stagger == AGRID) .or. (IOB%wind_stagger == BGRID_NE) .or. & + (IOB%wind_stagger == CGRID_NE)) wind_stagger = IOB%wind_stagger + + ! Set surface momentum stress related fields as a function of staggering. + if (present(taux) .or. present(tauy) .or. & + ((do_ustar.or.do_gustless) .and. .not.associated(IOB%stress_mag)) ) then + if (wind_stagger == BGRID_NE) then + ! This is necessary to fill in the halo points. + taux_at_q(:,:) = 0.0 ; tauy_at_q(:,:) = 0.0 + ! obtain fluxes from IOB; note the staggering of indices + do j=js,je ; do i=is,ie + if (associated(IOB%u_flux)) taux_at_q(I,J) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier + if (associated(IOB%v_flux)) tauy_at_q(I,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier + enddo ; enddo + if (G%symmetric) & + call fill_symmetric_edges(taux_at_q, tauy_at_q, G%Domain, stagger=BGRID_NE) + call pass_vector(taux_at_q, tauy_at_q, G%Domain, stagger=BGRID_NE, halo=1) + + if (present(taux)) then ; do j=js,je ; do I=Isq,Ieq + taux(I,j) = 0.0 + if ((G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) > 0) & + taux(I,j) = (G%mask2dBu(I,J)*taux_at_q(I,J) + G%mask2dBu(I,J-1)*taux_at_q(I,J-1)) / & + (G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) + enddo ; enddo ; endif + + if (present(tauy)) then ; do J=Jsq,Jeq ; do i=is,ie + tauy(i,J) = 0.0 + if ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) > 0) & + tauy(i,J) = (G%mask2dBu(I,J)*tauy_at_q(I,J) + G%mask2dBu(I-1,J)*tauy_at_q(I-1,J)) / & + (G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) + enddo ; enddo ; endif + + elseif (wind_stagger == AGRID) then + ! This is necessary to fill in the halo points. + taux_at_h(:,:) = 0.0 ; tauy_at_h(:,:) = 0.0 + ! obtain fluxes from IOB; note the staggering of indices + do j=js,je ; do i=is,ie + if (associated(IOB%u_flux)) taux_at_h(i,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier + if (associated(IOB%v_flux)) tauy_at_h(i,j) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier + enddo ; enddo + call pass_vector(taux_at_h, tauy_at_h, G%Domain, To_All+Omit_Corners, & + stagger=AGRID, halo=1) + + if (present(taux)) then ; do j=js,je ; do I=Isq,Ieq + taux(I,j) = 0.0 + if ((G%mask2dT(i,j) + G%mask2dT(i+1,j)) > 0) & + taux(I,j) = (G%mask2dT(i,j)*taux_at_h(i,j) + G%mask2dT(i+1,j)*taux_at_h(i+1,j)) / & + (G%mask2dT(i,j) + G%mask2dT(i+1,j)) + enddo ; enddo ; endif + + if (present(tauy)) then ; do J=Jsq,Jeq ; do i=is,ie + tauy(i,J) = 0.0 + if ((G%mask2dT(i,j) + G%mask2dT(i,j+1)) > 0) & + tauy(i,J) = (G%mask2dT(i,j)*tauy_at_h(i,j) + G%mask2dT(i,J+1)*tauy_at_h(i,j+1)) / & + (G%mask2dT(i,j) + G%mask2dT(i,j+1)) + enddo ; enddo ; endif + + else ! C-grid wind stresses. + do j=js,je ; do i=is,ie + if (associated(IOB%u_flux)) taux_at_u(I,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier + if (associated(IOB%v_flux)) tauy_at_v(i,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier + enddo ; enddo + if (G%symmetric) & + call fill_symmetric_edges(taux_at_u, tauy_at_v, G%Domain) + call pass_vector(taux_at_u, tauy_at_v, G%Domain, halo=1) + + if (present(taux)) then ; do j=js,je ; do I=Isq,Ieq + taux(I,j) = G%mask2dCu(I,j)*taux_at_u(I,j) + enddo ; enddo ; endif + + if (present(tauy)) then ; do J=Jsq,Jeq ; do i=is,ie + tauy(i,J) = G%mask2dCv(i,J)*tauy_at_v(i,J) + enddo ; enddo ; endif + + endif ! endif for extracting wind stress fields with various staggerings + endif + + if (do_ustar .or. do_gustless) then + ! Set surface friction velocity directly or as a function of staggering. + ! ustar is required for the bulk mixed layer formulation and other turbulent mixing + ! parametizations. The background gustiness (for example with a relatively small value + ! of 0.02 Pa) is intended to give reasonable behavior in regions of very weak winds. + if (associated(IOB%stress_mag)) then + if (do_ustar) then ; do j=js,je ; do i=is,ie + gustiness = CS%gust_const + !### SIMPLIFY THE TREATMENT OF GUSTINESS! + if (CS%read_gust_2d) then + if ((wind_stagger == CGRID_NE) .or. & + ((wind_stagger == AGRID) .and. (G%mask2dT(i,j) > 0)) .or. & + ((wind_stagger == BGRID_NE) .and. & + (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + & + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0)) ) & + gustiness = CS%gust(i,j) + endif + ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*IOB%stress_mag(i-i0,j-j0)) + enddo ; enddo ; endif + if (do_gustless) then ; do j=js,je ; do i=is,ie + gustless_ustar(i,j) = sqrt(Irho0*IOB%stress_mag(i-i0,j-j0)) + enddo ; enddo ; endif + elseif (wind_stagger == BGRID_NE) then + do j=js,je ; do i=is,ie + tau_mag = 0.0 ; gustiness = CS%gust_const + if (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + & + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0) then + tau_mag = sqrt(((G%mask2dBu(I,J)*(taux_at_q(I,J)**2 + tauy_at_q(I,J)**2) + & + G%mask2dBu(I-1,J-1)*(taux_at_q(I-1,J-1)**2 + tauy_at_q(I-1,J-1)**2)) + & + (G%mask2dBu(I,J-1)*(taux_at_q(I,J-1)**2 + tauy_at_q(I,J-1)**2) + & + G%mask2dBu(I-1,J)*(taux_at_q(I-1,J)**2 + tauy_at_q(I-1,J)**2)) ) / & + ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) + if (CS%read_gust_2d) gustiness = CS%gust(i,j) + endif + if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) + if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0*tau_mag) + enddo ; enddo + elseif (wind_stagger == AGRID) then + do j=js,je ; do i=is,ie + tau_mag = G%mask2dT(i,j) * sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2) + gustiness = CS%gust_const + if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) + if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) + if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0*tau_mag) + enddo ; enddo + else ! C-grid wind stresses. + do j=js,je ; do i=is,ie + taux2 = 0.0 ; tauy2 = 0.0 + if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0) & + taux2 = (G%mask2dCu(I-1,j)*taux_at_u(I-1,j)**2 + & + G%mask2dCu(I,j)*taux_at_u(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) + if ((G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) > 0) & + tauy2 = (G%mask2dCv(i,J-1)*tauy_at_v(i,J-1)**2 + & + G%mask2dCv(i,J)*tauy_at_v(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) + tau_mag = sqrt(taux2 + tauy2) + + gustiness = CS%gust_const + if (CS%read_gust_2d) gustiness = CS%gust(i,j) + + if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) + if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0*tau_mag) + enddo ; enddo + endif ! endif for wind friction velocity fields + endif + +end subroutine extract_IOB_stresses + + !> Adds thermodynamic flux adjustments obtained via data_override !! Component name is 'OCN' !! Available adjustments are: From 4b859d488ef76ec0a1fdc9b4cbfabdc2d100288d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 3 Aug 2018 18:53:49 -0400 Subject: [PATCH 008/174] Always set G%Domain_aux G%Domain_aux points to a non-symmetric MOM6 domain. It had previously only been set if G%Domain is symmetric, but was otherwise not associated. Now if G%domain is itself non-symmetric, G%domain_aux simply points back to G%domain. G%domain_aux can now be used more widely without causing problems. All answers are bitwise identical. --- src/core/MOM.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index c554e4f92e..ce23880906 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2135,8 +2135,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! Set a few remaining fields that are specific to the ocean grid type. call set_first_direction(G, first_direction) ! Allocate the auxiliary non-symmetric domain for debugging or I/O purposes. - if (CS%debug .or. G%symmetric) & + if (CS%debug .or. G%symmetric) then call clone_MOM_domain(G%Domain, G%Domain_aux, symmetric=.false.) + else ; G%Domain_aux => G%Domain ; endif ! Copy common variables from the vertical grid to the horizontal grid. ! Consider removing this later? G%ke = GV%ke ; G%g_Earth = GV%g_Earth @@ -2165,8 +2166,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call MOM_grid_end(G) ; deallocate(G) G => CS%G - if (CS%debug .or. CS%G%symmetric) & + if (CS%debug .or. CS%G%symmetric) then call clone_MOM_domain(CS%G%Domain, CS%G%Domain_aux, symmetric=.false.) + else ; CS%G%Domain_aux => CS%G%Domain ;endif G%ke = GV%ke ; G%g_Earth = GV%g_Earth endif From 7507e2d8d373f5562876de47b829bf07ebb5c868 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 3 Aug 2018 18:54:32 -0400 Subject: [PATCH 009/174] Set stresses via extract_IOB_stresses Replaced the code setting the wind stresses in code_IOB_to_forces with a call to extract_IOB_stresses. Also streamlined extract_IOB_stresses to avoid extra unnecessary communications. All answers are bitwise identical. --- .../coupled_driver/MOM_surface_forcing.F90 | 198 ++++-------------- 1 file changed, 35 insertions(+), 163 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 996455d26c..c963670ee3 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -669,132 +669,9 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) endif forces%accumulate_p_surf = .true. ! Multiple components may contribute to surface pressure. - wind_stagger = CS%wind_stagger - if ((IOB%wind_stagger == AGRID) .or. (IOB%wind_stagger == BGRID_NE) .or. & - (IOB%wind_stagger == CGRID_NE)) wind_stagger = IOB%wind_stagger - - ! Set surface momentum stress related fields as a function of staggering. - if (wind_stagger == BGRID_NE) then - ! This is necessary to fill in the halo points. - taux_at_q(:,:) = 0.0 ; tauy_at_q(:,:) = 0.0 - ! obtain fluxes from IOB; note the staggering of indices - do j=js,je ; do i=is,ie - if (associated(IOB%u_flux)) taux_at_q(I,J) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier - if (associated(IOB%v_flux)) tauy_at_q(I,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier - enddo ; enddo - if (G%symmetric) & - call fill_symmetric_edges(taux_at_q, tauy_at_q, G%Domain, stagger=BGRID_NE) - call pass_vector(taux_at_q, tauy_at_q, G%Domain, stagger=BGRID_NE, halo=1) - - do j=js,je ; do I=Isq,Ieq - forces%taux(I,j) = 0.0 - if ((G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) > 0) & - forces%taux(I,j) = (G%mask2dBu(I,J)*taux_at_q(I,J) + & - G%mask2dBu(I,J-1)*taux_at_q(I,J-1)) / & - (G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) - enddo ; enddo - - do J=Jsq,Jeq ; do i=is,ie - forces%tauy(i,J) = 0.0 - if ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) > 0) & - forces%tauy(i,J) = (G%mask2dBu(I,J)*tauy_at_q(I,J) + & - G%mask2dBu(I-1,J)*tauy_at_q(I-1,J)) / & - (G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) - enddo ; enddo - - elseif (wind_stagger == AGRID) then - ! This is necessary to fill in the halo points. - taux_at_h(:,:) = 0.0 ; tauy_at_h(:,:) = 0.0 - ! obtain fluxes from IOB; note the staggering of indices - do j=js,je ; do i=is,ie - if (associated(IOB%u_flux)) taux_at_h(i,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier - if (associated(IOB%v_flux)) tauy_at_h(i,j) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier - enddo ; enddo - call pass_vector(taux_at_h, tauy_at_h, G%Domain, To_All+Omit_Corners, & - stagger=AGRID, halo=1) - - do j=js,je ; do I=Isq,Ieq - forces%taux(I,j) = 0.0 - if ((G%mask2dT(i,j) + G%mask2dT(i+1,j)) > 0) & - forces%taux(I,j) = (G%mask2dT(i,j)*taux_at_h(i,j) + & - G%mask2dT(i+1,j)*taux_at_h(i+1,j)) / & - (G%mask2dT(i,j) + G%mask2dT(i+1,j)) - enddo ; enddo - - do J=Jsq,Jeq ; do i=is,ie - forces%tauy(i,J) = 0.0 - if ((G%mask2dT(i,j) + G%mask2dT(i,j+1)) > 0) & - forces%tauy(i,J) = (G%mask2dT(i,j)*tauy_at_h(i,j) + & - G%mask2dT(i,J+1)*tauy_at_h(i,j+1)) / & - (G%mask2dT(i,j) + G%mask2dT(i,j+1)) - enddo ; enddo - - else ! C-grid wind stresses. - do j=js,je ; do i=is,ie - if (associated(IOB%u_flux)) forces%taux(I,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier - if (associated(IOB%v_flux)) forces%tauy(i,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier - enddo ; enddo - if (G%symmetric) & - call fill_symmetric_edges(forces%taux, forces%tauy, G%Domain) - call pass_vector(forces%taux, forces%tauy, G%Domain, halo=1) - endif ! endif for wind stress fields - - ! Set surface friction velocity directly or as a function of staggering. - ! ustar is required for the bulk mixed layer formulation and other turbulent mixing - ! parametizations. The background gustiness (for example with a relatively small value - ! of 0.02 Pa) is intended to give reasonable behavior in regions of very weak winds. - if (associated(IOB%stress_mag)) then - do j=js,je ; do i=is,ie - gustiness = CS%gust_const - !### SIMPLIFY THE TREATMENT OF GUSTINESS! - if (CS%read_gust_2d) then - if ((wind_stagger == CGRID_NE) .or. & - ((wind_stagger == AGRID) .and. (G%mask2dT(i,j) > 0)) .or. & - ((wind_stagger == BGRID_NE) .and. & - (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + & - (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0)) ) & - gustiness = CS%gust(i,j) - endif - forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*IOB%stress_mag(i-i0,j-j0)) - enddo ; enddo - elseif (wind_stagger == BGRID_NE) then - do j=js,je ; do i=is,ie - tau_mag = 0.0 ; gustiness = CS%gust_const - if (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + & - (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0) then - tau_mag = sqrt(((G%mask2dBu(I,J)*(taux_at_q(I,J)**2 + tauy_at_q(I,J)**2) + & - G%mask2dBu(I-1,J-1)*(taux_at_q(I-1,J-1)**2 + tauy_at_q(I-1,J-1)**2)) + & - (G%mask2dBu(I,J-1)*(taux_at_q(I,J-1)**2 + tauy_at_q(I,J-1)**2) + & - G%mask2dBu(I-1,J)*(taux_at_q(I-1,J)**2 + tauy_at_q(I-1,J)**2)) ) / & - ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) - if (CS%read_gust_2d) gustiness = CS%gust(i,j) - endif - forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*tau_mag) - enddo ; enddo - elseif (wind_stagger == AGRID) then - do j=js,je ; do i=is,ie - gustiness = CS%gust_const - if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) - forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & - sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)) - enddo ; enddo - else ! C-grid wind stresses. - do j=js,je ; do i=is,ie - taux2 = 0.0 ; tauy2 = 0.0 - if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0) & - taux2 = (G%mask2dCu(I-1,j)*forces%taux(I-1,j)**2 + & - G%mask2dCu(I,j)*forces%taux(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) - if ((G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) > 0) & - tauy2 = (G%mask2dCv(i,J-1)*forces%tauy(i,J-1)**2 + & - G%mask2dCv(i,J)*forces%tauy(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) - - if (CS%read_gust_2d) then - forces%ustar(i,j) = sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) - else - forces%ustar(i,j) = sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) - endif - enddo ; enddo - endif ! endif for wind friction velocity fields + ! Set the wind stresses and ustar. + call extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux=forces%taux, tauy=forces%tauy, & + ustar=forces%ustar, tau_halo=1) ! Obtain optional ice-berg related fluxes from the IOB type: if (associated(IOB%area_berg)) then ; do j=js,je ; do i=is,ie @@ -860,7 +737,8 @@ end subroutine convert_IOB_to_forces !> This subroutine extracts the wind stresses and related fields like ustar from an !! Ice_ocean_boundary_type into optional argument arrays, including changes of units, sign !! conventions, and putting the fields into arrays with MOM-standard sized halos. -subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, ustar, gustless_ustar) +subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, ustar, & + gustless_ustar, tau_halo) type(ice_ocean_boundary_type), & target, intent(in) :: IOB !< An ice-ocean boundary type with fluxes to drive !! the ocean in a coupled model @@ -871,23 +749,24 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a !! previous call to surface_forcing_init. real, dimension(SZIB_(G),SZJ_(G)), & - optional, intent(out) :: taux !< The zonal wind stresses on a C-grid, in Pa. + optional, intent(inout) :: taux !< The zonal wind stresses on a C-grid, in Pa. real, dimension(SZI_(G),SZJB_(G)), & - optional, intent(out) :: tauy !< The meridional wind stresses on a C-grid, in Pa. + optional, intent(inout) :: tauy !< The meridional wind stresses on a C-grid, in Pa. real, dimension(SZI_(G),SZJ_(G)), & - optional, intent(out) :: ustar !< The surface friction velocity, in m s-1. + optional, intent(inout) :: ustar !< The surface friction velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G)), & optional, intent(out) :: gustless_ustar !< The surface friction velocity without !! any contributions from gustiness, in m s-1. + integer, optional, intent(in) :: tau_halo !< The halo size of wind stresses to set, 0 by default. ! Local variables - real, dimension(SZIB_(G),SZJ_(G)) :: & - taux_at_u ! Zonal wind stresses at u points (Pa) - real, dimension(SZI_(G),SZJB_(G)) :: & - tauy_at_v ! Meridional wind stresses at V points (Pa) - real, dimension(SZIB_(G),SZJB_(G)) :: & - taux_at_q, & ! Zonal wind stresses at q points (Pa) - tauy_at_q ! Meridional wind stresses at q points (Pa) + real, dimension(SZI_(G),SZJ_(G)) :: & + taux_at_u ! Zonal wind stresses at u points (Pa) with non-symmetric memory + real, dimension(SZI_(G),SZJ_(G)) :: & + tauy_at_v ! Meridional wind stresses at V points (Pa) with non-symmetric memory + real, dimension(SZI_(G),SZJ_(G)) :: & + taux_at_q, & ! Zonal wind stresses at q points (Pa) with non-symmetric memory + tauy_at_q ! Meridional wind stresses at q points (Pa) with non-symmetric memory real, dimension(SZI_(G),SZJ_(G)) :: & taux_at_h, & ! Zonal wind stresses at h points (Pa) @@ -900,20 +779,13 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta logical :: do_ustar, do_gustless integer :: wind_stagger ! AGRID, BGRID_NE, or CGRID_NE (integers from MOM_domains) - integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq, i0, j0 - integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, isr, ier, jsr, jer - integer :: isc_bnd, iec_bnd, jsc_bnd, jec_bnd - - call cpu_clock_begin(id_clock_forcing) + integer :: i, j, is, ie, js, je, ish, ieh, jsh, jeh, Isqh, Ieqh, Jsqh, Jeqh, i0, j0, halo - isc_bnd = index_bounds(1) ; iec_bnd = index_bounds(2) - jsc_bnd = index_bounds(3) ; jec_bnd = index_bounds(4) + halo = 0 ; if (present(tau_halo)) halo = tau_halo is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - isr = is-isd+1 ; ier = ie-isd+1 ; jsr = js-jsd+1 ; jer = je-jsd+1 - i0 = is - isc_bnd ; j0 = js - jsc_bnd + ish = G%isc-halo ; ieh = G%iec+halo ; jsh = G%jsc-halo ; jeh = G%jec+halo + Isqh = G%IscB-halo ; Ieqh = G%IecB+halo ; Jsqh = G%JscB-halo ; Jeqh = G%JecB+halo + i0 = is - index_bounds(1) ; j0 = js - index_bounds(3) Irho0 = 1.0/CS%Rho0 @@ -934,18 +806,16 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta if (associated(IOB%u_flux)) taux_at_q(I,J) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier if (associated(IOB%v_flux)) tauy_at_q(I,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier enddo ; enddo - if (G%symmetric) & - call fill_symmetric_edges(taux_at_q, tauy_at_q, G%Domain, stagger=BGRID_NE) - call pass_vector(taux_at_q, tauy_at_q, G%Domain, stagger=BGRID_NE, halo=1) + call pass_vector(taux_at_q, tauy_at_q, G%Domain_aux, stagger=BGRID_NE, halo=1+halo) - if (present(taux)) then ; do j=js,je ; do I=Isq,Ieq + if (present(taux)) then ; do j=jsh,jeh ; do I=Isqh,Ieqh taux(I,j) = 0.0 if ((G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) > 0) & taux(I,j) = (G%mask2dBu(I,J)*taux_at_q(I,J) + G%mask2dBu(I,J-1)*taux_at_q(I,J-1)) / & (G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) enddo ; enddo ; endif - if (present(tauy)) then ; do J=Jsq,Jeq ; do i=is,ie + if (present(tauy)) then ; do J=Jsqh,Jeqh ; do i=ish,ieh tauy(i,J) = 0.0 if ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) > 0) & tauy(i,J) = (G%mask2dBu(I,J)*tauy_at_q(I,J) + G%mask2dBu(I-1,J)*tauy_at_q(I-1,J)) / & @@ -960,17 +830,20 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta if (associated(IOB%u_flux)) taux_at_h(i,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier if (associated(IOB%v_flux)) tauy_at_h(i,j) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier enddo ; enddo - call pass_vector(taux_at_h, tauy_at_h, G%Domain, To_All+Omit_Corners, & - stagger=AGRID, halo=1) + if (halo == 0) then + call pass_vector(taux_at_h, tauy_at_h, G%Domain, To_All+Omit_Corners, stagger=AGRID, halo=1) + else + call pass_vector(taux_at_h, tauy_at_h, G%Domain, stagger=AGRID, halo=1+halo) + endif - if (present(taux)) then ; do j=js,je ; do I=Isq,Ieq + if (present(taux)) then ; do j=jsh,jeh ; do I=Isqh,Ieqh taux(I,j) = 0.0 if ((G%mask2dT(i,j) + G%mask2dT(i+1,j)) > 0) & taux(I,j) = (G%mask2dT(i,j)*taux_at_h(i,j) + G%mask2dT(i+1,j)*taux_at_h(i+1,j)) / & (G%mask2dT(i,j) + G%mask2dT(i+1,j)) enddo ; enddo ; endif - if (present(tauy)) then ; do J=Jsq,Jeq ; do i=is,ie + if (present(tauy)) then ; do J=Jsqh,Jeqh ; do i=ish,ieh tauy(i,J) = 0.0 if ((G%mask2dT(i,j) + G%mask2dT(i,j+1)) > 0) & tauy(i,J) = (G%mask2dT(i,j)*tauy_at_h(i,j) + G%mask2dT(i,J+1)*tauy_at_h(i,j+1)) / & @@ -978,19 +851,18 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta enddo ; enddo ; endif else ! C-grid wind stresses. + taux_at_u(:,:) = 0.0 ; tauy_at_v(:,:) = 0.0 do j=js,je ; do i=is,ie if (associated(IOB%u_flux)) taux_at_u(I,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier if (associated(IOB%v_flux)) tauy_at_v(i,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier enddo ; enddo - if (G%symmetric) & - call fill_symmetric_edges(taux_at_u, tauy_at_v, G%Domain) - call pass_vector(taux_at_u, tauy_at_v, G%Domain, halo=1) + call pass_vector(taux_at_u, tauy_at_v, G%Domain_aux, halo=1+halo) - if (present(taux)) then ; do j=js,je ; do I=Isq,Ieq + if (present(taux)) then ; do j=jsh,jeh ; do I=Isqh,Ieqh taux(I,j) = G%mask2dCu(I,j)*taux_at_u(I,j) enddo ; enddo ; endif - if (present(tauy)) then ; do J=Jsq,Jeq ; do i=is,ie + if (present(tauy)) then ; do J=Jsqh,Jeqh ; do i=ish,ieh tauy(i,J) = G%mask2dCv(i,J)*tauy_at_v(i,J) enddo ; enddo ; endif From 0d1894635bedf9275905debea05bdb0ea762a73a Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 3 Aug 2018 19:13:53 -0400 Subject: [PATCH 010/174] Code cleanup in MOM_surface_forcing.F90 Code cleanup in MOM_surface_forcing.F90 to reduce memory use. All answers are bitwise identical. --- .../coupled_driver/MOM_surface_forcing.F90 | 95 +++++++------------ 1 file changed, 34 insertions(+), 61 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index c963670ee3..a341a34b42 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -576,25 +576,14 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) !! previous call to surface_forcing_init. ! Local variables - real, dimension(SZIB_(G),SZJB_(G)) :: & - taux_at_q, & ! Zonal wind stresses at q points (Pa) - tauy_at_q ! Meridional wind stresses at q points (Pa) - real, dimension(SZI_(G),SZJ_(G)) :: & - rigidity_at_h, & ! Ice rigidity at tracer points (m3 s-1) - taux_at_h, & ! Zonal wind stresses at h points (Pa) - tauy_at_h ! Meridional wind stresses at h points (Pa) + rigidity_at_h ! Ice rigidity at tracer points (m3 s-1) - real :: gustiness ! unresolved gustiness that contributes to ustar (Pa) - real :: Irho0 ! inverse of the mean density in (m^3/kg) - real :: taux2, tauy2 ! squared wind stresses (Pa^2) - real :: tau_mag ! magnitude of the wind stress (Pa) real :: I_GEarth ! 1.0 / G%G_Earth (s^2/m) real :: Kv_rho_ice ! (CS%kv_sea_ice / CS%density_sea_ice) ( m^5/(s*kg) ) real :: mass_ice ! mass of sea ice at a face (kg/m^2) real :: mass_eff ! effective mass of sea ice for rigidity (kg/m^2) - integer :: wind_stagger ! AGRID, BGRID_NE, or CGRID_NE (integers from MOM_domains) integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq, i0, j0 integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, isr, ier, jsr, jer integer :: isc_bnd, iec_bnd, jsc_bnd, jec_bnd @@ -610,8 +599,6 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) isr = is-isd+1 ; ier = ie-isd+1 ; jsr = js-jsd+1 ; jer = je-jsd+1 i0 = is - isc_bnd ; j0 = js - jsc_bnd - Irho0 = 1.0/CS%Rho0 - ! allocation and initialization if this is the first time that this ! mechanical forcing type has been used. if (.not.forces%initialized) then @@ -761,16 +748,11 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & - taux_at_u ! Zonal wind stresses at u points (Pa) with non-symmetric memory - real, dimension(SZI_(G),SZJ_(G)) :: & - tauy_at_v ! Meridional wind stresses at V points (Pa) with non-symmetric memory - real, dimension(SZI_(G),SZJ_(G)) :: & - taux_at_q, & ! Zonal wind stresses at q points (Pa) with non-symmetric memory - tauy_at_q ! Meridional wind stresses at q points (Pa) with non-symmetric memory - + taux_in ! Zonal wind stresses (in Pa) at u, h, or q points, depending on the value of + ! wind_stagger, always with non-symmetric memory to permit array reuse. real, dimension(SZI_(G),SZJ_(G)) :: & - taux_at_h, & ! Zonal wind stresses at h points (Pa) - tauy_at_h ! Meridional wind stresses at h points (Pa) + tauy_in ! Meridional wind stresses (in Pa) at v, h, or q points, depending on the value of + ! wind_stagger, always with non-symmetric memory to permit array reuse. real :: gustiness ! unresolved gustiness that contributes to ustar (Pa) real :: Irho0 ! inverse of the mean density in (m^3/kg) @@ -798,72 +780,63 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta ! Set surface momentum stress related fields as a function of staggering. if (present(taux) .or. present(tauy) .or. & ((do_ustar.or.do_gustless) .and. .not.associated(IOB%stress_mag)) ) then + + ! This is necessary to fill in the halo points. + taux_in(:,:) = 0.0 ; tauy_in(:,:) = 0.0 + ! Obtain stress from IOB; note that the staggering locations of taux_in and tauy_in depend + ! on the values of wind_stagger, so the case-sensitive index convention is not used here. + do j=js,je ; do i=is,ie + if (associated(IOB%u_flux)) taux_in(i,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier + if (associated(IOB%v_flux)) tauy_in(i,j) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier + enddo ; enddo + if (wind_stagger == BGRID_NE) then - ! This is necessary to fill in the halo points. - taux_at_q(:,:) = 0.0 ; tauy_at_q(:,:) = 0.0 - ! obtain fluxes from IOB; note the staggering of indices - do j=js,je ; do i=is,ie - if (associated(IOB%u_flux)) taux_at_q(I,J) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier - if (associated(IOB%v_flux)) tauy_at_q(I,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier - enddo ; enddo - call pass_vector(taux_at_q, tauy_at_q, G%Domain_aux, stagger=BGRID_NE, halo=1+halo) + call pass_vector(taux_in, tauy_in, G%Domain_aux, stagger=BGRID_NE, halo=1+halo) if (present(taux)) then ; do j=jsh,jeh ; do I=Isqh,Ieqh taux(I,j) = 0.0 if ((G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) > 0) & - taux(I,j) = (G%mask2dBu(I,J)*taux_at_q(I,J) + G%mask2dBu(I,J-1)*taux_at_q(I,J-1)) / & + taux(I,j) = (G%mask2dBu(I,J)*taux_in(I,J) + G%mask2dBu(I,J-1)*taux_in(I,J-1)) / & (G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) enddo ; enddo ; endif if (present(tauy)) then ; do J=Jsqh,Jeqh ; do i=ish,ieh tauy(i,J) = 0.0 if ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) > 0) & - tauy(i,J) = (G%mask2dBu(I,J)*tauy_at_q(I,J) + G%mask2dBu(I-1,J)*tauy_at_q(I-1,J)) / & + tauy(i,J) = (G%mask2dBu(I,J)*tauy_in(I,J) + G%mask2dBu(I-1,J)*tauy_in(I-1,J)) / & (G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) enddo ; enddo ; endif elseif (wind_stagger == AGRID) then - ! This is necessary to fill in the halo points. - taux_at_h(:,:) = 0.0 ; tauy_at_h(:,:) = 0.0 - ! obtain fluxes from IOB; note the staggering of indices - do j=js,je ; do i=is,ie - if (associated(IOB%u_flux)) taux_at_h(i,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier - if (associated(IOB%v_flux)) tauy_at_h(i,j) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier - enddo ; enddo if (halo == 0) then - call pass_vector(taux_at_h, tauy_at_h, G%Domain, To_All+Omit_Corners, stagger=AGRID, halo=1) + call pass_vector(taux_in, tauy_in, G%Domain, To_All+Omit_Corners, stagger=AGRID, halo=1) else - call pass_vector(taux_at_h, tauy_at_h, G%Domain, stagger=AGRID, halo=1+halo) + call pass_vector(taux_in, tauy_in, G%Domain, stagger=AGRID, halo=1+halo) endif if (present(taux)) then ; do j=jsh,jeh ; do I=Isqh,Ieqh taux(I,j) = 0.0 if ((G%mask2dT(i,j) + G%mask2dT(i+1,j)) > 0) & - taux(I,j) = (G%mask2dT(i,j)*taux_at_h(i,j) + G%mask2dT(i+1,j)*taux_at_h(i+1,j)) / & + taux(I,j) = (G%mask2dT(i,j)*taux_in(i,j) + G%mask2dT(i+1,j)*taux_in(i+1,j)) / & (G%mask2dT(i,j) + G%mask2dT(i+1,j)) enddo ; enddo ; endif if (present(tauy)) then ; do J=Jsqh,Jeqh ; do i=ish,ieh tauy(i,J) = 0.0 if ((G%mask2dT(i,j) + G%mask2dT(i,j+1)) > 0) & - tauy(i,J) = (G%mask2dT(i,j)*tauy_at_h(i,j) + G%mask2dT(i,J+1)*tauy_at_h(i,j+1)) / & + tauy(i,J) = (G%mask2dT(i,j)*tauy_in(i,j) + G%mask2dT(i,J+1)*tauy_in(i,j+1)) / & (G%mask2dT(i,j) + G%mask2dT(i,j+1)) enddo ; enddo ; endif else ! C-grid wind stresses. - taux_at_u(:,:) = 0.0 ; tauy_at_v(:,:) = 0.0 - do j=js,je ; do i=is,ie - if (associated(IOB%u_flux)) taux_at_u(I,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier - if (associated(IOB%v_flux)) tauy_at_v(i,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier - enddo ; enddo - call pass_vector(taux_at_u, tauy_at_v, G%Domain_aux, halo=1+halo) + call pass_vector(taux_in, tauy_in, G%Domain_aux, halo=1+halo) if (present(taux)) then ; do j=jsh,jeh ; do I=Isqh,Ieqh - taux(I,j) = G%mask2dCu(I,j)*taux_at_u(I,j) + taux(I,j) = G%mask2dCu(I,j)*taux_in(I,j) enddo ; enddo ; endif if (present(tauy)) then ; do J=Jsqh,Jeqh ; do i=ish,ieh - tauy(i,J) = G%mask2dCv(i,J)*tauy_at_v(i,J) + tauy(i,J) = G%mask2dCv(i,J)*tauy_in(i,J) enddo ; enddo ; endif endif ! endif for extracting wind stress fields with various staggerings @@ -896,10 +869,10 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta tau_mag = 0.0 ; gustiness = CS%gust_const if (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + & (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0) then - tau_mag = sqrt(((G%mask2dBu(I,J)*(taux_at_q(I,J)**2 + tauy_at_q(I,J)**2) + & - G%mask2dBu(I-1,J-1)*(taux_at_q(I-1,J-1)**2 + tauy_at_q(I-1,J-1)**2)) + & - (G%mask2dBu(I,J-1)*(taux_at_q(I,J-1)**2 + tauy_at_q(I,J-1)**2) + & - G%mask2dBu(I-1,J)*(taux_at_q(I-1,J)**2 + tauy_at_q(I-1,J)**2)) ) / & + tau_mag = sqrt(((G%mask2dBu(I,J)*(taux_in(I,J)**2 + tauy_in(I,J)**2) + & + G%mask2dBu(I-1,J-1)*(taux_in(I-1,J-1)**2 + tauy_in(I-1,J-1)**2)) + & + (G%mask2dBu(I,J-1)*(taux_in(I,J-1)**2 + tauy_in(I,J-1)**2) + & + G%mask2dBu(I-1,J)*(taux_in(I-1,J)**2 + tauy_in(I-1,J)**2)) ) / & ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) if (CS%read_gust_2d) gustiness = CS%gust(i,j) endif @@ -908,7 +881,7 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta enddo ; enddo elseif (wind_stagger == AGRID) then do j=js,je ; do i=is,ie - tau_mag = G%mask2dT(i,j) * sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2) + tau_mag = G%mask2dT(i,j) * sqrt(taux_in(i,j)**2 + tauy_in(i,j)**2) gustiness = CS%gust_const if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) @@ -918,11 +891,11 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta do j=js,je ; do i=is,ie taux2 = 0.0 ; tauy2 = 0.0 if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0) & - taux2 = (G%mask2dCu(I-1,j)*taux_at_u(I-1,j)**2 + & - G%mask2dCu(I,j)*taux_at_u(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) + taux2 = (G%mask2dCu(I-1,j)*taux_in(I-1,j)**2 + & + G%mask2dCu(I,j)*taux_in(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) if ((G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) > 0) & - tauy2 = (G%mask2dCv(i,J-1)*tauy_at_v(i,J-1)**2 + & - G%mask2dCv(i,J)*tauy_at_v(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) + tauy2 = (G%mask2dCv(i,J-1)*tauy_in(i,J-1)**2 + & + G%mask2dCv(i,J)*tauy_in(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) tau_mag = sqrt(taux2 + tauy2) gustiness = CS%gust_const From b15f514126eeb3a9d03a4627a3f9db2c123bfdc8 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 6 Aug 2018 15:04:55 -0400 Subject: [PATCH 011/174] Set ustar in fluxes via extract_IOB_stresses Set ustar in fluxes via extract_IOB_stresses, using sub-optimal expressions involving division by mean density rather than multiplication by its reciprocal to reproduce what had been done in set_derived_forcing_fields. All answers are bitwise identical. --- .../coupled_driver/MOM_surface_forcing.F90 | 26 ++++++++++++++++--- 1 file changed, 22 insertions(+), 4 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index a341a34b42..71e7f611aa 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -544,6 +544,16 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & endif + ! Set the wind stresses and ustar. + if (associated(fluxes%ustar) .and. associated(fluxes%ustar_gustless)) then + call extract_IOB_stresses(IOB, index_bounds, Time, G, CS, ustar=fluxes%ustar, & + gustless_ustar=fluxes%ustar_gustless) + elseif (associated(fluxes%ustar)) then + call extract_IOB_stresses(IOB, index_bounds, Time, G, CS, ustar=fluxes%ustar) + elseif (associated(fluxes%ustar_gustless)) then + call extract_IOB_stresses(IOB, index_bounds, Time, G, CS, gustless_ustar=fluxes%ustar_gustless) + endif + if (coupler_type_initialized(fluxes%tr_fluxes) .and. & coupler_type_initialized(IOB%fluxes)) & call coupler_type_copy_data(IOB%fluxes, fluxes%tr_fluxes) @@ -862,7 +872,9 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*IOB%stress_mag(i-i0,j-j0)) enddo ; enddo ; endif if (do_gustless) then ; do j=js,je ; do i=is,ie - gustless_ustar(i,j) = sqrt(Irho0*IOB%stress_mag(i-i0,j-j0)) + gustless_ustar(i,j) = sqrt(IOB%stress_mag(i-i0,j-j0) / CS%Rho0) +!### Change to: +! gustless_ustar(i,j) = sqrt(Irho0 * IOB%stress_mag(i-i0,j-j0)) enddo ; enddo ; endif elseif (wind_stagger == BGRID_NE) then do j=js,je ; do i=is,ie @@ -877,7 +889,9 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta if (CS%read_gust_2d) gustiness = CS%gust(i,j) endif if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) - if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0*tau_mag) + if (do_gustless) gustless_ustar(i,j) = sqrt(tau_mag / CS%Rho0) +!### Change to: +! if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) enddo ; enddo elseif (wind_stagger == AGRID) then do j=js,je ; do i=is,ie @@ -885,7 +899,9 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta gustiness = CS%gust_const if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) - if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0*tau_mag) + if (do_gustless) gustless_ustar(i,j) = sqrt(tau_mag / CS%Rho0) +!### Change to: +! if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) enddo ; enddo else ! C-grid wind stresses. do j=js,je ; do i=is,ie @@ -902,7 +918,9 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta if (CS%read_gust_2d) gustiness = CS%gust(i,j) if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) - if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0*tau_mag) + if (do_gustless) gustless_ustar(i,j) = sqrt(tau_mag / CS%Rho0) +!### Change to: +! if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) enddo ; enddo endif ! endif for wind friction velocity fields endif From f20c3f1e04b822af8a97489a850b766a54f7da2c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 6 Aug 2018 15:05:23 -0400 Subject: [PATCH 012/174] +Changed interface to forcing_accumulate Turned forces into an optional argument to forcing_accumulate and changed the order of the list of arguments. Forces is no longer needed when the pressure and ustar fields are properly set in the temporary fluxes array. The forces argument is now omitted from the call to forcing_accumulate in update_ocean_model, and the call to set_derived_forcing_fields has been eliminated. All answers are bitwise identical. --- config_src/coupled_driver/ocean_model_MOM.F90 | 13 ++--- src/core/MOM_forcing_type.F90 | 51 +++++++++++++------ 2 files changed, 40 insertions(+), 24 deletions(-) diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index a09a5bfe29..dde127b146 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -505,9 +505,6 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & OS%sfc_state, dt_coupling, OS%marine_ice_CSp) endif - ! Fields that exist in both the forcing and mech_forcing types must be copied. - call copy_common_forcing_fields(OS%forces, OS%fluxes, OS%grid, skip_pres=.true.) - #ifdef _USE_GENERIC_TRACER call enable_averaging(dt_coupling, OS%Time + Ocean_coupling_time_step, OS%diag) !Is this needed? call MOM_generic_tracer_fluxes_accumulate(OS%fluxes, weight) !here weight=1, just saving the current fluxes @@ -516,6 +513,8 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & OS%fluxes%fluxes_used = .false. OS%fluxes%dt_buoy_accum = dt_coupling else + ! The previous fluxes have not been used yet, so translate the input fluxes + ! into a temporary type and then accumulate them in about 20 lines. OS%flux_tmp%C_p = OS%fluxes%C_p if (do_thermo) & call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%flux_tmp, index_bnds, OS%Time, & @@ -536,16 +535,15 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & OS%sfc_state, dt_coupling, OS%marine_ice_CSp) endif - call forcing_accumulate(OS%flux_tmp, OS%forces, OS%fluxes, dt_coupling, OS%grid, weight) + call forcing_accumulate(OS%flux_tmp, OS%fluxes, dt_coupling, OS%grid, weight) ! Some of the fields that exist in both the forcing and mech_forcing types - ! (e.g., ustar) are time-averages must be copied back to the forces type. + ! (now just ustar) are time-averages must be copied back to the forces type. call copy_back_forcing_fields(OS%fluxes, OS%forces, OS%grid) #ifdef _USE_GENERIC_TRACER call MOM_generic_tracer_fluxes_accumulate(OS%flux_tmp, weight) !weight of the current flux in the running average #endif endif - call set_derived_forcing_fields(OS%forces, OS%fluxes, OS%grid, OS%GV%Rho0) call set_net_mass_forcing(OS%fluxes, OS%forces, OS%grid) if (OS%use_waves) then @@ -573,8 +571,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & else n_max = 1 ; if (dt_coupling > OS%dt) n_max = ceiling(dt_coupling/OS%dt - 0.001) dt_dyn = dt_coupling / real(n_max) - thermo_does_span_coupling = (OS%thermo_spans_coupling .and. & - (OS%dt_therm > 1.5*dt_coupling)) + thermo_does_span_coupling = (OS%thermo_spans_coupling .and. (OS%dt_therm > 1.5*dt_coupling)) if (thermo_does_span_coupling) then dt_therm = dt_coupling * floor(OS%dt_therm / dt_coupling + 0.001) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 9486967b40..4235c2a82f 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -1742,15 +1742,15 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use end subroutine register_forcing_type_diags !> Accumulate the forcing over time steps -subroutine forcing_accumulate(flux_tmp, forces, fluxes, dt, G, wt2) - type(forcing), intent(in) :: flux_tmp !< A temporary structure with current - !!thermodynamic forcing fields - type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - type(forcing), intent(inout) :: fluxes !< A structure containing time-averaged - !! thermodynamic forcing fields - real, intent(in) :: dt !< The elapsed time since the last call to this subroutine, in s - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, intent(out) :: wt2 !< The relative weight of the new fluxes +subroutine forcing_accumulate(flux_tmp, fluxes, dt, G, wt2, forces) + type(forcing), intent(in) :: flux_tmp !< A temporary structure with current + !! thermodynamic forcing fields + type(forcing), intent(inout) :: fluxes !< A structure containing time-averaged + !! thermodynamic forcing fields + real, intent(in) :: dt !< The elapsed time since the last call to this subroutine, in s + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + real, intent(out) :: wt2 !< The relative weight of the new fluxes + type(mech_forcing), optional, intent(in) :: forces !< A structure with the driving mechanical forces ! This subroutine copies mechancal forcing from flux_tmp to fluxes and ! stores the time-weighted averages of the various buoyancy fluxes in fluxes, @@ -1774,15 +1774,29 @@ subroutine forcing_accumulate(flux_tmp, forces, fluxes, dt, G, wt2) wt2 = 1.0 - wt1 ! = dt / (fluxes%dt_buoy_accum + dt) fluxes%dt_buoy_accum = fluxes%dt_buoy_accum + dt - ! Copy over the pressure fields. - do j=js,je ; do i=is,ie - fluxes%p_surf(i,j) = forces%p_surf(i,j) - fluxes%p_surf_full(i,j) = forces%p_surf_full(i,j) - enddo ; enddo + ! Copy over the pressure fields and accumulate averages of ustar, either from the forcing + ! type or from the temporary fluxes type. + if (present(forces)) then + do j=js,je ; do i=is,ie + fluxes%p_surf(i,j) = forces%p_surf(i,j) + fluxes%p_surf_full(i,j) = forces%p_surf_full(i,j) + + fluxes%ustar(i,j) = wt1*fluxes%ustar(i,j) + wt2*forces%ustar(i,j) + enddo ; enddo + else + do j=js,je ; do i=is,ie + fluxes%p_surf(i,j) = flux_tmp%p_surf(i,j) + fluxes%p_surf_full(i,j) = flux_tmp%p_surf_full(i,j) + + fluxes%ustar(i,j) = wt1*fluxes%ustar(i,j) + wt2*flux_tmp%ustar(i,j) + enddo ; enddo + endif ! Average the water, heat, and salt fluxes, and ustar. do j=js,je ; do i=is,ie - fluxes%ustar(i,j) = wt1*fluxes%ustar(i,j) + wt2*forces%ustar(i,j) +!### Replace the expression for ustar_gustless with this one... +! fluxes%ustar_gustless(i,j) = wt1*fluxes%ustar_gustless(i,j) + wt2*flux_tmp%ustar_gustless(i,j) + fluxes%ustar_gustless(i,j) = flux_tmp%ustar_gustless(i,j) fluxes%evap(i,j) = wt1*fluxes%evap(i,j) + wt2*flux_tmp%evap(i,j) fluxes%lprec(i,j) = wt1*fluxes%lprec(i,j) + wt2*flux_tmp%lprec(i,j) @@ -1922,9 +1936,12 @@ subroutine set_derived_forcing_fields(forces, fluxes, G, Rho0) !! as used to calculate ustar. real :: taux2, tauy2 ! Squared wind stress components, in Pa^2. + real :: Irho0 ! Inverse of the mean density in (m^3/kg) integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + Irho0 = 1.0/Rho0 + if (associated(forces%taux) .and. associated(forces%tauy) .and. & associated(fluxes%ustar_gustless)) then do j=js,je ; do i=is,ie @@ -1940,13 +1957,15 @@ subroutine set_derived_forcing_fields(forces, fluxes, G, Rho0) (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) fluxes%ustar_gustless(i,j) = sqrt(sqrt(taux2 + tauy2) / Rho0) +!### Change to: +! fluxes%ustar_gustless(i,j) = sqrt(sqrt(taux2 + tauy2) * Irho0) enddo ; enddo endif end subroutine set_derived_forcing_fields -!> This subroutine calculates determines the net mass source to th eocean from +!> This subroutine calculates determines the net mass source to the ocean from !! a (thermodynamic) forcing type and stores it in a mech_forcing type. subroutine set_net_mass_forcing(fluxes, forces, G) type(forcing), intent(in) :: fluxes !< A structure containing thermodynamic forcing fields From c02b134bd143f8ce595312ee50ae6fbd8ba92bb8 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 6 Aug 2018 19:04:08 -0400 Subject: [PATCH 013/174] (+)Restored the interface to forcing_accumulate Restored the interface to forcing_accumulate to what it had been previously, and added a new subroutine, fluxes_accumulate, that uses the newer interface, with the new forcing_accumulate calling fluxes_accumulate. This new interface is now in use in update_ocean_model. In addition, set_net_mass_forcing now calls get_net_mass_forcing to eliminate duplicated code. All answers are bitwise identical, and slightly older public interfaces have been restored to avoid code conflicts with MOM6 drivers outside of coupled_driver. --- config_src/coupled_driver/ocean_model_MOM.F90 | 13 ++- src/core/MOM_forcing_type.F90 | 92 +++++++++++++------ 2 files changed, 69 insertions(+), 36 deletions(-) diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index dde127b146..a2d87c6624 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -23,11 +23,9 @@ module ocean_model_mod use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe use MOM_error_handler, only : callTree_enter, callTree_leave use MOM_file_parser, only : get_param, log_version, close_param_file, param_file_type -use MOM_forcing_type, only : allocate_forcing_type -use MOM_forcing_type, only : forcing, mech_forcing -use MOM_forcing_type, only : forcing_accumulate, copy_common_forcing_fields -use MOM_forcing_type, only : copy_back_forcing_fields, set_net_mass_forcing -use MOM_forcing_type, only : set_derived_forcing_fields +use MOM_forcing_type, only : forcing, mech_forcing, allocate_forcing_type +use MOM_forcing_type, only : fluxes_accumulate, get_net_mass_forcing +use MOM_forcing_type, only : copy_back_forcing_fields use MOM_forcing_type, only : forcing_diagnostics, mech_forcing_diags use MOM_get_input, only : Get_MOM_Input, directories use MOM_grid, only : ocean_grid_type @@ -535,7 +533,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & OS%sfc_state, dt_coupling, OS%marine_ice_CSp) endif - call forcing_accumulate(OS%flux_tmp, OS%fluxes, dt_coupling, OS%grid, weight) + call fluxes_accumulate(OS%flux_tmp, OS%fluxes, dt_coupling, OS%grid, weight) ! Some of the fields that exist in both the forcing and mech_forcing types ! (now just ustar) are time-averages must be copied back to the forces type. call copy_back_forcing_fields(OS%fluxes, OS%forces, OS%grid) @@ -544,7 +542,8 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call MOM_generic_tracer_fluxes_accumulate(OS%flux_tmp, weight) !weight of the current flux in the running average #endif endif - call set_net_mass_forcing(OS%fluxes, OS%forces, OS%grid) + if (associated(OS%forces%net_mass_src)) & + call get_net_mass_forcing(OS%fluxes, OS%grid, OS%forces%net_mass_src) if (OS%use_waves) then call Update_Surface_Waves(OS%grid, OS%GV, OS%time, ocean_coupling_time_step, OS%waves) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 4235c2a82f..6aa0487439 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -26,11 +26,13 @@ module MOM_forcing_type public extractFluxes1d, extractFluxes2d, optics_type public MOM_forcing_chksum, MOM_mech_forcing_chksum -public calculateBuoyancyFlux1d, calculateBuoyancyFlux2d, forcing_accumulate +public calculateBuoyancyFlux1d, calculateBuoyancyFlux2d +public forcing_accumulate, fluxes_accumulate public forcing_SinglePointPrint, mech_forcing_diags, forcing_diagnostics public register_forcing_type_diags, allocate_forcing_type, deallocate_forcing_type public copy_common_forcing_fields, allocate_mech_forcing, deallocate_mech_forcing -public set_derived_forcing_fields, copy_back_forcing_fields, set_net_mass_forcing +public set_derived_forcing_fields, copy_back_forcing_fields +public set_net_mass_forcing, get_net_mass_forcing !> Structure that contains pointers to the boundary forcing used to drive the !! liquid ocean simulated by MOM. @@ -1741,8 +1743,29 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use end subroutine register_forcing_type_diags -!> Accumulate the forcing over time steps -subroutine forcing_accumulate(flux_tmp, fluxes, dt, G, wt2, forces) +!> Accumulate the forcing over time steps, taking input from a mechanical forcing type +!! and a temporary forcing-flux type. +subroutine forcing_accumulate(flux_tmp, forces, fluxes, dt, G, wt2) + type(forcing), intent(in) :: flux_tmp !< A temporary structure with current + !!thermodynamic forcing fields + type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces + type(forcing), intent(inout) :: fluxes !< A structure containing time-averaged + !! thermodynamic forcing fields + real, intent(in) :: dt !< The elapsed time since the last call to this subroutine, in s + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + real, intent(out) :: wt2 !< The relative weight of the new fluxes + + ! This subroutine copies mechancal forcing from flux_tmp to fluxes and + ! stores the time-weighted averages of the various buoyancy fluxes in fluxes, + ! and increments the amount of time over which the buoyancy forcing should be + ! applied, all via a call to fluxes accumulate. + + call fluxes_accumulate(flux_tmp, fluxes, dt, G, wt2, forces) + +end subroutine forcing_accumulate + +!> Accumulate the thermodynamic fluxes over time steps +subroutine fluxes_accumulate(flux_tmp, fluxes, dt, G, wt2, forces) type(forcing), intent(in) :: flux_tmp !< A temporary structure with current !! thermodynamic forcing fields type(forcing), intent(inout) :: fluxes !< A structure containing time-averaged @@ -1880,7 +1903,7 @@ subroutine forcing_accumulate(flux_tmp, fluxes, dt, G, wt2, forces) call coupler_type_increment_data(flux_tmp%tr_fluxes, fluxes%tr_fluxes, & scale_factor=wt2, scale_prev=wt1) -end subroutine forcing_accumulate +end subroutine fluxes_accumulate !> This subroutine copies the computational domains of common forcing fields !! from a mech_forcing type to a (thermodynamic) forcing type. @@ -1970,34 +1993,45 @@ end subroutine set_derived_forcing_fields subroutine set_net_mass_forcing(fluxes, forces, G) type(forcing), intent(in) :: fluxes !< A structure containing thermodynamic forcing fields type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(ocean_grid_type), intent(in) :: G !< grid type + type(ocean_grid_type), intent(in) :: G !< The ocean grid type + + if (associated(forces%net_mass_src)) & + call get_net_mass_forcing(fluxes, G, forces%net_mass_src) + +end subroutine set_net_mass_forcing + +!> This subroutine calculates determines the net mass source to the ocean from +!! a (thermodynamic) forcing type and stores it in a provided array. +subroutine get_net_mass_forcing(fluxes, G, net_mass_src) + type(forcing), intent(in) :: fluxes !< A structure containing thermodynamic forcing fields + type(ocean_grid_type), intent(in) :: G !< The ocean grid type + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: net_mass_src !< The net mass flux of water into the ocean + !! in kg m-2 s-1. integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - if (associated(forces%net_mass_src)) then - forces%net_mass_src(:,:) = 0.0 - if (associated(fluxes%lprec)) then ; do j=js,je ; do i=is,ie - forces%net_mass_src(i,j) = forces%net_mass_src(i,j) + fluxes%lprec(i,j) - enddo ; enddo ; endif - if (associated(fluxes%fprec)) then ; do j=js,je ; do i=is,ie - forces%net_mass_src(i,j) = forces%net_mass_src(i,j) + fluxes%fprec(i,j) - enddo ; enddo ; endif - if (associated(fluxes%vprec)) then ; do j=js,je ; do i=is,ie - forces%net_mass_src(i,j) = forces%net_mass_src(i,j) + fluxes%vprec(i,j) - enddo ; enddo ; endif - if (associated(fluxes%lrunoff)) then ; do j=js,je ; do i=is,ie - forces%net_mass_src(i,j) = forces%net_mass_src(i,j) + fluxes%lrunoff(i,j) - enddo ; enddo ; endif - if (associated(fluxes%frunoff)) then ; do j=js,je ; do i=is,ie - forces%net_mass_src(i,j) = forces%net_mass_src(i,j) + fluxes%frunoff(i,j) - enddo ; enddo ; endif - if (associated(fluxes%evap)) then ; do j=js,je ; do i=is,ie - forces%net_mass_src(i,j) = forces%net_mass_src(i,j) + fluxes%evap(i,j) - enddo ; enddo ; endif - endif - -end subroutine set_net_mass_forcing + net_mass_src(:,:) = 0.0 + if (associated(fluxes%lprec)) then ; do j=js,je ; do i=is,ie + net_mass_src(i,j) = net_mass_src(i,j) + fluxes%lprec(i,j) + enddo ; enddo ; endif + if (associated(fluxes%fprec)) then ; do j=js,je ; do i=is,ie + net_mass_src(i,j) = net_mass_src(i,j) + fluxes%fprec(i,j) + enddo ; enddo ; endif + if (associated(fluxes%vprec)) then ; do j=js,je ; do i=is,ie + net_mass_src(i,j) = net_mass_src(i,j) + fluxes%vprec(i,j) + enddo ; enddo ; endif + if (associated(fluxes%lrunoff)) then ; do j=js,je ; do i=is,ie + net_mass_src(i,j) = net_mass_src(i,j) + fluxes%lrunoff(i,j) + enddo ; enddo ; endif + if (associated(fluxes%frunoff)) then ; do j=js,je ; do i=is,ie + net_mass_src(i,j) = net_mass_src(i,j) + fluxes%frunoff(i,j) + enddo ; enddo ; endif + if (associated(fluxes%evap)) then ; do j=js,je ; do i=is,ie + net_mass_src(i,j) = net_mass_src(i,j) + fluxes%evap(i,j) + enddo ; enddo ; endif + +end subroutine get_net_mass_forcing !> This subroutine copies the computational domains of common forcing fields !! from a mech_forcing type to a (thermodynamic) forcing type. From 13f9303ced1ace1a33397b3ce3af81ac6439cbeb Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 7 Aug 2018 11:23:37 -0400 Subject: [PATCH 014/174] +Added optional arguments to convert_IOB_to_forces Added two new optional arguments to convert_IOB_to_forces to allow it to do a running time average of ustar, matching what had previously been done only for ustar in the fluxes type. Also added the new element dt_force_accum to the mech_forcing type to enable this averaging. All answers are bitwise identical, although there are new optional arguments to a publicly visible routine. --- .../coupled_driver/MOM_surface_forcing.F90 | 40 +++++++++++++++++-- src/core/MOM_forcing_type.F90 | 9 ++--- 2 files changed, 40 insertions(+), 9 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 71e7f611aa..a4cd1162d7 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -573,7 +573,7 @@ end subroutine convert_IOB_to_fluxes !> This subroutine translates the Ice_ocean_boundary_type into a MOM !! mechanical forcing type, including changes of units, sign conventions, !! and putting the fields into arrays with MOM-standard halos. -subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) +subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS, dt_forcing, reset_avg) type(ice_ocean_boundary_type), & target, intent(in) :: IOB !< An ice-ocean boundary type with fluxes to drive !! the ocean in a coupled model @@ -584,15 +584,22 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a !! previous call to surface_forcing_init. + real, optional, intent(in) :: dt_forcing !< A time interval over which to apply the + !! current value of ustar as a weighted running + !! average, in s, or if 0 do not average ustar. + !! Missing is equivalent to 0. + logical, optional, intent(in) :: reset_avg !< If true, reset the time average. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & - rigidity_at_h ! Ice rigidity at tracer points (m3 s-1) + rigidity_at_h, & ! Ice rigidity at tracer points (m3 s-1) + ustar_tmp ! A temporary array of ustars. real :: I_GEarth ! 1.0 / G%G_Earth (s^2/m) real :: Kv_rho_ice ! (CS%kv_sea_ice / CS%density_sea_ice) ( m^5/(s*kg) ) real :: mass_ice ! mass of sea ice at a face (kg/m^2) real :: mass_eff ! effective mass of sea ice for rigidity (kg/m^2) + real :: wt1, wt2 ! Relative weights of previous and current values of ustar, ND. integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq, i0, j0 integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, isr, ier, jsr, jer @@ -645,6 +652,23 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) if (associated(forces%rigidity_ice_u)) forces%rigidity_ice_u(:,:) = 0.0 if (associated(forces%rigidity_ice_v)) forces%rigidity_ice_v(:,:) = 0.0 + ! Set the weights for forcing fields that use running time averages. + if (present(reset_avg)) then ; if (reset_avg) forces%dt_force_accum = 0.0 ; endif + wt1 = 0.0 ; wt2 = 1.0 + if (present(dt_forcing)) then + if ((forces%dt_force_accum > 0.0) .and. (dt_forcing > 0.0)) then + wt1 = forces%dt_force_accum / (forces%dt_force_accum + dt_forcing) + wt2 = 1.0 - wt1 + endif + if (dt_forcing > 0.0) then + forces%dt_force_accum = max(forces%dt_force_accum, 0.0) + dt_forcing + else + forces%dt_force_accum = 0.0 ! Reset the averaging time interval. + endif + else + forces%dt_force_accum = 0.0 ! Reset the averaging time interval. + endif + ! applied surface pressure from atmosphere and cryosphere if (associated(IOB%p)) then if (CS%max_p_surf >= 0.0) then @@ -667,8 +691,16 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) forces%accumulate_p_surf = .true. ! Multiple components may contribute to surface pressure. ! Set the wind stresses and ustar. - call extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux=forces%taux, tauy=forces%tauy, & - ustar=forces%ustar, tau_halo=1) + if (wt1 <= 0.0) then + call extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux=forces%taux, tauy=forces%tauy, & + ustar=forces%ustar, tau_halo=1) + else + call extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux=forces%taux, tauy=forces%tauy, & + ustar=ustar_tmp, tau_halo=1) + do j=js,je ; do i=is,ie + forces%ustar(i,j) = wt1*forces%ustar(i,j) + wt2*ustar_tmp(i,j) + enddo ; enddo + endif ! Obtain optional ice-berg related fluxes from the IOB type: if (associated(IOB%area_berg)) then ; do j=js,je ; do i=is,ie diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 6aa0487439..1df0fe1473 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -42,8 +42,6 @@ module MOM_forcing_type !! MESO_surface_forcing.F90, which is a special case of solo_driver/MOM_surface_forcing.F90. type, public :: forcing - ! Pointers in this module should be initialized to NULL. - ! surface stress components and turbulent velocity scale real, pointer, dimension(:,:) :: & ustar => NULL(), & !< surface friction velocity scale (m/s) @@ -154,11 +152,10 @@ module MOM_forcing_type logical :: fluxes_used = .true. !< If true, all of the heat, salt, and mass !! fluxes have been applied to the ocean. - real :: dt_buoy_accum = -1.0 !< The amount of time over which the buoyancy fluxes + real :: dt_buoy_accum = -1.0 !< The amount of time over which the buoyancy fluxes !! should be applied, in s. If negative, this forcing !! type variable has not yet been inialized. - ! heat capacity real :: C_p !< heat capacity of seawater ( J/(K kg) ). !! C_p is is the same value as in thermovar_ptrs_type. @@ -169,7 +166,7 @@ module MOM_forcing_type !! This is not a convenient convention, but imposed on MOM6 by the coupler. ! For internal error tracking - integer :: num_msg = 0 !< Number of messages issues about excessive SW penetration + integer :: num_msg = 0 !< Number of messages issued about excessive SW penetration integer :: max_msg = 2 !< Maximum number of messages to issue about excessive SW penetration end type forcing @@ -213,6 +210,8 @@ module MOM_forcing_type real, pointer, dimension(:,:) :: & rigidity_ice_u => NULL(), & !< Depth-integrated lateral viscosity of ice shelves or sea ice at u-points (m3/s) rigidity_ice_v => NULL() !< Depth-integrated lateral viscosity of ice shelves or sea ice at v-points (m3/s) + real :: dt_force_accum = -1.0 !< The amount of time over which the mechanical forcing fluxes + !! have been averaged, in s. logical :: accumulate_p_surf = .false. !< If true, the surface pressure due to the atmosphere !! and various types of ice needs to be accumulated, and the !! surface pressure explicitly reset to zero at the driver level From 5f253d4ed91889250d04992386eafce5a6dd530c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 7 Aug 2018 11:23:55 -0400 Subject: [PATCH 015/174] Consolidate dynamic & thermodynamic forcing setup Consolidated the code in update_ocean_model that set up the dynamic and thermodynamic forcing structures. This takes advantage of the recently added optional arguments to convert_IOB_to_forces to do time averaging of ustar. All answers are bitwise identical. --- config_src/coupled_driver/ocean_model_MOM.F90 | 104 ++++++++---------- 1 file changed, 47 insertions(+), 57 deletions(-) diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index a2d87c6624..d1a15bc496 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -241,11 +241,12 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "ocean_model_init" ! This module's name. - character(len=48) :: stagger - integer :: secs, days + character(len=48) :: stagger ! A string indicating the staggering locations for the + ! surface velocities returned to the coupler. +! integer :: secs, days type(param_file_type) :: param_file !< A structure to parse for run-time parameters logical :: use_temperature - type(time_type) :: dt_geometric, dt_savedays, dt_from_base +! type(time_type) :: dt_geometric, dt_savedays, dt_from_base call callTree_enter("ocean_model_init(), ocean_model_MOM.F90") if (associated(OS)) then @@ -430,7 +431,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! start of a call to step_MOM. integer :: index_bnds(4) ! The computational domain index bounds in the ! ice-ocean boundary type. - real :: weight ! Flux accumulation weight + real :: weight ! Flux accumulation weight of the current fluxes. real :: dt_coupling ! The coupling time step in seconds. integer :: nts ! The number of baroclinic dynamics time steps ! within dt_coupling. @@ -444,13 +445,14 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! multiple dynamic timesteps. logical :: do_dyn ! If true, step the ocean dynamics and transport. logical :: do_thermo ! If true, step the ocean thermodynamics. - logical :: step_thermo ! If true, take a thermodynamic step. - integer :: secs, days + logical :: step_thermo ! If true, take a thermodynamic step. + integer :: secs, days ! Integer number of days and seconds in the timestep. integer :: is, ie, js, je call callTree_enter("update_ocean_model(), ocean_model_MOM.F90") call get_time(Ocean_coupling_time_step, secs, days) dt_coupling = 86400.0*real(days) + real(secs) +!### dt_coupling = time_type_to_real(Ocean_coupling_time_step) if (time_start_update /= OS%Time) then call MOM_error(WARNING, "update_ocean_model: internal clock does not "//& @@ -472,75 +474,59 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call coupler_type_spawn(Ocean_sfc%fields, OS%sfc_state%tr_fields, & (/is,is,ie,ie/), (/js,js,je,je/), as_needed=.true.) - ! Translate Ice_ocean_boundary into fluxes. + ! Translate Ice_ocean_boundary into fluxes and forces. call mpp_get_compute_domain(Ocean_sfc%Domain, index_bnds(1), index_bnds(2), & index_bnds(3), index_bnds(4)) - weight = 1.0 - - call convert_IOB_to_forces(Ice_ocean_boundary, OS%forces, index_bnds, OS%Time, & - OS%grid, OS%forcing_CSp) + if (do_dyn) then + call convert_IOB_to_forces(Ice_ocean_boundary, OS%forces, index_bnds, OS%Time, OS%grid, & + 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) + 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) + endif - if (OS%fluxes%fluxes_used) then - if (do_thermo) & + if (do_thermo) then + if (OS%fluxes%fluxes_used) then call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, index_bnds, OS%Time, & - OS%grid, OS%forcing_CSp, OS%sfc_state, & - OS%restore_salinity, OS%restore_temp) + OS%grid, OS%forcing_CSp, OS%sfc_state, OS%restore_salinity, & + OS%restore_temp) - ! Add ice shelf fluxes - if (OS%use_ice_shelf) then - if (do_thermo) & + ! Add ice shelf fluxes + if (OS%use_ice_shelf) & 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) - endif - if (OS%icebergs_alter_ocean) then - if (do_dyn) & - call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & - OS%sfc_state, dt_coupling, OS%marine_ice_CSp) - if (do_thermo) & + if (OS%icebergs_alter_ocean) & call iceberg_fluxes(OS%grid, OS%fluxes, OS%use_ice_shelf, & - OS%sfc_state, dt_coupling, OS%marine_ice_CSp) - endif + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) #ifdef _USE_GENERIC_TRACER - call enable_averaging(dt_coupling, OS%Time + Ocean_coupling_time_step, OS%diag) !Is this needed? - call MOM_generic_tracer_fluxes_accumulate(OS%fluxes, weight) !here weight=1, just saving the current fluxes + call enable_averaging(dt_coupling, OS%Time + Ocean_coupling_time_step, OS%diag) !Is this needed? + call MOM_generic_tracer_fluxes_accumulate(OS%fluxes, 1.0) !here weight=1, so just saving the current fluxes #endif - ! Indicate that there are new unused fluxes. - OS%fluxes%fluxes_used = .false. - OS%fluxes%dt_buoy_accum = dt_coupling - else - ! The previous fluxes have not been used yet, so translate the input fluxes - ! into a temporary type and then accumulate them in about 20 lines. - OS%flux_tmp%C_p = OS%fluxes%C_p - if (do_thermo) & + ! Indicate that there are new unused fluxes. + OS%fluxes%fluxes_used = .false. + OS%fluxes%dt_buoy_accum = dt_coupling + else + ! The previous fluxes have not been used yet, so translate the input fluxes + ! into a temporary type and then accumulate them in about 20 lines. + OS%flux_tmp%C_p = OS%fluxes%C_p call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%flux_tmp, index_bnds, OS%Time, & - OS%grid, OS%forcing_CSp, OS%sfc_state, OS%restore_salinity,OS%restore_temp) + OS%grid, OS%forcing_CSp, OS%sfc_state, OS%restore_salinity, & + OS%restore_temp) - if (OS%use_ice_shelf) then - if (do_thermo) & + if (OS%use_ice_shelf) & 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) - endif - if (OS%icebergs_alter_ocean) then - if (do_dyn) & - call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & - OS%sfc_state, dt_coupling, OS%marine_ice_CSp) - if (do_thermo) & + if (OS%icebergs_alter_ocean) & call iceberg_fluxes(OS%grid, OS%flux_tmp, OS%use_ice_shelf, & - OS%sfc_state, dt_coupling, OS%marine_ice_CSp) - endif - - call fluxes_accumulate(OS%flux_tmp, OS%fluxes, dt_coupling, OS%grid, weight) - ! Some of the fields that exist in both the forcing and mech_forcing types - ! (now just ustar) are time-averages must be copied back to the forces type. - call copy_back_forcing_fields(OS%fluxes, OS%forces, OS%grid) + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) + call fluxes_accumulate(OS%flux_tmp, OS%fluxes, dt_coupling, OS%grid, weight) #ifdef _USE_GENERIC_TRACER - call MOM_generic_tracer_fluxes_accumulate(OS%flux_tmp, weight) !weight of the current flux in the running average + call MOM_generic_tracer_fluxes_accumulate(OS%flux_tmp, weight) !weight of the current flux in the running average #endif + endif endif if (associated(OS%forces%net_mass_src)) & call get_net_mass_forcing(OS%fluxes, OS%grid, OS%forces%net_mass_src) @@ -613,6 +599,8 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & if (step_thermo) then ! Back up Time2 to the start of the thermodynamic segment. + !### Use ticks here for more precision. + !Time2 = Time2 - real_to_time_type(dtdia - dt_dyn) Time2 = Time2 - set_time(int(floor((dtdia - dt_dyn) + 0.5))) call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & @@ -621,6 +609,8 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & endif t_elapsed_seg = t_elapsed_seg + dt_dyn + !### Use ticks here for more precision. + ! Time2 = Time1 + real_to_time_type(t_elapsed_seg) Time2 = Time1 + set_time(int(floor(t_elapsed_seg + 0.5))) enddo endif From c54a25aca7e36cde16ca8dff7e9c6c94dfd3def6 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 7 Aug 2018 12:46:40 -0400 Subject: [PATCH 016/174] (*)Allow for fractional second coupling timesteps By replacing several set_time calls that quantize times at whole numbers of seconds with calls to real_to_time_type, the MOM6 coupled timesteps can now be integer numbers of ticks (fractional seconds). This could change answers if MOM6 were called with non-integer second timesteps, but in all existing test cases this is not the case, so the answers are bitwise identical. --- config_src/coupled_driver/ocean_model_MOM.F90 | 25 ++++++------------- config_src/solo_driver/MOM_driver.F90 | 11 ++++---- 2 files changed, 14 insertions(+), 22 deletions(-) diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index d1a15bc496..e3fd612c70 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -37,10 +37,10 @@ module ocean_model_mod use MOM_surface_forcing, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum use MOM_surface_forcing, only : ice_ocean_boundary_type, surface_forcing_CS use MOM_surface_forcing, only : forcing_save_restart -use MOM_time_manager, only : time_type, get_time, set_time, operator(>) -use MOM_time_manager, only : operator(+), operator(-), operator(*), operator(/) -use MOM_time_manager, only : operator(/=), operator(<=), operator(>=) -use MOM_time_manager, only : operator(<), real_to_time_type, time_type_to_real +use MOM_time_manager, only : time_type, operator(>), operator(+), operator(-) +use MOM_time_manager, only : operator(*), operator(/), operator(/=) +use MOM_time_manager, only : operator(<=), operator(>=), operator(<) +use MOM_time_manager, only : real_to_time_type, time_type_to_real use MOM_tracer_flow_control, only : call_tracer_register, tracer_flow_control_init use MOM_tracer_flow_control, only : call_tracer_flux_init use MOM_variables, only : surface @@ -243,10 +243,8 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) character(len=40) :: mdl = "ocean_model_init" ! This module's name. character(len=48) :: stagger ! A string indicating the staggering locations for the ! surface velocities returned to the coupler. -! integer :: secs, days type(param_file_type) :: param_file !< A structure to parse for run-time parameters - logical :: use_temperature -! type(time_type) :: dt_geometric, dt_savedays, dt_from_base + logical :: use_temperature ! If true, temperature and salinity are state variables. call callTree_enter("ocean_model_init(), ocean_model_MOM.F90") if (associated(OS)) then @@ -446,13 +444,10 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & logical :: do_dyn ! If true, step the ocean dynamics and transport. logical :: do_thermo ! If true, step the ocean thermodynamics. logical :: step_thermo ! If true, take a thermodynamic step. - integer :: secs, days ! Integer number of days and seconds in the timestep. integer :: is, ie, js, je call callTree_enter("update_ocean_model(), ocean_model_MOM.F90") - call get_time(Ocean_coupling_time_step, secs, days) - dt_coupling = 86400.0*real(days) + real(secs) -!### dt_coupling = time_type_to_real(Ocean_coupling_time_step) + dt_coupling = time_type_to_real(Ocean_coupling_time_step) if (time_start_update /= OS%Time) then call MOM_error(WARNING, "update_ocean_model: internal clock does not "//& @@ -599,9 +594,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & if (step_thermo) then ! Back up Time2 to the start of the thermodynamic segment. - !### Use ticks here for more precision. - !Time2 = Time2 - real_to_time_type(dtdia - dt_dyn) - Time2 = Time2 - set_time(int(floor((dtdia - dt_dyn) + 0.5))) + Time2 = Time2 - real_to_time_type(dtdia - dt_dyn) call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) @@ -609,9 +602,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & endif t_elapsed_seg = t_elapsed_seg + dt_dyn - !### Use ticks here for more precision. - ! Time2 = Time1 + real_to_time_type(t_elapsed_seg) - Time2 = Time1 + set_time(int(floor(t_elapsed_seg + 0.5))) + Time2 = Time1 + real_to_time_type(t_elapsed_seg) enddo endif diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index 61c3f4a509..7dd60403c2 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -48,7 +48,8 @@ program MOM_main use MOM_string_functions,only : uppercase use MOM_surface_forcing, only : set_forcing, forcing_save_restart use MOM_surface_forcing, only : surface_forcing_init, surface_forcing_CS - use MOM_time_manager, only : time_type, set_date, set_time, get_date, time_type_to_real + use MOM_time_manager, only : time_type, set_date, set_time, get_date + use MOM_time_manager, only : real_to_time_type, time_type_to_real use MOM_time_manager, only : operator(+), operator(-), operator(*), operator(/) use MOM_time_manager, only : operator(>), operator(<), operator(>=) use MOM_time_manager, only : increment_date, set_calendar_type, month_name @@ -356,7 +357,7 @@ program MOM_main endif ntstep = MAX(1,ceiling(dt_forcing/dt - 0.001)) - Time_step_ocean = set_time(int(floor(dt_forcing+0.5))) + Time_step_ocean = real_to_time_type(dt_forcing) elapsed_time_master = (abs(dt_forcing - time_type_to_real(Time_step_ocean)) > 1.0e-12*dt_forcing) if (elapsed_time_master) & call MOM_mesg("Using real elapsed time for the master clock.", 2) @@ -532,7 +533,7 @@ program MOM_main dtdia = dt_dyn*(n - n_last_thermo) ! Back up Time2 to the start of the thermodynamic segment. if (n > n_last_thermo+1) & - Time2 = Time2 - set_time(int(floor((dtdia - dt_dyn) + 0.5))) + Time2 = Time2 - real_to_time_type(dtdia - dt_dyn) call step_MOM(forces, fluxes, sfc_state, Time2, dtdia, MOM_CSp, & do_dynamics=.false., do_thermodynamics=.true., & start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_forcing) @@ -541,7 +542,7 @@ program MOM_main endif t_elapsed_seg = t_elapsed_seg + dt_dyn - Time2 = Time1 + set_time(int(floor(t_elapsed_seg + 0.5))) + Time2 = Time1 + real_to_time_type(t_elapsed_seg) enddo endif @@ -559,7 +560,7 @@ program MOM_main elapsed_time = elapsed_time - floor(elapsed_time) endif if (elapsed_time_master) then - Master_Time = segment_start_time + set_time(int(floor(elapsed_time+0.5))) + Master_Time = segment_start_time + real_to_time_type(elapsed_time) else Master_Time = Master_Time + Time_step_ocean endif From d9e9457b19cd27de5028b9ff34cb777cac564d27 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 7 Aug 2018 13:32:41 -0400 Subject: [PATCH 017/174] Use real_to_time_type in 63+year segment clock cor Use real_to_time_type in long-time (>63 year segment) ocean-only model clock correction for improved accuracy with fractional timesteps and very long run segments. All answers are bitwise identical in existing test cases. --- config_src/solo_driver/MOM_driver.F90 | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index 7dd60403c2..f30a740254 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -138,7 +138,7 @@ program MOM_main real :: dt_dyn, dtdia, t_elapsed_seg integer :: n, n_max, nts, n_last_thermo logical :: diabatic_first, single_step_call - type(time_type) :: Time2 + type(time_type) :: Time2, time_chg integer :: Restart_control ! An integer that is bit-tested to determine whether ! incremental restart files are saved and whether they @@ -388,7 +388,7 @@ program MOM_main endif call get_param(param_file, mod_name, "SINGLE_STEPPING_CALL", single_step_call, & - "If true, advance the state of MOM with a single step \n"//& + "If true, advance the state of MOMtime_chg with a single step \n"//& "including both dynamics and thermodynamics. If false \n"//& "the two phases are advanced with separate calls.", default=.true.) call get_param(param_file, mod_name, "DT_THERM", dt_therm, & @@ -550,14 +550,14 @@ program MOM_main ! This is here to enable fractional-second time steps. elapsed_time = elapsed_time + dt_forcing if (elapsed_time > 2e9) then - ! This is here to ensure that the conversion from a real to an integer - ! can be accurately represented in long runs (longer than ~63 years). - ! It will also ensure that elapsed time does not lose resolution of order - ! the timetype's resolution, provided that the timestep and tick are - ! larger than 10-5 seconds. If a clock with a finer resolution is used, - ! a smaller value would be required. - segment_start_time = segment_start_time + set_time(int(floor(elapsed_time))) - elapsed_time = elapsed_time - floor(elapsed_time) + ! This is here to ensure that the conversion from a real to an integer can be accurately + ! represented in long runs (longer than ~63 years). It will also ensure that elapsed time + ! does not lose resolution of order the timetype's resolution, provided that the timestep and + ! tick are larger than 10-5 seconds. If a clock with a finer resolution is used, a smaller + ! value would be required. + time_chg = real_to_time_type(elapsed_time) + segment_start_time = segment_start_time + time_chg + elapsed_time = elapsed_time - time_type_to_real(time_chg) endif if (elapsed_time_master) then Master_Time = segment_start_time + real_to_time_type(elapsed_time) From 974662e499e89e88955360ab474527a4a11b1844 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 7 Aug 2018 19:19:48 -0400 Subject: [PATCH 018/174] Corrected description of SINGLE_STEPPING_CALL Corrected the documentation in the get_param call for SINGLE_STEPPING_CALL, that was inadvertently messed up two commits ago. All answers are bitwise identical, and inadvertent changes to the MOM_parameter_doc files have been reversed. --- config_src/solo_driver/MOM_driver.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index f30a740254..19901f9a0c 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -388,7 +388,7 @@ program MOM_main endif call get_param(param_file, mod_name, "SINGLE_STEPPING_CALL", single_step_call, & - "If true, advance the state of MOMtime_chg with a single step \n"//& + "If true, advance the state of MOM with a single step \n"//& "including both dynamics and thermodynamics. If false \n"//& "the two phases are advanced with separate calls.", default=.true.) call get_param(param_file, mod_name, "DT_THERM", dt_therm, & From a30575d192ff9f75dd825e3966ef0e414e6faac8 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 8 Aug 2018 16:13:14 -0400 Subject: [PATCH 019/174] +Added APPROX_NET_MASS_SRC & moved RESTORE_SALINITY Added code to store an estimate of the net mass source in the mech_forcing type, along with the new run time parameter APPROX_NET_MASS_SRC that controls this behavior. This estimate should be correct for coupled models, but may be off with data overrides or restoring. Because forces%net_mass_src is not yet used in the solution, that answers are invariant to the use of this option. Also moved the get_param calls for RESTORE_SALINITY and RESTORE_TEMPERATURE into surface_forcing_init, and eliminated the corresponding arguments from surface_forcing_init and convert_IOB_to_fluxes, because these parameters were not used in the top-level MOM6 code. Also added a new flag, net_mass_src_set, to the mech_forcing type and dOxygenized the comments in and surrounding the surface_forcing_CS. By default, all answers are bitwise identical, but there is a new run-time parameter, changes to publicly visible interfaces, and the MOM_parameter_doc files change. --- .../coupled_driver/MOM_surface_forcing.F90 | 287 ++++++++++-------- config_src/coupled_driver/ocean_model_MOM.F90 | 22 +- src/core/MOM_forcing_type.F90 | 1 + 3 files changed, 161 insertions(+), 149 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index a4cd1162d7..532ed8081b 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -50,107 +50,106 @@ module MOM_surface_forcing public ice_ocn_bnd_type_chksum public forcing_save_restart - -! surface_forcing_CS is a structure containing pointers to the forcing fields -! which may be used to drive MOM. All fluxes are positive downward. +!> surface_forcing_CS is a structure containing pointers to the forcing fields +!! which may be used to drive MOM. All fluxes are positive downward. type, public :: surface_forcing_CS ; private - integer :: wind_stagger ! AGRID, BGRID_NE, or CGRID_NE (integer values - ! from MOM_domains) to indicate the staggering of - ! the winds that are being provided in calls to - ! update_ocean_model. - logical :: use_temperature ! If true, temp and saln used as state variables + integer :: wind_stagger !< AGRID, BGRID_NE, or CGRID_NE (integer values + !! from MOM_domains) to indicate the staggering of + !! the winds that are being provided in calls to + !! update_ocean_model. + logical :: use_temperature !< If true, temp and saln used as state variables real :: wind_stress_multiplier !< A multiplier applied to incoming wind stress (nondim). - real :: Rho0 ! Boussinesq reference density (kg/m^3) - real :: area_surf = -1.0 ! total ocean surface area (m^2) - real :: latent_heat_fusion ! latent heat of fusion (J/kg) - real :: latent_heat_vapor ! latent heat of vaporization (J/kg) - - real :: max_p_surf ! maximum surface pressure that can be - ! exerted by the atmosphere and floating sea-ice, - ! in Pa. This is needed because the FMS coupling - ! structure does not limit the water that can be - ! frozen out of the ocean and the ice-ocean heat - ! fluxes are treated explicitly. - logical :: use_limited_P_SSH ! If true, return the sea surface height with - ! the correction for the atmospheric (and sea-ice) - ! pressure limited by max_p_surf instead of the - ! full atmospheric pressure. The default is true. - - real :: gust_const ! constant unresolved background gustiness for ustar (Pa) - logical :: read_gust_2d ! If true, use a 2-dimensional gustiness supplied - ! from an input file. + real :: Rho0 !< Boussinesq reference density (kg/m^3) + real :: area_surf = -1.0 !< Total ocean surface area (m^2) + real :: latent_heat_fusion !< Latent heat of fusion (J/kg) + real :: latent_heat_vapor !< Latent heat of vaporization (J/kg) + + real :: max_p_surf !< The maximum surface pressure that can be + !! exerted by the atmosphere and floating sea-ice, + !! in Pa. This is needed because the FMS coupling + !! structure does not limit the water that can be + !! frozen out of the ocean and the ice-ocean heat + !! fluxes are treated explicitly. + logical :: use_limited_P_SSH !< If true, return the sea surface height with + !! the correction for the atmospheric (and sea-ice) + !! pressure limited by max_p_surf instead of the + !! full atmospheric pressure. The default is true. + logical :: approx_net_mass_src !< If true, use the net mass sources from the ice-ocean boundary + !! type without any further adjustments to drive the ocean dynamics. + !! The actual net mass source may differ due to corrections. + + real :: gust_const !< Constant unresolved background gustiness for ustar (Pa) + logical :: read_gust_2d !< If true, use a 2-dimensional gustiness supplied from an input file. + real, pointer, dimension(:,:) :: & + TKE_tidal => NULL() !< Turbulent kinetic energy introduced to the bottom boundary layer + !! by drag on the tidal flows, in W m-2. real, pointer, dimension(:,:) :: & - TKE_tidal => NULL(), & ! turbulent kinetic energy introduced to the - ! bottom boundary layer by drag on the tidal flows, - ! in W m-2. - gust => NULL(), & ! spatially varying unresolved background - ! gustiness that contributes to ustar (Pa). - ! gust is used when read_gust_2d is true. - ustar_tidal => NULL() ! tidal contribution to the bottom friction velocity (m/s) - real :: cd_tides ! drag coefficient that applies to the tides (nondimensional) - real :: utide ! constant tidal velocity to use if read_tideamp - ! is false, in m s-1. - logical :: read_tideamp ! If true, spatially varying tidal amplitude read from a file. - - logical :: rigid_sea_ice ! If true, sea-ice exerts a rigidity that acts - ! to damp surface deflections (especially surface - ! gravity waves). The default is false. - real :: Kv_sea_ice ! viscosity in sea-ice that resists sheared vertical motions (m^2/s) - real :: density_sea_ice ! typical density of sea-ice (kg/m^3). The value is - ! only used to convert the ice pressure into - ! appropriate units for use with Kv_sea_ice. - real :: rigid_sea_ice_mass ! A mass per unit area of sea-ice beyond which - ! sea-ice viscosity becomes effective, in kg m-2, - ! typically of order 1000 kg m-2. - logical :: allow_flux_adjustments ! If true, use data_override to obtain flux adjustments - - real :: Flux_const ! piston velocity for surface restoring (m/s) - logical :: salt_restore_as_sflux ! If true, SSS restore as salt flux instead of water flux - logical :: adjust_net_srestore_to_zero ! adjust srestore to zero (for both salt_flux or vprec) - logical :: adjust_net_srestore_by_scaling ! adjust srestore w/o moving zero contour - logical :: adjust_net_fresh_water_to_zero ! adjust net surface fresh-water (w/ restoring) to zero - logical :: use_net_FW_adjustment_sign_bug ! use the wrong sign when adjusting net FW - logical :: adjust_net_fresh_water_by_scaling ! adjust net surface fresh-water w/o moving zero contour - logical :: mask_srestore_under_ice ! If true, use an ice mask defined by frazil - ! criteria for salinity restoring. - real :: ice_salt_concentration ! salt concentration for sea ice (kg/kg) - logical :: mask_srestore_marginal_seas ! if true, then mask SSS restoring in marginal seas - real :: max_delta_srestore ! maximum delta salinity used for restoring - real :: max_delta_trestore ! maximum delta sst used for restoring - real, pointer, dimension(:,:) :: basin_mask => NULL() ! mask for SSS restoring by basin - - type(diag_ctrl), pointer :: diag ! structure to regulate diagnostic output timing - character(len=200) :: inputdir ! directory where NetCDF input files are - character(len=200) :: salt_restore_file ! filename for salt restoring data - character(len=30) :: salt_restore_var_name ! name of surface salinity in salt_restore_file - logical :: mask_srestore ! if true, apply a 2-dimensional mask to the surface - ! salinity restoring fluxes. The masking file should be - ! in inputdir/salt_restore_mask.nc and the field should - ! be named 'mask' - real, pointer, dimension(:,:) :: srestore_mask => NULL() ! mask for SSS restoring - character(len=200) :: temp_restore_file ! filename for sst restoring data - character(len=30) :: temp_restore_var_name ! name of surface temperature in temp_restore_file - logical :: mask_trestore ! if true, apply a 2-dimensional mask to the surface - ! temperature restoring fluxes. The masking file should be - ! in inputdir/temp_restore_mask.nc and the field should - ! be named 'mask' - real, pointer, dimension(:,:) :: trestore_mask => NULL() ! mask for SST restoring - integer :: id_srestore = -1 ! id number for time_interp_external. - integer :: id_trestore = -1 ! id number for time_interp_external. - - ! Diagnostics handles - type(forcing_diags), public :: handles + gust => NULL() !< A spatially varying unresolved background gustiness that + !! contributes to ustar (Pa). gust is used when read_gust_2d is true. + real, pointer, dimension(:,:) :: & + ustar_tidal => NULL() !< Tidal contribution to the bottom friction velocity (m/s) + real :: cd_tides !< Drag coefficient that applies to the tides (nondimensional) + real :: utide !< Constant tidal velocity to use if read_tideamp is false, in m s-1. + logical :: read_tideamp !< If true, spatially varying tidal amplitude read from a file. + + logical :: rigid_sea_ice !< If true, sea-ice exerts a rigidity that acts to damp surface + !! deflections (especially surface gravity waves). The default is false. + real :: Kv_sea_ice !< Viscosity in sea-ice that resists sheared vertical motions (m^2/s) + real :: density_sea_ice !< Typical density of sea-ice (kg/m^3). The value is only used to convert + !! the ice pressure into appropriate units for use with Kv_sea_ice. + real :: rigid_sea_ice_mass !< A mass per unit area of sea-ice beyond which sea-ice viscosity + !! becomes effective, in kg m-2, typically of order 1000 kg m-2. + logical :: allow_flux_adjustments !< If true, use data_override to obtain flux adjustments + + logical :: restore_salt !< If true, the coupled MOM driver adds a term to restore surface + !! salinity to a specified value. + logical :: restore_temp !< If true, the coupled MOM driver adds a term to restore sea + !! surface temperature to a specified value. + real :: Flux_const !< Piston velocity for surface restoring (m/s) + logical :: salt_restore_as_sflux !< If true, SSS restore as salt flux instead of water flux + logical :: adjust_net_srestore_to_zero !< Adjust srestore to zero (for both salt_flux or vprec) + logical :: adjust_net_srestore_by_scaling !< Adjust srestore w/o moving zero contour + logical :: adjust_net_fresh_water_to_zero !< Adjust net surface fresh-water (with restoring) to zero + logical :: use_net_FW_adjustment_sign_bug !< Use the wrong sign when adjusting net FW + logical :: adjust_net_fresh_water_by_scaling !< Adjust net surface fresh-water w/o moving zero contour + logical :: mask_srestore_under_ice !< If true, use an ice mask defined by frazil criteria + !! for salinity restoring. + real :: ice_salt_concentration !< Salt concentration for sea ice (kg/kg) + logical :: mask_srestore_marginal_seas !< If true, then mask SSS restoring in marginal seas + real :: max_delta_srestore !< Maximum delta salinity used for restoring + real :: max_delta_trestore !< Maximum delta sst used for restoring + real, pointer, dimension(:,:) :: basin_mask => NULL() !< Mask for surface salinity restoring by basin + + type(diag_ctrl), pointer :: diag => NULL() !< Structure to regulate diagnostic output timing + character(len=200) :: inputdir !< Directory where NetCDF input files are + character(len=200) :: salt_restore_file !< Filename for salt restoring data + character(len=30) :: salt_restore_var_name !< Name of surface salinity in salt_restore_file + logical :: mask_srestore !< If true, apply a 2-dimensional mask to the surface + !! salinity restoring fluxes. The masking file should be + !! in inputdir/salt_restore_mask.nc and the field should + !! be named 'mask' + real, pointer, dimension(:,:) :: srestore_mask => NULL() !< mask for SSS restoring + character(len=200) :: temp_restore_file !< Filename for sst restoring data + character(len=30) :: temp_restore_var_name !< Name of surface temperature in temp_restore_file + logical :: mask_trestore !< If true, apply a 2-dimensional mask to the surface + !! temperature restoring fluxes. The masking file should be + !! in inputdir/temp_restore_mask.nc and the field should + !! be named 'mask' + real, pointer, dimension(:,:) :: trestore_mask => NULL() !< Mask for SST restoring + integer :: id_srestore = -1 !< An id number for time_interp_external. + integer :: id_trestore = -1 !< An id number for time_interp_external. + + type(forcing_diags), public :: handles !< Diagnostics handles !### type(ctrl_forcing_CS), pointer :: ctrl_forcing_CSp => NULL() - type(MOM_restart_CS), pointer :: restart_CSp => NULL() - type(user_revise_forcing_CS), pointer :: urf_CS => NULL() + type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< A pointer to the restart control structure + type(user_revise_forcing_CS), pointer :: urf_CS => NULL() !< A control structure for user forcing revisions end type surface_forcing_CS -! ice_ocean_boundary_type is a structure corresponding to forcing, but with -! the elements, units, and conventions that exactly conform to the use for -! MOM-based coupled models. +!> ice_ocean_boundary_type is a structure corresponding to forcing, but with the elements, units, +!! and conventions that exactly conform to the use for MOM6-based coupled models. type, public :: ice_ocean_boundary_type real, pointer, dimension(:,:) :: u_flux =>NULL() !< i-direction wind stress (Pa) real, pointer, dimension(:,:) :: v_flux =>NULL() !< j-direction wind stress (Pa) @@ -179,25 +178,23 @@ module MOM_surface_forcing !! ice-shelves, expressed as a coefficient !! for divergence damping, as determined !! outside of the ocean model in (m3/s) - integer :: xtype !< The type of the exchange - REGRID, REDIST or DIRECT - type(coupler_2d_bc_type) :: fluxes !< A structure that may contain an array of - !! named fields used for passive tracer fluxes. - integer :: wind_stagger = -999 !< A flag indicating the spatial discretization of - !! wind stresses. This flag may be set by the - !! flux-exchange code, based on what the sea-ice - !! model is providing. Otherwise, the value from - !! the surface_forcing_CS is used. + integer :: xtype !< The type of the exchange - REGRID, REDIST or DIRECT + type(coupler_2d_bc_type) :: fluxes !< A structure that may contain an array of named fields + !! used for passive tracer fluxes. + integer :: wind_stagger = -999 !< A flag indicating the spatial discretization of wind stresses. + !! This flag may be set by the flux-exchange code, based on what + !! the sea-ice model is providing. Otherwise, the value from + !! the surface_forcing_CS is used. end type ice_ocean_boundary_type -integer :: id_clock_forcing +integer :: id_clock_forcing !< A CPU time clock contains !> This subroutine translates the Ice_ocean_boundary_type into a MOM !! thermodynamic forcing type, including changes of units, sign conventions, !! and putting the fields into arrays with MOM-standard halos. -subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & - sfc_state, restore_salt, restore_temp) +subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, sfc_state) type(ice_ocean_boundary_type), & target, intent(in) :: IOB !< An ice-ocean boundary type with fluxes to drive !! the ocean in a coupled model @@ -212,9 +209,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & !! previous call to surface_forcing_init. type(surface), intent(in) :: sfc_state !< A structure containing fields that describe the !! surface state of the ocean. - logical, optional, intent(in) :: restore_salt !< If true, salinity is restored to a target value. - logical, optional, intent(in) :: restore_temp !< If true, temperature is restored to a target value. - real, dimension(SZI_(G),SZJ_(G)) :: & data_restore, & ! The surface value toward which to restore (g/kg or degC) @@ -234,10 +228,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, isr, ier, jsr, jer integer :: isc_bnd, iec_bnd, jsc_bnd, jec_bnd - logical :: restore_salinity ! local copy of the argument restore_salt, if it - ! is present, or false (no restoring) otherwise. - logical :: restore_sst ! local copy of the argument restore_temp, if it - ! is present, or false (no restoring) otherwise. real :: delta_sss ! temporary storage for sss diff from restoring value real :: delta_sst ! temporary storage for sst diff from restoring value @@ -264,11 +254,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & fluxes%netFWGlobalAdj = 0.0 fluxes%netFWGlobalScl = 0.0 - restore_salinity = .false. - if (present(restore_salt)) restore_salinity = restore_salt - restore_sst = .false. - if (present(restore_temp)) restore_sst = restore_temp - ! allocation and initialization if this is the first time that this ! flux type has been used. if (fluxes%dt_buoy_accum < 0) then @@ -305,7 +290,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & fluxes%ustar_tidal(i,j) = CS%ustar_tidal(i,j) enddo ; enddo - if (restore_temp) call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) + if (CS%restore_temp) call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) fluxes%dt_buoy_accum = 0.0 endif ! endif for allocation and initialization @@ -343,7 +328,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & enddo ; enddo ! Salinity restoring logic - if (restore_salinity) then + if (CS%restore_salt) then call time_interp_external(CS%id_srestore,Time,data_restore) ! open_ocn_mask indicates where to restore salinity (1 means restore, 0 does not) open_ocn_mask(:,:) = 1.0 @@ -396,7 +381,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & endif ! SST restoring logic - if (restore_sst) then + if (CS%restore_temp) then call time_interp_external(CS%id_trestore,Time,data_restore) do j=js,je ; do i=is,ie delta_sst = data_restore(i,j)- sfc_state%SST(i,j) @@ -593,7 +578,8 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS, dt_forc ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & rigidity_at_h, & ! Ice rigidity at tracer points (m3 s-1) - ustar_tmp ! A temporary array of ustars. + net_mass_src, & ! A temporary of net mass sources, in kg m-2 s-1. + ustar_tmp ! A temporary array of ustar values, in m s-1. real :: I_GEarth ! 1.0 / G%G_Earth (s^2/m) real :: Kv_rho_ice ! (CS%kv_sea_ice / CS%density_sea_ice) ( m^5/(s*kg) ) @@ -702,6 +688,36 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS, dt_forc enddo ; enddo endif + ! Find the net mass source in the input forcing without other adjustments. + if (CS%approx_net_mass_src .and. associated(forces%net_mass_src)) then + net_mass_src(:,:) = 0.0 + i0 = is - isc_bnd ; j0 = js - jsc_bnd + do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.0) then + if (associated(IOB%lprec)) & + net_mass_src(i,j) = net_mass_src(i,j) + IOB%lprec(i-i0,j-j0) + if (associated(IOB%fprec)) & + net_mass_src(i,j) = net_mass_src(i,j) + IOB%fprec(i-i0,j-j0) + if (associated(IOB%runoff)) & + net_mass_src(i,j) = net_mass_src(i,j) + IOB%runoff(i-i0,j-j0) + if (associated(IOB%calving)) & + net_mass_src(i,j) = net_mass_src(i,j) + IOB%calving(i-i0,j-j0) + if (associated(IOB%q_flux)) & + net_mass_src(i,j) = net_mass_src(i,j) - IOB%q_flux(i-i0,j-j0) + endif ; enddo ; enddo + if (wt1 <= 0.0) then + do j=js,je ; do i=is,ie + forces%net_mass_src(i,j) = wt2*net_mass_src(i,j) + enddo ; enddo + else + do j=js,je ; do i=is,ie + forces%net_mass_src(i,j) = wt1*forces%net_mass_src(i,j) + wt2*net_mass_src(i,j) + enddo ; enddo + endif + forces%net_mass_src_set = .true. + else + forces%net_mass_src_set = .false. + endif + ! Obtain optional ice-berg related fluxes from the IOB type: if (associated(IOB%area_berg)) then ; do j=js,je ; do i=is,ie forces%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j) @@ -1084,7 +1100,7 @@ subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, & end subroutine forcing_save_restart !> Initialize the surface forcing, including setting parameters and allocating permanent memory. -subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, restore_temp) +subroutine surface_forcing_init(Time, G, param_file, diag, CS) type(time_type), intent(in) :: Time !< The current model time type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters @@ -1092,10 +1108,6 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res !! diagnostic output type(surface_forcing_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module - logical, optional, intent(in) :: restore_salt !< If present and true surface salinity - !! restoring will be applied in this model. - logical, optional, intent(in) :: restore_temp !< If present and true surface temperature - !! restoring will be applied in this model. ! Local variables real :: utide ! The RMS tidal velocity, in m s-1. @@ -1154,11 +1166,19 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res "the ice-ocean heat fluxes are treated explicitly. No \n"//& "limit is applied if a negative value is used.", units="Pa", & default=-1.0) + call get_param(param_file, mdl, "RESTORE_SALINITY", CS%restore_salt, & + "If true, the coupled driver will add a globally-balanced \n"//& + "fresh-water flux that drives sea-surface salinity \n"//& + "toward specified values.", default=.false.) + call get_param(param_file, mdl, "RESTORE_TEMPERATURE", CS%restore_temp, & + "If true, the coupled driver will add a \n"//& + "heat flux that drives sea-surface temperauture \n"//& + "toward specified values.", default=.false.) call get_param(param_file, mdl, "ADJUST_NET_SRESTORE_TO_ZERO", & CS%adjust_net_srestore_to_zero, & "If true, adjusts the salinity restoring seen to zero\n"//& "whether restoring is via a salt flux or virtual precip.",& - default=restore_salt) + default=CS%restore_salt) call get_param(param_file, mdl, "ADJUST_NET_SRESTORE_BY_SCALING", & CS%adjust_net_srestore_by_scaling, & "If true, adjustments to salt restoring to achieve zero net are\n"//& @@ -1188,6 +1208,11 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res "correction for the atmospheric (and sea-ice) pressure \n"//& "limited by max_p_surf instead of the full atmospheric \n"//& "pressure.", default=.true.) + call get_param(param_file, mdl, "APPROX_NET_MASS_SRC", CS%approx_net_mass_src, & + "If true, use the net mass sources from the ice-ocean \n"//& + "boundary type without any further adjustments to drive \n"//& + "the ocean dynamics. The actual net mass source may differ \n"//& + "due to internal corrections.", default=.false.) call get_param(param_file, mdl, "WIND_STAGGER", stagger, & "A case-insensitive character string to indicate the \n"//& @@ -1203,7 +1228,7 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res "coupler. This is used for testing and should be =1.0 for any\n"//& "production runs.", default=1.0) - if (restore_salt) then + if (CS%restore_salt) then call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & "The constant that relates the restoring surface fluxes \n"//& "to the relative surface anomalies (akin to a piston \n"//& @@ -1251,7 +1276,7 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res "a mask for SSS restoring.", default=.false.) endif - if (restore_temp) then + if (CS%restore_temp) then call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & "The constant that relates the restoring surface fluxes \n"//& "to the relative surface anomalies (akin to a piston \n"//& @@ -1370,7 +1395,7 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res call data_override_init(Ocean_domain_in=G%Domain%mpp_domain) endif - if (present(restore_salt)) then ; if (restore_salt) then + if (CS%restore_salt) then salt_file = trim(CS%inputdir) // trim(CS%salt_restore_file) CS%id_srestore = init_external_field(salt_file, CS%salt_restore_var_name, domain=G%Domain%mpp_domain) call safe_alloc_ptr(CS%srestore_mask,isd,ied,jsd,jed); CS%srestore_mask(:,:) = 1.0 @@ -1378,9 +1403,9 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res flnam = trim(CS%inputdir) // 'salt_restore_mask.nc' call MOM_read_data(flnam,'mask', CS%srestore_mask, G%domain, timelevel=1) endif - endif ; endif + endif - if (present(restore_temp)) then ; if (restore_temp) then + if (CS%restore_temp) then temp_file = trim(CS%inputdir) // trim(CS%temp_restore_file) CS%id_trestore = init_external_field(temp_file, CS%temp_restore_var_name, domain=G%Domain%mpp_domain) call safe_alloc_ptr(CS%trestore_mask,isd,ied,jsd,jed); CS%trestore_mask(:,:) = 1.0 @@ -1388,7 +1413,7 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res flnam = trim(CS%inputdir) // 'temp_restore_mask.nc' call MOM_read_data(flnam, 'mask', CS%trestore_mask, G%domain, timelevel=1) endif - endif ; endif + endif ! Set up any restart fields associated with the forcing. call restart_init(param_file, CS%restart_CSp, "MOM_forcing.res") diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index e3fd612c70..44d94a77f6 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -149,10 +149,6 @@ module ocean_model_mod logical :: icebergs_alter_ocean !< If true, the icebergs can change ocean the !! ocean dynamics and forcing fluxes. - logical :: restore_salinity !< If true, the coupled MOM driver adds a term to - !! restore salinity to a specified value. - logical :: restore_temp !< If true, the coupled MOM driver adds a term to - !! restore sst to a specified value. real :: press_to_z !< A conversion factor between pressure and ocean !! depth in m, usually 1/(rho_0*g), in m Pa-1. real :: C_p !< The heat capacity of seawater, in J K-1 kg-1. @@ -311,14 +307,6 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) else ; call MOM_error(FATAL,"ocean_model_init: OCEAN_SURFACE_STAGGER = "// & trim(stagger)//" is invalid.") ; endif - call get_param(param_file, mdl, "RESTORE_SALINITY",OS%restore_salinity, & - "If true, the coupled driver will add a globally-balanced \n"//& - "fresh-water flux that drives sea-surface salinity \n"//& - "toward specified values.", default=.false.) - call get_param(param_file, mdl, "RESTORE_TEMPERATURE",OS%restore_temp, & - "If true, the coupled driver will add a \n"//& - "heat flux that drives sea-surface temperauture \n"//& - "toward specified values.", default=.false.) call get_param(param_file, mdl, "RHO_0", Rho0, & "The mean ocean density used with BOUSSINESQ true to \n"//& "calculate accelerations and the mass for conservation \n"//& @@ -343,7 +331,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) do_integrals=.true., gas_fields_ocn=gas_fields_ocn) call surface_forcing_init(Time_in, OS%grid, param_file, OS%diag, & - OS%forcing_CSp, OS%restore_salinity, OS%restore_temp) + OS%forcing_CSp) if (OS%use_ice_shelf) then call initialize_ice_shelf(param_file, OS%grid, OS%Time, OS%ice_shelf_CSp, & @@ -486,8 +474,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & if (do_thermo) then if (OS%fluxes%fluxes_used) then call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, index_bnds, OS%Time, & - OS%grid, OS%forcing_CSp, OS%sfc_state, OS%restore_salinity, & - OS%restore_temp) + OS%grid, OS%forcing_CSp, OS%sfc_state) ! Add ice shelf fluxes if (OS%use_ice_shelf) & @@ -508,8 +495,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! into a temporary type and then accumulate them in about 20 lines. OS%flux_tmp%C_p = OS%fluxes%C_p call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%flux_tmp, index_bnds, OS%Time, & - OS%grid, OS%forcing_CSp, OS%sfc_state, OS%restore_salinity, & - OS%restore_temp) + OS%grid, OS%forcing_CSp, OS%sfc_state) if (OS%use_ice_shelf) & call shelf_calc_flux(OS%sfc_state, OS%flux_tmp, OS%Time, dt_coupling, OS%Ice_shelf_CSp) @@ -523,7 +509,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & #endif endif endif - if (associated(OS%forces%net_mass_src)) & + if (associated(OS%forces%net_mass_src) .and. .not.OS%forces%net_mass_src_set) & call get_net_mass_forcing(OS%fluxes, OS%grid, OS%forces%net_mass_src) if (OS%use_waves) then diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 1df0fe1473..ba170c63f4 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -212,6 +212,7 @@ module MOM_forcing_type rigidity_ice_v => NULL() !< Depth-integrated lateral viscosity of ice shelves or sea ice at v-points (m3/s) real :: dt_force_accum = -1.0 !< The amount of time over which the mechanical forcing fluxes !! have been averaged, in s. + logical :: net_mass_src_set = .false. !< If true, an estimate of net_mass_src has been provided. logical :: accumulate_p_surf = .false. !< If true, the surface pressure due to the atmosphere !! and various types of ice needs to be accumulated, and the !! surface pressure explicitly reset to zero at the driver level From 6c4681130b9bec8abffe9372de09649627e15ed9 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 8 Aug 2018 18:51:27 -0400 Subject: [PATCH 020/174] +Removed forcing type arg from mech_forcing_diags Moved 4 diagnostics from mech_forcing_diags to forcing_diagnostics and removed the now unused (thermodynamic) forcing type argument fluxes from mech_forcing_diags, so that the location of the diagnostics better reflects their use in stepping MOM6. All calls to mech_forcing_diags in the drivers were changed accordingly. Also, a new element, nstep_thermo, was added to the ocean_state_type to allow dynamic and thermodynamic calls to update_ocean_model to be counted separately, and some additional calls now only occur if the dynamics or thermodynamics are being stepped. All answers are bitwise identical, but one publicly visible interface has changed. --- config_src/coupled_driver/ocean_model_MOM.F90 | 40 +++++++++++------- config_src/mct_driver/ocn_comp_mct.F90 | 3 +- config_src/solo_driver/MOM_driver.F90 | 3 +- src/core/MOM_forcing_type.F90 | 42 ++++++++++++------- 4 files changed, 52 insertions(+), 36 deletions(-) diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index 44d94a77f6..37df04d8e7 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -20,7 +20,7 @@ module ocean_model_mod use MOM_diag_mediator, only : diag_mediator_close_registration, diag_mediator_end use MOM_domains, only : pass_var, pass_vector, AGRID, BGRID_NE, CGRID_NE use MOM_domains, only : TO_ALL, Omit_Corners -use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe +use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe use MOM_error_handler, only : callTree_enter, callTree_leave use MOM_file_parser, only : get_param, log_version, close_param_file, param_file_type use MOM_forcing_type, only : forcing, mech_forcing, allocate_forcing_type @@ -143,7 +143,8 @@ module ocean_model_mod !! restart file is saved at the end of a run segment !! unless Restart_control is negative. - integer :: nstep = 0 !< The number of calls to update_ocean. + integer :: nstep = 0 !< The number of calls to update_ocean that update the dynamics. + integer :: nstep_thermo = 0 !< The number of calls to update_ocean that update the thermodynamics. logical :: use_ice_shelf !< If true, the ice shelf model is enabled. logical :: use_waves !< If true use wave coupling. @@ -375,8 +376,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) call close_param_file(param_file) call diag_mediator_close_registration(OS%diag) - if (is_root_pe()) & - write(*,'(/12x,a/)') '======== COMPLETED MOM INITIALIZATION ========' + call MOM_mesg('==== Completed MOM6 Coupled Initialization ====', 2) call callTree_leave("ocean_model_init(") end subroutine ocean_model_init @@ -485,7 +485,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & #ifdef _USE_GENERIC_TRACER call enable_averaging(dt_coupling, OS%Time + Ocean_coupling_time_step, OS%diag) !Is this needed? - call MOM_generic_tracer_fluxes_accumulate(OS%fluxes, 1.0) !here weight=1, so just saving the current fluxes + call MOM_generic_tracer_fluxes_accumulate(OS%fluxes, 1.0) ! Here weight=1, so just store the current fluxes #endif ! Indicate that there are new unused fluxes. OS%fluxes%fluxes_used = .false. @@ -505,25 +505,31 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call fluxes_accumulate(OS%flux_tmp, OS%fluxes, dt_coupling, OS%grid, weight) #ifdef _USE_GENERIC_TRACER - call MOM_generic_tracer_fluxes_accumulate(OS%flux_tmp, weight) !weight of the current flux in the running average + ! Incorporate the current tracer fluxes into the running averages + call MOM_generic_tracer_fluxes_accumulate(OS%flux_tmp, weight) #endif endif endif - if (associated(OS%forces%net_mass_src) .and. .not.OS%forces%net_mass_src_set) & + + ! The net mass forcing is not currently used in the MOM6 dynamics solvers, so this is may be unnecessary. + if (do_dyn .and. associated(OS%forces%net_mass_src) .and. .not.OS%forces%net_mass_src_set) & call get_net_mass_forcing(OS%fluxes, OS%grid, OS%forces%net_mass_src) - if (OS%use_waves) then + if (OS%use_waves .and. do_thermo) then + ! For now, the waves are only updated on the thermodynamics steps, because that is where + ! the wave intensities are actually used to drive mixing. At some point, the wave updates + ! might also need to become a part of the ocean dynamics, according to B. Reichl. call Update_Surface_Waves(OS%grid, OS%GV, OS%time, ocean_coupling_time_step, OS%waves) endif - if (OS%nstep==0) then + if ((OS%nstep==0) .and. (OS%nstep_thermo==0)) then call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp, OS%restart_CSp) endif call disable_averaging(OS%diag) Master_time = OS%Time ; Time1 = OS%Time - if (OS%offline_tracer_mode) then + if (OS%offline_tracer_mode .and. do_thermo) then call step_offline(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp) elseif ((.not.do_thermo) .or. (.not.do_dyn)) then ! The call sequence is being orchestrated from outside of update_ocean_model. @@ -593,14 +599,16 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & endif OS%Time = Master_time + Ocean_coupling_time_step - OS%nstep = OS%nstep + 1 + if (do_dyn) OS%nstep = OS%nstep + 1 + if (do_thermo) OS%nstep_thermo = OS%nstep_thermo + 1 - call enable_averaging(dt_coupling, OS%Time, OS%diag) - call mech_forcing_diags(OS%forces, OS%fluxes, dt_coupling, OS%grid, & - OS%diag, OS%forcing_CSp%handles) - call disable_averaging(OS%diag) + if (do_dyn) then + call enable_averaging(dt_coupling, OS%Time, OS%diag) + call mech_forcing_diags(OS%forces, dt_coupling, OS%grid, OS%diag, OS%forcing_CSp%handles) + call disable_averaging(OS%diag) + endif - if (OS%fluxes%fluxes_used) then + if (OS%fluxes%fluxes_used .and. do_thermo) then call enable_averaging(OS%fluxes%dt_buoy_accum, OS%Time, OS%diag) call forcing_diagnostics(OS%fluxes, OS%sfc_state, OS%fluxes%dt_buoy_accum, & OS%grid, OS%diag, OS%forcing_CSp%handles) diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index d294c29656..d2de157a49 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -1790,8 +1790,7 @@ subroutine update_ocean_model(OS, Ocean_sfc, time_start_update, & OS%nstep = OS%nstep + 1 call enable_averaging(time_step, OS%Time, OS%diag) - call mech_forcing_diags(OS%forces, OS%fluxes, time_step, OS%grid, & - OS%diag, OS%forcing_CSp%handles) + call mech_forcing_diags(OS%forces, time_step, OS%grid, OS%diag, OS%forcing_CSp%handles) call disable_averaging(OS%diag) if (OS%fluxes%fluxes_used) then diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index 19901f9a0c..da0f77d935 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -571,8 +571,7 @@ program MOM_main endif ; endif call enable_averaging(dt_forcing, Time, diag) - call mech_forcing_diags(forces, fluxes, dt_forcing, grid, diag, & - surface_forcing_CSp%handles) + call mech_forcing_diags(forces, dt_forcing, grid, diag, surface_forcing_CSp%handles) call disable_averaging(diag) if (.not. offline_tracer_mode) then diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index ba170c63f4..857979f61d 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -298,7 +298,7 @@ module MOM_forcing_type integer :: id_netFWGlobalAdj = -1 integer :: id_netFWGlobalScl = -1 - ! momentum flux amd forcing diagnostic handles + ! momentum flux and forcing diagnostic handles integer :: id_taux = -1 integer :: id_tauy = -1 integer :: id_ustar = -1 @@ -1038,6 +1038,11 @@ subroutine MOM_mech_forcing_chksum(mesg, forces, G, haloshift) haloshift=hshift, symmetric=.true.) if (associated(forces%p_surf)) & call hchksum(forces%p_surf, mesg//" forces%p_surf",G%HI,haloshift=hshift) + if (associated(forces%ustar)) & + call hchksum(forces%ustar, mesg//" forces%ustar",G%HI,haloshift=hshift) + if (associated(forces%rigidity_ice_u) .and. associated(forces%rigidity_ice_v)) & + call uvchksum(mesg//" forces%rigidity_ice_[uv]", forces%rigidity_ice_u, & + forces%rigidity_ice_v, G%HI, haloshift=hshift, symmetric=.true.) end subroutine MOM_mech_forcing_chksum @@ -2054,9 +2059,8 @@ end subroutine copy_back_forcing_fields !> Offer mechanical forcing fields for diagnostics for those !! fields registered as part of register_forcing_type_diags. -subroutine mech_forcing_diags(forces, fluxes, dt, G, diag, handles) +subroutine mech_forcing_diags(forces, dt, G, diag, handles) type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - type(forcing), intent(in) :: fluxes !< A structure containing thermodynamic forcing fields real, intent(in) :: dt !< time step type(ocean_grid_type), intent(in) :: G !< grid type type(diag_ctrl), intent(in) :: diag !< diagnostic type @@ -2071,20 +2075,15 @@ subroutine mech_forcing_diags(forces, fluxes, dt, G, diag, handles) if ((handles%id_taux > 0) .and. associated(forces%taux)) & call post_data(handles%id_taux, forces%taux, diag) + if ((handles%id_tauy > 0) .and. associated(forces%tauy)) & call post_data(handles%id_tauy, forces%tauy, diag) - if ((handles%id_ustar > 0) .and. associated(fluxes%ustar)) & - call post_data(handles%id_ustar, fluxes%ustar, diag) - if (handles%id_ustar_berg > 0) & - call post_data(handles%id_ustar_berg, fluxes%ustar_berg, diag) - if (handles%id_area_berg > 0) & - call post_data(handles%id_area_berg, fluxes%area_berg, diag) - if (handles%id_mass_berg > 0) & - call post_data(handles%id_mass_berg, fluxes%mass_berg, diag) - if (handles%id_frac_ice_cover > 0) & - call post_data(handles%id_frac_ice_cover, fluxes%frac_shelf_h, diag) - if (handles%id_ustar_ice_cover > 0) & - call post_data(handles%id_ustar_ice_cover, fluxes%ustar_shelf, diag) + + if ((handles%id_mass_berg > 0) .and. associated(forces%mass_berg)) & + call post_data(handles%id_mass_berg, forces%mass_berg, diag) + + if ((handles%id_area_berg > 0) .and. associated(forces%area_berg)) & + call post_data(handles%id_area_berg, forces%area_berg, diag) endif @@ -2575,8 +2574,19 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if ((handles%id_buoy > 0) .and. associated(fluxes%buoy)) & call post_data(handles%id_buoy, fluxes%buoy, diag) + if ((handles%id_ustar > 0) .and. associated(fluxes%ustar)) & + call post_data(handles%id_ustar, fluxes%ustar, diag) - endif + if ((handles%id_ustar_berg > 0) .and. associated(fluxes%ustar_berg)) & + call post_data(handles%id_ustar_berg, fluxes%ustar_berg, diag) + + if ((handles%id_frac_ice_cover > 0) .and. associated(fluxes%frac_shelf_h)) & + call post_data(handles%id_frac_ice_cover, fluxes%frac_shelf_h, diag) + + if ((handles%id_ustar_ice_cover > 0) .and. associated(fluxes%ustar_shelf)) & + call post_data(handles%id_ustar_ice_cover, fluxes%ustar_shelf, diag) + + endif ! query_averaging_enabled call cpu_clock_end(handles%id_clock_forcing) end subroutine forcing_diagnostics From 0cb2d87ab0a44c030b839ac72f75733aebf29454 Mon Sep 17 00:00:00 2001 From: "Jessica.Liptak" Date: Thu, 9 Aug 2018 16:09:44 -0400 Subject: [PATCH 021/174] removed underscore from allocated statement in MOM_generic_tracer_column_physics routine --- src/tracer/MOM_generic_tracer.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index d06ffe0e2c..48b8e4512c 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -498,7 +498,7 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, ! g_tracer=>CS%g_tracer_list do - if (_allocated(g_tracer%trunoff)) then + if (allocated(g_tracer%trunoff)) then call g_tracer_get_alias(g_tracer,g_tracer_name) call g_tracer_get_pointer(g_tracer,g_tracer_name,'stf', stf_array) call g_tracer_get_pointer(g_tracer,g_tracer_name,'trunoff',trunoff_array) From 0bd868837b866211e3eaf899079fe5aceb858849 Mon Sep 17 00:00:00 2001 From: Raymond Menzel Date: Thu, 9 Aug 2018 17:18:33 -0400 Subject: [PATCH 022/174] Allocate surface tracers on the compute domain instead of the data domain. --- src/core/MOM_variables.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 4165fb0e11..4a2dbbea54 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -338,7 +338,7 @@ subroutine allocate_surface_state(sfc_state, G, use_temperature, do_integrals, & if (present(gas_fields_ocn)) & call coupler_type_spawn(gas_fields_ocn, sfc_state%tr_fields, & - (/isd,is,ie,ied/), (/jsd,js,je,jed/), as_needed=.true.) + (/is,is,ie,ie/), (/js,js,je,je/), as_needed=.true.) sfc_state%arrays_allocated = .true. From c4529f3de50ced17375d1595b68f608742cb80c0 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 10 Aug 2018 19:24:16 -0400 Subject: [PATCH 023/174] +Added optional arguments to updaet_ocean_model Added optional start_cycle, end_cycle, and cycle_length arguments to update_ocean_model, for use with dynamics- or thermodynamics-only steps. Also added a separate clock to the ocean_state_type for the ocean dynamics, to keep track of time when the dynamics and thermodynamics are updated separately. Also cleaned up comments describing local variables and eliminated a redundant variable. All answers are bitwise identical, even when there are separate calls to step the ocean dynamics and thermodynamics. --- config_src/coupled_driver/ocean_model_MOM.F90 | 131 ++++++++++-------- 1 file changed, 74 insertions(+), 57 deletions(-) diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index 37df04d8e7..742688506f 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -136,6 +136,8 @@ module ocean_model_mod ! This type is private, and can therefore vary between different ocean models. logical :: is_ocean_PE = .false. !< True if this is an ocean PE. type(time_type) :: Time !< The ocean model's time and master clock. + type(time_type) :: Time_dyn !< The ocean model's time for the dynamics. Time and Time_dyn + !! should be the same after a full time step. integer :: Restart_control !< An integer that is bit-tested to determine whether !! incremental restart files are saved and whether they !! have a time stamped name. +1 (bit 0) for generic @@ -254,7 +256,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) OS%is_ocean_pe = Ocean_sfc%is_ocean_pe if (.not.OS%is_ocean_pe) return - OS%Time = Time_in + OS%Time = Time_in ; OS%Time_dyn = Time_in call initialize_MOM(OS%Time, Time_init, param_file, OS%dirs, OS%MOM_CSp, & OS%restart_CSp, Time_in, offline_tracer_mode=OS%offline_tracer_mode, & diag_ptr=OS%diag, count_calls=.true.) @@ -386,23 +388,22 @@ end subroutine ocean_model_init !! time time_start_update) for a time interval of Ocean_coupling_time_step, !! returning the publicly visible ocean surface properties in Ocean_sfc and !! storing the new ocean properties in Ocean_state. -subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & - time_start_update, Ocean_coupling_time_step, & - update_dyn, update_thermo, Ocn_fluxes_used) +subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_update, & + Ocean_coupling_time_step, update_dyn, update_thermo, & + Ocn_fluxes_used, start_cycle, end_cycle, cycle_length) type(ice_ocean_boundary_type), & - intent(in) :: Ice_ocean_boundary !< A structure containing the - !! various forcing fields coming from the ice. + intent(in) :: Ice_ocean_boundary !< A structure containing the various + !! forcing fields coming from the ice and atmosphere. type(ocean_state_type), & - pointer :: OS !< A pointer to a private structure containing - !! the internal ocean state. + pointer :: OS !< A pointer to a private structure containing the + !! internal ocean state. type(ocean_public_type), & - intent(inout) :: Ocean_sfc !< A structure containing all the - !! publicly visible ocean surface fields after - !! a coupling time step. The data in this type is - !! intent out. + intent(inout) :: Ocean_sfc !< A structure containing all the publicly visible + !! ocean surface fields after a coupling time step. + !! The data in this type is intent out. type(time_type), intent(in) :: time_start_update !< The time at the beginning of the update step. - type(time_type), intent(in) :: Ocean_coupling_time_step !< The amount of time over - !! which to advance the ocean. + type(time_type), intent(in) :: Ocean_coupling_time_step !< The amount of time over which to + !! advance the ocean. logical, optional, intent(in) :: update_dyn !< If present and false, do not do updates !! due to the ocean dynamics. logical, optional, intent(in) :: update_thermo !< If present and false, do not do updates @@ -410,37 +411,38 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & logical, optional, intent(in) :: Ocn_fluxes_used !< If present, this indicates whether the !! cumulative thermodynamic fluxes from the ocean, !! like frazil, have been used and should be reset. + logical, optional, intent(in) :: start_cycle !< This indicates whether this call is to be + !! treated as the first call to step_MOM in a + !! time-stepping cycle; missing is like true. + logical, optional, intent(in) :: end_cycle !< This indicates whether this call is to be + !! treated as the last call to step_MOM in a + !! time-stepping cycle; missing is like true. + real, optional, intent(in) :: cycle_length !< The duration of a coupled time stepping cycle, in s. + ! Local variables - type(time_type) :: Master_time ! This allows step_MOM to temporarily change - ! the time that is seen by internal modules. - type(time_type) :: Time1 ! The value of the ocean model's time at the - ! start of a call to step_MOM. - integer :: index_bnds(4) ! The computational domain index bounds in the - ! ice-ocean boundary type. - real :: weight ! Flux accumulation weight of the current fluxes. - real :: dt_coupling ! The coupling time step in seconds. - integer :: nts ! The number of baroclinic dynamics time steps - ! within dt_coupling. - real :: dt_therm ! A limited and quantized version of OS%dt_therm (sec) - real :: dt_dyn ! The dynamics time step in sec. - real :: dtdia ! The diabatic time step in sec. - real :: t_elapsed_seg ! The elapsed time in this update segment, in s. - integer :: n, n_max, n_last_thermo - type(time_type) :: Time2 ! A temporary time. - logical :: thermo_does_span_coupling ! If true, thermodynamic forcing spans - ! multiple dynamic timesteps. - logical :: do_dyn ! If true, step the ocean dynamics and transport. - logical :: do_thermo ! If true, step the ocean thermodynamics. - logical :: step_thermo ! If true, take a thermodynamic step. + type(time_type) :: Time_seg_start ! Stores the ocean model time at the start of this call to allow + ! step_MOM to temporarily change the time as seen by internal modules. + type(time_type) :: Time1 ! The value of the ocean model's time at the start of a call to step_MOM. + integer :: index_bnds(4) ! The computational domain index bounds in the ice-ocean boundary type. + real :: weight ! Flux accumulation weight of the current fluxes. + real :: dt_coupling ! The coupling time step in seconds. + real :: dt_therm ! A limited and quantized version of OS%dt_therm (sec) + real :: dt_dyn ! The dynamics time step in sec. + real :: dtdia ! The diabatic time step in sec. + real :: t_elapsed_seg ! The elapsed time in this update segment, in s. + integer :: n ! The internal iteration counter. + integer :: nts ! The number of baroclinic dynamics time steps in a thermodynamic step. + integer :: n_max ! The number of calls to step_MOM dynamics in this call to update_ocean_model. + integer :: n_last_thermo ! The iteration number the last time thermodynamics were updated. + logical :: thermo_does_span_coupling ! If true, thermodynamic forcing spans multiple dynamic timesteps. + logical :: do_dyn ! If true, step the ocean dynamics and transport. + logical :: do_thermo ! If true, step the ocean thermodynamics. + logical :: step_thermo ! If true, take a thermodynamic step. integer :: is, ie, js, je call callTree_enter("update_ocean_model(), ocean_model_MOM.F90") dt_coupling = time_type_to_real(Ocean_coupling_time_step) - if (time_start_update /= OS%Time) then - call MOM_error(WARNING, "update_ocean_model: internal clock does not "//& - "agree with time_start_update argument.") - endif if (.not.associated(OS)) then call MOM_error(FATAL, "update_ocean_model called with an unassociated "// & "ocean_state_type structure. ocean_model_init must be "// & @@ -451,6 +453,18 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & do_dyn = .true. ; if (present(update_dyn)) do_dyn = update_dyn do_thermo = .true. ; if (present(update_thermo)) do_thermo = update_thermo + if (do_thermo .and. (time_start_update /= OS%Time)) & + call MOM_error(WARNING, "update_ocean_model: internal clock does not "//& + "agree with time_start_update argument.") + if (do_dyn .and. (time_start_update /= OS%Time_dyn)) & + call MOM_error(WARNING, "update_ocean_model: internal dynamics clock does not "//& + "agree with time_start_update argument.") + + if (.not.(do_dyn .or. do_thermo)) call MOM_error(FATAL, & + "update_ocean_model called without updating either dynamics or thermodynamics.") + if (do_dyn .and. do_thermo .and. (OS%Time /= OS%Time_dyn)) call MOM_error(FATAL, & + "update_ocean_model called to update both dynamics and thermodynamics with inconsistent clocks.") + ! This is benign but not necessary if ocean_model_init_sfc was called or if ! OS%sfc_state%tr_fields was spawned in ocean_model_init. Consider removing it. is = OS%grid%isc ; ie = OS%grid%iec ; js = OS%grid%jsc ; je = OS%grid%jec @@ -462,7 +476,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & index_bnds(3), index_bnds(4)) if (do_dyn) then - call convert_IOB_to_forces(Ice_ocean_boundary, OS%forces, index_bnds, OS%Time, OS%grid, & + call convert_IOB_to_forces(Ice_ocean_boundary, OS%forces, index_bnds, OS%Time_dyn, OS%grid, & 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) @@ -486,6 +500,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & #ifdef _USE_GENERIC_TRACER call enable_averaging(dt_coupling, OS%Time + Ocean_coupling_time_step, OS%diag) !Is this needed? call MOM_generic_tracer_fluxes_accumulate(OS%fluxes, 1.0) ! Here weight=1, so just store the current fluxes + call disable_averaging(OS%diag) #endif ! Indicate that there are new unused fluxes. OS%fluxes%fluxes_used = .false. @@ -522,22 +537,21 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call Update_Surface_Waves(OS%grid, OS%GV, OS%time, ocean_coupling_time_step, OS%waves) endif - if ((OS%nstep==0) .and. (OS%nstep_thermo==0)) then + if ((OS%nstep==0) .and. (OS%nstep_thermo==0)) then ! This is the first call to update_ocean_model. call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp, OS%restart_CSp) endif - call disable_averaging(OS%diag) - Master_time = OS%Time ; Time1 = OS%Time + Time_seg_start = OS%Time ; if (do_dyn) Time_seg_start = OS%Time_dyn + Time1 = Time_seg_start if (OS%offline_tracer_mode .and. do_thermo) then call step_offline(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp) elseif ((.not.do_thermo) .or. (.not.do_dyn)) then ! The call sequence is being orchestrated from outside of update_ocean_model. call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, & - Waves=OS%Waves, do_dynamics=do_thermo, do_thermodynamics=do_dyn, & + Waves=OS%Waves, do_dynamics=do_dyn, do_thermodynamics=do_thermo, & + start_cycle=start_cycle, end_cycle=end_cycle, cycle_length=cycle_length, & reset_therm=Ocn_fluxes_used) - !### What to do with these? , start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) - elseif (OS%single_step_call) then call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves) else @@ -553,7 +567,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & n_last_thermo = 0 endif - Time2 = Time1 ; t_elapsed_seg = 0.0 + Time1 = Time_seg_start ; t_elapsed_seg = 0.0 do n=1,n_max if (OS%diabatic_first) then if (thermo_does_span_coupling) call MOM_error(FATAL, & @@ -561,16 +575,16 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & "THERMO_SPANS_COUPLING and DIABATIC_FIRST.") if (modulo(n-1,nts)==0) then dtdia = dt_dyn*min(nts,n_max-(n-1)) - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) endif - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dt_dyn, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) else - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dt_dyn, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) @@ -585,25 +599,27 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & endif if (step_thermo) then - ! Back up Time2 to the start of the thermodynamic segment. - Time2 = Time2 - real_to_time_type(dtdia - dt_dyn) - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, & + ! Back up Time1 to the start of the thermodynamic segment. + Time1 = Time1 - real_to_time_type(dtdia - dt_dyn) + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) endif endif t_elapsed_seg = t_elapsed_seg + dt_dyn - Time2 = Time1 + real_to_time_type(t_elapsed_seg) + Time1 = Time_seg_start + real_to_time_type(t_elapsed_seg) enddo endif - OS%Time = Master_time + Ocean_coupling_time_step + if (do_dyn) OS%Time_dyn = Time_seg_start + Ocean_coupling_time_step if (do_dyn) OS%nstep = OS%nstep + 1 + OS%Time = Time_seg_start ! Reset the clock to compensate for shared pointers. + if (do_thermo) OS%Time = OS%Time + Ocean_coupling_time_step if (do_thermo) OS%nstep_thermo = OS%nstep_thermo + 1 if (do_dyn) then - call enable_averaging(dt_coupling, OS%Time, OS%diag) + call enable_averaging(dt_coupling, OS%Time_dyn, OS%diag) call mech_forcing_diags(OS%forces, dt_coupling, OS%grid, OS%diag, OS%forcing_CSp%handles) call disable_averaging(OS%diag) endif @@ -619,7 +635,8 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! 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 coupler_type_send_data(Ocean_sfc%fields, OS%Time) + Time1 = OS%Time ; if (do_dyn) Time1 = OS%Time_dyn + call coupler_type_send_data(Ocean_sfc%fields, Time1) call callTree_leave("update_ocean_model()") end subroutine update_ocean_model From 40466156dec6f9ed43185a2d11d8cb9bf3398cbb Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 11 Aug 2018 14:31:56 -0400 Subject: [PATCH 024/174] Removed trailing white space --- config_src/coupled_driver/MOM_surface_forcing.F90 | 2 +- src/core/MOM_forcing_type.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 532ed8081b..bbaac1df07 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -642,7 +642,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS, dt_forc if (present(reset_avg)) then ; if (reset_avg) forces%dt_force_accum = 0.0 ; endif wt1 = 0.0 ; wt2 = 1.0 if (present(dt_forcing)) then - if ((forces%dt_force_accum > 0.0) .and. (dt_forcing > 0.0)) then + if ((forces%dt_force_accum > 0.0) .and. (dt_forcing > 0.0)) then wt1 = forces%dt_force_accum / (forces%dt_force_accum + dt_forcing) wt2 = 1.0 - wt1 endif diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 857979f61d..9ac616dac0 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -1998,7 +1998,7 @@ end subroutine set_derived_forcing_fields subroutine set_net_mass_forcing(fluxes, forces, G) type(forcing), intent(in) :: fluxes !< A structure containing thermodynamic forcing fields type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(ocean_grid_type), intent(in) :: G !< The ocean grid type + type(ocean_grid_type), intent(in) :: G !< The ocean grid type if (associated(forces%net_mass_src)) & call get_net_mass_forcing(fluxes, G, forces%net_mass_src) From 3bf78bd416a64497bc7b283c8a7efa7b6d4e267e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 13 Aug 2018 17:34:08 -0400 Subject: [PATCH 025/174] Avoid NaNs on land in ALE diagnostics Some of the temporary arrays used to calculate ALE tendencies were not being initialized, so there could be NaNs or other silly values reported over land. The needed array initialization calls were removed with NOAA-GFDL/MOM6@11c2a91, but have now been restored, and the diagnostics are only calculated and offered if remap_all_state_vars are given a diagnostic time-step (without which the diagnostics make no sense). This commit addresses issue number github.com/NOAA-GFDL/MOM6/issues/829. All answers are bitwise identical. --- src/ALE/MOM_ALE.F90 | 41 ++++++++++++++++++++--------------------- 1 file changed, 20 insertions(+), 21 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index a71dfb557c..7e2885fd6f 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -760,14 +760,12 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, nz = GV%ke ppt2mks = 0.001 - if (associated(Reg)) then - ntr = Reg%ntr - else - ntr = 0 - endif + ntr = 0 ; if (associated(Reg)) ntr = Reg%ntr if (present(dt)) then Idt = 1.0/dt + work_conc(:,:,:) = 0.0 + work_cont(:,:,:) = 0.0 endif ! Remap tracer @@ -801,22 +799,23 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, endif ; enddo ; enddo ! tendency diagnostics. - if (Tr%id_remap_conc > 0) then - call post_data(Tr%id_remap_conc, work_conc, CS_ALE%diag) - endif - if (Tr%id_remap_cont > 0) then - call post_data(Tr%id_remap_cont, work_cont, CS_ALE%diag) - endif - if (Tr%id_remap_cont_2d > 0) then - do j = G%jsc,G%jec ; do i = G%isc,G%iec - work_2d(i,j) = 0.0 - do k = 1,GV%ke - work_2d(i,j) = work_2d(i,j) + work_cont(i,j,k) - enddo - enddo ; enddo - call post_data(Tr%id_remap_cont_2d, work_2d, CS_ALE%diag) + if (present(dt)) then + if (Tr%id_remap_conc > 0) then + call post_data(Tr%id_remap_conc, work_conc, CS_ALE%diag) + endif + if (Tr%id_remap_cont > 0) then + call post_data(Tr%id_remap_cont, work_cont, CS_ALE%diag) + endif + if (Tr%id_remap_cont_2d > 0) then + do j = G%jsc,G%jec ; do i = G%isc,G%iec + work_2d(i,j) = 0.0 + do k = 1,GV%ke + work_2d(i,j) = work_2d(i,j) + work_cont(i,j,k) + enddo + enddo ; enddo + call post_data(Tr%id_remap_cont_2d, work_2d, CS_ALE%diag) + endif endif - enddo ! m=1,ntr endif ! endif for ntr > 0 @@ -866,7 +865,7 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, endif if (CS_ALE%id_vert_remap_h > 0) call post_data(CS_ALE%id_vert_remap_h, h_old, CS_ALE%diag) - if (CS_ALE%id_vert_remap_h_tendency > 0) then + if ((CS_ALE%id_vert_remap_h_tendency > 0) .and. present(dt)) then do k = 1, nz ; do j = G%jsc,G%jec ; do i = G%isc,G%iec work_cont(i,j,k) = (h_new(i,j,k) - h_old(i,j,k))*Idt enddo ; enddo ; enddo From ac757ef71f3036a147b8008381491cfe7dd8508d Mon Sep 17 00:00:00 2001 From: "Jessica.Liptak" Date: Tue, 14 Aug 2018 10:12:46 -0400 Subject: [PATCH 026/174] Capitalized _allocated in MOM_generic tracer to fix bug with intel16 -O0 (debug). --- src/tracer/MOM_generic_tracer.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index 48b8e4512c..42db298632 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -498,7 +498,7 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, ! g_tracer=>CS%g_tracer_list do - if (allocated(g_tracer%trunoff)) then + if (_ALLOCATED(g_tracer%trunoff)) then call g_tracer_get_alias(g_tracer,g_tracer_name) call g_tracer_get_pointer(g_tracer,g_tracer_name,'stf', stf_array) call g_tracer_get_pointer(g_tracer,g_tracer_name,'trunoff',trunoff_array) From e3dc939f93b7dd817deaf8e1a0e9252ca8c97204 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 14 Aug 2018 11:31:05 -0400 Subject: [PATCH 027/174] (*)Increase precision of time handling Replaced the use of set_time and get_time with real_to_time_type and time_type_to_real to increase the precision of handling time by allowing the sub-second ticks to be used effectively, and thereby permitting the use of fractional second timesteps within MOM6. This modification could change answers in cases where times are not an integer number of seconds. However, all existing test cases only use times that are an integer number of seconds, so the answers are bitwise identical in the test cases. --- src/core/MOM.F90 | 35 +++++++++---------- src/core/MOM_barotropic.F90 | 6 ++-- src/core/MOM_dynamics_split_RK2.F90 | 2 +- src/core/MOM_dynamics_unsplit.F90 | 4 +-- src/core/MOM_dynamics_unsplit_RK2.F90 | 2 +- src/framework/MOM_file_parser.F90 | 10 +++--- src/framework/MOM_horizontal_regridding.F90 | 2 +- src/framework/MOM_restart.F90 | 17 ++++----- src/ice_shelf/MOM_ice_shelf.F90 | 2 +- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 10 +++--- .../MOM_state_initialization.F90 | 2 +- .../MOM_tracer_initialization_from_Z.F90 | 1 - src/ocean_data_assim/MOM_oda_driver.F90 | 2 +- .../lateral/MOM_internal_tides.F90 | 10 ++---- .../vertical/MOM_diabatic_driver.F90 | 7 ++-- .../vertical/MOM_opacity.F90 | 3 -- src/tracer/DOME_tracer.F90 | 2 +- src/tracer/ISOMIP_tracer.F90 | 2 +- src/tracer/MOM_OCMIP2_CFC.F90 | 2 +- src/tracer/MOM_generic_tracer.F90 | 2 +- src/tracer/advection_test_tracer.F90 | 2 +- src/tracer/boundary_impulse_tracer.F90 | 2 +- src/tracer/dye_example.F90 | 2 +- src/tracer/dyed_obc_tracer.F90 | 2 +- src/tracer/ideal_age_example.F90 | 6 ++-- src/tracer/oil_tracer.F90 | 8 ++--- src/tracer/pseudo_salt_tracer.F90 | 2 +- src/tracer/tracer_example.F90 | 2 +- src/user/BFB_surface_forcing.F90 | 2 +- src/user/Kelvin_initialization.F90 | 2 +- src/user/MOM_controlled_forcing.F90 | 6 ++-- src/user/MOM_wave_interface.F90 | 4 +-- src/user/SCM_CVmix_tests.F90 | 7 ++-- src/user/SCM_idealized_hurricane.F90 | 3 +- src/user/dumbbell_surface_forcing.F90 | 1 + src/user/dyed_channel_initialization.F90 | 2 +- src/user/shelfwave_initialization.F90 | 2 +- src/user/supercritical_initialization.F90 | 2 +- src/user/tidal_bay_initialization.F90 | 2 +- src/user/user_revise_forcing.F90 | 2 +- 40 files changed, 80 insertions(+), 104 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index c554e4f92e..bf47d7b08c 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -39,7 +39,7 @@ module MOM use MOM_restart, only : register_restart_field, query_initialized, save_restart use MOM_restart, only : restart_init, is_new_run, MOM_restart_CS use MOM_spatial_means, only : global_mass_integral -use MOM_time_manager, only : time_type, set_time, time_type_to_real, operator(+) +use MOM_time_manager, only : time_type, real_to_time_type, time_type_to_real, operator(+) use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/) use MOM_time_manager, only : operator(>=), increment_date use MOM_unit_tests, only : unit_tests @@ -556,7 +556,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & do j=js,je ; do i=is,ie ; CS%ssh_rint(i,j) = 0.0 ; enddo ; enddo if (associated(CS%VarMix)) then - call enable_averaging(cycle_time, Time_start+set_time(int(cycle_time)), & + call enable_averaging(cycle_time, Time_start + real_to_time_type(cycle_time), & CS%diag) call calc_resoln_function(h, CS%tv, G, GV, CS%VarMix) call disable_averaging(CS%diag) @@ -582,7 +582,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (CS%UseWaves) then ! Update wave information, which is presently kept static over each call to step_mom - call enable_averaging(time_interval, Time_start + set_time(int(floor(time_interval+0.5))), CS%diag) + call enable_averaging(time_interval, Time_start + real_to_time_type(time_interval), CS%diag) call Update_Stokes_Drift(G, GV, Waves, h, forces%ustar) call disable_averaging(CS%diag) endif @@ -604,9 +604,9 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & do n=1,n_max rel_time = rel_time + dt ! The relative time at the end of the step. ! Set the universally visible time to the middle of the time step. - CS%Time = Time_start + set_time(int(floor(0.5 + rel_time - 0.5*dt))) + CS%Time = Time_start + real_to_time_type(rel_time - 0.5*dt) ! Set the local time to the end of the time step. - Time_local = Time_start + set_time(int(floor(rel_time+0.5))) + Time_local = Time_start + real_to_time_type(rel_time) if (showCallTree) call callTree_enter("DT cycles (step_MOM) n=",n) @@ -633,10 +633,10 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (dtdia > dt) then ! If necessary, temporarily reset CS%Time to the center of the period covered ! by the call to step_MOM_thermo, noting that they begin at the same time. - CS%Time = CS%Time + set_time(int(floor(0.5*(dtdia-dt) + 0.5))) + CS%Time = CS%Time + real_to_time_type(0.5*(dtdia-dt)) ! The end-time of the diagnostic interval needs to be set ahead if there ! are multiple dynamic time steps worth of thermodynamics applied here. - end_time_thermo = Time_local + set_time(int(floor(dtdia-dt+0.5))) + end_time_thermo = Time_local + real_to_time_type(dtdia-dt) endif ! Apply diabatic forcing, do mixing, and regrid. @@ -649,7 +649,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (showCallTree) call callTree_waypoint("finished diabatic_first (step_MOM)") if (dtdia > dt) & ! Reset CS%Time to its previous value. - CS%Time = Time_start + set_time(int(floor(0.5 + rel_time - 0.5*dt))) + CS%Time = Time_start + real_to_time_type(rel_time - 0.5*dt) endif ! end of block "(CS%diabatic_first .and. (CS%t_dyn_rel_adv==0.0))" if (do_dyn) then @@ -731,7 +731,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & ! If necessary, temporarily reset CS%Time to the center of the period covered ! by the call to step_MOM_thermo, noting that they end at the same time. - if (dtdia > dt) CS%Time = CS%Time - set_time(int(floor(0.5*(dtdia-dt) + 0.5))) + if (dtdia > dt) CS%Time = CS%Time - real_to_time_type(0.5*(dtdia-dt)) ! Apply diabatic forcing, do mixing, and regrid. call step_MOM_thermo(CS, G, GV, u, v, h, CS%tv, fluxes, dtdia, & @@ -740,7 +740,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & CS%t_dyn_rel_thermo = 0.0 if (dtdia > dt) & ! Reset CS%Time to its previous value. - CS%Time = Time_start + set_time(int(floor(0.5 + rel_time - 0.5*dt))) + CS%Time = Time_start + real_to_time_type(rel_time - 0.5*dt) endif if (do_dyn) then @@ -774,7 +774,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & CS%t_dyn_rel_diag = 0.0 call cpu_clock_begin(id_clock_Z_diag) - if (Time_local + set_time(int(0.5*dt_therm)) > CS%Z_diag_time) then + if (Time_local + real_to_time_type(0.5*dt_therm) > CS%Z_diag_time) then call enable_averaging(real(time_type_to_real(CS%Z_diag_interval)), & CS%Z_diag_time, CS%diag) !### This is the one place where fluxes might used if do_thermo=.false. Is this correct? @@ -852,7 +852,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (MOM_state_is_synchronized(CS)) & call write_energy(CS%u, CS%v, CS%h, CS%tv, Time_local, CS%nstep_tot, & G, GV, CS%sum_output_CSp, CS%tracer_flow_CSp, & - dt_forcing=set_time(int(floor(time_interval+0.5))) ) + dt_forcing=real_to_time_type(time_interval) ) call cpu_clock_end(id_clock_other) @@ -912,7 +912,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & if ((CS%t_dyn_rel_adv == 0.0) .and. CS%thickness_diffuse .and. CS%thickness_diffuse_first) then - call enable_averaging(dt_thermo, Time_local+set_time(int(floor(dt_thermo-dt+0.5))), CS%diag) + call enable_averaging(dt_thermo, Time_local+real_to_time_type(dt_thermo-dt), CS%diag) call cpu_clock_begin(id_clock_thick_diff) if (associated(CS%VarMix)) & call calc_slope_functions(h, CS%tv, dt, G, GV, CS%VarMix) @@ -931,7 +931,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & ! The bottom boundary layer properties need to be recalculated. if (bbl_time_int > 0.0) then call enable_averaging(bbl_time_int, & - Time_local + set_time(int(bbl_time_int-dt+0.5)), CS%diag) + Time_local + real_to_time_type(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, & @@ -2286,7 +2286,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & CS%OBC, CS%update_OBC_CSp, CS%ALE_CSp, CS%set_visc_CSp, & CS%visc, dirs, CS%ntrunc, calc_dtbt=calc_dtbt) if (CS%dtbt_reset_period > 0.0) then - CS%dtbt_reset_interval = set_time(int(floor(CS%dtbt_reset_period))) + CS%dtbt_reset_interval = real_to_time_type(CS%dtbt_reset_period) ! Set dtbt_reset_time to be the next even multiple of dtbt_reset_interval. CS%dtbt_reset_time = Time_init + CS%dtbt_reset_interval * & ((Time - Time_init) / CS%dtbt_reset_interval) @@ -2325,11 +2325,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & param_file, diag, CS%diagnostics_CSp, CS%tv) call diag_copy_diag_to_storage(CS%diag_pre_sync, CS%h, CS%diag) - CS%Z_diag_interval = set_time(int((CS%dt_therm) * & - max(1,floor(0.01 + Z_diag_int/(CS%dt_therm))))) + CS%Z_diag_interval = real_to_time_type(CS%dt_therm * max(1,floor(0.01 + Z_diag_int/CS%dt_therm))) call MOM_diag_to_Z_init(Time, G, GV, param_file, diag, CS%diag_to_Z_CSp) CS%Z_diag_time = Start_time + CS%Z_diag_interval * (1 + & - ((Time + set_time(int(CS%dt_therm))) - Start_time) / CS%Z_diag_interval) + ((Time + real_to_time_type(CS%dt_therm)) - Start_time) / CS%Z_diag_interval) if (associated(CS%sponge_CSp)) & call init_sponge_diags(Time, G, diag, CS%sponge_CSp) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 940c99b8be..c423b2d0c1 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -22,7 +22,7 @@ module MOM_barotropic use MOM_open_boundary, only : OBC_DIRECTION_N, OBC_DIRECTION_S, OBC_segment_type use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS use MOM_tidal_forcing, only : tidal_forcing_sensitivity, tidal_forcing_CS -use MOM_time_manager, only : time_type, set_time, operator(+), operator(-) +use MOM_time_manager, only : time_type, real_to_time_type, operator(+), operator(-) use MOM_variables, only : BT_cont_type, alloc_bt_cont_type use MOM_verticalGrid, only : verticalGrid_type @@ -723,7 +723,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & (CS%id_uhbt_hifreq > 0) .or. (CS%id_vhbt_hifreq > 0)) then do_hifreq_output = query_averaging_enabled(CS%diag, time_int_in, time_end_in) if (do_hifreq_output) & - time_bt_start = time_end_in - set_time(int(floor(dt+0.5))) + time_bt_start = time_end_in - real_to_time_type(dt) endif !--- begin setup for group halo update @@ -2008,7 +2008,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & enddo ; enddo if (do_hifreq_output) then - time_step_end = time_bt_start + set_time(int(floor(n*dtbt+0.5))) + time_step_end = time_bt_start + real_to_time_type(n*dtbt) call enable_averaging(dtbt, time_step_end, CS%diag) if (CS%id_ubt_hifreq > 0) call post_data(CS%id_ubt_hifreq, ubt(IsdB:IedB,jsd:jed), CS%diag) if (CS%id_vbt_hifreq > 0) call post_data(CS%id_vbt_hifreq, vbt(isd:ied,JsdB:JedB), CS%diag) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index d02285148a..0f4bd88111 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -30,7 +30,7 @@ module MOM_dynamics_split_RK2 use MOM_io, only : MOM_io_init, vardesc, var_desc use MOM_restart, only : register_restart_field, query_initialized, save_restart use MOM_restart, only : restart_init, is_new_run, MOM_restart_CS -use MOM_time_manager, only : time_type, set_time, time_type_to_real, operator(+) +use MOM_time_manager, only : time_type, time_type_to_real, operator(+) use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/) use MOM_ALE, only : ALE_CS diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 47d3510c5a..506dd3624b 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -72,7 +72,7 @@ module MOM_dynamics_unsplit use MOM_io, only : MOM_io_init use MOM_restart, only : register_restart_field, query_initialized, save_restart use MOM_restart, only : restart_init, MOM_restart_CS -use MOM_time_manager, only : time_type, set_time, time_type_to_real, operator(+) +use MOM_time_manager, only : time_type, real_to_time_type, operator(+) use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/) use MOM_ALE, only : ALE_CS @@ -267,7 +267,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call pass_var(hp, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) - call enable_averaging(0.5*dt,Time_local-set_time(int(0.5*dt)), CS%diag) + call enable_averaging(0.5*dt,Time_local-real_to_time_type(0.5*dt), CS%diag) ! Here the first half of the thickness fluxes are offered for averaging. if (CS%id_uh > 0) call post_data(CS%id_uh, uh, CS%diag) if (CS%id_vh > 0) call post_data(CS%id_vh, vh, CS%diag) diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index a1615ad413..0f6d61905e 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -70,7 +70,7 @@ module MOM_dynamics_unsplit_RK2 use MOM_io, only : MOM_io_init use MOM_restart, only : register_restart_field, query_initialized, save_restart use MOM_restart, only : restart_init, MOM_restart_CS -use MOM_time_manager, only : time_type, set_time, time_type_to_real, operator(+) +use MOM_time_manager, only : time_type, time_type_to_real, operator(+) use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/) use MOM_ALE, only : ALE_CS diff --git a/src/framework/MOM_file_parser.F90 b/src/framework/MOM_file_parser.F90 index ae876b16dd..70f3b9a941 100644 --- a/src/framework/MOM_file_parser.F90 +++ b/src/framework/MOM_file_parser.F90 @@ -6,8 +6,8 @@ module MOM_file_parser use MOM_coms, only : root_PE, broadcast use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg use MOM_error_handler, only : is_root_pe, stdlog, stdout -use MOM_time_manager, only : set_time, get_time, time_type, get_ticks_per_second -use MOM_time_manager, only : set_date, get_date +use MOM_time_manager, only : get_time, time_type, get_ticks_per_second +use MOM_time_manager, only : set_date, get_date, real_to_time_type use MOM_document, only : doc_param, doc_module, doc_init, doc_end, doc_type use MOM_document, only : doc_openBlock, doc_closeBlock use MOM_string_functions, only : left_int, left_ints, slasher @@ -821,7 +821,7 @@ subroutine read_param_time(CS, varname, value, timeunit, fail_if_missing, date_f character(len=240) :: err_msg logical :: found, defined real :: real_time, time_unit - integer :: days, secs, vals(7) + integer :: vals(7) if (present(date_format)) date_format = .false. @@ -854,9 +854,7 @@ subroutine read_param_time(CS, varname, value, timeunit, fail_if_missing, date_f else time_unit = 1.0 ; if (present(timeunit)) time_unit = timeunit read( value_string(1), *) real_time - days = int(real_time*(time_unit/86400.0)) - secs = int(floor((real_time*(time_unit/86400.0)-days)*86400.0 + 0.5)) - value = set_time(secs, days) + value = real_to_time_type(real_time*time_unit) endif else if (present(fail_if_missing)) then ; if (fail_if_missing) then diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index 19b73ee07f..c7befad3b3 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -19,7 +19,7 @@ module MOM_horizontal_regridding use MOM_io, only : open_file, read_data, read_axis_data, SINGLE_FILE, MULTIPLE use MOM_io, only : slasher, vardesc, write_field use MOM_string_functions, only : uppercase -use MOM_time_manager, only : time_type, set_time, get_external_field_size +use MOM_time_manager, only : time_type, get_external_field_size use MOM_time_manager, only : init_external_field, time_interp_external use MOM_time_manager, only : get_external_field_axes, get_external_field_missing use MOM_variables, only : thermo_var_ptrs diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index bf40da4897..436d514125 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -14,8 +14,8 @@ module MOM_restart use MOM_io, only : vardesc, var_desc, query_vardesc, modify_vardesc use MOM_io, only : MULTIPLE, NETCDF_FILE, READONLY_FILE, SINGLE_FILE use MOM_io, only : CENTER, CORNER, NORTH_FACE, EAST_FACE -use MOM_time_manager, only : time_type, get_time, get_date, set_date, set_time -use MOM_time_manager, only : days_in_month +use MOM_time_manager, only : time_type, time_type_to_real, real_to_time_type +use MOM_time_manager, only : days_in_month, get_date, set_date use MOM_verticalGrid, only : verticalGrid_type use mpp_mod, only: mpp_chksum use mpp_io_mod, only: mpp_attribute_exist, mpp_get_atts @@ -801,15 +801,14 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV) ! With parallel read & write, it is possible to disable the following... -! jgj: this was set to 4294967292, changed to 4294967295 (see mpp_parameter.F90) - if (CS%large_file_support) max_file_size = 4294967295_8 + ! The maximum file size is 4294967292, according to the NetCDF documentation. + if (CS%large_file_support) max_file_size = 4294967292_8 num_files = 0 next_var = 0 nz = 1 ; if (present(GV)) nz = GV%ke - call get_time(time,seconds,days) - restart_time = real(days) + real(seconds)/86400.0 + restart_time = time_type_to_real(time) restartname = trim(CS%restartfile) if (present(filename)) restartname = trim(filename) @@ -982,7 +981,7 @@ subroutine restore_state(filename, directory, day, G, CS) character(len=80) :: varname ! A variable's name. integer :: num_file ! The number of files (restart files and others ! explicitly in filename) that are open. - integer :: i, n, m, start_of_day, num_days, missing_fields + integer :: i, n, m, missing_fields integer :: isL, ieL, jsL, jeL, is0, js0 integer :: sizes(7) integer :: ndim, nvar, natt, ntime, pos @@ -1028,9 +1027,7 @@ subroutine restore_state(filename, directory, day, G, CS) t1 = time_vals(1) deallocate(time_vals) - start_of_day = INT((t1 - INT(t1)) *86400) ! Number of seconds. - num_days = INT(t1) - day = set_time(start_of_day, num_days) + day = real_to_time_type(t1) exit enddo diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index e1a61f355c..7e3c4ac606 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -25,7 +25,7 @@ module MOM_ice_shelf use MOM_io, only : write_field, close_file, SINGLE_FILE, MULTIPLE use MOM_restart, only : register_restart_field, query_initialized, save_restart use MOM_restart, only : restart_init, restore_state, MOM_restart_CS -use MOM_time_manager, only : time_type, set_time, time_type_to_real +use MOM_time_manager, only : time_type, time_type_to_real use MOM_transcribe_grid, only : copy_dyngrid_to_MOM_grid, copy_MOM_grid_to_dyngrid use MOM_variables, only : surface use MOM_forcing_type, only : forcing, allocate_forcing_type, MOM_forcing_chksum diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index e504db90c7..9d25d8c8a3 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -17,7 +17,7 @@ module MOM_ice_shelf_dynamics use MOM_io, only : file_exists, slasher, MOM_read_data use MOM_restart, only : register_restart_field, query_initialized use MOM_restart, only : MOM_restart_CS -use MOM_time_manager, only : time_type, set_time, time_type_to_real +use MOM_time_manager, only : time_type, set_time !MJH use MOM_ice_shelf_initialize, only : initialize_ice_shelf_boundary use MOM_ice_shelf_state, only : ice_shelf_state use MOM_coms, only : reproducing_sum, sum_across_PEs, max_across_PEs, min_across_PEs @@ -523,13 +523,13 @@ subroutine initialize_diagnostic_fields(CS, ISS, G, Time) type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. type(time_type), intent(in) :: Time !< The current model time - integer :: i, j, iters, isd, ied, jsd, jed - real :: rhoi, rhow, OD - type(time_type) :: dummy_time + integer :: i, j, iters, isd, ied, jsd, jed + real :: rhoi, rhow, OD + type(time_type) :: dummy_time rhoi = CS%density_ice rhow = CS%density_ocean_avg - dummy_time = set_time (0,0) + dummy_time = set_time(0,0) isd=G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed do j=jsd,jed diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 0f9c17022d..57820accc0 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -34,7 +34,7 @@ module MOM_state_initialization use MOM_ALE_sponge, only : set_up_ALE_sponge_field, initialize_ALE_sponge use MOM_ALE_sponge, only : ALE_sponge_CS use MOM_string_functions, only : uppercase, lowercase -use MOM_time_manager, only : time_type, set_time +use MOM_time_manager, only : time_type use MOM_tracer_registry, only : tracer_registry_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : setVerticalGridAxes, verticalGrid_type diff --git a/src/initialization/MOM_tracer_initialization_from_Z.F90 b/src/initialization/MOM_tracer_initialization_from_Z.F90 index 67cf7bbd24..07be1ee340 100644 --- a/src/initialization/MOM_tracer_initialization_from_Z.F90 +++ b/src/initialization/MOM_tracer_initialization_from_Z.F90 @@ -16,7 +16,6 @@ module MOM_tracer_initialization_from_Z use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type, isPointInCell use MOM_string_functions, only : uppercase -use MOM_time_manager, only : time_type, set_time use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : setVerticalGridAxes use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index 17cc300bd2..f9dae9b246 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -19,7 +19,7 @@ module MOM_oda_driver_mod use ensemble_manager_mod, only : get_ensemble_id, get_ensemble_size use ensemble_manager_mod, only : get_ensemble_pelist, get_ensemble_filter_pelist use time_manager_mod, only : time_type, decrement_time, increment_time -use time_manager_mod, only : get_date, get_time, operator(>=),operator(/=),operator(==),operator(<) +use time_manager_mod, only : get_date, operator(>=),operator(/=),operator(==),operator(<) use constants_mod, only : radius, epsln ! ODA Modules use ocean_da_types_mod, only : grid_type, ocean_profile_type, ocean_control_struct diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 3205f81b02..822c11470e 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -18,9 +18,7 @@ module MOM_internal_tides use MOM_io, only : slasher, vardesc, MOM_read_data use MOM_restart, only : register_restart_field, MOM_restart_CS, restart_init, save_restart use MOM_spatial_means, only : global_area_mean -use MOM_time_manager, only : time_type, operator(+), operator(/), operator(-) -use MOM_time_manager, only : get_time, get_date, set_time, set_date -use MOM_time_manager, only : time_type_to_real +use MOM_time_manager, only : time_type, time_type_to_real, operator(+), operator(/), operator(-) use MOM_variables, only : surface, thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_wave_structure, only: wave_structure_init, wave_structure, wave_structure_CS @@ -592,13 +590,8 @@ subroutine sum_En(G, CS, En, label) integer :: m,fr,a real :: En_sum, tmpForSumming, En_sum_diff, En_sum_pdiff character(len=160) :: mesg ! The text of an error message - integer :: seconds - real :: Isecs_per_day = 1.0 / 86400.0 real :: days - call get_time(CS%Time, seconds) - days = real(seconds) * Isecs_per_day - En_sum = 0.0 tmpForSumming = 0.0 do a=1,CS%nAngle @@ -614,6 +607,7 @@ subroutine sum_En(G, CS, En, label) CS%En_sum = En_sum !! Print to screen !if (is_root_pe()) then + ! days = time_type_to_real(CS%Time) / 86400.0 ! write(mesg,*) trim(label)//': days =', days, ', En_sum=', En_sum, & ! ', En_sum_diff=', En_sum_diff, ', Percent change=', En_sum_pdiff, '%' ! call MOM_mesg(mesg) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 188ba9c8f3..846e27de8b 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -61,8 +61,7 @@ module MOM_diabatic_driver use MOM_shortwave_abs, only : absorbRemainingSW, optics_type use MOM_sponge, only : apply_sponge, sponge_CS use MOM_ALE_sponge, only : apply_ALE_sponge, ALE_sponge_CS -use MOM_time_manager, only : operator(-), set_time -use MOM_time_manager, only : operator(<=), time_type ! for testing itides (BDM) +use MOM_time_manager, only : time_type, real_to_time_type, operator(-), operator(<=) use MOM_tracer_flow_control, only : call_tracer_column_fns, tracer_flow_control_CS use MOM_tracer_diabatic, only : tracer_vertdiff use MOM_variables, only : thermo_var_ptrs, vertvisc_type, accel_diag_ptrs @@ -440,7 +439,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! the end of the diabatic processes. if (associated(tv%T) .AND. associated(tv%frazil)) then ! For frazil diagnostic, the first call covers the first half of the time step - call enable_averaging(0.5*dt, Time_end - set_time(int(floor(0.5*dt+0.5))), CS%diag) + call enable_averaging(0.5*dt, Time_end - real_to_time_type(0.5*dt), CS%diag) if (CS%frazil_tendency_diag) then do k=1,nz ; do j=js,je ; do i=is,ie temp_diag(i,j,k) = tv%T(i,j,k) @@ -1316,7 +1315,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! the end of the diabatic processes. if (associated(tv%T) .AND. associated(tv%frazil)) then ! For frazil diagnostic, the first call covers the first half of the time step - call enable_averaging(0.5*dt, Time_end - set_time(int(floor(0.5*dt+0.5))), CS%diag) + call enable_averaging(0.5*dt, Time_end - real_to_time_type(0.5*dt), CS%diag) if (CS%frazil_tendency_diag) then do k=1,nz ; do j=js,je ; do i=is,ie temp_diag(i,j,k) = tv%T(i,j,k) diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index 26a23a0f0d..ca2afdc655 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -5,7 +5,6 @@ module MOM_opacity use MOM_diag_mediator, only : time_type, diag_ctrl, safe_alloc_ptr, post_data use MOM_diag_mediator, only : query_averaging_enabled, register_diag_field -use MOM_time_manager, only : get_time use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_string_functions, only : uppercase @@ -225,7 +224,6 @@ subroutine opacity_from_chl(optics, fluxes, G, CS, chl_in) ! radiation, in W m-2. type(time_type) :: day character(len=128) :: mesg - integer :: days, seconds integer :: i, j, k, n, is, ie, js, je, nz, nbands logical :: multiband_vis_input, multiband_nir_input @@ -271,7 +269,6 @@ subroutine opacity_from_chl(optics, fluxes, G, CS, chl_in) else ! Only the 2-d surface chlorophyll can be read in from a file. The ! same value is assumed for all layers. - call get_time(CS%Time,seconds,days) call time_interp_external(CS%sbc_chl, CS%Time, chl_data) do j=js,je ; do i=is,ie if ((G%mask2dT(i,j) > 0.5) .and. (chl_data(i,j) < 0.0)) then diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index 91b156751f..0354f90a51 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -15,7 +15,7 @@ module DOME_tracer use MOM_open_boundary, only : OBC_segment_type, register_segment_tracer use MOM_restart, only : MOM_restart_CS use MOM_sponge, only : set_up_sponge_field, sponge_CS -use MOM_time_manager, only : time_type, get_time +use MOM_time_manager, only : time_type use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_variables, only : surface diff --git a/src/tracer/ISOMIP_tracer.F90 b/src/tracer/ISOMIP_tracer.F90 index 40e8ef6db5..0707b54fb3 100644 --- a/src/tracer/ISOMIP_tracer.F90 +++ b/src/tracer/ISOMIP_tracer.F90 @@ -20,7 +20,7 @@ module ISOMIP_tracer use MOM_io, only : file_exists, MOM_read_data, slasher, vardesc, var_desc, query_vardesc use MOM_restart, only : MOM_restart_CS use MOM_ALE_sponge, only : set_up_ALE_sponge_field, ALE_sponge_CS -use MOM_time_manager, only : time_type, get_time +use MOM_time_manager, only : time_type use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_variables, only : surface diff --git a/src/tracer/MOM_OCMIP2_CFC.F90 b/src/tracer/MOM_OCMIP2_CFC.F90 index e8c3387cea..ebff38508c 100644 --- a/src/tracer/MOM_OCMIP2_CFC.F90 +++ b/src/tracer/MOM_OCMIP2_CFC.F90 @@ -14,7 +14,7 @@ module MOM_OCMIP2_CFC use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : query_initialized, MOM_restart_CS use MOM_sponge, only : set_up_sponge_field, sponge_CS -use MOM_time_manager, only : time_type, get_time +use MOM_time_manager, only : time_type use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_tracer_Z_init, only : tracer_Z_init diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index d06ffe0e2c..66dd26fca0 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -35,7 +35,7 @@ module MOM_generic_tracer use MOM_spatial_means, only : global_area_mean use MOM_sponge, only : set_up_sponge_field, sponge_CS use MOM_ALE_sponge, only : set_up_ALE_sponge_field, ALE_sponge_CS - use MOM_time_manager, only : time_type, get_time, set_time + use MOM_time_manager, only : time_type, set_time use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_Z_init, only : tracer_Z_init diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90 index 4ed395bac8..aeb1b3aae9 100644 --- a/src/tracer/advection_test_tracer.F90 +++ b/src/tracer/advection_test_tracer.F90 @@ -14,7 +14,7 @@ module advection_test_tracer use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : query_initialized, MOM_restart_CS use MOM_sponge, only : set_up_sponge_field, sponge_CS -use MOM_time_manager, only : time_type, get_time +use MOM_time_manager, only : time_type use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_variables, only : surface diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index 7995b712e3..9b785fe41d 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -14,7 +14,7 @@ module boundary_impulse_tracer use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS use MOM_sponge, only : set_up_sponge_field, sponge_CS -use MOM_time_manager, only : time_type, get_time +use MOM_time_manager, only : time_type use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_tracer_Z_init, only : tracer_Z_init diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index a597b1fc8c..0e1b9a06b9 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -14,7 +14,7 @@ module regional_dyes use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : query_initialized, MOM_restart_CS use MOM_sponge, only : set_up_sponge_field, sponge_CS -use MOM_time_manager, only : time_type, get_time +use MOM_time_manager, only : time_type use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_tracer_Z_init, only : tracer_Z_init diff --git a/src/tracer/dyed_obc_tracer.F90 b/src/tracer/dyed_obc_tracer.F90 index 2102f1cc71..af69a39c52 100644 --- a/src/tracer/dyed_obc_tracer.F90 +++ b/src/tracer/dyed_obc_tracer.F90 @@ -13,7 +13,7 @@ module dyed_obc_tracer use MOM_io, only : file_exists, MOM_read_data, slasher, vardesc, var_desc, query_vardesc use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : MOM_restart_CS -use MOM_time_manager, only : time_type, get_time +use MOM_time_manager, only : time_type use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_variables, only : surface diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90 index 1f77bd639e..d7fcb53324 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -14,7 +14,7 @@ module ideal_age_example use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : query_initialized, MOM_restart_CS use MOM_sponge, only : set_up_sponge_field, sponge_CS -use MOM_time_manager, only : time_type, get_time +use MOM_time_manager, only : time_type, time_type_to_real use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_tracer_Z_init, only : tracer_Z_init @@ -317,7 +317,6 @@ subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, real :: sfc_val ! The surface value for the tracers. real :: Isecs_per_year ! The number of seconds in a year. real :: year ! The time in years. - integer :: secs, days ! Integer components of the time type. integer :: i, j, k, is, ie, js, je, nz, m is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -342,8 +341,7 @@ subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, Isecs_per_year = 1.0 / (365.0*86400.0) ! Set the surface value of tracer 1 to increase exponentially ! with a 30 year time scale. - call get_time(CS%Time, secs, days) - year = (86400.0*days + real(secs)) * Isecs_per_year + year = time_type_to_real(CS%Time) * Isecs_per_year do m=1,CS%ntr if (CS%sfc_growth_rate(m) == 0.0) then diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index fd794aff0b..3b98c19a73 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -14,7 +14,7 @@ module oil_tracer use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : query_initialized, MOM_restart_CS use MOM_sponge, only : set_up_sponge_field, sponge_CS -use MOM_time_manager, only : time_type, get_time +use MOM_time_manager, only : time_type, time_type_to_real use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_tracer_Z_init, only : tracer_Z_init @@ -334,7 +334,6 @@ subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified real :: Isecs_per_year = 1.0 / (365.0*86400.0) real :: year, h_total, ldecay - integer :: secs, days integer :: i, j, k, is, ie, js, je, nz, m, k_max is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -356,10 +355,7 @@ subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS enddo endif - ! Set the surface value of tracer 1 to increase exponentially - ! with a 30 year time scale. - call get_time(CS%Time, secs, days) - year = (86400.0*days + real(secs)) * Isecs_per_year + year = time_type_to_real(CS%Time) * Isecs_per_year ! Decay tracer (limit decay rate to 1/dt - just in case) do m=2,CS%ntr diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90 index fb0d38d86a..d9f4d3f682 100644 --- a/src/tracer/pseudo_salt_tracer.F90 +++ b/src/tracer/pseudo_salt_tracer.F90 @@ -16,7 +16,7 @@ module pseudo_salt_tracer use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : query_initialized, MOM_restart_CS use MOM_sponge, only : set_up_sponge_field, sponge_CS -use MOM_time_manager, only : time_type, get_time +use MOM_time_manager, only : time_type use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_tracer_Z_init, only : tracer_Z_init diff --git a/src/tracer/tracer_example.F90 b/src/tracer/tracer_example.F90 index 966fa07410..bf6b504658 100644 --- a/src/tracer/tracer_example.F90 +++ b/src/tracer/tracer_example.F90 @@ -14,7 +14,7 @@ module USER_tracer_example use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : MOM_restart_CS use MOM_sponge, only : set_up_sponge_field, sponge_CS -use MOM_time_manager, only : time_type, get_time +use MOM_time_manager, only : time_type use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_variables, only : surface use MOM_verticalGrid, only : verticalGrid_type diff --git a/src/user/BFB_surface_forcing.F90 b/src/user/BFB_surface_forcing.F90 index 27168618be..edcdb002cf 100644 --- a/src/user/BFB_surface_forcing.F90 +++ b/src/user/BFB_surface_forcing.F90 @@ -12,7 +12,7 @@ module BFB_surface_forcing use MOM_grid, only : ocean_grid_type use MOM_io, only : file_exists, read_data use MOM_safe_alloc, only : safe_alloc_ptr -use MOM_time_manager, only : time_type, operator(+), operator(/), get_time +use MOM_time_manager, only : time_type, operator(+), operator(/) use MOM_tracer_flow_control, only : call_tracer_set_forcing use MOM_tracer_flow_control, only : tracer_flow_control_CS use MOM_variables, only : surface diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index eeda2e267f..8cf56a42ac 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -17,7 +17,7 @@ module Kelvin_initialization use MOM_open_boundary, only : OBC_DIRECTION_S, OBC_DIRECTION_W use MOM_open_boundary, only : OBC_registry_type use MOM_verticalGrid, only : verticalGrid_type -use MOM_time_manager, only : time_type, set_time, time_type_to_real +use MOM_time_manager, only : time_type, time_type_to_real implicit none ; private diff --git a/src/user/MOM_controlled_forcing.F90 b/src/user/MOM_controlled_forcing.F90 index c361a37176..05ea1edd88 100644 --- a/src/user/MOM_controlled_forcing.F90 +++ b/src/user/MOM_controlled_forcing.F90 @@ -18,8 +18,8 @@ module MOM_controlled_forcing use MOM_io, only : vardesc, var_desc use MOM_restart, only : register_restart_field, MOM_restart_CS use MOM_time_manager, only : time_type, operator(+), operator(/), operator(-) -use MOM_time_manager, only : get_time, get_date, set_time, set_date -use MOM_time_manager, only : time_type_to_real +use MOM_time_manager, only : get_date, set_date +use MOM_time_manager, only : time_type_to_real, real_to_time_type use MOM_variables, only : surface implicit none ; private @@ -121,7 +121,7 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec if (.not.associated(CS)) return if ((CS%num_cycle <= 0) .and. (.not.CS%do_integrated)) return - day_end = day_start + set_time(floor(dt+0.5)) + day_end = day_start + real_to_time_type(dt) do j=js,je ; do i=is,ie virt_heat(i,j) = 0.0 ; virt_precip(i,j) = 0.0 diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 950fe4729d..5a1be3f50b 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -12,8 +12,8 @@ module MOM_wave_interface use MOM_grid, only : ocean_grid_type use MOM_verticalgrid, only : verticalGrid_type use MOM_safe_alloc, only : safe_alloc_ptr -use MOM_time_manager, only : time_type, operator(+), operator(/), get_time,& - time_type_to_real,real_to_time_type +use MOM_time_manager, only : time_type, operator(+), operator(/) +use MOM_time_manager, only : time_type_to_real, real_to_time_type use MOM_variables, only : thermo_var_ptrs, surface use data_override_mod, only : data_override_init, data_override diff --git a/src/user/SCM_CVmix_tests.F90 b/src/user/SCM_CVmix_tests.F90 index 2f2026c848..fca5ffa1d2 100644 --- a/src/user/SCM_CVmix_tests.F90 +++ b/src/user/SCM_CVmix_tests.F90 @@ -8,11 +8,10 @@ module SCM_CVMix_tests use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_forcing_type, only : forcing, mech_forcing use MOM_grid, only : ocean_grid_type -use MOM_verticalgrid, only: verticalGrid_type +use MOM_verticalgrid, only : verticalGrid_type use MOM_safe_alloc, only : safe_alloc_ptr -use MOM_time_manager, only : time_type, operator(+), operator(/), get_time,& - time_type_to_real -use MOM_variables, only : thermo_var_ptrs, surface +use MOM_time_manager, only : time_type, operator(+), operator(/), time_type_to_real +use MOM_variables, only : thermo_var_ptrs, surface implicit none ; private #include diff --git a/src/user/SCM_idealized_hurricane.F90 b/src/user/SCM_idealized_hurricane.F90 index f688c40ec6..2bb04b30f9 100644 --- a/src/user/SCM_idealized_hurricane.F90 +++ b/src/user/SCM_idealized_hurricane.F90 @@ -10,8 +10,7 @@ module SCM_idealized_hurricane use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing use MOM_grid, only : ocean_grid_type use MOM_safe_alloc, only : safe_alloc_ptr -use MOM_time_manager, only : time_type, operator(+), operator(/), get_time,& - time_type_to_real +use MOM_time_manager, only : time_type, operator(+), operator(/), time_type_to_real use MOM_variables, only : thermo_var_ptrs, surface use MOM_verticalGrid, only : verticalGrid_type diff --git a/src/user/dumbbell_surface_forcing.F90 b/src/user/dumbbell_surface_forcing.F90 index 0718ceb09c..d206914e2a 100644 --- a/src/user/dumbbell_surface_forcing.F90 +++ b/src/user/dumbbell_surface_forcing.F90 @@ -162,6 +162,7 @@ subroutine dumbbell_dynamic_forcing(state, fluxes, day, dt, G, CS) call get_time(day,isecs,idays) rdays = real(idays) + real(isecs)/8.64e4 + ! This could be: rdays = time_type_to_real(day)/8.64e4 ! Allocate and zero out the forcing arrays, as necessary. call safe_alloc_ptr(fluxes%p_surf, isd, ied, jsd, jed) diff --git a/src/user/dyed_channel_initialization.F90 b/src/user/dyed_channel_initialization.F90 index 133b5388cb..cb1b9a6b2f 100644 --- a/src/user/dyed_channel_initialization.F90 +++ b/src/user/dyed_channel_initialization.F90 @@ -11,7 +11,7 @@ module dyed_channel_initialization use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE, OBC_SIMPLE use MOM_open_boundary, only : OBC_segment_type, register_segment_tracer use MOM_open_boundary, only : OBC_registry_type, register_OBC -use MOM_time_manager, only : time_type, set_time, time_type_to_real +use MOM_time_manager, only : time_type, time_type_to_real use MOM_tracer_registry, only : tracer_registry_type, tracer_name_lookup use MOM_tracer_registry, only : tracer_type use MOM_variables, only : thermo_var_ptrs diff --git a/src/user/shelfwave_initialization.F90 b/src/user/shelfwave_initialization.F90 index 1640c9ec5a..9207830032 100644 --- a/src/user/shelfwave_initialization.F90 +++ b/src/user/shelfwave_initialization.F90 @@ -11,7 +11,7 @@ module shelfwave_initialization use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE, OBC_DIRECTION_W use MOM_open_boundary, only : OBC_segment_type, register_OBC use MOM_open_boundary, only : OBC_registry_type -use MOM_time_manager, only : time_type, set_time, time_type_to_real +use MOM_time_manager, only : time_type, time_type_to_real implicit none ; private diff --git a/src/user/supercritical_initialization.F90 b/src/user/supercritical_initialization.F90 index 6b10664d57..f12378c3d9 100644 --- a/src/user/supercritical_initialization.F90 +++ b/src/user/supercritical_initialization.F90 @@ -9,7 +9,7 @@ module supercritical_initialization use MOM_grid, only : ocean_grid_type use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE, OBC_SIMPLE, OBC_segment_type use MOM_verticalGrid, only : verticalGrid_type -use MOM_time_manager, only : time_type, set_time, time_type_to_real +use MOM_time_manager, only : time_type, time_type_to_real implicit none ; private diff --git a/src/user/tidal_bay_initialization.F90 b/src/user/tidal_bay_initialization.F90 index 7726dbf171..161ad25c11 100644 --- a/src/user/tidal_bay_initialization.F90 +++ b/src/user/tidal_bay_initialization.F90 @@ -13,7 +13,7 @@ module tidal_bay_initialization use MOM_open_boundary, only : OBC_segment_type, register_OBC use MOM_open_boundary, only : OBC_registry_type use MOM_verticalGrid, only : verticalGrid_type -use MOM_time_manager, only : time_type, set_time, time_type_to_real +use MOM_time_manager, only : time_type, time_type_to_real implicit none ; private diff --git a/src/user/user_revise_forcing.F90 b/src/user/user_revise_forcing.F90 index f2e381cc4a..d1be729734 100644 --- a/src/user/user_revise_forcing.F90 +++ b/src/user/user_revise_forcing.F90 @@ -10,7 +10,7 @@ module user_revise_forcing use MOM_grid, only : ocean_grid_type use MOM_io, only : file_exists, read_data use MOM_restart, only : register_restart_field, MOM_restart_CS -use MOM_time_manager, only : time_type, operator(+), operator(/), get_time +use MOM_time_manager, only : time_type, operator(+), operator(/) use MOM_tracer_flow_control, only : call_tracer_set_forcing use MOM_tracer_flow_control, only : tracer_flow_control_CS use MOM_variables, only : surface From 5f6384cbeb921dea08b44fcaca336f523c9b7420 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 14 Aug 2018 16:25:09 -0400 Subject: [PATCH 028/174] (*)Corrected time units in MOM6 restart files The previous commit wrote and read the real time written to the restart files in seconds, not units of days (86400 seconds) as was traditionally done. This meant that while the restarts were internally consistent, they were incompatible with the restart files from any other versions of MOM6. The real times written to and read from the restart files have been reverted to be in days (i.e. 86400 seconds). All answers are bitwise identical. --- src/framework/MOM_restart.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index 436d514125..e491c297aa 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -808,7 +808,7 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV) next_var = 0 nz = 1 ; if (present(GV)) nz = GV%ke - restart_time = time_type_to_real(time) + restart_time = time_type_to_real(time) / 86400.0 restartname = trim(CS%restartfile) if (present(filename)) restartname = trim(filename) @@ -1027,7 +1027,7 @@ subroutine restore_state(filename, directory, day, G, CS) t1 = time_vals(1) deallocate(time_vals) - day = real_to_time_type(t1) + day = real_to_time_type(t1*86400.0) exit enddo From f579e9ee1d8a27f7ddc7535bca003213aaf0ce84 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 15 Aug 2018 10:41:18 -0400 Subject: [PATCH 029/174] +(*)Add real_to_time Added an alternate implementation of the FMS function real_to_time_type that is accurate over a larger range of input values. With 32 bit signed integers, this new version should work over the entire valid range (2^31 days or ~5.8835 million years) of time_types, whereas the standard version in the FMS time_manager stops working correctly for conversions of times greater than 2^31 seconds (~68.1 years). At some point the FMS version should be upgraded, at which point real_to_time could become a wrapper to the FMS version. All answers in the test cases are bitwise identical, but there is a new public interface. --- src/framework/MOM_time_manager.F90 | 30 ++++++++++++++++++++++++++++-- 1 file changed, 28 insertions(+), 2 deletions(-) diff --git a/src/framework/MOM_time_manager.F90 b/src/framework/MOM_time_manager.F90 index 25c367c1ef..229c3ded3a 100644 --- a/src/framework/MOM_time_manager.F90 +++ b/src/framework/MOM_time_manager.F90 @@ -20,8 +20,9 @@ module MOM_time_manager implicit none ; private -public :: time_type, get_time, set_time, time_type_to_real, real_to_time_type -public :: set_ticks_per_second , get_ticks_per_second +public :: time_type, get_time, set_time +public :: time_type_to_real, real_to_time_type, real_to_time +public :: set_ticks_per_second, get_ticks_per_second public :: operator(+), operator(-), operator(*), operator(/) public :: operator(>), operator(<), operator(>=), operator(<=) public :: operator(==), operator(/=), operator(//) @@ -35,4 +36,29 @@ module MOM_time_manager public :: get_external_field_axes public :: get_external_field_missing +contains + +!> This is an alternate implementation of the FMS function real_to_time_type that is accurate over +!! a larger range of input values. With 32 bit signed integers, this version should work over the +!! entire valid range (2^31 days or ~5.8835 million years) of time_types, whereas the standard +!! version in the FMS time_manager stops working for conversions of times greater than 2^31 seconds, +!! or ~68.1 years. +function real_to_time(x, err_msg) + type(time_type) :: real_to_time !< The output time as a time_type + real, intent(in) :: x !< The input time in real seconds. + character(len=*), intent(out), optional :: err_msg !< An optional returned error message. + + ! Local variables + integer :: seconds, days, ticks + real :: real_subsecond_remainder + + days = floor(x/86400.) + seconds = floor(x - 86400.*days) + real_subsecond_remainder = x - (days*86400. + seconds) + ticks = nint(real_subsecond_remainder * get_ticks_per_second()) + + real_to_time = set_time(seconds=seconds, days=days, ticks=ticks, err_msg=err_msg) +end function real_to_time + + end module MOM_time_manager From 97479d85f5745716d9e519173ba4b84fa2fcf513 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 15 Aug 2018 10:54:41 -0400 Subject: [PATCH 030/174] (*)Use real_to_time Use the new function real_to_time in place of the equivalent FMS function real_to_time_type throughout the MOM6 code. In some cases, the module use statements needed to be change dto go via the MOM_time_manager, rather than directly to the FMS time_manager_mod. All answers in the test cases are bitwise identical, and any problems with long times due to the previous commit using real_to_time_type should be averted. --- src/core/MOM.F90 | 34 +++++++++---------- src/core/MOM_barotropic.F90 | 6 ++-- src/core/MOM_dynamics_unsplit.F90 | 4 +-- src/framework/MOM_file_parser.F90 | 6 ++-- src/framework/MOM_restart.F90 | 4 +-- src/ice_shelf/MOM_ice_shelf.F90 | 6 ++-- .../vertical/MOM_diabatic_driver.F90 | 6 ++-- src/user/MOM_controlled_forcing.F90 | 4 +-- src/user/MOM_wave_interface.F90 | 1 - 9 files changed, 35 insertions(+), 36 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index bf47d7b08c..cccc460751 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -39,7 +39,7 @@ module MOM use MOM_restart, only : register_restart_field, query_initialized, save_restart use MOM_restart, only : restart_init, is_new_run, MOM_restart_CS use MOM_spatial_means, only : global_mass_integral -use MOM_time_manager, only : time_type, real_to_time_type, time_type_to_real, operator(+) +use MOM_time_manager, only : time_type, real_to_time, time_type_to_real, operator(+) use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/) use MOM_time_manager, only : operator(>=), increment_date use MOM_unit_tests, only : unit_tests @@ -556,7 +556,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & do j=js,je ; do i=is,ie ; CS%ssh_rint(i,j) = 0.0 ; enddo ; enddo if (associated(CS%VarMix)) then - call enable_averaging(cycle_time, Time_start + real_to_time_type(cycle_time), & + call enable_averaging(cycle_time, Time_start + real_to_time(cycle_time), & CS%diag) call calc_resoln_function(h, CS%tv, G, GV, CS%VarMix) call disable_averaging(CS%diag) @@ -582,7 +582,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (CS%UseWaves) then ! Update wave information, which is presently kept static over each call to step_mom - call enable_averaging(time_interval, Time_start + real_to_time_type(time_interval), CS%diag) + call enable_averaging(time_interval, Time_start + real_to_time(time_interval), CS%diag) call Update_Stokes_Drift(G, GV, Waves, h, forces%ustar) call disable_averaging(CS%diag) endif @@ -604,9 +604,9 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & do n=1,n_max rel_time = rel_time + dt ! The relative time at the end of the step. ! Set the universally visible time to the middle of the time step. - CS%Time = Time_start + real_to_time_type(rel_time - 0.5*dt) + CS%Time = Time_start + real_to_time(rel_time - 0.5*dt) ! Set the local time to the end of the time step. - Time_local = Time_start + real_to_time_type(rel_time) + Time_local = Time_start + real_to_time(rel_time) if (showCallTree) call callTree_enter("DT cycles (step_MOM) n=",n) @@ -633,10 +633,10 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (dtdia > dt) then ! If necessary, temporarily reset CS%Time to the center of the period covered ! by the call to step_MOM_thermo, noting that they begin at the same time. - CS%Time = CS%Time + real_to_time_type(0.5*(dtdia-dt)) + CS%Time = CS%Time + real_to_time(0.5*(dtdia-dt)) ! The end-time of the diagnostic interval needs to be set ahead if there ! are multiple dynamic time steps worth of thermodynamics applied here. - end_time_thermo = Time_local + real_to_time_type(dtdia-dt) + end_time_thermo = Time_local + real_to_time(dtdia-dt) endif ! Apply diabatic forcing, do mixing, and regrid. @@ -649,7 +649,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (showCallTree) call callTree_waypoint("finished diabatic_first (step_MOM)") if (dtdia > dt) & ! Reset CS%Time to its previous value. - CS%Time = Time_start + real_to_time_type(rel_time - 0.5*dt) + CS%Time = Time_start + real_to_time(rel_time - 0.5*dt) endif ! end of block "(CS%diabatic_first .and. (CS%t_dyn_rel_adv==0.0))" if (do_dyn) then @@ -731,7 +731,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & ! If necessary, temporarily reset CS%Time to the center of the period covered ! by the call to step_MOM_thermo, noting that they end at the same time. - if (dtdia > dt) CS%Time = CS%Time - real_to_time_type(0.5*(dtdia-dt)) + if (dtdia > dt) CS%Time = CS%Time - real_to_time(0.5*(dtdia-dt)) ! Apply diabatic forcing, do mixing, and regrid. call step_MOM_thermo(CS, G, GV, u, v, h, CS%tv, fluxes, dtdia, & @@ -740,7 +740,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & CS%t_dyn_rel_thermo = 0.0 if (dtdia > dt) & ! Reset CS%Time to its previous value. - CS%Time = Time_start + real_to_time_type(rel_time - 0.5*dt) + CS%Time = Time_start + real_to_time(rel_time - 0.5*dt) endif if (do_dyn) then @@ -774,7 +774,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & CS%t_dyn_rel_diag = 0.0 call cpu_clock_begin(id_clock_Z_diag) - if (Time_local + real_to_time_type(0.5*dt_therm) > CS%Z_diag_time) then + if (Time_local + real_to_time(0.5*dt_therm) > CS%Z_diag_time) then call enable_averaging(real(time_type_to_real(CS%Z_diag_interval)), & CS%Z_diag_time, CS%diag) !### This is the one place where fluxes might used if do_thermo=.false. Is this correct? @@ -852,7 +852,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (MOM_state_is_synchronized(CS)) & call write_energy(CS%u, CS%v, CS%h, CS%tv, Time_local, CS%nstep_tot, & G, GV, CS%sum_output_CSp, CS%tracer_flow_CSp, & - dt_forcing=real_to_time_type(time_interval) ) + dt_forcing=real_to_time(time_interval) ) call cpu_clock_end(id_clock_other) @@ -912,7 +912,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & if ((CS%t_dyn_rel_adv == 0.0) .and. CS%thickness_diffuse .and. CS%thickness_diffuse_first) then - call enable_averaging(dt_thermo, Time_local+real_to_time_type(dt_thermo-dt), CS%diag) + call enable_averaging(dt_thermo, Time_local+real_to_time(dt_thermo-dt), CS%diag) call cpu_clock_begin(id_clock_thick_diff) if (associated(CS%VarMix)) & call calc_slope_functions(h, CS%tv, dt, G, GV, CS%VarMix) @@ -931,7 +931,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & ! The bottom boundary layer properties need to be recalculated. if (bbl_time_int > 0.0) then call enable_averaging(bbl_time_int, & - Time_local + real_to_time_type(bbl_time_int-dt), CS%diag) + 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, & @@ -2286,7 +2286,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & CS%OBC, CS%update_OBC_CSp, CS%ALE_CSp, CS%set_visc_CSp, & CS%visc, dirs, CS%ntrunc, calc_dtbt=calc_dtbt) if (CS%dtbt_reset_period > 0.0) then - CS%dtbt_reset_interval = real_to_time_type(CS%dtbt_reset_period) + CS%dtbt_reset_interval = real_to_time(CS%dtbt_reset_period) ! Set dtbt_reset_time to be the next even multiple of dtbt_reset_interval. CS%dtbt_reset_time = Time_init + CS%dtbt_reset_interval * & ((Time - Time_init) / CS%dtbt_reset_interval) @@ -2325,10 +2325,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & param_file, diag, CS%diagnostics_CSp, CS%tv) call diag_copy_diag_to_storage(CS%diag_pre_sync, CS%h, CS%diag) - CS%Z_diag_interval = real_to_time_type(CS%dt_therm * max(1,floor(0.01 + Z_diag_int/CS%dt_therm))) + CS%Z_diag_interval = real_to_time(CS%dt_therm * max(1,floor(0.01 + Z_diag_int/CS%dt_therm))) call MOM_diag_to_Z_init(Time, G, GV, param_file, diag, CS%diag_to_Z_CSp) CS%Z_diag_time = Start_time + CS%Z_diag_interval * (1 + & - ((Time + real_to_time_type(CS%dt_therm)) - Start_time) / CS%Z_diag_interval) + ((Time + real_to_time(CS%dt_therm)) - Start_time) / CS%Z_diag_interval) if (associated(CS%sponge_CSp)) & call init_sponge_diags(Time, G, diag, CS%sponge_CSp) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index c423b2d0c1..674f6f1bff 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -22,7 +22,7 @@ module MOM_barotropic use MOM_open_boundary, only : OBC_DIRECTION_N, OBC_DIRECTION_S, OBC_segment_type use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS use MOM_tidal_forcing, only : tidal_forcing_sensitivity, tidal_forcing_CS -use MOM_time_manager, only : time_type, real_to_time_type, operator(+), operator(-) +use MOM_time_manager, only : time_type, real_to_time, operator(+), operator(-) use MOM_variables, only : BT_cont_type, alloc_bt_cont_type use MOM_verticalGrid, only : verticalGrid_type @@ -723,7 +723,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & (CS%id_uhbt_hifreq > 0) .or. (CS%id_vhbt_hifreq > 0)) then do_hifreq_output = query_averaging_enabled(CS%diag, time_int_in, time_end_in) if (do_hifreq_output) & - time_bt_start = time_end_in - real_to_time_type(dt) + time_bt_start = time_end_in - real_to_time(dt) endif !--- begin setup for group halo update @@ -2008,7 +2008,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & enddo ; enddo if (do_hifreq_output) then - time_step_end = time_bt_start + real_to_time_type(n*dtbt) + time_step_end = time_bt_start + real_to_time(n*dtbt) call enable_averaging(dtbt, time_step_end, CS%diag) if (CS%id_ubt_hifreq > 0) call post_data(CS%id_ubt_hifreq, ubt(IsdB:IedB,jsd:jed), CS%diag) if (CS%id_vbt_hifreq > 0) call post_data(CS%id_vbt_hifreq, vbt(isd:ied,JsdB:JedB), CS%diag) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 506dd3624b..3965758510 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -72,7 +72,7 @@ module MOM_dynamics_unsplit use MOM_io, only : MOM_io_init use MOM_restart, only : register_restart_field, query_initialized, save_restart use MOM_restart, only : restart_init, MOM_restart_CS -use MOM_time_manager, only : time_type, real_to_time_type, operator(+) +use MOM_time_manager, only : time_type, real_to_time, operator(+) use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/) use MOM_ALE, only : ALE_CS @@ -267,7 +267,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call pass_var(hp, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) - call enable_averaging(0.5*dt,Time_local-real_to_time_type(0.5*dt), CS%diag) + call enable_averaging(0.5*dt,Time_local-real_to_time(0.5*dt), CS%diag) ! Here the first half of the thickness fluxes are offered for averaging. if (CS%id_uh > 0) call post_data(CS%id_uh, uh, CS%diag) if (CS%id_vh > 0) call post_data(CS%id_vh, vh, CS%diag) diff --git a/src/framework/MOM_file_parser.F90 b/src/framework/MOM_file_parser.F90 index 70f3b9a941..72944c4f7a 100644 --- a/src/framework/MOM_file_parser.F90 +++ b/src/framework/MOM_file_parser.F90 @@ -7,7 +7,7 @@ module MOM_file_parser use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg use MOM_error_handler, only : is_root_pe, stdlog, stdout use MOM_time_manager, only : get_time, time_type, get_ticks_per_second -use MOM_time_manager, only : set_date, get_date, real_to_time_type +use MOM_time_manager, only : set_date, get_date, real_to_time, operator(-), set_time use MOM_document, only : doc_param, doc_module, doc_init, doc_end, doc_type use MOM_document, only : doc_openBlock, doc_closeBlock use MOM_string_functions, only : left_int, left_ints, slasher @@ -854,8 +854,8 @@ subroutine read_param_time(CS, varname, value, timeunit, fail_if_missing, date_f else time_unit = 1.0 ; if (present(timeunit)) time_unit = timeunit read( value_string(1), *) real_time - value = real_to_time_type(real_time*time_unit) - endif + value = real_to_time(real_time*time_unit) + endif else if (present(fail_if_missing)) then ; if (fail_if_missing) then if (.not.found) then diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index e491c297aa..8d5819f945 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -14,7 +14,7 @@ module MOM_restart use MOM_io, only : vardesc, var_desc, query_vardesc, modify_vardesc use MOM_io, only : MULTIPLE, NETCDF_FILE, READONLY_FILE, SINGLE_FILE use MOM_io, only : CENTER, CORNER, NORTH_FACE, EAST_FACE -use MOM_time_manager, only : time_type, time_type_to_real, real_to_time_type +use MOM_time_manager, only : time_type, time_type_to_real, real_to_time use MOM_time_manager, only : days_in_month, get_date, set_date use MOM_verticalGrid, only : verticalGrid_type use mpp_mod, only: mpp_chksum @@ -1027,7 +1027,7 @@ subroutine restore_state(filename, directory, day, G, CS) t1 = time_vals(1) deallocate(time_vals) - day = real_to_time_type(t1*86400.0) + day = real_to_time(t1*86400.0) exit enddo diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 7e3c4ac606..e6989caa54 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -25,7 +25,7 @@ module MOM_ice_shelf use MOM_io, only : write_field, close_file, SINGLE_FILE, MULTIPLE use MOM_restart, only : register_restart_field, query_initialized, save_restart use MOM_restart, only : restart_init, restore_state, MOM_restart_CS -use MOM_time_manager, only : time_type, time_type_to_real +use MOM_time_manager, only : time_type, time_type_to_real, time_type_to_real, real_to_time use MOM_transcribe_grid, only : copy_dyngrid_to_MOM_grid, copy_MOM_grid_to_dyngrid use MOM_variables, only : surface use MOM_forcing_type, only : forcing, allocate_forcing_type, MOM_forcing_chksum @@ -47,7 +47,7 @@ module MOM_ice_shelf use MOM_checksums, only : hchksum, qchksum, chksum, uchksum, vchksum, uvchksum use time_interp_external_mod, only : init_external_field, time_interp_external use time_interp_external_mod, only : time_interp_external_init -use time_manager_mod, only : print_time, time_type_to_real, real_to_time_type +use time_manager_mod, only : print_time implicit none ; private #include @@ -979,7 +979,7 @@ subroutine add_shelf_flux(G, CS, state, fluxes) ! just compute changes in mass after first time step if (t0>0.0) then - Time0 = real_to_time_type(t0) + Time0 = real_to_time(t0) last_hmask(:,:) = ISS%hmask(:,:) ; last_area_shelf_h(:,:) = ISS%area_shelf_h(:,:) call time_interp_external(CS%id_read_mass, Time0, last_mass_shelf) last_h_shelf = last_mass_shelf/CS%density_ice diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 846e27de8b..e3806fd684 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -61,7 +61,7 @@ module MOM_diabatic_driver use MOM_shortwave_abs, only : absorbRemainingSW, optics_type use MOM_sponge, only : apply_sponge, sponge_CS use MOM_ALE_sponge, only : apply_ALE_sponge, ALE_sponge_CS -use MOM_time_manager, only : time_type, real_to_time_type, operator(-), operator(<=) +use MOM_time_manager, only : time_type, real_to_time, operator(-), operator(<=) use MOM_tracer_flow_control, only : call_tracer_column_fns, tracer_flow_control_CS use MOM_tracer_diabatic, only : tracer_vertdiff use MOM_variables, only : thermo_var_ptrs, vertvisc_type, accel_diag_ptrs @@ -439,7 +439,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! the end of the diabatic processes. if (associated(tv%T) .AND. associated(tv%frazil)) then ! For frazil diagnostic, the first call covers the first half of the time step - call enable_averaging(0.5*dt, Time_end - real_to_time_type(0.5*dt), CS%diag) + call enable_averaging(0.5*dt, Time_end - real_to_time(0.5*dt), CS%diag) if (CS%frazil_tendency_diag) then do k=1,nz ; do j=js,je ; do i=is,ie temp_diag(i,j,k) = tv%T(i,j,k) @@ -1315,7 +1315,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! the end of the diabatic processes. if (associated(tv%T) .AND. associated(tv%frazil)) then ! For frazil diagnostic, the first call covers the first half of the time step - call enable_averaging(0.5*dt, Time_end - real_to_time_type(0.5*dt), CS%diag) + call enable_averaging(0.5*dt, Time_end - real_to_time(0.5*dt), CS%diag) if (CS%frazil_tendency_diag) then do k=1,nz ; do j=js,je ; do i=is,ie temp_diag(i,j,k) = tv%T(i,j,k) diff --git a/src/user/MOM_controlled_forcing.F90 b/src/user/MOM_controlled_forcing.F90 index 05ea1edd88..2034a16bb4 100644 --- a/src/user/MOM_controlled_forcing.F90 +++ b/src/user/MOM_controlled_forcing.F90 @@ -19,7 +19,7 @@ module MOM_controlled_forcing use MOM_restart, only : register_restart_field, MOM_restart_CS 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_type +use MOM_time_manager, only : time_type_to_real, real_to_time use MOM_variables, only : surface implicit none ; private @@ -121,7 +121,7 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec if (.not.associated(CS)) return if ((CS%num_cycle <= 0) .and. (.not.CS%do_integrated)) return - day_end = day_start + real_to_time_type(dt) + day_end = day_start + real_to_time(dt) do j=js,je ; do i=is,ie virt_heat(i,j) = 0.0 ; virt_precip(i,j) = 0.0 diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 5a1be3f50b..c8ce37ad55 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -13,7 +13,6 @@ module MOM_wave_interface use MOM_verticalgrid, only : verticalGrid_type use MOM_safe_alloc, only : safe_alloc_ptr use MOM_time_manager, only : time_type, operator(+), operator(/) -use MOM_time_manager, only : time_type_to_real, real_to_time_type use MOM_variables, only : thermo_var_ptrs, surface use data_override_mod, only : data_override_init, data_override From dba64e84b02cb9e0174dcaacb9881c2139c2f15e Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Wed, 15 Aug 2018 14:14:29 -0800 Subject: [PATCH 031/174] Fix to soliton initialization. - Now seems to work with PR #833. --- src/user/soliton_initialization.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/user/soliton_initialization.F90 b/src/user/soliton_initialization.F90 index c9e7eec40e..6f4b2898c5 100644 --- a/src/user/soliton_initialization.F90 +++ b/src/user/soliton_initialization.F90 @@ -53,7 +53,7 @@ subroutine soliton_initialize_thickness(h, G, GV) y = G%geoLatT(i,j)-y0 val3 = exp(-val1*x) val4 = val2*((2.0*val3/(1.0+(val3*val3)))**2) - h(i,j,k) = GV%m_to_H * (0.25*val4 * (6.0*y*y+3.0) * exp(-0.5*y*y)) + h(i,j,k) = GV%m_to_H * (0.25*val4 * (6.0*y*y+3.0) * exp(-0.5*y*y)) + G%bathyT(i,j) enddo enddo ; enddo From 22fbe6f3ae20f84da850e5f87438f72a1d9813d3 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Wed, 15 Aug 2018 14:19:56 -0800 Subject: [PATCH 032/174] Fix soliton initialization with GV%m_to_H --- src/user/soliton_initialization.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/user/soliton_initialization.F90 b/src/user/soliton_initialization.F90 index 6f4b2898c5..e258b87bf1 100644 --- a/src/user/soliton_initialization.F90 +++ b/src/user/soliton_initialization.F90 @@ -53,7 +53,7 @@ subroutine soliton_initialize_thickness(h, G, GV) y = G%geoLatT(i,j)-y0 val3 = exp(-val1*x) val4 = val2*((2.0*val3/(1.0+(val3*val3)))**2) - h(i,j,k) = GV%m_to_H * (0.25*val4 * (6.0*y*y+3.0) * exp(-0.5*y*y)) + G%bathyT(i,j) + h(i,j,k) = GV%m_to_H * (0.25*val4 * (6.0*y*y+3.0) * exp(-0.5*y*y) + G%bathyT(i,j)) enddo enddo ; enddo From 731f2cfb72b0b8e5129aed752406ce6535608889 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 16 Aug 2018 18:23:12 -0400 Subject: [PATCH 033/174] Eliminated unused variables in forcing modules Eliminated unused variables, duplicate comment blocks, and module use statements for get_time. All answers are bitwise identical. --- .../solo_driver/Neverland_surface_forcing.F90 | 42 ++++++++--------- .../solo_driver/user_surface_forcing.F90 | 45 +++---------------- 2 files changed, 26 insertions(+), 61 deletions(-) diff --git a/config_src/solo_driver/Neverland_surface_forcing.F90 b/config_src/solo_driver/Neverland_surface_forcing.F90 index 65a5ca1339..e6111b2a19 100644 --- a/config_src/solo_driver/Neverland_surface_forcing.F90 +++ b/config_src/solo_driver/Neverland_surface_forcing.F90 @@ -12,7 +12,7 @@ module Neverland_surface_forcing use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing use MOM_grid, only : ocean_grid_type use MOM_io, only : file_exists, read_data, slasher -use MOM_time_manager, only : time_type, operator(+), operator(/), get_time +use MOM_time_manager, only : time_type, operator(+), operator(/) use MOM_variables, only : surface implicit none ; private @@ -48,15 +48,15 @@ module Neverland_surface_forcing !! Neverland forcing configuration. subroutine Neverland_wind_forcing(sfc_state, forces, day, G, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that - !! describe the surface state of the ocean. + !! describe the surface state of the ocean. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(time_type), intent(in) :: day !< Time used for determining the fluxes. - type(ocean_grid_type), intent(inout) :: G !< Grid structure. - type(Neverland_surface_forcing_CS), pointer :: CS !< Control structure for this module. - ! Local variable + type(time_type), intent(in) :: day !< Time used for determining the fluxes. + type(ocean_grid_type), intent(inout) :: G !< Grid structure. + type(Neverland_surface_forcing_CS), pointer :: CS !< Control structure for this module. + + ! Local variables integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB - real :: x, y real :: PI real :: tau_max, off @@ -110,26 +110,26 @@ subroutine Neverland_wind_forcing(sfc_state, forces, day, G, CS) end subroutine Neverland_wind_forcing !> Returns the value of a cosine-bell function evaluated at x/L - real function cosbell(x,L) +real function cosbell(x,L) - real , intent(in) :: x !< non-dimensional position - real , intent(in) :: L !< non-dimensional width - real :: PI !< 3.1415926... calculated as 4*atan(1) + real , intent(in) :: x !< non-dimensional position + real , intent(in) :: L !< non-dimensional width + real :: PI !< 3.1415926... calculated as 4*atan(1) - PI = 4.0*atan(1.0) - cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0))) - end function cosbell + PI = 4.0*atan(1.0) + cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0))) +end function cosbell !> Returns the value of a sin-spike function evaluated at x/L - real function spike(x,L) +real function spike(x,L) - real , intent(in) :: x !< non-dimensional position - real , intent(in) :: L !< non-dimensional width - real :: PI !< 3.1415926... calculated as 4*atan(1) + real , intent(in) :: x !< non-dimensional position + real , intent(in) :: L !< non-dimensional width + real :: PI !< 3.1415926... calculated as 4*atan(1) - PI = 4.0*atan(1.0) - spike = (1 - sin(PI*MIN(ABS(x/L),0.5))) - end function spike + PI = 4.0*atan(1.0) + spike = (1 - sin(PI*MIN(ABS(x/L),0.5))) +end function spike !> Surface fluxes of buoyancy for the Neverland configurations. diff --git a/config_src/solo_driver/user_surface_forcing.F90 b/config_src/solo_driver/user_surface_forcing.F90 index e0136abf0f..7a27c75e18 100644 --- a/config_src/solo_driver/user_surface_forcing.F90 +++ b/config_src/solo_driver/user_surface_forcing.F90 @@ -12,7 +12,7 @@ module user_surface_forcing use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing use MOM_grid, only : ocean_grid_type use MOM_io, only : file_exists, read_data -use MOM_time_manager, only : time_type, operator(+), operator(/), get_time +use MOM_time_manager, only : time_type, operator(+), operator(/) use MOM_tracer_flow_control, only : call_tracer_set_forcing use MOM_tracer_flow_control, only : tracer_flow_control_CS use MOM_variables, only : surface @@ -49,30 +49,15 @@ module user_surface_forcing !! direction as the u- and v- velocities.) They are both in Pa. subroutine USER_wind_forcing(sfc_state, forces, day, G, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that - !! describe the surface state of the ocean. + !! describe the surface state of the ocean. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces type(time_type), intent(in) :: day !< The time of the fluxes type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(user_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned !! by a previous call to user_surface_forcing_init -! This subroutine sets the surface wind stresses, forces%taux and forces%tauy. -! These are the stresses in the direction of the model grid (i.e. the same -! direction as the u- and v- velocities.) They are both in Pa. -! In addition, this subroutine can be used to set the surface friction -! velocity, forces%ustar, in m s-1. This is needed with a bulk mixed layer. -! -! Arguments: state - A structure containing fields that describe the -! surface state of the ocean. -! (out) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (in) day - Time of the fluxes. -! (in) G - The ocean's grid structure. -! (in) CS - A pointer to the control structure returned by a previous -! call to user_surface_forcing_init - + ! Local variables integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq - integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB ! When modifying the code, comment out this error message. It is here ! so that the original (unmodified) version is not accidentally used. @@ -81,8 +66,6 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, 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 - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB ! Allocate the forcing arrays, if necessary. call allocate_mech_forcing(G, forces, stress=.true., ustar=.true.) @@ -138,22 +121,12 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) ! are in W m-2 and positive for heat going into the ocean. All fresh water ! fluxes are in kg m-2 s-1 and positive for water moving into the ocean. -! Arguments: state - A structure containing fields that describe the -! surface state of the ocean. -! (out) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (in) day_start - Start time of the fluxes. -! (in) day_interval - Length of time over which these fluxes -! will be applied. -! (in) G - The ocean's grid structure. -! (in) CS - A pointer to the control structure returned by a previous -! call to user_surface_forcing_init - + ! Local variables real :: Temp_restore ! The temperature that is being restored toward, in C. real :: Salin_restore ! The salinity that is being restored toward, in PSU. real :: density_restore ! The potential density that is being restored ! toward, in kg m-3. - real :: rhoXcp ! The mean density times the heat capacity, in J m-3 K-1. + real :: rhoXcp ! The mean density times the heat capacity, in J m-3 K-1. real :: buoy_rest_const ! A constant relating density anomalies to the ! restoring buoyancy flux, in m5 s-3 kg-1. @@ -266,14 +239,6 @@ subroutine USER_surface_forcing_init(Time, G, param_file, diag, CS) type(user_surface_forcing_CS), pointer :: CS !< A pointer that is set to point to !! the control structure for this module -! Arguments: Time - The current model time. -! (in) G - The ocean's grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) diag - A structure that is used to regulate diagnostic output. -! (in/out) CS - A pointer that is set to point to the control structure -! for this module - ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "user_surface_forcing" ! This module's name. From 904b5fe9b954304bb2537f711a20c9baaaa178d9 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 16 Aug 2018 18:24:42 -0400 Subject: [PATCH 034/174] +Removed MESO_wind_forcing MESO_wind_forcing was never actually being used, so I eliminated it and removed the call to it from set_forcing. Also eliminated unused variables and simplified the code converting day_interval to dt in set_forcing. Duplicate comment blocks were also eliminated in MESO_forcing.F90. All answers are bitwise identical. --- .../solo_driver/MESO_surface_forcing.F90 | 95 +------------------ .../solo_driver/MOM_surface_forcing.F90 | 33 ++----- 2 files changed, 9 insertions(+), 119 deletions(-) diff --git a/config_src/solo_driver/MESO_surface_forcing.F90 b/config_src/solo_driver/MESO_surface_forcing.F90 index eaa11da6c1..68852f89d9 100644 --- a/config_src/solo_driver/MESO_surface_forcing.F90 +++ b/config_src/solo_driver/MESO_surface_forcing.F90 @@ -12,14 +12,14 @@ module MESO_surface_forcing use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing use MOM_grid, only : ocean_grid_type use MOM_io, only : file_exists, MOM_read_data, slasher -use MOM_time_manager, only : time_type, operator(+), operator(/), get_time +use MOM_time_manager, only : time_type, operator(+), operator(/) use MOM_tracer_flow_control, only : call_tracer_set_forcing use MOM_tracer_flow_control, only : tracer_flow_control_CS use MOM_variables, only : surface implicit none ; private -public MESO_wind_forcing, MESO_buoyancy_forcing, MESO_surface_forcing_init +public MESO_buoyancy_forcing, MESO_surface_forcing_init !> This control structure is used to store parameters associated with the MESO forcing. type, public :: MESO_surface_forcing_CS ; private @@ -52,71 +52,6 @@ module MESO_surface_forcing contains -!### This subroutine sets zero surface wind stresses, but it is not even -!### used by the MESO experimeents. This subroutine can be deleted. -RWH -subroutine MESO_wind_forcing(sfc_state, forces, day, G, CS) - type(surface), intent(inout) :: sfc_state !< A structure containing fields that - !! describe the surface state of the ocean. - type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(time_type), intent(in) :: day !< The time of the fluxes - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(MESO_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned by a previous - !! call to MESO_surface_forcing_init - -! This subroutine sets the surface wind stresses, forces%taux and forces%tauy. -! These are the stresses in the direction of the model grid (i.e. the same -! direction as the u- and v- velocities.) They are both in Pa. -! In addition, this subroutine can be used to set the surface friction -! velocity, forces%ustar, in m s-1. This is needed with a bulk mixed layer. -! -! Arguments: state - A structure containing fields that describe the -! surface state of the ocean. -! (out) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (in) day - Time of the fluxes. -! (in) G - The ocean's grid structure. -! (in) CS - A pointer to the control structure returned by a previous -! call to MESO_surface_forcing_init - - integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq - integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB - - ! When modifying the code, comment out this error message. It is here - ! so that the original (unmodified) version is not accidentally used. - call MOM_error(FATAL, "MESO_wind_surface_forcing: " // & - "User forcing routine called without modification." ) - - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - - ! Allocate the forcing arrays, if necessary. - call allocate_mech_forcing(G, forces, stress=.true., ustar=.true.) - - ! Set the surface wind stresses, in units of Pa. A positive taux - ! accelerates the ocean to the (pseudo-)east. - - ! The i-loop extends to is-1 so that taux can be used later in the - ! calculation of ustar - otherwise the lower bound would be Isq. - do j=js,je ; do I=is-1,Ieq - forces%taux(I,j) = G%mask2dCu(I,j) * 0.0 ! Change this to the desired expression. - enddo ; enddo - do J=js-1,Jeq ; do i=is,ie - forces%tauy(i,J) = G%mask2dCv(i,J) * 0.0 ! Change this to the desired expression. - enddo ; enddo - - ! Set the surface friction velocity, in units of m s-1. ustar - ! is always positive. - if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie - ! This expression can be changed if desired, but need not be. - forces%ustar(i,j) = G%mask2dT(i,j) * sqrt(CS%gust_const/CS%Rho0 + & - sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + & - 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))/CS%Rho0) - enddo ; enddo ; endif - -end subroutine MESO_wind_forcing - !> This subroutine sets up the MESO buoyancy forcing, which uses control-theory style !! specification restorative buoyancy fluxes at large scales. subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) @@ -130,10 +65,6 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) type(MESO_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned by !! a previous call to MESO_surface_forcing_init -! This subroutine specifies the current surface fluxes of buoyancy or -! temperature and fresh water. It may also be modified to add -! surface fluxes of user provided tracers. - ! When temperature is used, there are long list of fluxes that need to be ! set - essentially the same as for a full coupled model, but most of these ! can be simply set to zero. The net fresh water flux should probably be @@ -144,17 +75,6 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) ! are in W m-2 and positive for heat going into the ocean. All fresh water ! fluxes are in kg m-2 s-1 and positive for water moving into the ocean. -! Arguments: state - A structure containing fields that describe the -! surface state of the ocean. -! (out) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (in) day_start - Start time of the fluxes. -! (in) day_interval - Length of time over which these fluxes -! will be applied. -! (in) G - The ocean's grid structure. -! (in) CS - A pointer to the control structure returned by a previous -! call to MESO_surface_forcing_init - real :: Temp_restore ! The temperature that is being restored toward, in C. real :: Salin_restore ! The salinity that is being restored toward, in PSU. real :: density_restore ! The potential density that is being restored @@ -293,14 +213,6 @@ subroutine MESO_surface_forcing_init(Time, G, param_file, diag, CS) type(MESO_surface_forcing_CS), pointer :: CS !< A pointer that is set to point to the !! control structure for this module -! Arguments: Time - The current model time. -! (in) G - The ocean's grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) diag - A structure that is used to regulate diagnostic output. -! (in/out) CS - A pointer that is set to point to the control structure -! for this module - ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MESO_surface_forcing" ! This module's name. @@ -383,9 +295,6 @@ end subroutine MESO_surface_forcing_init !! it is probably a good idea to read the forcing from input files !! using "file" for WIND_CONFIG and BUOY_CONFIG. !! -!! MESO_wind_forcing should set the surface wind stresses (taux and -!! tauy) perhaps along with the surface friction velocity (ustar). -!! !! MESO_buoyancy forcing is used to set the surface buoyancy !! forcing, which may include a number of fresh water flux fields !! (evap, liq_precip, froz_precip, liq_runoff, froz_runoff, and diff --git a/config_src/solo_driver/MOM_surface_forcing.F90 b/config_src/solo_driver/MOM_surface_forcing.F90 index 351b149830..a3a9a12204 100644 --- a/config_src/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/solo_driver/MOM_surface_forcing.F90 @@ -32,11 +32,11 @@ module MOM_surface_forcing use MOM_io, only : EAST_FACE, NORTH_FACE, num_timelevels use MOM_restart, only : register_restart_field, restart_init, MOM_restart_CS use MOM_restart, only : restart_init_end, save_restart, restore_state -use MOM_time_manager, only : time_type, operator(+), operator(/), get_time, set_time +use MOM_time_manager, only : time_type, operator(+), operator(/), get_time, time_type_to_real use MOM_tracer_flow_control, only : call_tracer_set_forcing use MOM_tracer_flow_control, only : tracer_flow_control_CS use MOM_variables, only : surface -use MESO_surface_forcing, only : MESO_wind_forcing, MESO_buoyancy_forcing +use MESO_surface_forcing, only : MESO_buoyancy_forcing use MESO_surface_forcing, only : MESO_surface_forcing_init, MESO_surface_forcing_CS use Neverland_surface_forcing, only : Neverland_wind_forcing, Neverland_buoyancy_forcing use Neverland_surface_forcing, only : Neverland_surface_forcing_init, Neverland_surface_forcing_CS @@ -226,7 +226,6 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, CS ! Local variables real :: dt ! length of time in seconds over which fluxes applied type(time_type) :: day_center ! central time of the fluxes. - integer :: intdt integer :: isd, ied, jsd, jed isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -234,8 +233,7 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, CS call callTree_enter("set_forcing, MOM_surface_forcing.F90") day_center = day_start + day_interval/2 - call get_time(day_interval, intdt) - dt = real(intdt) + dt = time_type_to_real(day_interval) if (CS%first_call_set_forcing) then ! Allocate memory for the mechanical and thermodyanmic forcing fields. @@ -275,8 +273,6 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, CS call wind_forcing_const(sfc_state, forces, 0., 0., day_center, G, CS) elseif (trim(CS%wind_config) == "const") then call wind_forcing_const(sfc_state, forces, CS%tau_x0, CS%tau_y0, day_center, G, CS) - elseif (trim(CS%wind_config) == "MESO") then - call MESO_wind_forcing(sfc_state, forces, day_center, G, CS%MESO_forcing_CSp) elseif (trim(CS%wind_config) == "Neverland") then call Neverland_wind_forcing(sfc_state, forces, day_center, G, CS%Neverland_forcing_CSp) elseif (trim(CS%wind_config) == "SCM_ideal_hurr") then @@ -369,13 +365,10 @@ subroutine wind_forcing_const(sfc_state, forces, tau_x0, tau_y0, day, G, CS) ! Local variables real :: mag_tau integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq - integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB call callTree_enter("wind_forcing_const, MOM_surface_forcing.F90") is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB !set steady surface wind stresses, in units of Pa. mag_tau = sqrt( tau_x0**2 + tau_y0**2) @@ -414,13 +407,10 @@ subroutine wind_forcing_2gyre(sfc_state, forces, day, G, CS) ! Local variables real :: PI integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq - integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB call callTree_enter("wind_forcing_2gyre, MOM_surface_forcing.F90") is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB !set the steady surface wind stresses, in units of Pa. PI = 4.0*atan(1.0) @@ -450,13 +440,10 @@ subroutine wind_forcing_1gyre(sfc_state, forces, day, G, CS) ! Local variables real :: PI integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq - integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB call callTree_enter("wind_forcing_1gyre, MOM_surface_forcing.F90") is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB ! set the steady surface wind stresses, in units of Pa. PI = 4.0*atan(1.0) @@ -484,25 +471,22 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, CS) ! Local variables real :: PI, y integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq - integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB call callTree_enter("wind_forcing_gyres, MOM_surface_forcing.F90") is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB ! steady surface wind stresses (Pa) PI = 4.0*atan(1.0) - do j=jsd,jed ; do I=is-1,IedB + do j=js-1,je+1 ; do I=is-1,Ieq y = (G%geoLatCu(I,j)-CS%South_lat)/CS%len_lat forces%taux(I,j) = CS%gyres_taux_const + & ( CS%gyres_taux_sin_amp*sin(CS%gyres_taux_n_pis*PI*y) & + CS%gyres_taux_cos_amp*cos(CS%gyres_taux_n_pis*PI*y) ) enddo ; enddo - do J=js-1,JedB ; do i=isd,ied + do J=js-1,Jeq ; do i=is-1,ie+1 forces%tauy(i,J) = 0.0 enddo ; enddo @@ -535,16 +519,13 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, CS) integer :: time_lev ! The time level that is used for a field. integer :: days, seconds integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq - integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB logical :: read_Ustar call callTree_enter("wind_forcing_from_file, MOM_surface_forcing.F90") is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - call get_time(day,seconds,days) + call get_time(day, seconds, days) time_lev_daily = days - 365*floor(real(days) / 365.0) if (time_lev_daily < 31) then ; time_lev_monthly = 0 @@ -774,7 +755,7 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) Irho0 = 1.0/CS%Rho0 ! Read the buoyancy forcing file - call get_time(day,seconds,days) + call get_time(day, seconds, days) time_lev_daily = days - 365*floor(real(days) / 365.0) From 396e19348e20764b07f402db17be293615d4bb4c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 16 Aug 2018 18:25:30 -0400 Subject: [PATCH 035/174] (*)Use real_to_time in driver code Replaced real_to_time_type with real_to_time in the coupled and ocean-only driver code to avoid problems when converting large times. All answers are bitwise identical in the test cases. --- config_src/coupled_driver/ocean_model_MOM.F90 | 6 +++--- config_src/solo_driver/MOM_driver.F90 | 20 +++++++++---------- 2 files changed, 13 insertions(+), 13 deletions(-) diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index 742688506f..70437d0e4c 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -40,7 +40,7 @@ module ocean_model_mod use MOM_time_manager, only : time_type, operator(>), operator(+), operator(-) use MOM_time_manager, only : operator(*), operator(/), operator(/=) use MOM_time_manager, only : operator(<=), operator(>=), operator(<) -use MOM_time_manager, only : real_to_time_type, time_type_to_real +use MOM_time_manager, only : real_to_time, time_type_to_real use MOM_tracer_flow_control, only : call_tracer_register, tracer_flow_control_init use MOM_tracer_flow_control, only : call_tracer_flux_init use MOM_variables, only : surface @@ -600,7 +600,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda if (step_thermo) then ! Back up Time1 to the start of the thermodynamic segment. - Time1 = Time1 - real_to_time_type(dtdia - dt_dyn) + Time1 = Time1 - real_to_time(dtdia - dt_dyn) call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) @@ -608,7 +608,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda endif t_elapsed_seg = t_elapsed_seg + dt_dyn - Time1 = Time_seg_start + real_to_time_type(t_elapsed_seg) + Time1 = Time_seg_start + real_to_time(t_elapsed_seg) enddo endif diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index da0f77d935..4933f29182 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -48,8 +48,8 @@ program MOM_main use MOM_string_functions,only : uppercase use MOM_surface_forcing, only : set_forcing, forcing_save_restart use MOM_surface_forcing, only : surface_forcing_init, surface_forcing_CS - use MOM_time_manager, only : time_type, set_date, set_time, get_date - use MOM_time_manager, only : real_to_time_type, time_type_to_real + use MOM_time_manager, only : time_type, set_date, get_date + use MOM_time_manager, only : real_to_time, time_type_to_real use MOM_time_manager, only : operator(+), operator(-), operator(*), operator(/) use MOM_time_manager, only : operator(>), operator(<), operator(>=) use MOM_time_manager, only : increment_date, set_calendar_type, month_name @@ -291,7 +291,7 @@ program MOM_main Start_time = set_date(date_init(1),date_init(2), date_init(3), & date_init(4),date_init(5),date_init(6)) else - Start_time = set_time(0,days=0) + Start_time = real_to_time(0.0) endif call time_interp_external_init @@ -357,7 +357,7 @@ program MOM_main endif ntstep = MAX(1,ceiling(dt_forcing/dt - 0.001)) - Time_step_ocean = real_to_time_type(dt_forcing) + Time_step_ocean = real_to_time(dt_forcing) elapsed_time_master = (abs(dt_forcing - time_type_to_real(Time_step_ocean)) > 1.0e-12*dt_forcing) if (elapsed_time_master) & call MOM_mesg("Using real elapsed time for the master clock.", 2) @@ -416,7 +416,7 @@ program MOM_main call get_param(param_file, mod_name, "RESTINT", restint, & "The interval between saves of the restart file in units \n"//& "of TIMEUNIT. Use 0 (the default) to not save \n"//& - "incremental restart files at all.", default=set_time(0), & + "incremental restart files at all.", default=real_to_time(0.0), & timeunit=Time_unit) call get_param(param_file, mod_name, "WRITE_CPU_STEPS", cpu_steps, & "The number of coupled timesteps between writing the cpu \n"//& @@ -455,7 +455,7 @@ program MOM_main if (((.not.BTEST(Restart_control,1)) .and. (.not.BTEST(Restart_control,0))) & .or. (Restart_control < 0)) permit_incr_restart = .false. - if (restint > set_time(0)) then + if (restint > real_to_time(0.0)) then ! restart_time is the next integral multiple of restint. restart_time = Start_time + restint * & (1 + ((Time + Time_step_ocean) - Start_time) / restint) @@ -533,7 +533,7 @@ program MOM_main dtdia = dt_dyn*(n - n_last_thermo) ! Back up Time2 to the start of the thermodynamic segment. if (n > n_last_thermo+1) & - Time2 = Time2 - real_to_time_type(dtdia - dt_dyn) + Time2 = Time2 - real_to_time(dtdia - dt_dyn) call step_MOM(forces, fluxes, sfc_state, Time2, dtdia, MOM_CSp, & do_dynamics=.false., do_thermodynamics=.true., & start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_forcing) @@ -542,7 +542,7 @@ program MOM_main endif t_elapsed_seg = t_elapsed_seg + dt_dyn - Time2 = Time1 + real_to_time_type(t_elapsed_seg) + Time2 = Time1 + real_to_time(t_elapsed_seg) enddo endif @@ -555,12 +555,12 @@ program MOM_main ! does not lose resolution of order the timetype's resolution, provided that the timestep and ! tick are larger than 10-5 seconds. If a clock with a finer resolution is used, a smaller ! value would be required. - time_chg = real_to_time_type(elapsed_time) + time_chg = real_to_time(elapsed_time) segment_start_time = segment_start_time + time_chg elapsed_time = elapsed_time - time_type_to_real(time_chg) endif if (elapsed_time_master) then - Master_Time = segment_start_time + real_to_time_type(elapsed_time) + Master_Time = segment_start_time + real_to_time(elapsed_time) else Master_Time = Master_Time + Time_step_ocean endif From 9252394b1f5605b911b09de86fc065a8f5b47713 Mon Sep 17 00:00:00 2001 From: Raymond Menzel Date: Tue, 21 Aug 2018 14:31:20 -0400 Subject: [PATCH 036/174] Reordered loops to address a bug when compiled with -O3 using the intel compiler version 16.0.3.210 --- .../vertical/MOM_vert_friction.F90 | 55 ++++++++++--------- 1 file changed, 29 insertions(+), 26 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 88da20bb4d..c345818493 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -217,14 +217,15 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & Idt = 1.0 / dt !Check if Stokes mixing allowed if requested (present and associated) + DoStokesMixing=.false. if (CS%StokesMixing) then - DoStokesMixing=(present(Waves) .and. associated(Waves)) - if (.not.DoStokesMixing) then - call MOM_error(FATAL,"Stokes Mixing called without allocated"//& - "Waves Control Structure") + if (present(Waves)) then + DoStokesMixing = associated(Waves) + if (.not. DoStokesMixing) then + call MOM_error(FATAL,"Stokes Mixing called without allocated"//& + "Waves Control Structure") + endif endif - else - DoStokesMixing=.false. endif do k=1,nz ; do i=Isq,Ieq ; Ray(i,k) = 0.0 ; enddo ; enddo @@ -232,17 +233,17 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & ! Update the zonal velocity component using a modification of a standard ! tridagonal solver. - ! When mixing down Eulerian current + Stokes drift add before calling solver - if (DoStokesMixing) then ; do k=1,nz ; do j=G%jsc,G%jec ; do I=Isq,Ieq - if (G%mask2dCu(I,j) > 0) u(I,j,k) = u(I,j,k) + Waves%Us_x(I,j,k) - enddo ; enddo ; enddo ; endif - !$OMP parallel do default(shared) firstprivate(Ray) & !$OMP private(do_i,surface_stress,zDS,stress,h_a,hfr, & !$OMP b_denom_1,b1,d1,c1) do j=G%jsc,G%jec do I=Isq,Ieq ; do_i(I) = (G%mask2dCu(I,j) > 0) ; enddo + ! 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) + enddo ; enddo ; endif + if (associated(ADp%du_dt_visc)) then ; do k=1,nz ; do I=Isq,Ieq ADp%du_dt_visc(I,j,k) = u(I,j,k) enddo ; enddo ; endif @@ -330,19 +331,15 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & taux_bot(I,j) = taux_bot(I,j) + Rho0 * (Ray(I,k)*u(I,j,k)) enddo ; enddo ; endif endif - enddo ! end u-component j loop - ! When mixing down Eulerian current + Stokes drift subtract after calling solver - if (DoStokesMixing) then ; do k=1,nz ; do j=G%jsc,G%jec ; do I=Isq,Ieq - if (G%mask2dCu(I,j) > 0) u(I,j,k) = u(I,j,k) - Waves%Us_x(I,j,k) - enddo ; enddo ; enddo ; 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) + enddo ; enddo ; endif + + enddo ! end u-component j loop ! Now work on the meridional velocity component. - ! When mixing down Eulerian current + Stokes drift add before calling solver - if (DoStokesMixing) then ; do k=1,nz ; do j=Jsq,Jeq ; do I=Is,Ie - if (G%mask2dCv(I,j) > 0) & - v(i,j,k) = v(i,j,k) + Waves%Us_y(i,j,k) - enddo ; enddo ; enddo ; endif !$OMP parallel do default(shared) firstprivate(Ray) & !$OMP private(do_i,surface_stress,zDS,stress,h_a,hfr, & @@ -350,6 +347,11 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & do J=Jsq,Jeq do i=is,ie ; do_i(i) = (G%mask2dCv(i,J) > 0) ; enddo + ! 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) + enddo ; enddo ; endif + if (associated(ADp%dv_dt_visc)) then ; do k=1,nz ; do i=is,ie ADp%dv_dt_visc(i,J,k) = v(i,J,k) enddo ; enddo ; endif @@ -411,12 +413,13 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & tauy_bot(i,J) = tauy_bot(i,J) + Rho0 * (Ray(i,k)*v(i,J,k)) enddo ; enddo ; endif endif - enddo ! end of v-component J loop - ! When mixing down Eulerian current + Stokes drift subtract after calling solver - if (DoStokesMixing) then ; do k=1,nz ; do J=Jsq,Jeq ; do i=Is,Ie - if (G%mask2dCv(i,J) > 0) v(i,J,k) = v(i,J,k) - Waves%Us_y(i,J,k) - enddo ; enddo ; enddo ; 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) + enddo ; enddo ; endif + + enddo ! end of v-component J loop call vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, CS) From e3ea419953d49623653c7f277389aefc424742d6 Mon Sep 17 00:00:00 2001 From: Raymond Menzel Date: Tue, 21 Aug 2018 15:31:03 -0400 Subject: [PATCH 037/174] Fixed logic, made ifs one-liners. --- src/parameterizations/vertical/MOM_vert_friction.F90 | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index c345818493..6b5fcb3202 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -219,13 +219,10 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & !Check if Stokes mixing allowed if requested (present and associated) DoStokesMixing=.false. if (CS%StokesMixing) then - if (present(Waves)) then - DoStokesMixing = associated(Waves) - if (.not. DoStokesMixing) then - call MOM_error(FATAL,"Stokes Mixing called without allocated"//& - "Waves Control Structure") - endif - endif + if (present(Waves)) DoStokesMixing = associated(Waves) + if (.not. DoStokesMixing) & + call MOM_error(FATAL,"Stokes Mixing called without allocated"//& + "Waves Control Structure") endif do k=1,nz ; do i=Isq,Ieq ; Ray(i,k) = 0.0 ; enddo ; enddo From 24f3c3fb6986a66f48d69515adc22d892b3f1c8d Mon Sep 17 00:00:00 2001 From: Matthew Harrison Date: Tue, 21 Aug 2018 16:08:59 -0400 Subject: [PATCH 038/174] Added grid rotation angle to the list of available static diagnostics --- src/diagnostics/MOM_diagnostics.F90 | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index f200a15bed..2c1b92b896 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -1952,6 +1952,14 @@ subroutine write_static_fields(G, GV, tv, diag) 'Open zonal grid spacing at v points (meter)', 'm', interp_method='none') if (id > 0) call post_data(id, G%dx_Cv, diag, .true.) + id = register_static_field('ocean_model', 'sin_rot', diag%axesT1, & + 'sine of the clockwise angle of the ocean grid north to true north', 'radians') + if (id > 0) call post_data(id, G%sin_rot, diag, .true.) + + id = register_static_field('ocean_model', 'cos_rot', diag%axesT1, & + 'cosine of the clockwise angle of the ocean grid north to true north', 'radians') + if (id > 0) call post_data(id, G%cos_rot, diag, .true.) + ! This static diagnostic is from CF 1.8, and is the fraction of a cell ! covered by ocean, given as a percentage (poorly named). From e3923d3436c67fe8be30c742ce31a516ad6166c0 Mon Sep 17 00:00:00 2001 From: Matthew Harrison Date: Tue, 21 Aug 2018 16:55:02 -0400 Subject: [PATCH 039/174] correct units for sin/cos grid rotation --- src/diagnostics/MOM_diagnostics.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 2c1b92b896..8e18ed5a01 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -1953,11 +1953,11 @@ subroutine write_static_fields(G, GV, tv, diag) if (id > 0) call post_data(id, G%dx_Cv, diag, .true.) id = register_static_field('ocean_model', 'sin_rot', diag%axesT1, & - 'sine of the clockwise angle of the ocean grid north to true north', 'radians') + 'sine of the clockwise angle of the ocean grid north to true north', 'none') if (id > 0) call post_data(id, G%sin_rot, diag, .true.) id = register_static_field('ocean_model', 'cos_rot', diag%axesT1, & - 'cosine of the clockwise angle of the ocean grid north to true north', 'radians') + 'cosine of the clockwise angle of the ocean grid north to true north', 'none') if (id > 0) call post_data(id, G%cos_rot, diag, .true.) From 8da88521c841d6275e9463fe6b6869f8fe8a375f Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Wed, 22 Aug 2018 15:50:37 -0400 Subject: [PATCH 040/174] Fixes reading a scalar on restart when restart files are distributed - The mpp_domain is still needed for reading a scalar from a restart file because the io_layout describing the restart files is needed. --- src/framework/MOM_restart.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index 8d5819f945..4a1ad4878e 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -1102,7 +1102,7 @@ subroutine restore_state(filename, directory, day, G, CS) if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr1d(m)%p) elseif (associated(CS%var_ptr0d(m)%p)) then ! Read a scalar... call read_data(unit_path(n), varname, CS%var_ptr0d(m)%p, & - no_domain=.true., timelevel=1) + G%Domain%mpp_domain, timelevel=1) if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr0d(m)%p) elseif ((pos == 0) .and. associated(CS%var_ptr2d(m)%p)) then ! Read a non-decomposed 2d array. ! Probably should query the field type to make sure that the sizes are right. From f13dc1b251ebe65567cc3e8d876c68490b428c55 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Wed, 22 Aug 2018 16:54:05 -0400 Subject: [PATCH 041/174] Fixes an OOB when processing the restart filename variable - A combined conditional in a logical test can trigger an out-of-bounds index even though the logic is correct. This re-arrangement allows debug executables to get past the test. --- src/framework/MOM_restart.F90 | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index 8d5819f945..a773405897 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -1368,8 +1368,12 @@ function open_restart_units(filename, directory, G, CS, units, file_paths, & enddo fname = filename(start_char:m-1) start_char = m - do while ((start_char <= len_trim(filename)) .and. (filename(start_char:start_char) == ' ')) - start_char = start_char + 1 + do while (start_char <= len_trim(filename)) + if (filename(start_char:start_char) == ' ') then + start_char = start_char + 1 + else + exit + endif enddo if ((fname(1:1)=='r') .and. ( len_trim(fname) == 1)) then From 62f2e96b2d3d12db093bf4354c4fc225996d0de9 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 23 Aug 2018 17:56:59 -0400 Subject: [PATCH 042/174] +Eliminated use_io_layout from the MOM_domain_type Eliminated the logical element use_io_layout from the MOM_domain_type, as this variable is always true. As a result, several logical tests were simplified and an extensive block of code in restore_state that is never executed was eliminated, and the remaining portions were simplified. As a further result, there is no longer any MOM6 code calling read_field, so that interface (which is a simple pass-through wrapper for mpp_read) was eliminated. In addition, one misspelling and an incorrect parameter description were corrected in MOM_domains, which minorly changes entries in the MOM_parameter_doc.layout files. All answers are bitwise identical. --- src/framework/MOM_domains.F90 | 7 +- src/framework/MOM_io.F90 | 14 +- src/framework/MOM_restart.F90 | 154 +++++---------------- src/initialization/MOM_grid_initialize.F90 | 4 +- 4 files changed, 43 insertions(+), 136 deletions(-) diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index 103b328aa1..a38facf79a 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -118,7 +118,6 @@ module MOM_domains !! domain in the i-direction in a define_domain call. integer :: Y_FLAGS !< Flag that specifies the properties of the !! domain in the j-direction in a define_domain call. - logical :: use_io_layout !< True if an I/O layout is available. logical, pointer :: maskmap(:,:) => NULL() !< A pointer to an array indicating !! which logical processors are actually used for !! the ocean code. The other logical processors @@ -1401,11 +1400,11 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & "STATIC_MEMORY_ this is set in "//trim(inc_nm)//" at compile time.",& layoutParam=.true.) call log_param(param_file, mdl, trim(njproc_nm), layout(2), & - "The number of processors in the x-direction. With \n"//& !### FIX THIS COMMENT + "The number of processors in the y-direction. With \n"//& "STATIC_MEMORY_ this is set in "//trim(inc_nm)//" at compile time.",& layoutParam=.true.) call log_param(param_file, mdl, trim(layout_nm), layout, & - "The processor layout that was acutally used.",& + "The processor layout that was actually used.",& layoutParam=.true.) ! Idiot check that fewer PEs than columns have been requested @@ -1490,7 +1489,6 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & MOM_dom%Y_FLAGS = Y_FLAGS MOM_dom%layout = layout MOM_dom%io_layout = io_layout - MOM_dom%use_io_layout = (io_layout(1) + io_layout(2) > 0) if (is_static) then ! A requirement of equal sized compute domains is necessary when STATIC_MEMORY_ @@ -1554,7 +1552,6 @@ subroutine clone_MD_to_MD(MD_in, MOM_dom, min_halo, halo_size, symmetric, & MOM_dom%X_FLAGS = MD_in%X_FLAGS ; MOM_dom%Y_FLAGS = MD_in%Y_FLAGS MOM_dom%layout(:) = MD_in%layout(:) ; MOM_dom%io_layout(:) = MD_in%io_layout(:) - MOM_dom%use_io_layout = (MOM_dom%io_layout(1) + MOM_dom%io_layout(2) > 0) if (associated(MD_in%maskmap)) then mask_table_exists = .true. diff --git a/src/framework/MOM_io.F90 b/src/framework/MOM_io.F90 index 21d42ea436..e523270802 100644 --- a/src/framework/MOM_io.F90 +++ b/src/framework/MOM_io.F90 @@ -30,7 +30,7 @@ module MOM_io use mpp_io_mod, only : MPP_APPEND, MPP_MULTI, MPP_OVERWR, MPP_NETCDF, MPP_RDONLY use mpp_io_mod, only : get_file_info=>mpp_get_info, get_file_atts=>mpp_get_atts use mpp_io_mod, only : get_file_fields=>mpp_get_fields, get_file_times=>mpp_get_times -use mpp_io_mod, only : read_field=>mpp_read, io_infra_init=>mpp_io_init +use mpp_io_mod, only : io_infra_init=>mpp_io_init use netcdf @@ -38,7 +38,7 @@ module MOM_io public :: close_file, create_file, field_exists, field_size, fieldtype, get_filename_appendix public :: file_exists, flush_file, get_file_info, get_file_atts, get_file_fields -public :: get_file_times, open_file, read_axis_data, read_data, read_field +public :: get_file_times, open_file, read_axis_data, read_data public :: num_timelevels, MOM_read_data, MOM_read_vector, ensembler public :: reopen_file, slasher, write_field, write_version_number, MOM_io_init public :: open_namelist_file, check_nml_error, io_infra_init, io_infra_end @@ -154,9 +154,7 @@ subroutine create_file(unit, filename, vars, novars, fields, threading, timeunit endif one_file = .true. - if (domain_set) then - one_file = ((thread == SINGLE_FILE) .or. .not.Domain%use_io_layout) - endif + if (domain_set) one_file = (thread == SINGLE_FILE) if (one_file) then call open_file(unit, filename, MPP_OVERWR, MPP_NETCDF, threading=thread) @@ -398,9 +396,7 @@ subroutine reopen_file(unit, filename, vars, novars, fields, threading, timeunit endif one_file = .true. - if (domain_set) then - one_file = ((thread == SINGLE_FILE) .or. .not.Domain%use_io_layout) - endif + if (domain_set) one_file = (thread == SINGLE_FILE) if (one_file) then call open_file(unit, filename, MPP_APPEND, MPP_NETCDF, threading=thread) @@ -1012,7 +1008,7 @@ end subroutine MOM_io_init !! !! * write_field: write a field to an open file. !! * write_time: write a value of the time axis to an open file. -!! * read_field: read a field from an open file. +!! * read_data: read a variable from an open file. !! * read_time: read a time from an open file. !! !! * name_output_file: provide a name for an output file based on a diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index efa03ab8a8..a98f815bc9 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -9,7 +9,7 @@ module MOM_restart use MOM_string_functions, only : lowercase use MOM_grid, only : ocean_grid_type use MOM_io, only : create_file, fieldtype, file_exists, open_file, close_file -use MOM_io, only : read_field, write_field, MOM_read_data, read_data, get_filename_appendix +use MOM_io, only : write_field, MOM_read_data, read_data, get_filename_appendix use MOM_io, only : get_file_info, get_file_atts, get_file_fields, get_file_times use MOM_io, only : vardesc, var_desc, query_vardesc, modify_vardesc use MOM_io, only : MULTIPLE, NETCDF_FILE, READONLY_FILE, SINGLE_FILE @@ -1093,117 +1093,46 @@ subroutine restore_state(filename, directory, day, G, CS) call mpp_get_atts(fields(i),checksum=checksum_file) is_there_a_checksum = .true. endif - if (.NOT. CS%checksum_required ) is_there_a_checksum = .false. ! Do not need to do data checksumming. + if (.NOT. CS%checksum_required) is_there_a_checksum = .false. ! Do not need to do data checksumming. if (associated(CS%var_ptr1d(m)%p)) then ! Read a 1d array, which should be invariant to domain decomposition. call read_data(unit_path(n), varname, CS%var_ptr1d(m)%p, & - no_domain=.true., timelevel=1) - if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr1d(m)%p) + G%Domain%mpp_domain, timelevel=1) + if (is_there_a_checksum) checksum_data = mpp_chksum(CS%var_ptr1d(m)%p) elseif (associated(CS%var_ptr0d(m)%p)) then ! Read a scalar... call read_data(unit_path(n), varname, CS%var_ptr0d(m)%p, & G%Domain%mpp_domain, timelevel=1) - if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr0d(m)%p) - elseif ((pos == 0) .and. associated(CS%var_ptr2d(m)%p)) then ! Read a non-decomposed 2d array. - ! Probably should query the field type to make sure that the sizes are right. - call read_data(unit_path(n), varname, CS%var_ptr2d(m)%p, & - no_domain=.true., timelevel=1) - if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr2d(m)%p(isL:ieL,jsL:jeL)) - elseif ((pos == 0) .and. associated(CS%var_ptr3d(m)%p)) then ! Read a non-decomposed 3d array. - ! Probably should query the field type to make sure that the sizes are right. - call read_data(unit_path(n), varname, CS%var_ptr3d(m)%p, & - no_domain=.true., timelevel=1) - if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr3d(m)%p(isL:ieL,jsL:jeL,:)) - elseif ((pos == 0) .and. associated(CS%var_ptr4d(m)%p)) then ! Read a non-decomposed 4d array. - ! Probably should query the field type to make sure that the sizes are right. - call read_data(unit_path(n), varname, CS%var_ptr4d(m)%p, & - no_domain=.true., timelevel=1) - if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr4d(m)%p(isL:ieL,jsL:jeL,:,:)) - elseif (unit_is_global(n) .or. G%Domain%use_io_layout) then - if (associated(CS%var_ptr3d(m)%p)) then - ! Read 3d array... Time level 1 is always used. - call MOM_read_data(unit_path(n), varname, CS%var_ptr3d(m)%p, & - G%Domain, 1, position=pos) - if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr3d(m)%p(isL:ieL,jsL:jeL,:)) - elseif (associated(CS%var_ptr2d(m)%p)) then ! Read 2d array... + if (is_there_a_checksum) checksum_data = mpp_chksum(CS%var_ptr0d(m)%p) + elseif (associated(CS%var_ptr2d(m)%p)) then ! Read a 2d array. + if (pos /= 0) then call MOM_read_data(unit_path(n), varname, CS%var_ptr2d(m)%p, & - G%Domain, 1, position=pos) - if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr2d(m)%p(isL:ieL,jsL:jeL)) - elseif (associated(CS%var_ptr4d(m)%p)) then ! Read 4d array... - call MOM_read_data(unit_path(n), varname, CS%var_ptr4d(m)%p, & - G%Domain, 1, position=pos) - if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr4d(m)%p(isL:ieL,jsL:jeL,:,:)) - else - call MOM_error(FATAL, "MOM_restart restore_state: "//& - "No pointers set for "//trim(varname)) - endif - else ! Do not use an io_layout. !### GET RID OF THIS BRANCH ONCE read_data_4d_new IS AVAILABLE. - ! This file is decomposed onto the current processors. We need - ! to check whether the sizes look right, and abort if not. - call get_file_atts(fields(i),ndim=ndim,siz=sizes) - - ! NOTE: The index ranges f var_ptrs always start with 1, so with - ! symmetric memory the staggering is swapped from NE to SW! - is0 = 1-G%isd - if ((pos == EAST_FACE) .or. (pos == CORNER)) is0 = 1-G%IsdB - if (sizes(1) == G%iec-G%isc+1) then - isL = G%isc+is0 ; ieL = G%iec+is0 - elseif (sizes(1) == G%IecB-G%IscB+1) then - isL = G%IscB+is0 ; ieL = G%IecB+is0 - elseif (((pos == EAST_FACE) .or. (pos == CORNER)) .and. & - (G%IscB == G%isc) .and. (sizes(1) == G%iec-G%isc+2)) then - ! This is reading a symmetric file in a non-symmetric model. - isL = G%isc-1+is0 ; ieL = G%iec+is0 - else - call MOM_error(WARNING, "MOM_restart restore_state, "//trim(varname)//& - " has the wrong i-size in "//trim(unit_path(n))) - exit + G%Domain, timelevel=1, position=pos) + else ! This array is not domain-decomposed. This variant may be under-tested. + call read_data(unit_path(n), varname, CS%var_ptr2d(m)%p, & + no_domain=.true., timelevel=1) endif - - js0 = 1-G%jsd - if ((pos == NORTH_FACE) .or. (pos == CORNER)) js0 = 1-G%JsdB - if (sizes(2) == G%jec-G%jsc+1) then - jsL = G%jsc+js0 ; jeL = G%jec+js0 - elseif (sizes(2) == G%jecB-G%jscB+1) then - jsL = G%jscB+js0 ; jeL = G%jecB+js0 - elseif (((pos == NORTH_FACE) .or. (pos == CORNER)) .and. & - (G%JscB == G%jsc) .and. (sizes(2) == G%jec-G%jsc+2)) then - ! This is reading a symmetric file in a non-symmetric model. - jsL = G%jsc-1+js0 ; jeL = G%jec+js0 - else - call MOM_error(WARNING, "MOM_restart restore_state, "//trim(varname)//& - " has the wrong j-size in "//trim(unit_path(n))) - exit + if (is_there_a_checksum) checksum_data = mpp_chksum(CS%var_ptr2d(m)%p(isL:ieL,jsL:jeL)) + elseif (associated(CS%var_ptr3d(m)%p)) then ! Read a 3d array. + if (pos /= 0) then + call MOM_read_data(unit_path(n), varname, CS%var_ptr3d(m)%p, & + G%Domain, timelevel=1, position=pos) + else ! This array is not domain-decomposed. This variant may be under-tested. + call read_data(unit_path(n), varname, CS%var_ptr3d(m)%p, & + no_domain=.true., timelevel=1) endif - - if (associated(CS%var_ptr3d(m)%p)) then - if (ntime == 0) then - call read_field(unit(n), fields(i), & - CS%var_ptr3d(m)%p(isL:ieL,jsL:jeL,:)) - else - call read_field(unit(n), fields(i), & - CS%var_ptr3d(m)%p(isL:ieL,jsL:jeL,:), 1) - endif - elseif (associated(CS%var_ptr2d(m)%p)) then - if (ntime == 0) then - call read_field(unit(n), fields(i), & - CS%var_ptr2d(m)%p(isL:ieL,jsL:jeL)) - else - call read_field(unit(n), fields(i), & - CS%var_ptr2d(m)%p(isL:ieL,jsL:jeL), 1) - endif - elseif (associated(CS%var_ptr4d(m)%p)) then - if (ntime == 0) then - call read_field(unit(n), fields(i), & - CS%var_ptr4d(m)%p(isL:ieL,jsL:jeL,:,:)) - else - call read_field(unit(n), fields(i), & - CS%var_ptr4d(m)%p(isL:ieL,jsL:jeL,:,:), 1) - endif - else - call MOM_error(FATAL, "MOM_restart restore_state: "//& - "No pointers set for "//trim(varname)) + if (is_there_a_checksum) checksum_data = mpp_chksum(CS%var_ptr3d(m)%p(isL:ieL,jsL:jeL,:)) + elseif (associated(CS%var_ptr4d(m)%p)) then ! Read a 4d array. + if (pos /= 0) then + call MOM_read_data(unit_path(n), varname, CS%var_ptr4d(m)%p, & + G%Domain, timelevel=1, position=pos) + else ! This array is not domain-decomposed. This variant may be under-tested. + call read_data(unit_path(n), varname, CS%var_ptr4d(m)%p, & + no_domain=.true., timelevel=1) endif + if (is_there_a_checksum) checksum_data = mpp_chksum(CS%var_ptr4d(m)%p(isL:ieL,jsL:jeL,:,:)) + else + call MOM_error(FATAL, "MOM_restart restore_state: No pointers set for "//trim(varname)) endif if (is_root_pe() .and. is_there_a_checksum .and. (checksum_file(1) /= checksum_data)) then @@ -1412,24 +1341,11 @@ function open_restart_units(filename, directory, G, CS, units, file_paths, & threading = MULTIPLE, fileset = SINGLE_FILE) if (present(global_files)) global_files(n) = .true. elseif (CS%parallel_restartfiles) then - if (G%Domain%use_io_layout) then - ! Look for decomposed files using the I/O Layout. - fexists = file_exists(filepath, G%Domain) - if (fexists .and. (present(units))) & - call open_file(units(n), trim(filepath), READONLY_FILE, NETCDF_FILE, & - domain=G%Domain%mpp_domain) - else - ! Look for any PE-specific files of the form NAME.nc.####. - if (num_PEs()>10000) then - write(filepath, '(a,i6.6)' ) trim(filepath)//'.', pe_here() - else - write(filepath, '(a,i4.4)' ) trim(filepath)//'.', pe_here() - endif - inquire(file=filepath, exist=fexists) - if (fexists .and. (present(units))) & - call open_file(units(n), trim(filepath), READONLY_FILE, NETCDF_FILE, & - threading = MULTIPLE, fileset = SINGLE_FILE) - endif + ! Look for decomposed files using the I/O Layout. + fexists = file_exists(filepath, G%Domain) + if (fexists .and. (present(units))) & + call open_file(units(n), trim(filepath), READONLY_FILE, NETCDF_FILE, & + domain=G%Domain%mpp_domain) if (fexists .and. present(global_files)) global_files(n) = .false. endif diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index be82ffc33f..9f7c5dcc28 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -220,7 +220,6 @@ subroutine set_grid_metrics_from_mosaic(G, param_file) SGdom%niglobal = 2*G%domain%niglobal SGdom%njglobal = 2*G%domain%njglobal SGdom%layout(:) = G%domain%layout(:) - SGdom%use_io_layout = G%domain%use_io_layout SGdom%io_layout(:) = G%domain%io_layout(:) global_indices(1) = 1+SGdom%nihalo global_indices(2) = SGdom%niglobal+SGdom%nihalo @@ -241,8 +240,7 @@ subroutine set_grid_metrics_from_mosaic(G, param_file) symmetry=.true., name="MOM_MOSAIC") endif - if (SGdom%use_io_layout) & - call MOM_define_IO_domain(SGdom%mpp_domain, SGdom%io_layout) + call MOM_define_IO_domain(SGdom%mpp_domain, SGdom%io_layout) deallocate(exni) deallocate(exnj) From fd733157c0591fd6c21b08cf68bae1cedc42e826 Mon Sep 17 00:00:00 2001 From: Niki Zadeh Date: Fri, 24 Aug 2018 10:21:50 -0400 Subject: [PATCH 043/174] Fix scalar restart variable checksums - For scalar variables mpp_chksum has to be called with passing the pelist argument equal to the current pe, otherwise checksums will not agree on different pes - This fixes the symptom of checksum mismatch for scalar var BTDT for different layouts. --- src/framework/MOM_restart.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index efa03ab8a8..cae8001032 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -17,7 +17,7 @@ module MOM_restart use MOM_time_manager, only : time_type, time_type_to_real, real_to_time use MOM_time_manager, only : days_in_month, get_date, set_date use MOM_verticalGrid, only : verticalGrid_type -use mpp_mod, only: mpp_chksum +use mpp_mod, only: mpp_chksum,mpp_pe use mpp_io_mod, only: mpp_attribute_exist, mpp_get_atts implicit none ; private @@ -917,7 +917,7 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV) elseif (associated(CS%var_ptr1d(m)%p)) then check_val(m-start_var+1,1) = mpp_chksum(CS%var_ptr1d(m)%p) elseif (associated(CS%var_ptr0d(m)%p)) then - check_val(m-start_var+1,1) = mpp_chksum(CS%var_ptr0d(m)%p) + check_val(m-start_var+1,1) = mpp_chksum(CS%var_ptr0d(m)%p,pelist=(/mpp_pe()/)) endif enddo @@ -1103,7 +1103,7 @@ subroutine restore_state(filename, directory, day, G, CS) elseif (associated(CS%var_ptr0d(m)%p)) then ! Read a scalar... call read_data(unit_path(n), varname, CS%var_ptr0d(m)%p, & G%Domain%mpp_domain, timelevel=1) - if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr0d(m)%p) + if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr0d(m)%p,pelist=(/mpp_pe()/)) elseif ((pos == 0) .and. associated(CS%var_ptr2d(m)%p)) then ! Read a non-decomposed 2d array. ! Probably should query the field type to make sure that the sizes are right. call read_data(unit_path(n), varname, CS%var_ptr2d(m)%p, & From 0dac02a3e5310cbc35b48393f37075e0ec6325b5 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 24 Aug 2018 12:04:33 -0400 Subject: [PATCH 044/174] Shortened excessively long comment lines Split comments on lines exceeding 120 characters in length. All answers are bitwise identical. --- src/initialization/midas_vertmap.F90 | 23 ++++++++++++----------- 1 file changed, 12 insertions(+), 11 deletions(-) diff --git a/src/initialization/midas_vertmap.F90 b/src/initialization/midas_vertmap.F90 index 95c7b9fa3f..4da55554d3 100644 --- a/src/initialization/midas_vertmap.F90 +++ b/src/initialization/midas_vertmap.F90 @@ -71,7 +71,8 @@ end function wright_eos_2d function alpha_wright_eos_2d(T,S,p) result(drho_dT) real(kind=8), dimension(:,:), intent(in) :: T,S !< temperature (degC) and Salinity (psu) real, intent(in) :: p !< pressure (Pa) - real(kind=8), dimension(size(T,1),size(T,2)) :: drho_dT !< partial derivative of density with respect to temperature (kg m-3 C-1) + real(kind=8), dimension(size(T,1),size(T,2)) :: drho_dT !< partial derivative of density with + !! respect to temperature (kg m-3 C-1) ! Local variables real(kind=8) :: a0,a1,a2,b0,b1,b2,b3,b4,b5,c0,c1,c2,c3,c4,c5 real(kind=8) :: al0,lam,p0,I_denom,I_denom2 @@ -110,7 +111,8 @@ end function alpha_wright_eos_2d function beta_wright_eos_2d(T,S,p) result(drho_dS) real(kind=8), dimension(:,:), intent(in) :: T,S !< temperature (degC) and salinity (psu) real, intent(in) :: p !< pressure (Pa) - real(kind=8), dimension(size(T,1),size(T,2)) :: drho_dS !< partial derivative of density with respect to salinity (kg m-3 PSU-1) + real(kind=8), dimension(size(T,1),size(T,2)) :: drho_dS !< partial derivative of density with + !! respect to salinity (kg m-3 PSU-1) ! Local variables real(kind=8) :: a0,a1,a2,b0,b1,b2,b3,b4,b5,c0,c1,c2,c3,c4,c5 real(kind=8) :: al0,lam,p0,I_denom,I_denom2 @@ -150,7 +152,8 @@ function tracer_z_init(tr_in,z_edges,e,nkml,nkbl,land_fill,wet,nlay,nlevs,debug, integer, intent(in) :: nkbl !< The number of buffer layers real, intent(in) :: land_fill !< fill in data over land (1) real, dimension(size(tr_in,1),size(tr_in,2)), intent(in) :: wet !< The wet mask for the source data (valid points) - real, dimension(size(tr_in,1),size(tr_in,2)), optional, intent(in) ::nlevs !< The number of input levels with valid data + real, dimension(size(tr_in,1),size(tr_in,2)), & + optional, intent(in) :: nlevs !< The number of input levels with valid data logical, optional, intent(in) :: debug !< optional debug flag integer, optional, intent(in) :: i_debug !< i-index of point for debugging integer, optional, intent(in) :: j_debug !< j-index of point for debugging @@ -283,14 +286,12 @@ function tracer_z_init(tr_in,z_edges,e,nkml,nkbl,land_fill,wet,nlay,nlevs,debug, ! For the piecewise parabolic form add the following... ! + C1_3*cur_tr*(z2(kz)**2 + z2(kz)*z1(kz) + z1(kz)**2)) - if (debug_) then - if (PRESENT(i_debug)) then - if (i == i_debug.and.j == j_debug) then - print *,'0004 k,kz,nlevs,sl_tr,tr = ',k,kz,nlevs_data(i,j),sl_tr,tr(i,j,k) - print *,'0005 k,kz,tr(kz),tr(kz-1),tr(kz+1) = ',k,kz,tr_1d(kz),tr_1d(kz-1),tr_1d(kz+1),z_edges(kz+2) - endif - endif - endif + if (debug_) then ; if (PRESENT(i_debug)) then + if (i == i_debug.and.j == j_debug) then + print *,'0004 k,kz,nlevs,sl_tr,tr = ',k,kz,nlevs_data(i,j),sl_tr,tr(i,j,k) + print *,'0005 k,kz,tr(kz),tr(kz-1),tr(kz+1) = ',k,kz,tr_1d(kz),tr_1d(kz-1),tr_1d(kz+1),z_edges(kz+2) + endif + endif ; endif endif k_bot_prev = k_bot From a12d07791ddb4d47314ef853fed496fd83bdb09e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 24 Aug 2018 12:05:34 -0400 Subject: [PATCH 045/174] +Renamed GV%Angstrom to GV%Angstrom_H Renamed two elements of the vertical grid type, Angstrom and Angstrom_z, to Angstrom_H and Angstrom_m, for greater clarity and in preparation for adding an additional Angstrom element for then new vertical distance units. All answers are bitwise identical, although names of elements in a transparent type have changed. --- src/core/MOM.F90 | 2 +- src/core/MOM_CoriolisAdv.F90 | 2 +- src/core/MOM_barotropic.F90 | 2 +- src/core/MOM_continuity_PPM.F90 | 8 ++-- src/core/MOM_dynamics_split_RK2.F90 | 2 +- src/core/MOM_forcing_type.F90 | 2 +- src/core/MOM_verticalGrid.F90 | 12 ++--- src/diagnostics/MOM_PointAccel.F90 | 4 +- src/diagnostics/MOM_diag_to_Z.F90 | 2 +- .../MOM_state_initialization.F90 | 46 +++++++++---------- .../lateral/MOM_lateral_mixing_coeffs.F90 | 6 +-- .../lateral/MOM_mixed_layer_restrat.F90 | 4 +- .../lateral/MOM_thickness_diffuse.F90 | 6 +-- .../vertical/MOM_bulk_mixed_layer.F90 | 14 +++--- .../vertical/MOM_diabatic_aux.F90 | 8 ++-- .../vertical/MOM_diabatic_driver.F90 | 14 +++--- .../vertical/MOM_energetic_PBL.F90 | 2 +- .../vertical/MOM_entrain_diffusive.F90 | 30 ++++++------ .../vertical/MOM_geothermal.F90 | 13 +++--- .../vertical/MOM_opacity.F90 | 4 +- .../vertical/MOM_regularize_layers.F90 | 18 ++++---- .../vertical/MOM_set_diffusivity.F90 | 16 +++---- .../vertical/MOM_set_viscosity.F90 | 22 ++++----- .../vertical/MOM_shortwave_abs.F90 | 4 +- src/parameterizations/vertical/MOM_sponge.F90 | 14 +++--- .../vertical/MOM_vert_friction.F90 | 2 +- src/tracer/DOME_tracer.F90 | 2 +- src/tracer/MOM_generic_tracer.F90 | 2 +- src/tracer/MOM_offline_aux.F90 | 14 +++--- src/tracer/MOM_offline_main.F90 | 6 +-- src/tracer/MOM_tracer_advect.F90 | 4 +- src/tracer/MOM_tracer_hor_diff.F90 | 2 +- src/user/BFB_initialization.F90 | 4 +- src/user/DOME2d_initialization.F90 | 26 +++++------ src/user/DOME_initialization.F90 | 12 ++--- src/user/ISOMIP_initialization.F90 | 12 ++--- src/user/Neverland_initialization.F90 | 2 +- src/user/Phillips_initialization.F90 | 6 +-- src/user/benchmark_initialization.F90 | 10 ++-- src/user/circle_obcs_initialization.F90 | 6 +-- src/user/dense_water_initialization.F90 | 6 +-- src/user/dumbbell_initialization.F90 | 8 ++-- src/user/lock_exchange_initialization.F90 | 4 +- src/user/seamount_initialization.F90 | 8 ++-- src/user/sloshing_initialization.F90 | 4 +- 45 files changed, 199 insertions(+), 198 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 54b5197ad9..3d869f6681 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1966,7 +1966,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & IsdB = dG%IsdB ; IedB = dG%IedB ; JsdB = dG%JsdB ; JedB = dG%JedB ALLOC_(CS%u(IsdB:IedB,jsd:jed,nz)) ; CS%u(:,:,:) = 0.0 ALLOC_(CS%v(isd:ied,JsdB:JedB,nz)) ; CS%v(:,:,:) = 0.0 - ALLOC_(CS%h(isd:ied,jsd:jed,nz)) ; CS%h(:,:,:) = GV%Angstrom + ALLOC_(CS%h(isd:ied,jsd:jed,nz)) ; CS%h(:,:,:) = GV%Angstrom_H ALLOC_(CS%uh(IsdB:IedB,jsd:jed,nz)) ; CS%uh(:,:,:) = 0.0 ALLOC_(CS%vh(isd:ied,JsdB:JedB,nz)) ; CS%vh(:,:,:) = 0.0 if (use_temperature) then diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 7bff7a68b7..948901ac63 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -222,7 +222,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, 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 - h_tiny = GV%Angstrom ! Perhaps this should be set to h_neglect instead. + 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) do j=Jsq-1,Jeq+2 ; do I=Isq-1,Ieq+2 diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 674f6f1bff..68ef858090 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -4056,7 +4056,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & ! IareaT, IdxCu, and IdyCv need to be allocated with wide halos. ALLOC_(CS%IareaT(CS%isdw:CS%iedw,CS%jsdw:CS%jedw)) ; CS%IareaT(:,:) = 0.0 - ALLOC_(CS%bathyT(CS%isdw:CS%iedw,CS%jsdw:CS%jedw)) ; CS%bathyT(:,:) = GV%Angstrom_z !### Change to 0.0? + ALLOC_(CS%bathyT(CS%isdw:CS%iedw,CS%jsdw:CS%jedw)) ; CS%bathyT(:,:) = GV%Angstrom_m !### Change to 0.0? ALLOC_(CS%IdxCu(CS%isdw-1:CS%iedw,CS%jsdw:CS%jedw)) ; CS%IdxCu(:,:) = 0.0 ALLOC_(CS%IdyCv(CS%isdw:CS%iedw,CS%jsdw-1:CS%jedw)) ; CS%IdyCv(:,:) = 0.0 ALLOC_(CS%dy_Cu(CS%isdw-1:CS%iedw,CS%jsdw:CS%jedw)) ; CS%dy_Cu(:,:) = 0.0 diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 131ecfbe13..faa5ec79e2 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -144,7 +144,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, logical :: x_first is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - h_min = GV%Angstrom + h_min = GV%Angstrom_H if (.not.associated(CS)) call MOM_error(FATAL, & "MOM_continuity_PPM: Module must be initialized before it is used.") @@ -312,7 +312,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & enddo ; enddo else call PPM_reconstruction_x(h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), G, LB, & - 2.0*GV%Angstrom, CS%monotonic, simple_2nd=CS%simple_2nd, OBC=OBC) + 2.0*GV%Angstrom_H, CS%monotonic, simple_2nd=CS%simple_2nd, OBC=OBC) endif do I=ish-1,ieh ; visc_rem(I,k) = 1.0 ; enddo enddo @@ -1129,7 +1129,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & enddo ; enddo else call PPM_reconstruction_y(h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), G, LB, & - 2.0*GV%Angstrom, CS%monotonic, simple_2nd=CS%simple_2nd, OBC=OBC) + 2.0*GV%Angstrom_H, CS%monotonic, simple_2nd=CS%simple_2nd, OBC=OBC) endif do i=ish,ieh ; visc_rem(i,k) = 1.0 ; enddo enddo @@ -2255,7 +2255,7 @@ subroutine continuity_PPM_init(Time, G, GV, param_file, diag, CS) "tolerance for SSH is 4 times this value. The default \n"//& "is 0.5*NK*ANGSTROM, and this should not be set less x\n"//& "than about 10^-15*MAXIMUM_DEPTH.", units="m", & - default=0.5*G%ke*GV%Angstrom_z) + default=0.5*G%ke*GV%Angstrom_m) call get_param(param_file, mdl, "ETA_TOLERANCE_AUX", CS%tol_eta_aux, & "The tolerance for free-surface height discrepancies \n"//& diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 0f4bd88111..cf248f5103 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -909,7 +909,7 @@ subroutine register_restarts_dyn_split_RK2(HI, GV, param_file, CS, restart_CS, u ALLOC_(CS%eta(isd:ied,jsd:jed)) ; CS%eta(:,:) = 0.0 ALLOC_(CS%u_av(IsdB:IedB,jsd:jed,nz)) ; CS%u_av(:,:,:) = 0.0 ALLOC_(CS%v_av(isd:ied,JsdB:JedB,nz)) ; CS%v_av(:,:,:) = 0.0 - ALLOC_(CS%h_av(isd:ied,jsd:jed,nz)) ; CS%h_av(:,:,:) = GV%Angstrom + ALLOC_(CS%h_av(isd:ied,jsd:jed,nz)) ; CS%h_av(:,:,:) = GV%Angstrom_H thickness_units = get_thickness_units(GV) flux_units = get_flux_units(GV) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 9ac616dac0..443ae86cd7 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -856,7 +856,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, fluxes, optics, h, Temp, Salt, tv, j, useRiverHeatContent = .False. useCalvingHeatContent = .False. - depthBeforeScalingFluxes = max( GV%Angstrom, 1.e-30*GV%m_to_H ) + depthBeforeScalingFluxes = max( GV%Angstrom_H, 1.e-30*GV%m_to_H ) pressure(:) = 0. ! Ignore atmospheric pressure GoRho = GV%g_Earth / GV%Rho0 start = 1 + G%isc - G%isd diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index 4eb972148b..e66c137d88 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -34,8 +34,8 @@ module MOM_verticalGrid ! The following variables give information about the vertical grid. logical :: Boussinesq !< If true, make the Boussinesq approximation. - real :: Angstrom !< A one-Angstrom thickness in the model thickness units. - real :: Angstrom_z !< A one-Angstrom thickness in m. + real :: Angstrom_H !< A one-Angstrom thickness in the model thickness units. + real :: Angstrom_m !< A one-Angstrom thickness in m. real :: H_subroundoff !< A thickness that is so small that it can be added to a thickness of !! Angstrom or larger without changing it at the bit level, in thickness units. !! If Angstrom is 0 or exceedingly small, this is negligible compared to 1e-17 m. @@ -87,7 +87,7 @@ subroutine verticalGridInit( param_file, GV ) units="kg m-3", default=1035.0) call get_param(param_file, mdl, "BOUSSINESQ", GV%Boussinesq, & "If true, make the Boussinesq approximation.", default=.true.) - call get_param(param_file, mdl, "ANGSTROM", GV%Angstrom_z, & + call get_param(param_file, mdl, "ANGSTROM", GV%Angstrom_m, & "The minumum layer thickness, usually one-Angstrom.", & units="m", default=1.0e-10) call get_param(param_file, mdl, "H_RESCALE_POWER", H_power, & @@ -128,14 +128,14 @@ subroutine verticalGridInit( param_file, GV ) GV%H_to_kg_m2 = GV%Rho0 * GV%H_to_m GV%kg_m2_to_H = 1.0 / GV%H_to_kg_m2 GV%m_to_H = 1.0 / GV%H_to_m - GV%Angstrom = GV%m_to_H * GV%Angstrom_z + GV%Angstrom_H = GV%m_to_H * GV%Angstrom_m else GV%kg_m2_to_H = 1.0 / GV%H_to_kg_m2 GV%m_to_H = GV%Rho0 * GV%kg_m2_to_H GV%H_to_m = GV%H_to_kg_m2 / GV%Rho0 - GV%Angstrom = GV%Angstrom_z*1000.0*GV%kg_m2_to_H + GV%Angstrom_H = GV%Angstrom_m*1000.0*GV%kg_m2_to_H endif - GV%H_subroundoff = 1e-20 * max(GV%Angstrom,GV%m_to_H*1e-17) + GV%H_subroundoff = 1e-20 * max(GV%Angstrom_H,GV%m_to_H*1e-17) GV%H_to_Pa = GV%g_Earth * GV%H_to_kg_m2 ! Log derivative values. diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index 6f93c7b0f0..639e52a8b7 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -102,7 +102,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a logical :: prev_avail integer :: file - Angstrom = GV%Angstrom + GV%H_subroundoff + Angstrom = GV%Angstrom_H + GV%H_subroundoff ! if (.not.associated(CS)) return nz = G%ke @@ -430,7 +430,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a logical :: prev_avail integer :: file - Angstrom = GV%Angstrom + GV%H_subroundoff + Angstrom = GV%Angstrom_H + GV%H_subroundoff ! if (.not.associated(CS)) return nz = G%ke diff --git a/src/diagnostics/MOM_diag_to_Z.F90 b/src/diagnostics/MOM_diag_to_Z.F90 index 77e49442af..cc272049d6 100644 --- a/src/diagnostics/MOM_diag_to_Z.F90 +++ b/src/diagnostics/MOM_diag_to_Z.F90 @@ -190,7 +190,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS) Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB IsgB = G%IsgB ; IegB = G%IegB ; JsgB = G%JsgB ; JegB = G%JegB nkml = max(GV%nkml, 1) - Angstrom = GV%Angstrom + Angstrom = GV%Angstrom_H ssh(:,:) = ssh_in linear_velocity_profiles = .true. ! Update the halos diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 57820accc0..c612970361 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -660,9 +660,9 @@ subroutine initialize_thickness_from_file(h, G, GV, param_file, file_has_thickne call adjustEtaToFitBathymetry(G, GV, eta, h) else do k=nz,1,-1 ; do j=js,je ; do i=is,ie - if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_z)) then - eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom + if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_m)) then + eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_m + h(i,j,k) = GV%Angstrom_H else h(i,j,k) = GV%m_to_H * (eta(i,j,K) - eta(i,j,K+1)) endif @@ -688,7 +688,7 @@ end subroutine initialize_thickness_from_file !> Adjust interface heights to fit the bathymetry and diagnose layer thickness. !! !! If the bottom most interface is below the topography then the bottom-most -!! layers are contracted to GV%Angstrom_z. +!! layers are contracted to GV%Angstrom_m. !! If the bottom most interface is above the topography then the entire column !! is dilated (expanded) to fill the void. !! @remark{There is a (hard-wired) "tolerance" parameter such that the @@ -725,9 +725,9 @@ subroutine adjustEtaToFitBathymetry(G, GV, eta, h) do k=nz,1,-1 ; do j=js,je ; do i=is,ie ! Collapse layers to thinnest possible if the thickness less than ! the thinnest possible (or negative). - if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_z)) then - eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom_z + if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_m)) then + eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_m + h(i,j,k) = GV%Angstrom_m else h(i,j,k) = (eta(i,j,K) - eta(i,j,K+1)) endif @@ -807,9 +807,9 @@ subroutine initialize_thickness_uniform(h, G, GV, param_file, just_read_params) eta1D(nz+1) = -1.0*G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = e0(K) - if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_z)) then - eta1D(K) = eta1D(K+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom + if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_m)) then + eta1D(K) = eta1D(K+1) + GV%Angstrom_m + h(i,j,k) = GV%Angstrom_H else h(i,j,k) = GV%m_to_H * (eta1D(K) - eta1D(K+1)) endif @@ -885,9 +885,9 @@ subroutine initialize_thickness_list(h, G, GV, param_file, just_read_params) eta1D(nz+1) = -1.0*G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = e0(K) - if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_z)) then - eta1D(K) = eta1D(K+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom + if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_m)) then + eta1D(K) = eta1D(K+1) + GV%Angstrom_m + h(i,j,k) = GV%Angstrom_H else h(i,j,k) = GV%m_to_H * (eta1D(K) - eta1D(K+1)) endif @@ -1055,9 +1055,9 @@ subroutine depress_surface(h, G, GV, param_file, tv, just_read_params) do k=1,nz if (eta(i,j,K) <= eta_sfc(i,j)) exit if (eta(i,j,K+1) >= eta_sfc(i,j)) then - h(i,j,k) = GV%Angstrom + h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = max(GV%Angstrom, h(i,j,k) * & + h(i,j,k) = max(GV%Angstrom_H, h(i,j,k) * & (eta_sfc(i,j) - eta(i,j,K+1)) / (eta(i,j,K) - eta(i,j,K+1)) ) endif enddo @@ -1757,8 +1757,8 @@ subroutine initialize_sponges_file(G, GV, use_temperature, tv, param_file, CSp, eta(i,j,nz+1) = -G%bathyT(i,j) enddo ; enddo do k=nz,1,-1 ; do j=js,je ; do i=is,ie - if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_z)) & - eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_z + if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_m)) & + eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_m enddo ; enddo ; enddo ! Set the inverse damping rates so that the model will know where to ! apply the sponges, along with the interface heights. @@ -1783,8 +1783,8 @@ subroutine initialize_sponges_file(G, GV, use_temperature, tv, param_file, CSp, enddo ; enddo do k=nz,1,-1 ; do j=js,je ; do i=is,ie - if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_z)) & - eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_z + if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_m)) & + eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_m enddo ; enddo ; enddo do k=1,nz; do j=js,je ; do i=is,ie h(i,j,k) = eta(i,j,k)-eta(i,j,k+1) @@ -2246,9 +2246,9 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) call adjustEtaToFitBathymetry(G, GV, zi, h) else do k=nz,1,-1 ; do j=js,je ; do i=is,ie - if (zi(i,j,K) < (zi(i,j,K+1) + GV%Angstrom_z)) then - zi(i,j,K) = zi(i,j,K+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom + if (zi(i,j,K) < (zi(i,j,K+1) + GV%Angstrom_m)) then + zi(i,j,K) = zi(i,j,K+1) + GV%Angstrom_m + h(i,j,k) = GV%Angstrom_H else h(i,j,k) = GV%m_to_H * (zi(i,j,K) - zi(i,j,K+1)) endif @@ -2374,7 +2374,7 @@ subroutine MOM_state_init_tests(G, GV, tv) write(0,*) ' ==================================================================== ' write(0,*) '' write(0,*) h - call cut_off_column_top(nk, tv, GV%Rho0, GV%g_Earth, -e(nk+1), GV%Angstrom, & + call cut_off_column_top(nk, tv, GV%Rho0, GV%g_Earth, -e(nk+1), GV%Angstrom_H, & T, T_t, T_b, S, S_t, S_b, 0.5*P_tot, h, remap_CS) write(0,*) h diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index ecc586d025..738c6dd2f0 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -618,7 +618,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) one_meter = 1.0 * GV%m_to_H h_neglect = GV%H_subroundoff - H_cutoff = real(2*nz) * (GV%Angstrom + h_neglect) + H_cutoff = real(2*nz) * (GV%Angstrom_H + h_neglect) !$OMP parallel default(none) shared(is,ie,js,je,CS,nz,e,G,GV,h,H_cutoff,h_neglect, & !$OMP one_meter,SN_u_local,SN_v_local,calculate_slopes) & @@ -691,7 +691,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) enddo ; enddo ! SN above contains S^2*N^2*H, convert to vertical average of S*N do I=is-1,ie - !SN_u(I,j) = sqrt( SN_u(I,j) / ( max(G%bathyT(I,j), G%bathyT(I+1,j)) + GV%Angstrom ) ) + !SN_u(I,j) = sqrt( SN_u(I,j) / ( max(G%bathyT(I,j), G%bathyT(I+1,j)) + GV%Angstrom_H ) ) !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_m ) then 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)) ) @@ -706,7 +706,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) CS%SN_v(i,J) = CS%SN_v(i,J) + SN_v_local(i,J,k) enddo ; enddo do i=is,ie - !SN_v(i,J) = sqrt( SN_v(i,J) / ( max(G%bathyT(i,J), G%bathyT(i,J+1)) + GV%Angstrom ) ) + !SN_v(i,J) = sqrt( SN_v(i,J) / ( max(G%bathyT(i,J), G%bathyT(i,J+1)) + GV%Angstrom_H ) ) !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_m ) then 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)) ) diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index f37b298edc..1d156620a0 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -304,7 +304,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var keep_going = .true. do k=1,nz do i=is-1,ie+1 - h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom),0.0) + h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0) enddo if (keep_going) then call calculate_density(tv%T(:,j,k),tv%S(:,j,k),p0,rho_ml(:),is-1,ie-is+3,tv%eqn_of_state) @@ -625,7 +625,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, CS) do i=is-1,ie+1 Rml_av(i,j) = Rml_av(i,j) + h(i,j,k)*Rho0(i) htot(i,j) = htot(i,j) + h(i,j,k) - h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom),0.0) + h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0) enddo enddo diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index fd05c4a5a2..0cf6880e7c 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -376,7 +376,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS do j=js,je ; do i=is,ie h(i,j,k) = h(i,j,k) - dt * 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(i,j,k) = GV%Angstrom + if (h(i,j,k) < GV%Angstrom_H) h(i,j,k) = GV%Angstrom_H enddo ; enddo enddo @@ -552,7 +552,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV h_avail_rsum(i,j,1) = 0.0 pres(i,j,1) = 0.0 ! ### This should be atmospheric pressure. - h_avail(i,j,1) = max(I4dt*G%areaT(i,j)*(h(i,j,1)-GV%Angstrom),0.0) + h_avail(i,j,1) = max(I4dt*G%areaT(i,j)*(h(i,j,1)-GV%Angstrom_H),0.0) h_avail_rsum(i,j,2) = h_avail(i,j,1) h_frac(i,j,1) = 1.0 pres(i,j,2) = pres(i,j,1) + GV%H_to_Pa*h(i,j,1) @@ -560,7 +560,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV !$OMP do do j=js-1,je+1 do k=2,nz ; do i=is-1,ie+1 - h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom),0.0) + h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0) h_avail_rsum(i,j,k+1) = h_avail_rsum(i,j,k) + h_avail(i,j,k) h_frac(i,j,k) = 0.0 ; if (h_avail(i,j,k) > 0.0) & h_frac(i,j,k) = h_avail(i,j,k) / h_avail_rsum(i,j,k+1) diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 1974249df1..ab05237607 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -503,7 +503,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & do k=1,nz ; do i=is,ie h(i,k) = h_3d(i,j,k) ; u(i,k) = u_3d(i,j,k) ; v(i,k) = v_3d(i,j,k) h_orig(i,k) = h_3d(i,j,k) - eps(i,k) = 0.0 ; if (k > nkmb) eps(i,k) = GV%Angstrom + eps(i,k) = 0.0 ; if (k > nkmb) eps(i,k) = GV%Angstrom_H T(i,k) = tv%T(i,j,k) ; S(i,k) = tv%S(i,j,k) do n=1,nsw opacity_band(n,i,k) = GV%H_to_m*optics%opacity_band(n,i,j,k) @@ -1169,7 +1169,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & C2, & ! Temporary variable with units of kg m-3 H-1. r_SW_top ! Temporary variables with units of H kg m-3. - Angstrom = GV%Angstrom + Angstrom = GV%Angstrom_H C1_3 = 1.0/3.0 ; C1_6 = 1.0/6.0 g_H2_2Rho0 = (GV%g_Earth * GV%H_to_m**2) / (2.0 * GV%Rho0) Idt = 1.0/dt @@ -1931,7 +1931,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & endif h_ent = h_ent + dh_Newt - if (ABS(dh_Newt) < 0.2*GV%Angstrom) exit + if (ABS(dh_Newt) < 0.2*GV%Angstrom_H) exit enddo endif @@ -2597,7 +2597,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, Rho0xG = GV%Rho0 * GV%g_Earth Idt_H2 = GV%H_to_m**2 / dt_diag I2Rho0 = 0.5 / GV%Rho0 - Angstrom = GV%Angstrom + Angstrom = GV%Angstrom_H ! This is hard coding of arbitrary and dimensional numbers. h_min_bl_thick = 5.0 * GV%m_to_H @@ -3532,10 +3532,10 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e ! temperature and salinity. If none is available a pseudo-orthogonal ! extrapolation is used. The 10.0 and 0.9 in the following are ! arbitrary but probably about right. - if ((h(i,k+1) < 10.0*GV%Angstrom) .or. & + if ((h(i,k+1) < 10.0*GV%Angstrom_H) .or. & ((RcvTgt(k+1)-Rcv(i,nkmb)) >= 0.9*(Rcv(i,k1) - Rcv(i,0)))) then if (k>=nz-1) then ; orthogonal_extrap = .true. - elseif ((h(i,k+2) <= 10.0*GV%Angstrom) .and. & + elseif ((h(i,k+2) <= 10.0*GV%Angstrom_H) .and. & ((RcvTgt(k+1)-Rcv(i,nkmb)) < 0.9*(Rcv(i,k+2)-Rcv(i,0)))) then k1 = k+2 else ; orthogonal_extrap = .true. ; endif @@ -3782,7 +3782,7 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS) "layers before sorting when ML_RESORT is true.", & units="nondim", default=0, fail_if_missing=.true.) ! Fail added by AJA. ! This gives a minimum decay scale that is typically much less than Angstrom. - ustar_min_dflt = 2e-4*CS%omega*(GV%Angstrom_z + GV%H_to_m*GV%H_subroundoff) + ustar_min_dflt = 2e-4*CS%omega*(GV%Angstrom_m + GV%H_to_m*GV%H_subroundoff) call get_param(param_file, mdl, "BML_USTAR_MIN", CS%ustar_min, & "The minimum value of ustar that should be used by the \n"//& "bulk mixed layer model in setting vertical TKE decay \n"//& diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index f662eda365..def2d87323 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -177,7 +177,7 @@ subroutine make_frazil(h, tv, G, GV, CS, p_surf) endif hc = (tv%C_p*GV%H_to_kg_m2) * h(i,j,k) - if (h(i,j,k) <= 10.0*GV%Angstrom) then + if (h(i,j,k) <= 10.0*GV%Angstrom_H) then ! Very thin layers should not be cooled by the frazil flux. if (tv%T(i,j,k) < T_freeze(i)) then fraz_col(i) = fraz_col(i) + hc * (T_freeze(i) - tv%T(i,j,k)) @@ -340,7 +340,7 @@ subroutine adjust_salt(h, tv, G, GV, CS) if ((G%mask2dT(i,j) > 0.0) .and. & ((tv%S(i,j,k) < S_min) .or. (salt_add_col(i,j) > 0.0))) then mc = GV%H_to_kg_m2 * h(i,j,k) - if (h(i,j,k) <= 10.0*GV%Angstrom) then + if (h(i,j,k) <= 10.0*GV%Angstrom_H) then ! Very thin layers should not be adjusted by the salt flux if (tv%S(i,j,k) < S_min) then salt_add_col(i,j) = salt_add_col(i,j) + mc * (S_min - tv%S(i,j,k)) @@ -421,7 +421,7 @@ subroutine insert_brine(h, tv, G, GV, fluxes, nkmb, CS, dt, id_brine_lay) do i=is,ie T(i,k)=tv%T(i,j,k); S(i,k)=tv%S(i,j,k) ! avoid very small thickness - h_2d(i,k)=MAX(h(i,j,k), GV%Angstrom) + h_2d(i,k)=MAX(h(i,j,k), GV%Angstrom_H) enddo call calculate_density(T(:,k), S(:,k), p_ref_cv, Rcv(:,k), is, & @@ -845,7 +845,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & ! To accommodate vanishing upper layers, we need to allow for an instantaneous ! distribution of forcing over some finite vertical extent. The bulk mixed layer ! code handles this issue properly. - H_limit_fluxes = max(GV%Angstrom, 1.E-30*GV%m_to_H) + H_limit_fluxes = max(GV%Angstrom_H, 1.E-30*GV%m_to_H) ! diagnostic to see if need to create mass to avoid grounding if (CS%id_createdH>0) CS%createdH(:,:) = 0. diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index e3806fd684..719c4cc184 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -1783,10 +1783,10 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en hold(i,j,nz) = h(i,j,nz) h(i,j,nz) = h(i,j,nz) + (ea(i,j,nz) - eb(i,j,nz-1)) if (h(i,j,1) <= 0.0) then - h(i,j,1) = GV%Angstrom + h(i,j,1) = GV%Angstrom_H endif if (h(i,j,nz) <= 0.0) then - h(i,j,nz) = GV%Angstrom + h(i,j,nz) = GV%Angstrom_H endif enddo do k=2,nz-1 ; do i=is,ie @@ -1794,7 +1794,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en h(i,j,k) = h(i,j,k) + ((ea(i,j,k) - eb(i,j,k-1)) + & (eb(i,j,k) - ea(i,j,k+1))) if (h(i,j,k) <= 0.0) then - h(i,j,k) = GV%Angstrom + h(i,j,k) = GV%Angstrom_H endif enddo ; enddo enddo @@ -2228,12 +2228,12 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en !$OMP parallel do default(shared) do k=1,nz do i=is-1,ie+1 - hold(i,js-1,k) = GV%Angstrom ; ea(i,js-1,k) = 0.0 ; eb(i,js-1,k) = 0.0 - hold(i,je+1,k) = GV%Angstrom ; ea(i,je+1,k) = 0.0 ; eb(i,je+1,k) = 0.0 + hold(i,js-1,k) = GV%Angstrom_H ; ea(i,js-1,k) = 0.0 ; eb(i,js-1,k) = 0.0 + hold(i,je+1,k) = GV%Angstrom_H ; ea(i,je+1,k) = 0.0 ; eb(i,je+1,k) = 0.0 enddo do j=js,je - hold(is-1,j,k) = GV%Angstrom ; ea(is-1,j,k) = 0.0 ; eb(is-1,j,k) = 0.0 - hold(ie+1,j,k) = GV%Angstrom ; ea(ie+1,j,k) = 0.0 ; eb(ie+1,j,k) = 0.0 + hold(is-1,j,k) = GV%Angstrom_H ; ea(is-1,j,k) = 0.0 ; eb(is-1,j,k) = 0.0 + hold(ie+1,j,k) = GV%Angstrom_H ; ea(ie+1,j,k) = 0.0 ; eb(ie+1,j,k) = 0.0 enddo enddo diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 3074faa243..22204ae3f6 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -2227,7 +2227,7 @@ subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS) units="nondim", default=0.95) endif ! This gives a minimum decay scale that is typically much less than Angstrom. - CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_z + GV%H_to_m*GV%H_subroundoff) + CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_m + GV%H_to_m*GV%H_subroundoff) call log_param(param_file, mdl, "EPBL_USTAR_MIN", CS%ustar_min, & "The (tiny) minimum friction velocity used within the \n"//& "ePBL code, derived from OMEGA and ANGSTROM.", units="m s-1") diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 03d01ba201..df3783fa32 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -204,7 +204,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & integer :: kb_min_act ! The minimum active value of kb in the current j-row. integer :: is1, ie1 ! The minimum and maximum active values of i in the current j-row. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - Angstrom = GV%Angstrom + Angstrom = GV%Angstrom_H h_neglect = GV%H_subroundoff if (.not. associated(CS)) call MOM_error(FATAL, & @@ -964,7 +964,7 @@ subroutine F_to_ent(F, h, kb, kmb, j, G, GV, CS, dsp1_ds, eakb, Ent_bl, ea, eb, ea(i,j,k) = ea(i,j,k+1) ! Add the entrainment of the thin interior layers to eb going ! up into the buffer layer. - eb(i,j,k) = eb(i,j,k+1) + max(0.0, h(i,j,k+1) - GV%Angstrom) + eb(i,j,k) = eb(i,j,k+1) + max(0.0, h(i,j,k+1) - GV%Angstrom_H) endif endif ; enddo ; enddo k = kmb @@ -972,10 +972,10 @@ subroutine F_to_ent(F, h, kb, kmb, j, G, GV, CS, dsp1_ds, eakb, Ent_bl, ea, eb, ! Adjust the previously calculated entrainment from below by the deepest ! buffer layer to account for entrainment of thin interior layers . if (kb(i) > kmb+1) & - eb(i,j,k) = eb(i,j,k+1) + max(0.0, h(i,j,k+1) - GV%Angstrom) + eb(i,j,k) = eb(i,j,k+1) + max(0.0, h(i,j,k+1) - GV%Angstrom_H) ! Determine the entrainment from above for each buffer layer. - h1 = (h(i,j,k) - GV%Angstrom) + (eb(i,j,k) - ea(i,j,k+1)) + h1 = (h(i,j,k) - GV%Angstrom_H) + (eb(i,j,k) - ea(i,j,k+1)) ea(i,j,k) = MAX(Ent_bl(i,K), Ent_bl(i,K)-0.5*h1, -h1) endif ; enddo do k=kmb-1,2,-1 ; do i=is,ie ; if (do_i(i)) then @@ -983,7 +983,7 @@ subroutine F_to_ent(F, h, kb, kmb, j, G, GV, CS, dsp1_ds, eakb, Ent_bl, ea, eb, eb(i,j,k) = max(2.0*Ent_bl(i,K+1) - ea(i,j,k+1), 0.0) ! Determine the entrainment from above for each buffer layer. - h1 = (h(i,j,k) - GV%Angstrom) + (eb(i,j,k) - ea(i,j,k+1)) + h1 = (h(i,j,k) - GV%Angstrom_H) + (eb(i,j,k) - ea(i,j,k+1)) ea(i,j,k) = MAX(Ent_bl(i,K), Ent_bl(i,K)-0.5*h1, -h1) ! if (h1 >= 0.0) then ; ea(i,j,k) = Ent_bl(i,K) ! elseif (Ent_bl(i,K)+0.5*h1 >= 0.0) then ; ea(i,j,k) = Ent_bl(i,K)-0.5*h1 @@ -1089,7 +1089,7 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, CS, j, Ent_bl, Sref integer :: i, k, is, ie, nz is = G%isc ; ie = G%iec ; nz = G%ke -! max_ent = 1.0e14*GV%Angstrom ! This is set to avoid roundoff problems. +! max_ent = 1.0e14*GV%Angstrom_H ! This is set to avoid roundoff problems. max_ent = 1.0e4*GV%m_to_H h_neglect = GV%H_subroundoff @@ -1143,9 +1143,9 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, CS, j, Ent_bl, Sref do k=kmb+1,nz ; do i=is,ie ; if (do_i(i)) then if ((k == kb(i)) .and. (S_est(i,kmb) > (GV%Rlay(k) - 1000.0))) then if (4.0*dtKd_int(i,Kmb+1)*frac_rem(i) > & - (h_bl(i,kmb) + h(i,j,k)) * (h(i,j,k) - GV%Angstrom)) then + (h_bl(i,kmb) + h(i,j,k)) * (h(i,j,k) - GV%Angstrom_H)) then ! Entrain this layer into the buffer layer and move kb down. - dh = max((h(i,j,k) - GV%Angstrom), 0.0) + dh = max((h(i,j,k) - GV%Angstrom_H), 0.0) if (dh > 0.0) then frac_rem(i) = frac_rem(i) - ((h_bl(i,kmb) + h(i,j,k)) * dh) / & (4.0*dtKd_int(i,Kmb+1)) @@ -1163,7 +1163,7 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, CS, j, Ent_bl, Sref ! This is where variables are be set up with a different vertical grid ! in which the (newly?) massless layers are taken out. do k=nz,kmb+1,-1 ; do i=is,ie - if (k >= kb(i)) h_interior(i) = h_interior(i) + (h(i,j,k)-GV%Angstrom) + if (k >= kb(i)) h_interior(i) = h_interior(i) + (h(i,j,k)-GV%Angstrom_H) if (k==kb(i)) then h_bl(i,kmb+1) = h(i,j,k) ; Sref(i,kmb+1) = GV%Rlay(k) - 1000.0 elseif (k==kb(i)+1) then @@ -1173,7 +1173,7 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, CS, j, Ent_bl, Sref do i=is,ie ; if (kb(i) >= nz) then h_bl(i,kmb+1) = h(i,j,nz) Sref(i,kmb+1) = GV%Rlay(nz) - 1000.0 - h_bl(i,kmb+2) = GV%Angstrom + h_bl(i,kmb+2) = GV%Angstrom_H Sref(i,kmb+2) = Sref(i,kmb+1) + (GV%Rlay(nz) - GV%Rlay(nz-1)) endif ; enddo @@ -1328,7 +1328,7 @@ subroutine determine_dSkb(h_bl, Sref, Ent_bl, E_kb, is, ie, kmb, G, GV, limit, & endif ! Determine the entrainment from above for each buffer layer. - h1 = (h_bl(i,k) - GV%Angstrom) + (eb(i,k) - ea(i,k+1)) + h1 = (h_bl(i,k) - GV%Angstrom_H) + (eb(i,k) - ea(i,k+1)) if (h1 >= 0.0) then ea(i,k) = Ent_bl(i,K) ; dea_dE(i,k) = 0.0 elseif (Ent_bl(i,K) + 0.5*h1 >= 0.0) then @@ -1411,7 +1411,7 @@ subroutine determine_dSkb(h_bl, Sref, Ent_bl, E_kb, is, ie, kmb, G, GV, limit, & if (present(dSLay)) then dz_drat = 1000.0 ! The limit of large dz_drat the same as choosing a ! Heaviside function. - eps_dSLay = 1.0e-10 ! Should be ~= GV%Angstrom / sqrt(Kd*dt) + eps_dSLay = 1.0e-10 ! Should be ~= GV%Angstrom_H / sqrt(Kd*dt) do i=is,ie ; if (do_i(i)) then dS_kbp1 = Sref(i,kmb+2) - Sref(i,kmb+1) IdS_kbp1 = 1.0 / (Sref(i,kmb+2) - Sref(i,kmb+1)) @@ -1758,7 +1758,7 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & fa = (1.0 + eL) + dS_kb(i)*I_dSkbp1(i) fk = dtKd_kb(i) * (dS_Lay(i)/dS_kb(i)) fm = (ea_kbp1(i) - h_bl(i,kmb+1)) + eL*2.0*Ent_bl(i,Kmb+1) - if (fm > -GV%Angstrom) fm = fm + GV%Angstrom ! This could be smooth if need be. + if (fm > -GV%Angstrom_H) fm = fm + GV%Angstrom_H ! This could be smooth if need be. err(i) = (fa * Ent(i)**2 - fm * Ent(i)) - fk derror_dE(i) = ((2.0*fa + (ddSkb_dE(i)*I_dSkbp1(i))*Ent(i))*Ent(i) - fm) - & dtKd_kb(i) * (ddSlay_dE(i)*dS_kb(i) - ddSkb_dE(i)*dS_Lay(i))/(dS_kb(i)**2) @@ -2185,10 +2185,10 @@ subroutine entrain_diffusive_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mod, "DT", dt, & "The (baroclinic) dynamics time step.", units = "s", & fail_if_missing=.true.) -! CS%Tolerance_Ent = MAX(100.0*GV%Angstrom,1.0e-4*sqrt(dt*Kd)) ! +! CS%Tolerance_Ent = MAX(100.0*GV%Angstrom_H,1.0e-4*sqrt(dt*Kd)) ! call get_param(param_file, mod, "TOLERANCE_ENT", CS%Tolerance_Ent, & "The tolerance with which to solve for entrainment values.", & - units="m", default=MAX(100.0*GV%Angstrom_Z,1.0e-4*sqrt(dt*Kd))) + units="m", default=MAX(100.0*GV%Angstrom_m,1.0e-4*sqrt(dt*Kd))) CS%id_Kd = register_diag_field('ocean_model', 'Kd_effective', diag%axesTL, Time, & 'Diapycnal diffusivity as applied', 'm2 s-1') diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 360c3a791d..aede558414 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -112,7 +112,7 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS) nkmb = GV%nk_rho_varies Irho_cp = 1.0 / (GV%H_to_kg_m2 * tv%C_p) - Angstrom = GV%Angstrom + Angstrom = GV%Angstrom_H H_neglect = GV%H_subroundoff p_ref(:) = tv%P_Ref @@ -400,10 +400,11 @@ end subroutine geothermal_end !> \namespace mom_geothermal !! -!! Geothermal heating can be added either in a layered isopycnal mode, in which the heating raises the density of the layer to the -!! target density of the layer above, and then moves the water into that layer, or in a simple Eulerian mode, in which the bottommost -!! GEOTHERMAL_THICKNESS are heated. Geothermal heating will also provide a buoyant source of bottom TKE that can be used to further -!! mix the near-bottom water. In cold fresh water lakes where heating increases density, water should be moved into deeper layers, but -!! this is not implemented yet. +!! Geothermal heating can be added either in a layered isopycnal mode, in which the heating raises the density +!! of the layer to the target density of the layer above, and then moves the water into that layer, or in a +!! simple Eulerian mode, in which the bottommost GEOTHERMAL_THICKNESS are heated. Geothermal heating will also +!! provide a buoyant source of bottom TKE that can be used to further mix the near-bottom water. In cold fresh +!! water lakes where heating increases density, water should be moved into deeper layers, but this is not +!! implemented yet. end module MOM_geothermal diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index ca2afdc655..db90deeaca 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -115,14 +115,14 @@ subroutine set_opacity(optics, fluxes, G, GV, CS) else ; Inv_nbands = 1.0 / real(optics%nbands) ; endif ! Make sure there is no division by 0. - inv_sw_pen_scale = 1.0 / max(CS%pen_sw_scale, 0.1*GV%Angstrom_z, & + inv_sw_pen_scale = 1.0 / max(CS%pen_sw_scale, 0.1*GV%Angstrom_m, & GV%H_to_m*GV%H_subroundoff) if ( CS%Opacity_scheme == DOUBLE_EXP ) then !$OMP parallel do default(shared) do k=1,nz ; do j=js,je ; do i=is,ie optics%opacity_band(1,i,j,k) = inv_sw_pen_scale optics%opacity_band(2,i,j,k) = 1.0 / max(CS%pen_sw_scale_2nd, & - 0.1*GV%Angstrom_z,GV%H_to_m*GV%H_subroundoff) + 0.1*GV%Angstrom_m,GV%H_to_m*GV%H_subroundoff) enddo ; enddo ; enddo if (.not.associated(fluxes%sw) .or. (CS%pen_SW_scale <= 0.0)) then !$OMP parallel do default(shared) diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index 1b9b1ff6ef..2b5aa4802b 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -337,20 +337,20 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS) do K=1,nz_filt ; do i=is,ie ; if (do_i(i)) then if (G%mask2dCu(I,j) <= 0.0) then ; e_e = e(i,j,K) ; else e_e = max(e(i+1,j,K) + min(e(i,j,K) - e(i+1,j,nz+1), 0.0), & - e(i,j,nz+1) + (nz+1-k)*GV%Angstrom) + e(i,j,nz+1) + (nz+1-k)*GV%Angstrom_H) endif if (G%mask2dCu(I-1,j) <= 0.0) then ; e_w = e(i,j,K) ; else e_w = max(e(i-1,j,K) + min(e(i,j,K) - e(i-1,j,nz+1), 0.0), & - e(i,j,nz+1) + (nz+1-k)*GV%Angstrom) + e(i,j,nz+1) + (nz+1-k)*GV%Angstrom_H) endif if (G%mask2dCv(i,J) <= 0.0) then ; e_n = e(i,j,K) ; else e_n = max(e(i,j+1,K) + min(e(i,j,K) - e(i,j+1,nz+1), 0.0), & - e(i,j,nz+1) + (nz+1-k)*GV%Angstrom) + e(i,j,nz+1) + (nz+1-k)*GV%Angstrom_H) endif if (G%mask2dCv(i,J-1) <= 0.0) then ; e_s = e(i,j,K) ; else e_s = max(e(i,j-1,K) + min(e(i,j,K) - e(i,j-1,nz+1), 0.0), & - e(i,j,nz+1) + (nz+1-k)*GV%Angstrom) + e(i,j,nz+1) + (nz+1-k)*GV%Angstrom_H) endif wt = max(0.0, min(1.0, I_dtol*(def_rat_h(i,j)-CS%h_def_tol1))) @@ -386,10 +386,10 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS) do k=nkmb+1,nz cols_left = .false. do i=is,ie ; if (more_ent_i(i)) then - if (h_2d(i,k) - GV%Angstrom > h_neglect) then - if (e_2d(i,nkmb+1)-e_filt(i,nkmb+1) > h_2d(i,k) - GV%Angstrom) then - h_add = h_2d(i,k) - GV%Angstrom - h_2d(i,k) = GV%Angstrom + if (h_2d(i,k) - GV%Angstrom_H > h_neglect) then + if (e_2d(i,nkmb+1)-e_filt(i,nkmb+1) > h_2d(i,k) - GV%Angstrom_H) then + h_add = h_2d(i,k) - GV%Angstrom_H + h_2d(i,k) = GV%Angstrom_H else h_add = e_2d(i,nkmb+1)-e_filt(i,nkmb+1) h_2d(i,k) = h_2d(i,k) - h_add @@ -644,7 +644,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS) h_predicted = h_2d_init(i,k) + ((d_ea(i,k) - d_eb(i,k-1)) + & (d_eb(i,k) - d_ea(i,k+1))) endif - if (abs(h(i,j,k) - h_predicted) > MAX(1e-9*abs(h_predicted),GV%Angstrom)) & + if (abs(h(i,j,k) - h_predicted) > MAX(1e-9*abs(h_predicted),GV%Angstrom_H)) & call MOM_error(FATAL, "regularize_surface: d_ea mismatch.") endif ; enddo ; enddo do i=is,ie ; if (do_i(i)) then diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 8d3206303c..ce5ea313d8 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -762,7 +762,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & ! in sigma-0. do k=kb(i)-1,kmb+1,-1 if (rho_0(i,kmb) > rho_0(i,k)) exit - if (h(i,j,k)>2.0*GV%Angstrom) kb(i) = k + if (h(i,j,k)>2.0*GV%Angstrom_H) kb(i) = k enddo enddo @@ -786,15 +786,15 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & htot(i) = GV%H_to_m*h(i,j,kmb) mFkb(i) = 0.0 if (kb(i) < nz) & - mFkb(i) = ds_dsp1(i,kb(i)) * (GV%H_to_m*(h(i,j,kmb) - GV%Angstrom)) + mFkb(i) = ds_dsp1(i,kb(i)) * (GV%H_to_m*(h(i,j,kmb) - GV%Angstrom_H)) enddo do k=1,kmb-1 ; do i=is,ie htot(i) = htot(i) + GV%H_to_m*h(i,j,k) - mFkb(i) = mFkb(i) + ds_dsp1(i,k+1)*(GV%H_to_m*(h(i,j,k) - GV%Angstrom)) + mFkb(i) = mFkb(i) + ds_dsp1(i,k+1)*(GV%H_to_m*(h(i,j,k) - GV%Angstrom_H)) enddo ; enddo else do i=is,i - maxEnt(i,1) = 0.0 ; htot(i) = GV%H_to_m*(h(i,j,1) - GV%Angstrom) + maxEnt(i,1) = 0.0 ; htot(i) = GV%H_to_m*(h(i,j,1) - GV%Angstrom_H) enddo endif do k=kb_min,nz-1 ; do i=is,ie @@ -803,12 +803,12 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & elseif (k > kb(i)) then maxEnt(i,k) = (1.0/dsp1_ds(i,k))*(maxEnt(i,k-1) + htot(i)) ! maxEnt(i,k) = ds_dsp1(i,k)*(maxEnt(i,k-1) + htot(i)) ! BITWISE CHG - htot(i) = htot(i) + GV%H_to_m*(h(i,j,k) - GV%Angstrom) + htot(i) = htot(i) + GV%H_to_m*(h(i,j,k) - GV%Angstrom_H) endif enddo ; enddo do i=is,ie - htot(i) = GV%H_to_m*(h(i,j,nz) - GV%Angstrom) ; maxEnt(i,nz) = 0.0 + htot(i) = GV%H_to_m*(h(i,j,nz) - GV%Angstrom_H) ; maxEnt(i,nz) = 0.0 do_i(i) = (G%mask2dT(i,j) > 0.5) enddo do k=nz-1,kb_min,-1 @@ -817,7 +817,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & if (k=CS%Hbbl) exit ! terminate the k loop hweight = MIN(CS%Hbbl - htot_vel, h_at_vel(i,k)) - if (hweight < 1.5*GV%Angstrom + h_neglect) cycle + if (hweight < 1.5*GV%Angstrom_H + h_neglect) cycle htot_vel = htot_vel + h_at_vel(i,k) hwtot = hwtot + hweight @@ -795,18 +795,18 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) dV_dL2 = 0.5*(slope+a) - a*L0 ; dVol = (vol-Vol_0) ! dV_dL2 = 0.5*(slope+a) - a*L0 ; dVol = max(vol-Vol_0, 0.0) - !### The following code is more robust when GV%Angstrom=0, but it + !### The following code is more robust when GV%Angstrom_H=0, but it !### changes answers. - ! Vol_tol = max(0.5*GV%Angstrom + GV%H_subroundoff, 1e-14*vol) - ! Vol_quit = max(0.9*GV%Angstrom + GV%H_subroundoff, 1e-14*vol) + ! Vol_tol = max(0.5*GV%Angstrom_H + GV%H_subroundoff, 1e-14*vol) + ! Vol_quit = max(0.9*GV%Angstrom_H + GV%H_subroundoff, 1e-14*vol) ! if (dVol <= 0.0) then ! L(K) = L0 ! Vol_err = 0.5*(L(K)*L(K))*(slope + a_3*(3.0-4.0*L(K))) - vol ! elseif (a*a*dVol**3 < Vol_tol*dV_dL2**2 * & ! (dV_dL2*Vol_tol - 2.0*a*L0*dVol)) then - if (a*a*dVol**3 < GV%Angstrom*dV_dL2**2 * & - (0.25*dV_dL2*GV%Angstrom - a*L0*dVol)) then + if (a*a*dVol**3 < GV%Angstrom_H*dV_dL2**2 * & + (0.25*dV_dL2*GV%Angstrom_H - a*L0*dVol)) then ! One iteration of Newton's method should give an estimate ! that is accurate to within Vol_tol. L(K) = sqrt(L0*L0 + dVol / dV_dL2) @@ -1159,7 +1159,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) use_EOS = associated(tv%eqn_of_state) dt_Rho0 = dt/GV%H_to_kg_m2 h_neglect = GV%H_subroundoff - h_tiny = 2.0*GV%Angstrom + h_neglect + h_tiny = 2.0*GV%Angstrom_H + h_neglect g_H_Rho0 = (GV%g_Earth * GV%H_to_m) / GV%Rho0 H_to_m = GV%H_to_m ; m_to_H = GV%m_to_H @@ -1346,7 +1346,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) if (use_EOS .or. .not.CS%linear_drag) then ; do k=1,nz if (htot_vel>=CS%Htbl_shelf) exit ! terminate the k loop hweight = MIN(CS%Htbl_shelf - htot_vel, h_at_vel(i,k)) - if (hweight <= 1.5*GV%Angstrom + h_neglect) cycle + if (hweight <= 1.5*GV%Angstrom_H + h_neglect) cycle htot_vel = htot_vel + h_at_vel(i,k) hwtot = hwtot + hweight @@ -1591,7 +1591,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) if (use_EOS .or. .not.CS%linear_drag) then ; do k=1,nz if (htot_vel>=CS%Htbl_shelf) exit ! terminate the k loop hweight = MIN(CS%Htbl_shelf - htot_vel, h_at_vel(i,k)) - if (hweight <= 1.5*GV%Angstrom + h_neglect) cycle + if (hweight <= 1.5*GV%Angstrom_H + h_neglect) cycle htot_vel = htot_vel + h_at_vel(i,k) hwtot = hwtot + hweight @@ -1910,7 +1910,7 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) "The rotation rate of the earth.", units="s-1", & default=7.2921e-5) ! This give a minimum decay scale that is typically much less than Angstrom. - CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_z + GV%H_to_m*GV%H_subroundoff) + CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_m + GV%H_to_m*GV%H_subroundoff) else call get_param(param_file, mdl, "OMEGA", CS%omega, & "The rotation rate of the earth.", units="s-1", & diff --git a/src/parameterizations/vertical/MOM_shortwave_abs.F90 b/src/parameterizations/vertical/MOM_shortwave_abs.F90 index 1cf23e9c3e..a81a7803da 100644 --- a/src/parameterizations/vertical/MOM_shortwave_abs.F90 +++ b/src/parameterizations/vertical/MOM_shortwave_abs.F90 @@ -143,7 +143,7 @@ subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, min_SW_heating = 2.5e-11 - h_min_heat = 2.0*GV%Angstrom + GV%H_subroundoff + h_min_heat = 2.0*GV%Angstrom_H + GV%H_subroundoff is = G%isc ; ie = G%iec ; nz = G%ke C1_6 = 1.0 / 6.0 ; C1_60 = 1.0 / 60.0 @@ -348,7 +348,7 @@ subroutine sumSWoverBands(G, GV, h, opacity_band, nsw, j, dt, & integer :: is, ie, nz, i, k, ks, n SW_Remains = .false. - h_min_heat = 2.0*GV%Angstrom + GV%H_subroundoff + h_min_heat = 2.0*GV%Angstrom_H + GV%H_subroundoff is = G%isc ; ie = G%iec ; nz = G%ke pen_SW_bnd(:,:) = iPen_SW_bnd(:,:) diff --git a/src/parameterizations/vertical/MOM_sponge.F90 b/src/parameterizations/vertical/MOM_sponge.F90 index d4c5e69ed5..ce7471f9e1 100644 --- a/src/parameterizations/vertical/MOM_sponge.F90 +++ b/src/parameterizations/vertical/MOM_sponge.F90 @@ -441,10 +441,10 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) h_above(i,1) = 0.0 ; h_below(i,nz+1) = 0.0 enddo do K=nz,1,-1 ; do i=is,ie - h_below(i,K) = h_below(i,K+1) + max(h(i,j,k)-GV%Angstrom, 0.0) + h_below(i,K) = h_below(i,K+1) + max(h(i,j,k)-GV%Angstrom_H, 0.0) enddo ; enddo do K=2,nz+1 ; do i=is,ie - h_above(i,K) = h_above(i,K-1) + max(h(i,j,k-1)-GV%Angstrom, 0.0) + h_above(i,K) = h_above(i,K-1) + max(h(i,j,k-1)-GV%Angstrom_H, 0.0) enddo ; enddo do K=2,nz ! w is positive for an upward (lightward) flux of mass, resulting @@ -471,7 +471,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) enddo h(i,j,k) = max(h(i,j,k) + (w_int(i,j,K+1) - w_int(i,j,K)), & - min(h(i,j,k), GV%Angstrom)) + min(h(i,j,k), GV%Angstrom_H)) enddo ; enddo endif ; enddo @@ -506,7 +506,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) do k=nz,nkmb+1,-1 if (GV%Rlay(k) > Rcv_ml(i,j)) then w = MIN((((e(K)-e0) - e_str*CS%Ref_eta(K,c)) * damp)*GV%m_to_H, & - ((wb + h(i,j,k)) - GV%Angstrom)) + ((wb + h(i,j,k)) - GV%Angstrom_H)) wm = 0.5*(w-ABS(w)) do m=1,CS%fldno CS%var(m)%p(i,j,k) = (h(i,j,k)*CS%var(m)%p(i,j,k) + & @@ -518,7 +518,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) CS%var(m)%p(i,j,k) = I1pdamp * & (CS%var(m)%p(i,j,k) + CS%Ref_val(m)%p(k,c)*damp) enddo - w = wb + (h(i,j,k) - GV%Angstrom) + w = wb + (h(i,j,k) - GV%Angstrom_H) wm = 0.5*(w-ABS(w)) endif eb(i,j,k) = eb(i,j,k) + wpb @@ -530,7 +530,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) if (wb < 0) then do k=nkmb,1,-1 - w = MIN((wb + (h(i,j,k) - GV%Angstrom)),0.0) + w = MIN((wb + (h(i,j,k) - GV%Angstrom_H)),0.0) h(i,j,k) = h(i,j,k) + (wb - w) ea(i,j,k) = ea(i,j,k) - w wb = w @@ -562,7 +562,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) wb = 0.0 do k=nz,1,-1 w = MIN((((e(K)-e0) - e_str*CS%Ref_eta(K,c)) * damp)*GV%m_to_H, & - ((wb + h(i,j,k)) - GV%Angstrom)) + ((wb + h(i,j,k)) - GV%Angstrom_H)) wm = 0.5*(w - ABS(w)) do m=1,CS%fldno CS%var(m)%p(i,j,k) = (h(i,j,k)*CS%var(m)%p(i,j,k) + & diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 6b5fcb3202..69d7f4b7e2 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1387,7 +1387,7 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, CS) maxvel = CS%maxvel truncvel = 0.9*maxvel - H_report = 6.0 * GV%Angstrom + H_report = 6.0 * GV%Angstrom_H dt_Rho0 = dt / GV%Rho0 if (len_trim(CS%u_trunc_file) > 0) then diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index 0354f90a51..749962b17f 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -232,7 +232,7 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, h, diag, OBC, CS, & else d_tr = 0.0 endif - if (h(i,j,k) < 2.0*GV%Angstrom) d_tr=0.0 + if (h(i,j,k) < 2.0*GV%Angstrom_H) d_tr=0.0 CS%tr(i,j,k,m) = CS%tr(i,j,k,m) + d_tr enddo enddo diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index b373fc064a..ee1f038180 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -519,7 +519,7 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, !Prepare input arrays for source update ! - rho_dzt(:,:,:) = GV%H_to_kg_m2 * GV%Angstrom + rho_dzt(:,:,:) = GV%H_to_kg_m2 * GV%Angstrom_H do k = 1, nk ; do j = jsc, jec ; do i = isc, iec !{ rho_dzt(i,j,k) = GV%H_to_kg_m2 * h_old(i,j,k) enddo ; enddo ; enddo !} diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index ffff913eff..dc616e8a49 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -70,7 +70,7 @@ subroutine update_h_horizontal_flux(G, GV, uhtr, vhtr, h_pre, h_new) ! 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, 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%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) @@ -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*min(G%areaT(i,j),G%areaT(i+1,j)) + uh_neglect = GV%Angstrom_H*min(G%areaT(i,j),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*min(G%areaT(i,j),G%areaT(i,j+1)) + vh_neglect = GV%Angstrom_H*min(G%areaT(i,j),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") @@ -400,7 +400,7 @@ subroutine distribute_residual_uh_upwards(G, GV, hvol, uh) ! Set index-related variables for fields on T-grid is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - min_h = GV%Angstrom*0.1 + min_h = GV%Angstrom_H*0.1 do j=js,je ! Copy over uh and cell volume to working arrays @@ -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*min(G%areaT(i,j),G%areaT(i+1,j)) + uh_neglect = GV%Angstrom_H*min(G%areaT(i,j),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") @@ -498,7 +498,7 @@ subroutine distribute_residual_vh_upwards(G, GV, hvol, vh) ! Set index-related variables for fields on T-grid is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - min_h = 0.1*GV%Angstrom + min_h = 0.1*GV%Angstrom_H do i=is,ie ! Copy over uh and cell volume to working arrays @@ -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*min(G%areaT(i,j),G%areaT(i,j+1)) + vh_neglect = GV%Angstrom_H*min(G%areaT(i,j),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 0d90d890fd..8a59f69a61 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -450,7 +450,7 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) if (CS%id_eta_pre_distribute>0) then eta_work(:,:) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie - if (h_pre(i,j,k)>GV%Angstrom) then + if (h_pre(i,j,k)>GV%Angstrom_H) then eta_work(i,j) = eta_work(i,j) + h_pre(i,j,k) endif enddo ; enddo ; enddo @@ -583,7 +583,7 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) if (CS%id_eta_post_distribute>0) then eta_work(:,:) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie - if (h_pre(i,j,k)>GV%Angstrom) then + if (h_pre(i,j,k)>GV%Angstrom_H) then eta_work(i,j) = eta_work(i,j) + h_pre(i,j,k) endif enddo ; enddo ; enddo @@ -1057,7 +1057,7 @@ subroutine update_offline_fields(CS, h, fluxes, do_ale) ! Apply masks/factors at T, U, and V points do k=1,nz ; do j=js,je ; do i=is,ie if (CS%G%mask2dT(i,j)<1.0) then - CS%h_end(i,j,k) = CS%GV%Angstrom + CS%h_end(i,j,k) = CS%GV%Angstrom_H endif enddo ; enddo ; enddo diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 0370aeaee4..589ad07e19 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -382,7 +382,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & stencil = 1 if (usePPM .and. .not. useHuynh) stencil = 2 - min_h = 0.1*GV%Angstrom + min_h = 0.1*GV%Angstrom_H h_neglect = GV%H_subroundoff dt=1.0/Idt @@ -711,7 +711,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & stencil = 1 if (usePPM .and. .not. useHuynh) stencil = 2 - min_h = 0.1*GV%Angstrom + min_h = 0.1*GV%Angstrom_H h_neglect = GV%H_subroundoff dt=1.0/Idt !do i=is,ie ; ts2(i) = 0.0 ; enddo diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 99aa562a60..597b0fc822 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -696,7 +696,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & enddo ; enddo if (PEmax_kRho > nz) PEmax_kRho = nz ! PEmax_kRho could have been nz+1. - h_exclude = 10.0*(GV%Angstrom + GV%H_subroundoff) + h_exclude = 10.0*(GV%Angstrom_H + GV%H_subroundoff) !$OMP parallel default(none) shared(is,ie,js,je,nkmb,G,GV,h,h_exclude,num_srt,k0_srt, & !$OMP rho_srt,h_srt,PEmax_kRho,k_end_srt,rho_coord,max_srt) & !$OMP private(ns,tmp,itmp) diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index 972c475683..605d4706ca 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -137,11 +137,11 @@ subroutine BFB_initialize_sponges_southonly(G, use_temperature, tv, param_file, ! do k = 1,nz; eta(i,j,k) = H0(k); enddo ! if (G%geoLatT(i,j) > 40.0) then ! do k = 1,nz - ! eta(i,j,k) = -G%Angstrom_z*(k-1) + ! eta(i,j,k) = -G%Angstrom_m*(k-1) ! enddo ! elseif (G%geoLatT(i,j) > 20.0) then ! do k = 1,nz - ! eta(i,j,k) = min(H0(k) + (G%geoLatT(i,j) - 20.0)*(G%max_depth - nz*G%Angstrom_z)/20.0, -(k-1)*G%angstrom_z) + ! eta(i,j,k) = min(H0(k) + (G%geoLatT(i,j) - 20.0)*(G%max_depth - nz*G%Angstrom_m)/20.0, -(k-1)*G%Angstrom_m) ! enddo ! endif eta(i,j,nz+1) = -G%max_depth diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index 474a71d683..1c5c1e5b7f 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -146,9 +146,9 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, param_file, just_read_params eta1D(nz+1) = -1.0*G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_z)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then + eta1D(k) = eta1D(k+1) + GV%Angstrom_m + h(i,j,k) = GV%Angstrom_H else h(i,j,k) = GV%m_to_H * (eta1D(k) - eta1D(k+1)) endif @@ -156,8 +156,8 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, param_file, just_read_params x = ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon if ( x <= dome2d_width_bay ) then - h(i,j,1:nz-1) = GV%Angstrom - h(i,j,nz) = GV%m_to_H * dome2d_depth_bay * G%max_depth - (nz-1) * GV%Angstrom + h(i,j,1:nz-1) = GV%Angstrom_H + h(i,j,nz) = GV%m_to_H * dome2d_depth_bay * G%max_depth - (nz-1) * GV%Angstrom_H endif enddo ; enddo @@ -447,9 +447,9 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) eta1D(nz+1) = -1.0*G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_z)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom_z + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then + eta1D(k) = eta1D(k+1) + GV%Angstrom_m + h(i,j,k) = GV%Angstrom_m else h(i,j,k) = eta1D(k) - eta1D(k+1) endif @@ -485,9 +485,9 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) eta1D(nz+1) = -1.0*G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = -G%max_depth * real(k-1) / real(nz) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_z)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom_z + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then + eta1D(k) = eta1D(k+1) + GV%Angstrom_m + h(i,j,k) = GV%Angstrom_m else h(i,j,k) = eta1D(k) - eta1D(k+1) endif @@ -495,8 +495,8 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) x = ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon if ( x <= dome2d_width_bay ) then - h(i,j,1:nz-1) = GV%Angstrom - h(i,j,nz) = dome2d_depth_bay * G%max_depth - (nz-1) * GV%Angstrom + h(i,j,1:nz-1) = GV%Angstrom_H + h(i,j,nz) = dome2d_depth_bay * G%max_depth - (nz-1) * GV%Angstrom_H endif eta(i,j,nz+1) = -G%bathyT(i,j) diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index e4e35d77e5..03274c0d8c 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -116,9 +116,9 @@ subroutine DOME_initialize_thickness(h, G, GV, param_file, just_read_params) eta1D(nz+1) = -1.0*G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = e0(K) - if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_z)) then - eta1D(K) = eta1D(K+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom + if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_m)) then + eta1D(K) = eta1D(K+1) + GV%Angstrom_m + h(i,j,k) = GV%Angstrom_H else h(i,j,k) = GV%m_to_H * (eta1D(K) - eta1D(K+1)) endif @@ -190,12 +190,12 @@ subroutine DOME_initialize_sponges(G, GV, tv, PF, CSp) ! depth space for Boussinesq or non-Boussinesq models. eta(i,j,1) = 0.0 do k=2,nz -! eta(i,j,K)=max(H0(k), -G%bathyT(i,j), GV%Angstrom_z*(nz-k+1)-G%bathyT(i,j)) +! eta(i,j,K)=max(H0(k), -G%bathyT(i,j), GV%Angstrom_m*(nz-k+1)-G%bathyT(i,j)) e_dense = -G%bathyT(i,j) if (e_dense >= H0(k)) then ; eta(i,j,K) = e_dense else ; eta(i,j,K) = H0(k) ; endif - if (eta(i,j,K) < GV%Angstrom_z*(nz-k+1)-G%bathyT(i,j)) & - eta(i,j,K) = GV%Angstrom_z*(nz-k+1)-G%bathyT(i,j) + if (eta(i,j,K) < GV%Angstrom_m*(nz-k+1)-G%bathyT(i,j)) & + eta(i,j,K) = GV%Angstrom_m*(nz-k+1)-G%bathyT(i,j) enddo eta(i,j,nz+1) = -G%bathyT(i,j) diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index d0b87d518f..f65ba242b0 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -195,9 +195,9 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par eta1D(nz+1) = -1.0*G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_z)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then + eta1D(k) = eta1D(k+1) + GV%Angstrom_m + h(i,j,k) = GV%Angstrom_H else h(i,j,k) = GV%m_to_H * (eta1D(k) - eta1D(k+1)) endif @@ -539,9 +539,9 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) eta1D(nz+1) = -1.0*G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_z)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom_z + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then + eta1D(k) = eta1D(k+1) + GV%Angstrom_m + h(i,j,k) = GV%Angstrom_m else h(i,j,k) = eta1D(k) - eta1D(k+1) endif diff --git a/src/user/Neverland_initialization.F90 b/src/user/Neverland_initialization.F90 index 0aa80f3c2e..40c0f81ff4 100644 --- a/src/user/Neverland_initialization.F90 +++ b/src/user/Neverland_initialization.F90 @@ -137,7 +137,7 @@ subroutine Neverland_initialize_thickness(h, G, GV, param_file, eqn_of_state, P_ do j=js,je ; do i=is,ie e_interface = -G%bathyT(i,j) do k=nz,1,-1 - h(i,j,k) = max( GV%Angstrom, GV%m_to_H * (e0(k) - e_interface) ) + h(i,j,k) = max( GV%Angstrom_H, GV%m_to_H * (e0(k) - e_interface) ) e_interface = max( e0(k), e_interface - GV%H_to_m * h(i,j,k) ) enddo diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index 5267b5585b..6d2aa72e90 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -98,9 +98,9 @@ subroutine Phillips_initialize_thickness(h, G, GV, param_file, just_read_params) eta1D(nz+1) = -1.0*G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = eta_im(j,K) - if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_z)) then - eta1D(K) = eta1D(K+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom + if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_m)) then + eta1D(K) = eta1D(K+1) + GV%Angstrom_m + h(i,j,k) = GV%Angstrom_H else h(i,j,k) = GV%m_to_H * (eta1D(K) - eta1D(K+1)) endif diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index b681843002..8823f211c0 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -158,7 +158,7 @@ subroutine benchmark_initialize_thickness(h, G, GV, param_file, eqn_of_state, & ! This sets the initial thickness (in m) of the layers. The ! ! thicknesses are set to insure that: 1. each layer is at least ! -! Gv%Angstrom_z thick, and 2. the interfaces are where they should be ! +! Gv%Angstrom_m thick, and 2. the interfaces are where they should be ! ! based on the resting depths and interface height perturbations, ! ! as long at this doesn't interfere with 1. ! eta1D(nz+1) = -1.0*G%bathyT(i,j) @@ -180,12 +180,12 @@ subroutine benchmark_initialize_thickness(h, G, GV, param_file, eqn_of_state, & if (eta1D(K) > -ML_depth) eta1D(K) = -ML_depth - if (eta1D(K) < eta1D(K+1) + GV%Angstrom_z) & - eta1D(K) = eta1D(K+1) + GV%Angstrom_z + if (eta1D(K) < eta1D(K+1) + GV%Angstrom_m) & + eta1D(K) = eta1D(K+1) + GV%Angstrom_m - h(i,j,k) = max(GV%m_to_H * (eta1D(K) - eta1D(K+1)), GV%Angstrom) + h(i,j,k) = max(GV%m_to_H * (eta1D(K) - eta1D(K+1)), GV%Angstrom_H) enddo - h(i,j,1) = max(GV%m_to_H * (0.0 - eta1D(2)), GV%Angstrom) + h(i,j,1) = max(GV%m_to_H * (0.0 - eta1D(2)), GV%Angstrom_H) enddo ; enddo diff --git a/src/user/circle_obcs_initialization.F90 b/src/user/circle_obcs_initialization.F90 index 1ff42509c5..5c8d67d937 100644 --- a/src/user/circle_obcs_initialization.F90 +++ b/src/user/circle_obcs_initialization.F90 @@ -73,9 +73,9 @@ subroutine circle_obcs_initialize_thickness(h, G, GV, param_file, just_read_para eta1D(nz+1) = -1.0*G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = e0(K) - if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_z)) then - eta1D(K) = eta1D(K+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom + if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_m)) then + eta1D(K) = eta1D(K+1) + GV%Angstrom_m + h(i,j,k) = GV%Angstrom_H else h(i,j,k) = GV%m_to_H * (eta1D(K) - eta1D(K+1)) endif diff --git a/src/user/dense_water_initialization.F90 b/src/user/dense_water_initialization.F90 index 30625377cc..59f11dd98d 100644 --- a/src/user/dense_water_initialization.F90 +++ b/src/user/dense_water_initialization.F90 @@ -229,10 +229,10 @@ subroutine dense_water_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, A do k = nz,1,-1 eta1D(k) = e0(k) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_z)) then + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then ! is this layer vanished? - eta1D(k) = eta1D(k+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom_z + eta1D(k) = eta1D(k+1) + GV%Angstrom_m + h(i,j,k) = GV%Angstrom_m else h(i,j,k) = eta1D(k) - eta1D(k+1) endif diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index de9f88c094..d0109a8b6c 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -135,16 +135,16 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, param_file, just_read_param e0(K) = - G%max_depth * ( ( S_light - S_surf ) + ( S_dense - S_light ) * & ( (real(K)-1.5) / real(nz-1) ) ) / S_range e0(K) = nint(2048.*e0(K))/2048. ! Force round numbers ... the above expression has irrational factors ... - e0(K) = min(real(1-K)*GV%Angstrom_z, e0(K)) ! Bound by surface + e0(K) = min(real(1-K)*GV%Angstrom_m, e0(K)) ! Bound by surface e0(K) = max(-G%max_depth, e0(K)) ! Bound by bottom enddo do j=js,je ; do i=is,ie eta1D(nz+1) = -1.0*G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_z)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom_z + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then + eta1D(k) = eta1D(k+1) + GV%Angstrom_m + h(i,j,k) = GV%Angstrom_m else h(i,j,k) = eta1D(k) - eta1D(k+1) endif diff --git a/src/user/lock_exchange_initialization.F90 b/src/user/lock_exchange_initialization.F90 index c3e06391cb..3c48bc9b9a 100644 --- a/src/user/lock_exchange_initialization.F90 +++ b/src/user/lock_exchange_initialization.F90 @@ -78,11 +78,11 @@ subroutine lock_exchange_initialize_thickness(h, G, GV, param_file, just_read_pa enddo eta1D(nz+1) = -G%max_depth ! Force bottom interface to bottom do k=nz,2,-1 ! Make sure interfaces increase upwards - eta1D(K) = max( eta1D(K), eta1D(K+1) + GV%Angstrom_Z ) + eta1D(K) = max( eta1D(K), eta1D(K+1) + GV%Angstrom_m ) enddo eta1D(1) = 0. ! Force bottom interface to bottom do k=2,nz ! Make sure interfaces decrease downwards - eta1D(K) = min( eta1D(K), eta1D(K-1) - GV%Angstrom_Z ) + eta1D(K) = min( eta1D(K), eta1D(K-1) - GV%Angstrom_m ) enddo do k=nz,1,-1 h(i,j,k) = GV%m_to_H * (eta1D(K) - eta1D(K+1)) diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index 131f73ea3e..3243c94d0f 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -138,16 +138,16 @@ subroutine seamount_initialize_thickness ( h, G, GV, param_file, just_read_param e0(K) = - G%max_depth * ( ( S_light - S_surf ) + ( S_dense - S_light ) * & ( (real(K)-1.5) / real(nz-1) ) ) / S_range e0(K) = nint(2048.*e0(K))/2048. ! Force round numbers ... the above expression has irrational factors ... - e0(K) = min(real(1-K)*GV%Angstrom_z, e0(K)) ! Bound by surface + e0(K) = min(real(1-K)*GV%Angstrom_m, e0(K)) ! Bound by surface e0(K) = max(-G%max_depth, e0(K)) ! Bound by bottom enddo do j=js,je ; do i=is,ie eta1D(nz+1) = -1.0*G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_z)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then + eta1D(k) = eta1D(k+1) + GV%Angstrom_m + h(i,j,k) = GV%Angstrom_H else h(i,j,k) = GV%m_to_H * (eta1D(k) - eta1D(k+1)) endif diff --git a/src/user/sloshing_initialization.F90 b/src/user/sloshing_initialization.F90 index a81cf181e6..f70bbc1619 100644 --- a/src/user/sloshing_initialization.F90 +++ b/src/user/sloshing_initialization.F90 @@ -153,8 +153,8 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param ! are strictly positive do k = nz,1,-1 - if ( z_inter(k) < (z_inter(k+1) + GV%Angstrom_Z) ) then - z_inter(k) = z_inter(k+1) + GV%Angstrom_Z + if ( z_inter(k) < (z_inter(k+1) + GV%Angstrom_m) ) then + z_inter(k) = z_inter(k+1) + GV%Angstrom_m endif enddo From b3fe50afc23cefae798cd1213e541e605d68a690 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 24 Aug 2018 15:58:32 -0400 Subject: [PATCH 046/174] Avoid use of %Domain_aux to avoid intermittent MPI sync problem - The combination of coverage instrumentation, O2 optimization and the use of Domain_aux for halo-updates of data passed from the coupler was leading to MPI errors about inconsistent messages. This could very easily be a compiler issue but there might very well be an issue in Domain_aux. --- .../coupled_driver/MOM_surface_forcing.F90 | 124 +++++++++++------- 1 file changed, 73 insertions(+), 51 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index bbaac1df07..57eb9cfcbc 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -805,12 +805,12 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta integer, optional, intent(in) :: tau_halo !< The halo size of wind stresses to set, 0 by default. ! Local variables - real, dimension(SZI_(G),SZJ_(G)) :: & - taux_in ! Zonal wind stresses (in Pa) at u, h, or q points, depending on the value of - ! wind_stagger, always with non-symmetric memory to permit array reuse. - real, dimension(SZI_(G),SZJ_(G)) :: & - tauy_in ! Meridional wind stresses (in Pa) at v, h, or q points, depending on the value of - ! wind_stagger, always with non-symmetric memory to permit array reuse. + real, dimension(SZI_(G),SZJ_(G)) :: taux_in_A ! Zonal wind stresses (in Pa) at h points + real, dimension(SZI_(G),SZJ_(G)) :: tauy_in_A ! Meridional wind stresses (in Pa) at h points + real, dimension(SZIB_(G),SZJ_(G)) :: taux_in_C ! Zonal wind stresses (in Pa) at u points + real, dimension(SZI_(G),SZJB_(G)) :: tauy_in_C ! Meridional wind stresses (in Pa) at v points + real, dimension(SZIB_(G),SZJB_(G)) :: taux_in_B ! Zonal wind stresses (in Pa) at q points + real, dimension(SZIB_(G),SZJB_(G)) :: tauy_in_B ! Meridional wind stresses (in Pa) at q points real :: gustiness ! unresolved gustiness that contributes to ustar (Pa) real :: Irho0 ! inverse of the mean density in (m^3/kg) @@ -835,68 +835,90 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta if ((IOB%wind_stagger == AGRID) .or. (IOB%wind_stagger == BGRID_NE) .or. & (IOB%wind_stagger == CGRID_NE)) wind_stagger = IOB%wind_stagger + if (associated(IOB%u_flux).neqv.associated(IOB%v_flux)) call MOM_error(FATAL,"extract_IOB_stresses: "//& + "associated(IOB%u_flux) /= associated(IOB%v_flux !!!") + if (present(taux).neqv.present(tauy)) call MOM_error(FATAL,"extract_IOB_stresses: "//& + "present(taux) /= present(tauy) !!!") + ! Set surface momentum stress related fields as a function of staggering. if (present(taux) .or. present(tauy) .or. & ((do_ustar.or.do_gustless) .and. .not.associated(IOB%stress_mag)) ) then - ! This is necessary to fill in the halo points. - taux_in(:,:) = 0.0 ; tauy_in(:,:) = 0.0 - ! Obtain stress from IOB; note that the staggering locations of taux_in and tauy_in depend - ! on the values of wind_stagger, so the case-sensitive index convention is not used here. - do j=js,je ; do i=is,ie - if (associated(IOB%u_flux)) taux_in(i,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier - if (associated(IOB%v_flux)) tauy_in(i,j) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier - enddo ; enddo - if (wind_stagger == BGRID_NE) then - call pass_vector(taux_in, tauy_in, G%Domain_aux, stagger=BGRID_NE, halo=1+halo) - - if (present(taux)) then ; do j=jsh,jeh ; do I=Isqh,Ieqh - taux(I,j) = 0.0 - if ((G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) > 0) & - taux(I,j) = (G%mask2dBu(I,J)*taux_in(I,J) + G%mask2dBu(I,J-1)*taux_in(I,J-1)) / & - (G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) - enddo ; enddo ; endif - - if (present(tauy)) then ; do J=Jsqh,Jeqh ; do i=ish,ieh - tauy(i,J) = 0.0 - if ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) > 0) & - tauy(i,J) = (G%mask2dBu(I,J)*tauy_in(I,J) + G%mask2dBu(I-1,J)*tauy_in(I-1,J)) / & - (G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) - enddo ; enddo ; endif + taux_in_B(:,:) = 0.0 ; tauy_in_B(:,:) = 0.0 + if (associated(IOB%u_flux).and.associated(IOB%v_flux)) then + do J=js,je ; do I=is,ie + taux_in_B(I,J) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier + tauy_in_B(I,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier + enddo ; enddo + endif + if (G%symmetric) call fill_symmetric_edges(taux_in_B, tauy_in_B, G%Domain, stagger=BGRID_NE) + call pass_vector(taux_in_B, tauy_in_B, G%Domain, stagger=BGRID_NE, halo=max(1,halo)) + + if (present(taux).and.present(tauy)) then + do j=jsh,jeh ; do I=Isqh,Ieqh + taux(I,j) = 0.0 + if ((G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) > 0) & + taux(I,j) = (G%mask2dBu(I,J)*taux_in_B(I,J) + G%mask2dBu(I,J-1)*taux_in_B(I,J-1)) / & + (G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) + enddo ; enddo + do J=Jsqh,Jeqh ; do i=ish,ieh + tauy(i,J) = 0.0 + if ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) > 0) & + tauy(i,J) = (G%mask2dBu(I,J)*tauy_in_B(I,J) + G%mask2dBu(I-1,J)*tauy_in_B(I-1,J)) / & + (G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) + enddo ; enddo + endif elseif (wind_stagger == AGRID) then + taux_in_A(:,:) = 0.0 ; tauy_in_A(:,:) = 0.0 + if (associated(IOB%u_flux).and.associated(IOB%v_flux)) then + do j=js,je ; do i=is,ie + taux_in_A(i,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier + tauy_in_A(i,j) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier + enddo ; enddo + endif + if (halo == 0) then - call pass_vector(taux_in, tauy_in, G%Domain, To_All+Omit_Corners, stagger=AGRID, halo=1) + call pass_vector(taux_in_A, tauy_in_A, G%Domain, To_All+Omit_Corners, stagger=AGRID, halo=1) else - call pass_vector(taux_in, tauy_in, G%Domain, stagger=AGRID, halo=1+halo) + call pass_vector(taux_in_A, tauy_in_A, G%Domain, stagger=AGRID, halo=max(1,halo)) endif if (present(taux)) then ; do j=jsh,jeh ; do I=Isqh,Ieqh taux(I,j) = 0.0 if ((G%mask2dT(i,j) + G%mask2dT(i+1,j)) > 0) & - taux(I,j) = (G%mask2dT(i,j)*taux_in(i,j) + G%mask2dT(i+1,j)*taux_in(i+1,j)) / & + taux(I,j) = (G%mask2dT(i,j)*taux_in_A(i,j) + G%mask2dT(i+1,j)*taux_in_A(i+1,j)) / & (G%mask2dT(i,j) + G%mask2dT(i+1,j)) enddo ; enddo ; endif if (present(tauy)) then ; do J=Jsqh,Jeqh ; do i=ish,ieh tauy(i,J) = 0.0 if ((G%mask2dT(i,j) + G%mask2dT(i,j+1)) > 0) & - tauy(i,J) = (G%mask2dT(i,j)*tauy_in(i,j) + G%mask2dT(i,J+1)*tauy_in(i,j+1)) / & + tauy(i,J) = (G%mask2dT(i,j)*tauy_in_A(i,j) + G%mask2dT(i,J+1)*tauy_in_A(i,j+1)) / & (G%mask2dT(i,j) + G%mask2dT(i,j+1)) enddo ; enddo ; endif else ! C-grid wind stresses. - call pass_vector(taux_in, tauy_in, G%Domain_aux, halo=1+halo) - - if (present(taux)) then ; do j=jsh,jeh ; do I=Isqh,Ieqh - taux(I,j) = G%mask2dCu(I,j)*taux_in(I,j) - enddo ; enddo ; endif + taux_in_C(:,:) = 0.0 ; tauy_in_C(:,:) = 0.0 + if (associated(IOB%u_flux).and.associated(IOB%v_flux)) then + do j=js,je ; do i=is,ie + taux_in_C(I,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier + tauy_in_C(i,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier + enddo ; enddo + endif - if (present(tauy)) then ; do J=Jsqh,Jeqh ; do i=ish,ieh - tauy(i,J) = G%mask2dCv(i,J)*tauy_in(i,J) - enddo ; enddo ; endif + if (G%symmetric) call fill_symmetric_edges(taux_in_C, tauy_in_C, G%Domain) + call pass_vector(taux_in_C, tauy_in_C, G%Domain, halo=max(1,halo)) + if (present(taux).and.present(tauy)) then + do j=jsh,jeh ; do I=Isqh,Ieqh + taux(I,j) = G%mask2dCu(I,j)*taux_in_C(I,j) + enddo ; enddo + do J=Jsqh,Jeqh ; do i=ish,ieh + tauy(i,J) = G%mask2dCv(i,J)*tauy_in_C(i,J) + enddo ; enddo + endif endif ! endif for extracting wind stress fields with various staggerings endif @@ -929,10 +951,10 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta tau_mag = 0.0 ; gustiness = CS%gust_const if (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + & (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0) then - tau_mag = sqrt(((G%mask2dBu(I,J)*(taux_in(I,J)**2 + tauy_in(I,J)**2) + & - G%mask2dBu(I-1,J-1)*(taux_in(I-1,J-1)**2 + tauy_in(I-1,J-1)**2)) + & - (G%mask2dBu(I,J-1)*(taux_in(I,J-1)**2 + tauy_in(I,J-1)**2) + & - G%mask2dBu(I-1,J)*(taux_in(I-1,J)**2 + tauy_in(I-1,J)**2)) ) / & + tau_mag = sqrt(((G%mask2dBu(I,J)*(taux_in_B(I,J)**2 + tauy_in_B(I,J)**2) + & + G%mask2dBu(I-1,J-1)*(taux_in_B(I-1,J-1)**2 + tauy_in_B(I-1,J-1)**2)) + & + (G%mask2dBu(I,J-1)*(taux_in_B(I,J-1)**2 + tauy_in_B(I,J-1)**2) + & + G%mask2dBu(I-1,J)*(taux_in_B(I-1,J)**2 + tauy_in_B(I-1,J)**2)) ) / & ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) if (CS%read_gust_2d) gustiness = CS%gust(i,j) endif @@ -943,7 +965,7 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta enddo ; enddo elseif (wind_stagger == AGRID) then do j=js,je ; do i=is,ie - tau_mag = G%mask2dT(i,j) * sqrt(taux_in(i,j)**2 + tauy_in(i,j)**2) + tau_mag = G%mask2dT(i,j) * sqrt(taux_in_A(i,j)**2 + tauy_in_A(i,j)**2) gustiness = CS%gust_const if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) @@ -955,11 +977,11 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta do j=js,je ; do i=is,ie taux2 = 0.0 ; tauy2 = 0.0 if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0) & - taux2 = (G%mask2dCu(I-1,j)*taux_in(I-1,j)**2 + & - G%mask2dCu(I,j)*taux_in(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) + taux2 = (G%mask2dCu(I-1,j)*taux_in_C(I-1,j)**2 + & + G%mask2dCu(I,j)*taux_in_C(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) if ((G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) > 0) & - tauy2 = (G%mask2dCv(i,J-1)*tauy_in(i,J-1)**2 + & - G%mask2dCv(i,J)*tauy_in(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) + tauy2 = (G%mask2dCv(i,J-1)*tauy_in_C(i,J-1)**2 + & + G%mask2dCv(i,J)*tauy_in_C(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) tau_mag = sqrt(taux2 + tauy2) gustiness = CS%gust_const From fd369095795436bb3aba36fb1065605f65434a37 Mon Sep 17 00:00:00 2001 From: Niki Zadeh Date: Mon, 27 Aug 2018 13:44:08 -0400 Subject: [PATCH 047/174] Fix data_override issue introduced by present(gas_fields_ocn) - commit 515d9283 in ocean_model_MOM.F90 has introduced a new path that initialization takes before the data_override_init() is being called. This leads to some ocean-ice-biogeochemistry model to crash because they call data_override before init is called for it: Image PC Routine Line Source fms_MOM6_SIS2_com 000000000177DD86 mpp_mod_mp_mpp_er 69 mpp_util_mpi.inc fms_MOM6_SIS2_com 0000000001657BCC data_override_mod 581 data_override.F90 fms_MOM6_SIS2_com 000000000165127F data_override_mod 762 data_override.F90 fms_MOM6_SIS2_com 000000000165733F data_override_mod 636 data_override.F90 fms_MOM6_SIS2_com 0000000000F673EF generic_abiotic_m 1043 generic_abiotic.F90 fms_MOM6_SIS2_com 0000000000DF4A2F generic_tracer_mp 718 generic_tracer.F90 fms_MOM6_SIS2_com 0000000000C6E1A7 mom_generic_trace 872 MOM_generic_tracer.F90 fms_MOM6_SIS2_com 0000000000DF6488 mom_tracer_flow_c 835 MOM_tracer_flow_control.F90 fms_MOM6_SIS2_com 000000000078EAE7 mom_mp_extract_su 2889 MOM.F90 fms_MOM6_SIS2_com 0000000000772E28 ocean_model_mod_m 372 ocean_model_MOM.F90 fms_MOM6_SIS2_com 000000000041385A coupler_main_IP_c 1837 coupler_main.F90 fms_MOM6_SIS2_com 000000000040A7BB MAIN__ 611 coupler_main.F90 - To fix this issue we leverage an existing data_override_init call which is being done at the right place, but only if some parameters are set. --- config_src/coupled_driver/MOM_surface_forcing.F90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 57eb9cfcbc..51d3e0c7b7 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -1413,9 +1413,8 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS) call get_param(param_file, mdl, "ALLOW_FLUX_ADJUSTMENTS", CS%allow_flux_adjustments, & "If true, allows flux adjustments to specified via the \n"//& "data_table using the component name 'OCN'.", default=.false.) - if (CS%allow_flux_adjustments) then - call data_override_init(Ocean_domain_in=G%Domain%mpp_domain) - endif + + call data_override_init(Ocean_domain_in=G%Domain%mpp_domain) if (CS%restore_salt) then salt_file = trim(CS%inputdir) // trim(CS%salt_restore_file) From ddc9ed1c33a1b7357b213929118ecaa19ae63f9f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 28 Aug 2018 14:52:20 -0400 Subject: [PATCH 048/174] +Added rescale_grid_bathymetry and G%Zd_to_m Added new public subroutines, rescale_grid_bathymetry and rescale_dyn_horgrid_bathymetry to change then internal representation of bathymetry, along with new elements Zd_to_m in the ocean_grid_type and dyn_horgrid_type to record the depth units. Also copy over the vertical depth units in copy_dyngrid_to_MOM_grid and copy_MOM_grid_to_dyngrid. All answers are bitwise identical, but there are new public interfaces and transparent types have new elements. --- src/core/MOM_grid.F90 | 45 ++++++++++++++++++++++++++----- src/core/MOM_transcribe_grid.F90 | 2 ++ src/framework/MOM_dyn_horgrid.F90 | 45 +++++++++++++++++++++++++++---- 3 files changed, 81 insertions(+), 11 deletions(-) diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index e72038a252..c92730ec33 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -14,7 +14,7 @@ module MOM_grid #include public MOM_grid_init, MOM_grid_end, set_derived_metrics, set_first_direction -public isPointInCell, hor_index_type, get_global_grid_size +public isPointInCell, hor_index_type, get_global_grid_size, rescale_grid_bathymetry !> Ocean grid type. See mom_grid for details. type, public :: ocean_grid_type @@ -131,17 +131,18 @@ module MOM_grid y_axis_units !< The units that are used in labeling the y coordinate axes. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - bathyT !< Ocean bottom depth at tracer points, in m. + bathyT !< Ocean bottom depth at tracer points, in depth units. + real :: Zd_to_m = 1.0 !< The conversion factor between the units of bathyT and m. logical :: bathymetry_at_vel !< If true, there are separate values for the !! basin depths at velocity points. Otherwise the effects of !! of topography are entirely determined from thickness points. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: & - Dblock_u, & !< Topographic depths at u-points at which the flow is blocked, in m. - Dopen_u !< Topographic depths at u-points at which the flow is open at width dy_Cu, in m. + Dblock_u, & !< Topographic depths at u-points at which the flow is blocked, in depth units. + Dopen_u !< Topographic depths at u-points at which the flow is open at width dy_Cu, in depth units. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: & - Dblock_v, & !< Topographic depths at v-points at which the flow is blocked, in m. - Dopen_v !< Topographic depths at v-points at which the flow is open at width dx_Cv, in m. + Dblock_v, & !< Topographic depths at v-points at which the flow is blocked, in depth units. + Dopen_v !< Topographic depths at v-points at which the flow is open at width dx_Cv, in depth units. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & CoriolisBu !< The Coriolis parameter at corner points, in s-1. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & @@ -345,6 +346,38 @@ subroutine MOM_grid_init(G, param_file, HI, global_indexing, bathymetry_at_vel) end subroutine MOM_grid_init +!> rescale_grid_bathymetry permits a change in the internal units for the bathymetry on the grid, +!! both rescaling the depths and recording the new internal units. +subroutine rescale_grid_bathymetry(G, m_in_new_units) + type(ocean_grid_type), intent(inout) :: G !< The horizontal grid structure + real, intent(in) :: m_in_new_units !< The new internal representation of 1 m depth. + + ! Local variables + real :: rescale + 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 + + if (m_in_new_units == G%Zd_to_m) return + if (m_in_new_units < 0.0) & + call MOM_error(FATAL, "rescale_grid_bathymetry: Negative depth units are not permitted.") + if (m_in_new_units == 0.0) & + call MOM_error(FATAL, "rescale_grid_bathymetry: Zero depth units are not permitted.") + + rescale = G%Zd_to_m / m_in_new_units + do j=jsd,jed ; do i=isd,ied + G%bathyT(i,j) = rescale*G%bathyT(i,j) + enddo ; enddo + if (G%bathymetry_at_vel) then ; do j=jsd,jed ; do I=IsdB,IedB + G%Dblock_u(I,j) = rescale*G%Dblock_u(I,j) ; G%Dopen_u(I,j) = rescale*G%Dopen_u(I,j) + enddo ; enddo ; endif + if (G%bathymetry_at_vel) then ; do J=JsdB,JedB ; do i=isd,ied + G%Dblock_v(i,J) = rescale*G%Dblock_v(i,J) ; G%Dopen_v(i,J) = rescale*G%Dopen_v(i,J) + enddo ; enddo ; endif + G%Zd_to_m = 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) diff --git a/src/core/MOM_transcribe_grid.F90 b/src/core/MOM_transcribe_grid.F90 index eea4874f4e..649d481dc9 100644 --- a/src/core/MOM_transcribe_grid.F90 +++ b/src/core/MOM_transcribe_grid.F90 @@ -44,6 +44,7 @@ subroutine copy_dyngrid_to_MOM_grid(dG, oG) if ((isd > oG%isc) .or. (ied < oG%ied) .or. (jsd > oG%jsc) .or. (jed > oG%jed)) & call MOM_error(FATAL, "copy_dyngrid_to_MOM_grid called with incompatible grids.") + oG%Zd_to_m = dG%Zd_to_m do i=isd,ied ; do j=jsd,jed oG%geoLonT(i,j) = dG%geoLonT(i+ido,j+jdo) oG%geoLatT(i,j) = dG%geoLatT(i+ido,j+jdo) @@ -187,6 +188,7 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG) if ((isd > dG%isc) .or. (ied < dG%ied) .or. (jsd > dG%jsc) .or. (jed > dG%jed)) & call MOM_error(FATAL, "copy_dyngrid_to_MOM_grid called with incompatible grids.") + dG%Zd_to_m = oG%Zd_to_m do i=isd,ied ; do j=jsd,jed dG%geoLonT(i,j) = oG%geoLonT(i+ido,j+jdo) dG%geoLatT(i,j) = oG%geoLatT(i+ido,j+jdo) diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 403729559d..2ff129ce66 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -11,6 +11,7 @@ module MOM_dyn_horgrid implicit none ; private public create_dyn_horgrid, destroy_dyn_horgrid, set_derived_dyn_horgrid +public rescale_dyn_horgrid_bathymetry !> Describes the horizontal ocean grid with only dynamic memory arrays type, public :: dyn_horgrid_type @@ -130,17 +131,18 @@ module MOM_dyn_horgrid ! Except on a Cartesian grid, these are usually some variant of "degrees". real, allocatable, dimension(:,:) :: & - bathyT !< Ocean bottom depth at tracer points, in m. + bathyT !< Ocean bottom depth at tracer points, in depth units. + real :: Zd_to_m = 1.0 !< The conversion factor between the units of bathyT and m. logical :: bathymetry_at_vel !< If true, there are separate values for the !! basin depths at velocity points. Otherwise the effects of !! of topography are entirely determined from thickness points. real, allocatable, dimension(:,:) :: & - Dblock_u, & !< Topographic depths at u-points at which the flow is blocked, in m. - Dopen_u !< Topographic depths at u-points at which the flow is open at width dy_Cu, in m. + Dblock_u, & !< Topographic depths at u-points at which the flow is blocked, in depth units. + Dopen_u !< Topographic depths at u-points at which the flow is open at width dy_Cu, in depth units. real, allocatable, dimension(:,:) :: & - Dblock_v, & !< Topographic depths at v-points at which the flow is blocked, in m. - Dopen_v !< Topographic depths at v-points at which the flow is open at width dx_Cv, in m. + Dblock_v, & !< Topographic depths at v-points at which the flow is blocked, in depth units. + Dopen_v !< Topographic depths at v-points at which the flow is open at width dx_Cv, in depth units. real, allocatable, dimension(:,:) :: & CoriolisBu !< The Coriolis parameter at corner points, in s-1. real, allocatable, dimension(:,:) :: & @@ -272,6 +274,39 @@ subroutine create_dyn_horgrid(G, HI, bathymetry_at_vel) end subroutine create_dyn_horgrid +!> rescale_dyn_horgrid_bathymetry permits a change in the internal units for the bathymetry on the +!! grid, both rescaling the depths and recording the new internal depth units. +subroutine rescale_dyn_horgrid_bathymetry(G, m_in_new_units) + type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type + real, intent(in) :: m_in_new_units !< The new internal representation of 1 m depth. + + ! Local variables + real :: rescale + 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 + + if (m_in_new_units == G%Zd_to_m) return + if (m_in_new_units < 0.0) & + call MOM_error(FATAL, "rescale_grid_bathymetry: Negative depth units are not permitted.") + if (m_in_new_units == 0.0) & + call MOM_error(FATAL, "rescale_grid_bathymetry: Zero depth units are not permitted.") + + rescale = G%Zd_to_m / m_in_new_units + do j=jsd,jed ; do i=isd,ied + G%bathyT(i,j) = rescale*G%bathyT(i,j) + enddo ; enddo + if (G%bathymetry_at_vel) then ; do j=jsd,jed ; do I=IsdB,IedB + G%Dblock_u(I,j) = rescale*G%Dblock_u(I,j) ; G%Dopen_u(I,j) = rescale*G%Dopen_u(I,j) + enddo ; enddo ; endif + if (G%bathymetry_at_vel) then ; do J=JsdB,JedB ; do i=isd,ied + G%Dblock_v(i,J) = rescale*G%Dblock_v(i,J) ; G%Dopen_v(i,J) = rescale*G%Dopen_v(i,J) + enddo ; enddo ; endif + G%Zd_to_m = 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) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type From 62b292621309de88d737405f09a7bc9ac08a3b00 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 28 Aug 2018 14:52:46 -0400 Subject: [PATCH 049/174] +Added Z_RESCALE_POWER & m_to_Z Added a new runtime argument, Z_RESCALE_POWER, to facilate power-of-two changes in the internal representation of vertical distances, plus four new elements (m_to_Z, Z_to_m, H_to_Z and Z_to_H) of the verticalGrid_type. All answers are bitwise identical, but the MOM_parameter_doc.debugging files have a new entry. --- src/core/MOM_verticalGrid.F90 | 33 ++++++++++++++++++++++++++------- 1 file changed, 26 insertions(+), 7 deletions(-) diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index e66c137d88..0fbef525af 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -35,6 +35,7 @@ module MOM_verticalGrid ! The following variables give information about the vertical grid. logical :: Boussinesq !< If true, make the Boussinesq approximation. real :: Angstrom_H !< A one-Angstrom thickness in the model thickness units. + real :: Angstrom_Z !< A one-Angstrom thickness in the model depth units. real :: Angstrom_m !< A one-Angstrom thickness in m. real :: H_subroundoff !< A thickness that is so small that it can be added to a thickness of !! Angstrom or larger without changing it at the bit level, in thickness units. @@ -51,6 +52,10 @@ module MOM_verticalGrid real :: m_to_H !< A constant that translates distances in m to the units of thickness. real :: H_to_m !< A constant that translates distances in the units of thickness to m. real :: H_to_Pa !< A constant that translates the units of thickness to pressure in Pa. + real :: m_to_Z !< A constant that translates distances in m to the units of depth. + real :: Z_to_m !< A constant that translates distances in the units of depth to m. + real :: H_to_Z !< A constant that translates thickness units to the units of depth. + real :: Z_to_H !< A constant that translates depth units to thickness units. end type verticalGrid_type contains @@ -63,8 +68,8 @@ subroutine verticalGridInit( param_file, GV ) ! All memory is allocated but not necessarily set to meaningful values until later. ! Local variables - integer :: nk, H_power - real :: rescale_factor + integer :: nk, H_power, Z_power + real :: H_rescale_factor, Z_rescale_factor ! This include declares and sets the variable "version". # include "version_variable.h" character(len=16) :: mdl = 'MOM_verticalGrid' @@ -96,20 +101,30 @@ subroutine verticalGridInit( param_file, GV ) units="nondim", default=0, debuggingParam=.true.) if (abs(H_power) > 300) call MOM_error(FATAL, "verticalGridInit: "//& "H_RESCALE_POWER is outside of the valid range of -300 to 300.") - rescale_factor = 1.0 - if (H_power /= 0) rescale_factor = 2.0**H_power + H_rescale_factor = 1.0 + if (H_power /= 0) H_rescale_factor = 2.0**H_power if (.not.GV%Boussinesq) then call get_param(param_file, mdl, "H_TO_KG_M2", GV%H_to_kg_m2,& "A constant that translates thicknesses from the model's \n"//& "internal units of thickness to kg m-2.", units="kg m-2 H-1", & default=1.0) - GV%H_to_kg_m2 = GV%H_to_kg_m2 * rescale_factor + GV%H_to_kg_m2 = GV%H_to_kg_m2 * H_rescale_factor else call get_param(param_file, mdl, "H_TO_M", GV%H_to_m, & "A constant that translates the model's internal \n"//& "units of thickness into m.", units="m H-1", default=1.0) - GV%H_to_m = GV%H_to_m * rescale_factor + GV%H_to_m = GV%H_to_m * H_rescale_factor endif + call get_param(param_file, mdl, "Z_RESCALE_POWER", Z_power, & + "An integer power of 2 that is used to rescale the model's \n"//& + "intenal units of depths and heights. Valid values range from -300 to 300.", & + units="nondim", default=0, debuggingParam=.true.) + if (abs(Z_power) > 300) call MOM_error(FATAL, "verticalGridInit: "//& + "Z_RESCALE_POWER is outside of the valid range of -300 to 300.") + Z_rescale_factor = 1.0 + if (Z_power /= 0) Z_rescale_factor = 2.0**Z_power + GV%Z_to_m = 1.0 * Z_rescale_factor + GV%m_to_Z = 1.0 / Z_rescale_factor #ifdef STATIC_MEMORY_ ! Here NK_ is a macro, while nk is a variable. call get_param(param_file, mdl, "NK", nk, & @@ -138,8 +153,12 @@ subroutine verticalGridInit( param_file, GV ) GV%H_subroundoff = 1e-20 * max(GV%Angstrom_H,GV%m_to_H*1e-17) GV%H_to_Pa = GV%g_Earth * GV%H_to_kg_m2 + GV%H_to_Z = GV%H_to_m * GV%m_to_Z + GV%Z_to_H = GV%Z_to_m * GV%m_to_H + GV%Angstrom_Z = GV%m_to_Z * GV%Angstrom_m + ! Log derivative values. - call log_param(param_file, mdl, "M to THICKNESS", GV%m_to_H*rescale_factor) + call log_param(param_file, mdl, "M to THICKNESS", GV%m_to_H*H_rescale_factor) call log_param(param_file, mdl, "M to THICKNESS rescaled by 2^-n", GV%m_to_H) call log_param(param_file, mdl, "THICKNESS to M rescaled by 2^n", GV%H_to_m) From ada60cc9b304c579e1c2e76cff57b214e4c2d742 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 28 Aug 2018 15:03:33 -0400 Subject: [PATCH 050/174] Test dimensional consistency of bathymetry Apply rescaling factors to bathymetry throughout the MOM6 code, which demonstrate the dimensional consistency of expressions with bathymetry. A minor bug in the sloshing initialization and a hard-coded dimensional number were identified and commented on in this process. All answers in the existing test suite are identical for nor rescaling or rescaling by 2^93 or 2^-93. --- src/ALE/MOM_ALE.F90 | 2 +- src/ALE/MOM_regridding.F90 | 14 ++-- src/ALE/coord_adapt.F90 | 2 +- src/core/MOM.F90 | 19 +++-- src/core/MOM_PressureForce_Montgomery.F90 | 12 ++-- src/core/MOM_PressureForce_analytic_FV.F90 | 12 ++-- src/core/MOM_PressureForce_blocked_AFV.F90 | 12 ++-- src/core/MOM_barotropic.F90 | 72 ++++++++++--------- src/core/MOM_dynamics_split_RK2.F90 | 2 +- src/core/MOM_dynamics_unsplit.F90 | 2 +- src/core/MOM_dynamics_unsplit_RK2.F90 | 2 +- src/core/MOM_interface_heights.F90 | 16 ++--- src/core/MOM_open_boundary.F90 | 5 +- src/diagnostics/MOM_PointAccel.F90 | 12 ++-- src/diagnostics/MOM_diag_to_Z.F90 | 18 ++--- src/diagnostics/MOM_diagnostics.F90 | 18 +++-- src/diagnostics/MOM_sum_output.F90 | 8 +-- src/diagnostics/MOM_wave_speed.F90 | 3 +- src/framework/MOM_diag_remap.F90 | 10 +-- src/framework/MOM_horizontal_regridding.F90 | 10 +-- src/ice_shelf/MOM_ice_shelf.F90 | 2 + src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 22 +++--- .../MOM_fixed_initialization.F90 | 4 +- src/initialization/MOM_grid_initialize.F90 | 7 +- .../MOM_shared_initialization.F90 | 11 ++- .../MOM_state_initialization.F90 | 38 +++++----- .../MOM_tracer_initialization_from_Z.F90 | 9 +-- src/initialization/midas_vertmap.F90 | 2 +- src/parameterizations/lateral/MOM_MEKE.F90 | 4 +- .../lateral/MOM_internal_tides.F90 | 5 +- .../lateral/MOM_lateral_mixing_coeffs.F90 | 14 ++-- .../vertical/MOM_ALE_sponge.F90 | 12 ++-- .../vertical/MOM_internal_tide_input.F90 | 7 +- .../vertical/MOM_set_viscosity.F90 | 6 +- src/parameterizations/vertical/MOM_sponge.F90 | 23 ++---- .../vertical/MOM_tidal_mixing.F90 | 23 +++--- .../vertical/MOM_vert_friction.F90 | 18 ++--- src/tracer/DOME_tracer.F90 | 2 +- src/tracer/MOM_tracer_Z_init.F90 | 8 +-- src/tracer/dye_example.F90 | 4 +- src/user/BFB_initialization.F90 | 2 +- src/user/DOME2d_initialization.F90 | 23 +++--- src/user/DOME_initialization.F90 | 14 ++-- src/user/ISOMIP_initialization.F90 | 43 ++++++----- src/user/Kelvin_initialization.F90 | 30 +++++--- src/user/Neverland_initialization.F90 | 2 +- src/user/Phillips_initialization.F90 | 2 +- src/user/adjustment_initialization.F90 | 2 +- src/user/baroclinic_zone_initialization.F90 | 2 +- src/user/benchmark_initialization.F90 | 2 +- src/user/circle_obcs_initialization.F90 | 2 +- src/user/dense_water_initialization.F90 | 2 +- src/user/dumbbell_initialization.F90 | 9 ++- src/user/seamount_initialization.F90 | 7 +- src/user/sloshing_initialization.F90 | 40 +++++------ src/user/soliton_initialization.F90 | 2 +- 56 files changed, 334 insertions(+), 322 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 7e2885fd6f..a7ac3cc4c7 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -1225,7 +1225,7 @@ subroutine ALE_initThicknessToCoord( CS, G, GV, h ) integer :: i, j, k do j = G%jsd,G%jed ; do i = G%isd,G%ied - h(i,j,:) = GV%m_to_H * getStaticThickness( CS%regridCS, 0., G%bathyT(i,j) ) + h(i,j,:) = GV%m_to_H * getStaticThickness( CS%regridCS, 0., G%Zd_to_m*G%bathyT(i,j) ) enddo ; enddo end subroutine ALE_initThicknessToCoord diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index 9f756346bf..16dfb9140e 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -904,7 +904,7 @@ subroutine check_remapping_grid( G, GV, h, dzInterface, msg ) !$OMP parallel do default(shared) do j = G%jsc-1,G%jec+1 do i = G%isc-1,G%iec+1 - if (G%mask2dT(i,j)>0.) call check_grid_column( GV%ke, G%bathyT(i,j), h(i,j,:), dzInterface(i,j,:), msg ) + if (G%mask2dT(i,j)>0.) call check_grid_column( GV%ke, G%Zd_to_m*G%bathyT(i,j), h(i,j,:), dzInterface(i,j,:), msg ) enddo enddo @@ -1147,7 +1147,7 @@ subroutine build_zstar_grid( CS, G, GV, h, dzInterface, frac_shelf_h) endif ! Local depth (G%bathyT is positive) - nominalDepth = G%bathyT(i,j)*GV%m_to_H + nominalDepth = G%bathyT(i,j)*G%Zd_to_m*GV%m_to_H ! Determine water column thickness totalThickness = 0.0 @@ -1236,7 +1236,7 @@ subroutine build_sigma_grid( CS, G, GV, h, dzInterface ) endif ! The rest of the model defines grids integrating up from the bottom - nominalDepth = G%bathyT(i,j)*GV%m_to_H + nominalDepth = G%bathyT(i,j)*G%Zd_to_m*GV%m_to_H ! Determine water column height totalThickness = 0.0 @@ -1340,7 +1340,7 @@ subroutine build_rho_grid( G, GV, h, tv, dzInterface, remapCS, CS ) ! Local depth (G%bathyT is positive) - nominalDepth = G%bathyT(i,j)*GV%m_to_H + nominalDepth = G%bathyT(i,j)*G%Zd_to_m*GV%m_to_H call build_rho_column(CS%rho_CS, nz, nominalDepth, h(i, j, :), & tv%T(i, j, :), tv%S(i, j, :), tv%eqn_of_state, zNew, & @@ -1445,7 +1445,7 @@ subroutine build_grid_HyCOM1( G, GV, h, tv, h_new, dzInterface, CS ) do j = G%jsc-1,G%jec+1 ; do i = G%isc-1,G%iec+1 if (G%mask2dT(i,j)>0.) then - depth = G%bathyT(i,j) * GV%m_to_H + depth = G%bathyT(i,j) * G%Zd_to_m*GV%m_to_H z_col(1) = 0. ! Work downward rather than bottom up do K = 1, GV%ke @@ -1576,7 +1576,7 @@ subroutine build_grid_SLight(G, GV, h, tv, dzInterface, CS) do j = G%jsc-1,G%jec+1 ; do i = G%isc-1,G%iec+1 if (G%mask2dT(i,j)>0.) then - depth = G%bathyT(i,j) * GV%m_to_H + depth = G%bathyT(i,j) * G%Zd_to_m*GV%m_to_H z_col(1) = 0. ! Work downward rather than bottom up do K=1,nz z_col(K+1) = z_col(K) + h(i, j, k) ! Work in units of h (m or Pa) @@ -1704,7 +1704,7 @@ subroutine build_grid_arbitrary( G, GV, h, dzInterface, h_new, CS ) do i = G%isc-1,G%iec+1 ! Local depth - local_depth = G%bathyT(i,j)*GV%m_to_H + local_depth = G%bathyT(i,j)*G%Zd_to_m*GV%m_to_H ! Determine water column height total_height = 0.0 diff --git a/src/ALE/coord_adapt.F90 b/src/ALE/coord_adapt.F90 index 5b17c3b57c..91ba50fab7 100644 --- a/src/ALE/coord_adapt.F90 +++ b/src/ALE/coord_adapt.F90 @@ -126,7 +126,7 @@ subroutine build_adapt_column(CS, G, GV, tv, i, j, zInt, tInt, sInt, h, zNext) zNext(nz+1) = zInt(i,j,nz+1) ! local depth for scaling diffusivity - depth = G%bathyT(i,j) * GV%m_to_H + depth = G%bathyT(i,j) * G%Zd_to_m*GV%m_to_H ! initialize del2sigma to zero del2sigma(:) = 0. diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 3d869f6681..eb7d8925b6 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -71,11 +71,12 @@ module MOM use MOM_dynamics_unsplit_RK2, only : initialize_dyn_unsplit_RK2, end_dyn_unsplit_RK2 use MOM_dynamics_unsplit_RK2, only : MOM_dyn_unsplit_RK2_CS use MOM_dyn_horgrid, only : dyn_horgrid_type, create_dyn_horgrid, destroy_dyn_horgrid +use MOM_dyn_horgrid, only : rescale_dyn_horgrid_bathymetry use MOM_debugging, only : check_redundant use MOM_EOS, only : EOS_init, calculate_density use MOM_fixed_initialization, only : MOM_initialize_fixed -use MOM_grid, only : ocean_grid_type, set_first_direction -use MOM_grid, only : MOM_grid_init, MOM_grid_end +use MOM_grid, only : ocean_grid_type, MOM_grid_init, MOM_grid_end +use MOM_grid, only : set_first_direction, rescale_grid_bathymetry use MOM_hor_index, only : hor_index_type, hor_index_init use MOM_interface_heights, only : find_eta use MOM_lateral_mixing_coeffs, only : calc_slope_functions, VarMix_init @@ -1956,6 +1957,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! Allocate initialize time-invariant MOM variables. call MOM_initialize_fixed(dG, CS%OBC, param_file, write_geom_files, dirs%output_directory) call callTree_waypoint("returned from MOM_initialize_fixed() (initialize_MOM)") + ! This could replace a later call to rescale_grid_bathymetry. + if (dG%Zd_to_m /= GV%Z_to_m) call rescale_dyn_horgrid_bathymetry(dG, GV%Z_to_m) + if (associated(CS%OBC)) call call_OBC_register(param_file, CS%update_OBC_CSp, CS%OBC) call tracer_registry_init(param_file, CS%tracer_Reg) @@ -2132,6 +2136,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call copy_dyngrid_to_MOM_grid(dG, G) call destroy_dyn_horgrid(dG) + ! This could be moved earlier, perhaps just after MOM_initialize_fixed. +! if (G%Zd_to_m /= GV%Z_to_m) call rescale_grid_bathymetry(G, GV%Z_to_m) + ! Set a few remaining fields that are specific to the ocean grid type. call set_first_direction(G, first_direction) ! Allocate the auxiliary non-symmetric domain for debugging or I/O purposes. @@ -2893,10 +2900,10 @@ subroutine extract_surface_state(CS, sfc_state) numberOfErrors=0 ! count number of errors do j=js,je; do i=is,ie if (G%mask2dT(i,j)>0.) then - localError = sfc_state%sea_lev(i,j)<=-G%bathyT(i,j) & + localError = sfc_state%sea_lev(i,j)<=-G%Zd_to_m*G%bathyT(i,j) & .or. sfc_state%sea_lev(i,j)>= CS%bad_val_ssh_max & .or. sfc_state%sea_lev(i,j)<=-CS%bad_val_ssh_max & - .or. sfc_state%sea_lev(i,j)+G%bathyT(i,j) < CS%bad_vol_col_thick + .or. sfc_state%sea_lev(i,j) + G%Zd_to_m*G%bathyT(i,j) < CS%bad_vol_col_thick if (use_temperature) localError = localError & .or. sfc_state%SSS(i,j)<0. & .or. sfc_state%SSS(i,j)>=CS%bad_val_sss_max & @@ -2909,7 +2916,7 @@ subroutine extract_surface_state(CS, sfc_state) write(msg(1:240),'(2(a,i4,x),2(a,f8.3,x),8(a,es11.4,x))') & 'Extreme surface sfc_state detected: i=',i,'j=',j, & 'x=',G%geoLonT(i,j), 'y=',G%geoLatT(i,j), & - 'D=',G%bathyT(i,j), 'SSH=',sfc_state%sea_lev(i,j), & + 'D=',G%Zd_to_m*G%bathyT(i,j), 'SSH=',sfc_state%sea_lev(i,j), & 'SST=',sfc_state%SST(i,j), 'SSS=',sfc_state%SSS(i,j), & 'U-=',sfc_state%u(I-1,j), 'U+=',sfc_state%u(I,j), & 'V-=',sfc_state%v(i,J-1), 'V+=',sfc_state%v(i,J) @@ -2917,7 +2924,7 @@ subroutine extract_surface_state(CS, sfc_state) write(msg(1:240),'(2(a,i4,x),2(a,f8.3,x),6(a,es11.4))') & 'Extreme surface sfc_state detected: i=',i,'j=',j, & 'x=',G%geoLonT(i,j), 'y=',G%geoLatT(i,j), & - 'D=',G%bathyT(i,j), 'SSH=',sfc_state%sea_lev(i,j), & + 'D=',G%Zd_to_m*G%bathyT(i,j), 'SSH=',sfc_state%sea_lev(i,j), & 'U-=',sfc_state%u(I-1,j), 'U+=',sfc_state%u(I,j), & 'V-=',sfc_state%v(i,J-1), 'V+=',sfc_state%v(i,J) endif diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index c68ac56305..1e9e41eb9a 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -186,7 +186,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, !$OMP I_gEarth,h,alpha_Lay) !$OMP do do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - SSH(i,j) = -G%bathyT(i,j) + SSH(i,j) = -G%Zd_to_m*G%bathyT(i,j) enddo ; enddo if (use_EOS) then !$OMP do @@ -209,12 +209,12 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp) !$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,geopot_bot,G,GV,e_tidal) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - geopot_bot(i,j) = -GV%g_Earth*(e_tidal(i,j) + G%bathyT(i,j)) + geopot_bot(i,j) = -GV%g_Earth*(e_tidal(i,j) + G%Zd_to_m*G%bathyT(i,j)) enddo ; enddo else !$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,geopot_bot,G,GV) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - geopot_bot(i,j) = -GV%g_Earth*G%bathyT(i,j) + geopot_bot(i,j) = -GV%g_Earth*G%Zd_to_m*G%bathyT(i,j) enddo ; enddo endif @@ -453,7 +453,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta ! barotropic tides. !$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,e,h,G,GV) do j=Jsq,Jeq+1 - do i=Isq,Ieq+1 ; e(i,j,1) = -1.0*G%bathyT(i,j) ; enddo + do i=Isq,Ieq+1 ; e(i,j,1) = -G%Zd_to_m*G%bathyT(i,j) ; enddo do k=1,nz ; do i=Isq,Ieq+1 e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_m enddo ; enddo @@ -466,12 +466,12 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta if (CS%tides) then !$OMP do do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -1.0*G%bathyT(i,j) - e_tidal(i,j) + e(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) - e_tidal(i,j) enddo ; enddo else !$OMP do do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -1.0*G%bathyT(i,j) + e(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) enddo ; enddo endif !$OMP do diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index c5e783cec3..9a50cd78e6 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -302,7 +302,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - za(i,j) = alpha_ref*p(i,j,nz+1) - GV%g_Earth*G%bathyT(i,j) + za(i,j) = alpha_ref*p(i,j,nz+1) - GV%g_Earth*G%Zd_to_m*G%bathyT(i,j) enddo do k=nz,1,-1 ; do i=Isq,Ieq+1 za(i,j) = za(i,j) + dza(i,j,k) @@ -533,7 +533,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - e(i,j,1) = -1.0*G%bathyT(i,j) + e(i,j,1) = -G%Zd_to_m*G%bathyT(i,j) enddo do k=1,nz ; do i=Isq,Ieq+1 e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_m @@ -546,12 +546,12 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p if (CS%tides) then !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -1.0*G%bathyT(i,j) - e_tidal(i,j) + e(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) - e_tidal(i,j) enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -1.0*G%bathyT(i,j) + e(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) enddo ; enddo endif !$OMP parallel do default(shared) @@ -668,7 +668,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p call int_density_dz_generic_plm( T_t(:,:,k), T_b(:,:,k), & S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & rho_ref, CS%Rho0, GV%g_Earth, & - dz_neglect, G%bathyT, G%HI, G%HI, & + dz_neglect, G%Zd_to_m*G%bathyT(:,:), G%HI, G%HI, & tv%eqn_of_state, dpa, intz_dpa, intx_dpa, inty_dpa, & useMassWghtInterp = CS%useMassWghtInterp) elseif ( CS%Recon_Scheme == 2 ) then @@ -683,7 +683,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p e(:,:,K), e(:,:,K+1), & rho_ref, CS%Rho0, GV%g_Earth, G%HI, G%HI, tv%eqn_of_state, & dpa, intz_dpa, intx_dpa, inty_dpa, & - G%bathyT, dz_neglect, CS%useMassWghtInterp) + G%Zd_to_m*G%bathyT(:,:), dz_neglect, CS%useMassWghtInterp) endif !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index ac1938449f..318f4126f1 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -269,7 +269,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - za(i,j) = alpha_ref*p(i,j,nz+1) - GV%g_Earth*G%bathyT(i,j) + za(i,j) = alpha_ref*p(i,j,nz+1) - GV%g_Earth*G%Zd_to_m*G%bathyT(i,j) enddo do k=nz,1,-1 ; do i=Isq,Ieq+1 za(i,j) = za(i,j) + dza(i,j,k) @@ -518,7 +518,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - e(i,j,1) = -1.0*G%bathyT(i,j) + e(i,j,1) = -G%Zd_to_m*G%bathyT(i,j) enddo do k=1,nz ; do i=Isq,Ieq+1 e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_m @@ -531,12 +531,12 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at if (CS%tides) then !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -1.0*G%bathyT(i,j) - e_tidal(i,j) + e(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) - e_tidal(i,j) enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -1.0*G%bathyT(i,j) + e(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) enddo ; enddo endif !$OMP parallel do default(shared) @@ -666,7 +666,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at call int_density_dz_generic_plm( T_t(:,:,k), T_b(:,:,k), & S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & rho_ref, CS%Rho0, GV%g_Earth, & - dz_neglect, G%bathyT, G%HI, G%Block(n), & + dz_neglect, G%Zd_to_m*G%bathyT(:,:), G%HI, G%Block(n), & tv%eqn_of_state, dpa_bk, intz_dpa_bk, intx_dpa_bk, inty_dpa_bk, & useMassWghtInterp = CS%useMassWghtInterp) elseif ( CS%Recon_Scheme == 2 ) then @@ -681,7 +681,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at e(:,:,K), e(:,:,K+1), & rho_ref, CS%Rho0, GV%g_Earth, G%HI, G%Block(n), tv%eqn_of_state, & dpa_bk, intz_dpa_bk, intx_dpa_bk, inty_dpa_bk, & - G%bathyT, dz_neglect, CS%useMassWghtInterp) + G%Zd_to_m*G%bathyT(:,:), dz_neglect, CS%useMassWghtInterp) endif do jb=Jsq_bk,Jeq_bk+1 ; do ib=Isq_bk,Ieq_bk+1 intz_dpa_bk(ib,jb) = intz_dpa_bk(ib,jb)*GV%m_to_H diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 68ef858090..7e5045a087 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -130,7 +130,8 @@ module MOM_barotropic real ALLOCABLE_, dimension(NIMEMW_,NJMEMW_) :: & ua_polarity, & !< Test vector components for checking grid polarity. va_polarity, & !< Test vector components for checking grid polarity. - bathyT !< A copy of bathyT (ocean bottom depth) with wide halos. + bathyT !< A copy of bathyT (ocean bottom depth) with wide halos, in depth units + real :: Zd_to_m = 1.0 !< The conversion factor between the units of bathyT and m. real ALLOCABLE_, dimension(NIMEMW_,NJMEMW_) :: IareaT !< This is a copy of G%IareaT with wide halos, but will !! still utilize the macro IareaT when referenced, m-2. @@ -804,18 +805,18 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & ! ### bathyT here should be replaced with bathyT+eta(Bous) or eta(non-Bous). !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - DCor_u(I,j) = 0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j)) + DCor_u(I,j) = 0.5 * G%Zd_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j)) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - DCor_v(i,J) = 0.5 * (G%bathyT(i,j+1) + G%bathyT(i,j)) + DCor_v(i,J) = 0.5 * G%Zd_to_m*(G%bathyT(i,j+1) + G%bathyT(i,j)) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do I=is-1,ie q(I,J) = 0.25 * G%CoriolisBu(I,J) * & ((G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i+1,j) + G%areaT(i,j+1))) / & - ((G%areaT(i,j) * G%bathyT(i,j) + G%areaT(i+1,j+1) * G%bathyT(i+1,j+1)) + & - (G%areaT(i+1,j) * G%bathyT(i+1,j) + G%areaT(i,j+1) * G%bathyT(i,j+1))) + (G%Zd_to_m*((G%areaT(i,j) * G%bathyT(i,j) + G%areaT(i+1,j+1) * G%bathyT(i+1,j+1)) + & + (G%areaT(i+1,j) * G%bathyT(i+1,j) + G%areaT(i,j+1) * G%bathyT(i,j+1)))) enddo ; enddo ! With very wide halos, q and D need to be calculated on the available data @@ -1291,7 +1292,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & do j=js,je ; do I=is-1,ie ; if (CS%lin_drag_u(I,j) > 0.0) then Htot = 0.5 * (eta(i,j) + eta(i+1,j)) if (GV%Boussinesq) & - Htot = Htot + 0.5*GV%m_to_H * (CS%bathyT(i,j) + CS%bathyT(i+1,j)) + Htot = Htot + 0.5*CS%Zd_to_m*GV%m_to_H * (CS%bathyT(i,j) + CS%bathyT(i+1,j)) bt_rem_u(I,j) = bt_rem_u(I,j) * (Htot / (Htot + CS%lin_drag_u(I,j) * dtbt)) Rayleigh_u(I,j) = CS%lin_drag_u(I,j) / Htot @@ -1300,7 +1301,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & do J=js-1,je ; do i=is,ie ; if (CS%lin_drag_v(i,J) > 0.0) then Htot = 0.5 * (eta(i,j) + eta(i,j+1)) if (GV%Boussinesq) & - Htot = Htot + 0.5*GV%m_to_H * (CS%bathyT(i,j) + CS%bathyT(i+1,j+1)) + Htot = Htot + 0.5*CS%Zd_to_m*GV%m_to_H * (CS%bathyT(i,j) + CS%bathyT(i+1,j+1)) bt_rem_v(i,J) = bt_rem_v(i,J) * (Htot / (Htot + CS%lin_drag_v(i,J) * dtbt)) Rayleigh_v(i,J) = CS%lin_drag_v(i,J) / Htot @@ -1353,7 +1354,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & ! Limit the sink (inward) correction to the amount of mass that is already ! inside the cell. Htot = eta(i,j) - if (GV%Boussinesq) Htot = CS%bathyT(i,j)*GV%m_to_H + eta(i,j) + if (GV%Boussinesq) Htot = CS%bathyT(i,j)*CS%Zd_to_m*GV%m_to_H + eta(i,j) CS%eta_cor(i,j) = max(CS%eta_cor(i,j), -max(0.0,Htot)) endif @@ -2633,17 +2634,17 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, MS, halo, use_BT_co else ! This is assuming Flather as only other option if (GV%Boussinesq) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then - BT_OBC%H_u(I,j) = G%bathyT(i,j)*GV%m_to_H + eta(i,j) + BT_OBC%H_u(I,j) = G%bathyT(i,j)*G%Zd_to_m*GV%m_to_H + eta(i,j) elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then - BT_OBC%H_u(I,j) = G%bathyT(i+1,j)*GV%m_to_H + eta(i+1,j) + BT_OBC%H_u(I,j) = G%bathyT(i+1,j)*G%Zd_to_m*GV%m_to_H + eta(i+1,j) endif else if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then BT_OBC%H_u(i,j) = eta(i,j) - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%bathyT(i,j) + eta(i,j))) + BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%Zd_to_m*G%bathyT(i,j) + eta(i,j))) elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then BT_OBC%H_u(i,j) = eta(i+1,j) - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%bathyT(i+1,j) + eta(i+1,j))) + BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%Zd_to_m*G%bathyT(i+1,j) + eta(i+1,j))) endif endif if (GV%Boussinesq) then @@ -2689,17 +2690,17 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, MS, halo, use_BT_co else ! This is assuming Flather as only other option if (GV%Boussinesq) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then - BT_OBC%H_v(i,J) = G%bathyT(i,j)*GV%m_to_H + eta(i,j) + BT_OBC%H_v(i,J) = G%bathyT(i,j)*G%Zd_to_m*GV%m_to_H + eta(i,j) elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then - BT_OBC%H_v(i,J) = G%bathyT(i,j+1)*GV%m_to_H + eta(i,j+1) + BT_OBC%H_v(i,J) = G%bathyT(i,j+1)*G%Zd_to_m*GV%m_to_H + eta(i,j+1) endif else if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then BT_OBC%H_v(i,J) = eta(i,j) - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%bathyT(i,j) + eta(i,j))) + BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%Zd_to_m*G%bathyT(i,j) + eta(i,j))) elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then BT_OBC%H_v(i,J) = eta(i,j+1) - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%bathyT(i,j+1) + eta(i,j+1))) + BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%Zd_to_m*G%bathyT(i,j+1) + eta(i,j+1))) endif endif if (GV%Boussinesq) then @@ -2857,8 +2858,8 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) enddo ; enddo elseif (CS%hvel_scheme == HYBRID .or. use_default) then do I=is-1,ie - e_u(I,nz+1) = -0.5 * GV%m_to_H * (G%bathyT(i+1,j) + G%bathyT(i,j)) - D_shallow_u(I) = -GV%m_to_H * min(G%bathyT(i+1,j), G%bathyT(i,j)) + e_u(I,nz+1) = -0.5 * G%Zd_to_m*GV%m_to_H * (G%bathyT(i+1,j) + G%bathyT(i,j)) + D_shallow_u(I) = -G%Zd_to_m*GV%m_to_H * min(G%bathyT(i+1,j), G%bathyT(i,j)) hatutot(I) = 0.0 enddo do k=nz,1,-1 ; do I=is-1,ie @@ -2920,8 +2921,8 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) enddo ; enddo elseif (CS%hvel_scheme == HYBRID .or. use_default) then do i=is,ie - e_v(i,nz+1) = -0.5 * GV%m_to_H * (G%bathyT(i,j+1) + G%bathyT(i,j)) - D_shallow_v(I) = -GV%m_to_H * min(G%bathyT(i,j+1), G%bathyT(i,j)) + e_v(i,nz+1) = -0.5 * G%Zd_to_m*GV%m_to_H * (G%bathyT(i,j+1) + G%bathyT(i,j)) + D_shallow_v(I) = -G%Zd_to_m*GV%m_to_H * min(G%bathyT(i,j+1), G%bathyT(i,j)) hatvtot(I) = 0.0 enddo do k=nz,1,-1 ; do i=is,ie @@ -3557,14 +3558,14 @@ subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max) if (GV%Boussinesq) then !$OMP do do j=js-hs,je+hs ; do I=is-1-hs,ie+hs - H1 = CS%bathyT(i,j)*GV%m_to_H + eta(i,j) ; H2 = CS%bathyT(i+1,j)*GV%m_to_H + eta(i+1,j) + H1 = CS%bathyT(i,j)*CS%Zd_to_m*GV%m_to_H + eta(i,j) ; H2 = CS%bathyT(i+1,j)*CS%Zd_to_m*GV%m_to_H + eta(i+1,j) Datu(I,j) = 0.0 ; if ((H1 > 0.0) .and. (H2 > 0.0)) & Datu(I,j) = CS%dy_Cu(I,j) * (2.0 * H1 * H2) / (H1 + H2) ! Datu(I,j) = CS%dy_Cu(I,j) * 0.5 * (H1 + H2) enddo ; enddo !$OMP do do J=js-1-hs,je+hs ; do i=is-hs,ie+hs - H1 = CS%bathyT(i,j)*GV%m_to_H + eta(i,j) ; H2 = CS%bathyT(i,j+1)*GV%m_to_H + eta(i,j+1) + H1 = CS%bathyT(i,j)*CS%Zd_to_m*GV%m_to_H + eta(i,j) ; H2 = CS%bathyT(i,j+1)*CS%Zd_to_m*GV%m_to_H + eta(i,j+1) Datv(i,J) = 0.0 ; if ((H1 > 0.0) .and. (H2 > 0.0)) & Datv(i,J) = CS%dx_Cv(i,J) * (2.0 * H1 * H2) / (H1 + H2) ! Datv(i,J) = CS%dy_v(i,J) * 0.5 * (H1 + H2) @@ -3589,12 +3590,12 @@ subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max) !$OMP do do j=js-hs,je+hs ; do I=is-1-hs,ie+hs Datu(I,j) = CS%dy_Cu(I,j) * GV%m_to_H * & - (max(CS%bathyT(i+1,j), CS%bathyT(i,j)) + add_max) + (CS%Zd_to_m*max(CS%bathyT(i+1,j), CS%bathyT(i,j)) + add_max) enddo ; enddo !$OMP do do J=js-1-hs,je+hs ; do i=is-hs,ie+hs Datv(i,J) = CS%dx_Cv(i,J) * GV%m_to_H * & - (max(CS%bathyT(i,j+1), CS%bathyT(i,j)) + add_max) + (CS%Zd_to_m*max(CS%bathyT(i,j+1), CS%bathyT(i,j)) + add_max) enddo ; enddo else !$OMP do @@ -3602,7 +3603,7 @@ subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max) Datu(I, j) = 0.0 !Would be "if (G%mask2dCu(I,j)>0.) &" is G was valid on BT domain if (CS%bathyT(i+1,j)+CS%bathyT(i,j)>0.) & - Datu(I,j) = 2.0*CS%dy_Cu(I,j) * GV%m_to_H * & + Datu(I,j) = 2.0*CS%dy_Cu(I,j) * CS%Zd_to_m*GV%m_to_H * & (CS%bathyT(i+1,j) * CS%bathyT(i,j)) / & (CS%bathyT(i+1,j) + CS%bathyT(i,j)) enddo ; enddo @@ -3611,7 +3612,7 @@ subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max) Datv(i, J) = 0.0 !Would be "if (G%mask2dCv(i,J)>0.) &" is G was valid on BT domain if (CS%bathyT(i,j+1)+CS%bathyT(i,j)>0.) & - Datv(i,J) = 2.0*CS%dx_Cv(i,J) * GV%m_to_H * & + Datv(i,J) = 2.0*CS%dx_Cv(i,J) * CS%Zd_to_m*GV%m_to_H * & (CS%bathyT(i,j+1) * CS%bathyT(i,j)) / & (CS%bathyT(i,j+1) + CS%bathyT(i,j)) enddo ; enddo @@ -3658,7 +3659,7 @@ subroutine bt_mass_source(h, eta, set_cor, G, GV, CS) do j=js,je do i=is,ie ; h_tot(i) = h(i,j,1) ; enddo if (GV%Boussinesq) then - do i=is,ie ; eta_h(i) = h(i,j,1) - G%bathyT(i,j)*GV%m_to_H ; enddo + do i=is,ie ; eta_h(i) = h(i,j,1) - G%bathyT(i,j)*G%Zd_to_m*GV%m_to_H ; enddo else do i=is,ie ; eta_h(i) = h(i,j,1) ; enddo endif @@ -4065,6 +4066,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & CS%IareaT(i,j) = G%IareaT(i,j) CS%bathyT(i,j) = G%bathyT(i,j) enddo ; enddo + CS%Zd_to_m = G%Zd_to_m ! Note: G%IdxCu & G%IdyCv may be smaller than CS%IdxCu & CS%IdyCv, even without ! wide halos. do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB @@ -4087,17 +4089,17 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & ALLOC_(CS%D_v_Cor(CS%isdw:CS%iedw,CS%jsdw-1:CS%jedw)) CS%q_D(:,:) = 0.0 ; CS%D_u_Cor(:,:) = 0.0 ; CS%D_v_Cor(:,:) = 0.0 do j=js,je ; do I=is-1,ie - CS%D_u_Cor(I,j) = 0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j)) + CS%D_u_Cor(I,j) = 0.5 * G%Zd_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j)) enddo ; enddo do J=js-1,je ; do i=is,ie - CS%D_v_Cor(i,J) = 0.5 * (G%bathyT(i,j+1) + G%bathyT(i,j)) + CS%D_v_Cor(i,J) = 0.5 * G%Zd_to_m*(G%bathyT(i,j+1) + G%bathyT(i,j)) enddo ; enddo do J=js-1,je ; do I=is-1,ie if (G%mask2dT(i,j)+G%mask2dT(i,j+1)+G%mask2dT(i+1,j)+G%mask2dT(i+1,j+1)>0.) then CS%q_D(I,J) = 0.25 * G%CoriolisBu(I,J) * & ((G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i+1,j) + G%areaT(i,j+1))) / & - ((G%areaT(i,j) * G%bathyT(i,j) + G%areaT(i+1,j+1) * G%bathyT(i+1,j+1)) + & - (G%areaT(i+1,j) * G%bathyT(i+1,j) + G%areaT(i,j+1) * G%bathyT(i,j+1))) + (G%Zd_to_m*((G%areaT(i,j) * G%bathyT(i,j) + G%areaT(i+1,j+1) * G%bathyT(i+1,j+1)) + & + (G%areaT(i+1,j) * G%bathyT(i+1,j) + G%areaT(i,j+1) * G%bathyT(i,j+1)))) else ! All four h points are masked out so q_D(I,J) will is meaningless CS%q_D(I,J) = 0. endif @@ -4294,24 +4296,24 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & ! if (GV%Boussinesq) then do j=js,je ; do I=is-1,ie if (G%mask2dCu(I,j)>0.) then - CS%IDatu(I,j) = G%mask2dCu(I,j) * 2.0 / (G%bathyT(i+1,j) + G%bathyT(i,j)) + CS%IDatu(I,j) = G%mask2dCu(I,j) * 2.0 / (G%Zd_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j))) else ! Both neighboring H points are masked out so IDatu(I,j) is meaningless CS%IDatu(I,j) = 0. endif enddo ; enddo do J=js-1,je ; do i=is,ie if (G%mask2dCv(i,J)>0.) then - CS%IDatv(i,J) = G%mask2dCv(i,J) * 2.0 / (G%bathyT(i,j+1) + G%bathyT(i,j)) + CS%IDatv(i,J) = G%mask2dCv(i,J) * 2.0 / (G%Zd_to_m*(G%bathyT(i,j+1) + G%bathyT(i,j))) else ! Both neighboring H points are masked out so IDatu(I,j) is meaningless CS%IDatv(i,J) = 0. endif enddo ; enddo ! else ! do j=js,je ; do I=is-1,ie -! CS%IDatu(I,j) = G%mask2dCu(I,j) * 2.0 / (GV%Rho0*(G%bathyT(i+1,j) + G%bathyT(i,j))) +! CS%IDatu(I,j) = G%mask2dCu(I,j) * 2.0 / (G%Zd_to_m*GV%Rho0*(G%bathyT(i+1,j) + G%bathyT(i,j))) ! enddo ; enddo ! do J=js-1,je ; do i=is,ie -! CS%IDatv(i,J) = G%mask2dCv(i,J) * 2.0 / (GV%Rho0*(G%bathyT(i,j+1) + G%bathyT(i,j))) +! CS%IDatv(i,J) = G%mask2dCv(i,J) * 2.0 / (G%Zd_to_m*GV%Rho0*(G%bathyT(i,j+1) + G%bathyT(i,j))) ! enddo ; enddo ! endif diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index cf248f5103..df60234ca3 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -1110,7 +1110,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_fil ! dimensions as h, either m or kg m-3. ! CS%eta(:,:) = 0.0 already from initialization. if (GV%Boussinesq) then - do j=js,je ; do i=is,ie ; CS%eta(i,j) = -G%bathyT(i,j) * GV%m_to_H ; enddo ; enddo + do j=js,je ; do i=is,ie ; CS%eta(i,j) = -G%bathyT(i,j) * G%Zd_to_m*GV%m_to_H ; enddo ; enddo endif do k=1,nz ; do j=js,je ; do i=is,ie CS%eta(i,j) = CS%eta(i,j) + h(i,j,k) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 3965758510..96d78fccde 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -491,7 +491,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & endif if (GV%Boussinesq) then - do j=js,je ; do i=is,ie ; eta_av(i,j) = -G%bathyT(i,j) ; enddo ; enddo + do j=js,je ; do i=is,ie ; eta_av(i,j) = -G%Zd_to_m*G%bathyT(i,j) ; enddo ; enddo else do j=js,je ; do i=is,ie ; eta_av(i,j) = 0.0 ; enddo ; enddo endif diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 0f6d61905e..aef20292f8 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -431,7 +431,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, endif if (GV%Boussinesq) then - do j=js,je ; do i=is,ie ; eta_av(i,j) = -G%bathyT(i,j) ; enddo ; enddo + do j=js,je ; do i=is,ie ; eta_av(i,j) = -G%Zd_to_m*G%bathyT(i,j) ; enddo ; enddo else do j=js,je ; do i=is,ie ; eta_av(i,j) = 0.0 ; enddo ; enddo endif diff --git a/src/core/MOM_interface_heights.F90 b/src/core/MOM_interface_heights.F90 index f30bcda8cb..1ae571a733 100644 --- a/src/core/MOM_interface_heights.F90 +++ b/src/core/MOM_interface_heights.F90 @@ -70,7 +70,7 @@ subroutine find_eta_3d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) !$OMP G_Earth,dz_geo,halo,I_gEarth) & !$OMP private(dilate,htot) !$OMP do - do j=jsv,jev ; do i=isv,iev ; eta(i,j,nz+1) = -G%bathyT(i,j) ; enddo ; enddo + do j=jsv,jev ; do i=isv,iev ; eta(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) ; enddo ; enddo if (GV%Boussinesq) then !$OMP do @@ -83,11 +83,11 @@ subroutine find_eta_3d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) !$OMP do do j=jsv,jev do i=isv,iev - dilate(i) = (eta_bt(i,j)*GV%H_to_m + G%bathyT(i,j)) / & - (eta(i,j,1) + G%bathyT(i,j)) + dilate(i) = (eta_bt(i,j)*GV%H_to_m + G%Zd_to_m*G%bathyT(i,j)) / & + (eta(i,j,1) + G%Zd_to_m*G%bathyT(i,j)) enddo do k=1,nz ; do i=isv,iev - eta(i,j,K) = dilate(i) * (eta(i,j,K) + G%bathyT(i,j)) - G%bathyT(i,j) + eta(i,j,K) = dilate(i) * (eta(i,j,K) + G%Zd_to_m*G%bathyT(i,j)) - G%Zd_to_m*G%bathyT(i,j) enddo ; enddo enddo endif @@ -127,7 +127,7 @@ subroutine find_eta_3d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) do k=1,nz ; do i=isv,iev ; htot(i) = htot(i) + h(i,j,k) ; enddo ; enddo do i=isv,iev ; dilate(i) = eta_bt(i,j) / htot(i) ; enddo do k=1,nz ; do i=isv,iev - eta(i,j,K) = dilate(i) * (eta(i,j,K) + G%bathyT(i,j)) - G%bathyT(i,j) + eta(i,j,K) = dilate(i) * (eta(i,j,K) + G%Zd_to_m*G%bathyT(i,j)) - G%Zd_to_m*G%bathyT(i,j) enddo ; enddo enddo endif @@ -178,7 +178,7 @@ subroutine find_eta_2d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) !$OMP G_Earth,dz_geo,halo,I_gEarth) & !$OMP private(htot) !$OMP do - do j=js,je ; do i=is,ie ; eta(i,j) = -G%bathyT(i,j) ; enddo ; enddo + do j=js,je ; do i=is,ie ; eta(i,j) = -G%Zd_to_m*G%bathyT(i,j) ; enddo ; enddo if (GV%Boussinesq) then if (present(eta_bt)) then @@ -225,8 +225,8 @@ subroutine find_eta_2d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) do i=is,ie ; htot(i) = GV%H_subroundoff ; enddo do k=1,nz ; do i=is,ie ; htot(i) = htot(i) + h(i,j,k) ; enddo ; enddo do i=is,ie - eta(i,j) = (eta_bt(i,j) / htot(i)) * (eta(i,j) + G%bathyT(i,j)) - & - G%bathyT(i,j) + eta(i,j) = (eta_bt(i,j) / htot(i)) * (eta(i,j) + G%Zd_to_m*G%bathyT(i,j)) - & + G%Zd_to_m*G%bathyT(i,j) enddo enddo endif diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index de8c2fe174..bd23331e14 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -2977,7 +2977,7 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) if (segment%direction == OBC_DIRECTION_W) ishift=1 I=segment%HI%IsdB do j=segment%HI%jsd,segment%HI%jed - segment%Cg(I,j) = sqrt(GV%g_prime(1)*G%bathyT(i+ishift,j)) + segment%Cg(I,j) = sqrt(GV%g_prime(1)*G%Zd_to_m*G%bathyT(i+ishift,j)) segment%Htot(I,j)=0.0 do k=1,G%ke segment%h(I,j,k) = h(i+ishift,j,k) @@ -2990,7 +2990,7 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) if (segment%direction == OBC_DIRECTION_S) jshift=1 J=segment%HI%JsdB do i=segment%HI%isd,segment%HI%ied - segment%Cg(i,J) = sqrt(GV%g_prime(1)*G%bathyT(i,j+jshift)) + segment%Cg(i,J) = sqrt(GV%g_prime(1)*G%Zd_to_m*G%bathyT(i,j+jshift)) segment%Htot(i,J)=0.0 do k=1,G%ke segment%h(i,J,k) = h(i,j+jshift,k) @@ -3710,6 +3710,7 @@ subroutine mask_outside_OBCs(G, param_file, OBC) call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & default=0.0, do_not_log=.true.) + min_depth = min_depth / G%Zd_to_m allocate(color(G%isd:G%ied, G%jsd:G%jed)) ; color = 0 allocate(color2(G%isd:G%ied, G%jsd:G%jed)) ; color2 = 0 diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index 639e52a8b7..29fb308dd3 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -244,13 +244,13 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (hin(i+1,j+1,k)); enddo - e(nz+1) = -G%bathyT(i,j) + e(nz+1) = -G%Zd_to_m*G%bathyT(i,j) do k=nz,1,-1 ; e(K) = e(K+1) + hin(i,j,k) ; enddo write(file,'(/,"e-: ",$)') write(file,'(ES10.3," ",$)') e(ks) do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K); enddo - e(nz+1) = -G%bathyT(i+1,j) + e(nz+1) = -G%Zd_to_m*G%bathyT(i+1,j) do k=nz,1,-1 ; e(K) = e(K+1) + hin(i+1,j,k) ; enddo write(file,'(/,"e+: ",$)') write(file,'(ES10.3," ",$)') e(ks) @@ -327,7 +327,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a (0.5*CS%v_av(i+1,J,k)*(hin(i+1,j,k) + hin(i+1,j+1,k))); enddo endif - write(file,'(/,"D: ",2(ES10.3))') G%bathyT(i,j),G%bathyT(i+1,j) + write(file,'(/,"D: ",2(ES10.3))') G%Zd_to_m*G%bathyT(i,j),G%Zd_to_m*G%bathyT(i+1,j) ! From here on, the normalized accelerations are written. if (prev_avail) then @@ -575,13 +575,13 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a write(file,'(/,"h++: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') hin(i+1,j+1,k); enddo - e(nz+1) = -G%bathyT(i,j) + e(nz+1) = -G%Zd_to_m*G%bathyT(i,j) do k=nz,1,-1 ; e(K) = e(K+1) + hin(i,j,k); enddo write(file,'(/,"e-: ",$)') write(file,'(ES10.3," ",$)') e(ks) do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K); enddo - e(nz+1) = -G%bathyT(i,j+1) + e(nz+1) = -G%Zd_to_m*G%bathyT(i,j+1) do k=nz,1,-1 ; e(K) = e(K+1) + hin(i,j+1,k) ; enddo write(file,'(/,"e+: ",$)') write(file,'(ES10.3," ",$)') e(ks) @@ -658,7 +658,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a (0.5*CS%u_prev(I,j+1,k)*(hin(i,j+1,k) + hin(i+1,j+1,k))); enddo endif - write(file,'(/,"D: ",2(ES10.3))') G%bathyT(i,j),G%bathyT(i,j+1) + write(file,'(/,"D: ",2(ES10.3))') G%Zd_to_m*G%bathyT(i,j),G%Zd_to_m*G%bathyT(i,j+1) ! From here on, the normalized accelerations are written. if (prev_avail) then diff --git a/src/diagnostics/MOM_diag_to_Z.F90 b/src/diagnostics/MOM_diag_to_Z.F90 index cc272049d6..2a4b1b1ec3 100644 --- a/src/diagnostics/MOM_diag_to_Z.F90 +++ b/src/diagnostics/MOM_diag_to_Z.F90 @@ -107,7 +107,7 @@ function global_z_mean(var,G,CS,tracer) do k=1,nz ; do j=js,je ; do i=is,ie valid_point = 1.0 ! Weight factor for partial bottom cells - depth_weight = min( max( (-1.*G%bathyT(i,j)), CS%Z_int(k+1) ) - CS%Z_int(k), 0.) + depth_weight = min( max( (-G%Zd_to_m*G%bathyT(i,j)), CS%Z_int(k+1) ) - CS%Z_int(k), 0.) ! Flag the point as invalid if it contains missing data, or is below the bathymetry if (var(i,j,k) == CS%missing_tr(tracer)) valid_point = 0. @@ -217,7 +217,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS) ! Remove all massless layers. do I=Isq,Ieq nk_valid(I) = 0 - D_pt(I) = 0.5*(G%bathyT(i+1,j)+G%bathyT(i,j)) + D_pt(I) = 0.5*G%Zd_to_m*(G%bathyT(i+1,j)+G%bathyT(i,j)) if (ice_shelf) then if (frac_shelf_h(i,j)+frac_shelf_h(i+1,j) > 0.) then ! under shelf shelf_depth(I) = abs(0.5*(ssh(i+1,j)+ssh(i,j))) @@ -314,7 +314,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS) shelf_depth(:) = 0.0 ! initially all is open ocean ! Remove all massless layers. do i=is,ie - nk_valid(i) = 0 ; D_pt(i) = 0.5*(G%bathyT(i,j)+G%bathyT(i,j+1)) + nk_valid(i) = 0 ; D_pt(i) = 0.5*G%Zd_to_m*(G%bathyT(i,j)+G%bathyT(i,j+1)) if (ice_shelf) then if (frac_shelf_h(i,j)+frac_shelf_h(i,j+1) > 0.) then ! under shelf shelf_depth(i) = abs(0.5*(ssh(i,j)+ssh(i,j+1))) @@ -406,7 +406,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS) shelf_depth(:) = 0.0 ! initially all is open ocean ! Remove all massless layers. do i=is,ie - nk_valid(i) = 0 ; D_pt(i) = G%bathyT(i,j) + nk_valid(i) = 0 ; D_pt(i) = G%Zd_to_m*G%bathyT(i,j) if (ice_shelf) then if (frac_shelf_h(i,j) > 0.) then ! under shelf shelf_depth(i) = abs(ssh(i,j)) @@ -556,13 +556,13 @@ subroutine calculate_Z_transport(uh_int, vh_int, h, dt, G, GV, CS) htot(i,j) = htot(i,j) + h(i,j,k) enddo ; enddo ; enddo do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - dilate(i,j) = G%bathyT(i,j) / htot(i,j) + dilate(i,j) = G%Zd_to_m*G%bathyT(i,j) / htot(i,j) enddo ; enddo ! zonal transport if (CS%id_uh_Z > 0) then ; do j=js,je do I=Isq,Ieq - kz(I) = nk_z ; z_int_above(I) = -0.5*(G%bathyT(i,j)+G%bathyT(i+1,j)) + kz(I) = nk_z ; z_int_above(I) = -0.5*G%Zd_to_m*(G%bathyT(i,j)+G%bathyT(i+1,j)) enddo do k=nk_z,1,-1 ; do I=Isq,Ieq uh_Z(I,k) = 0.0 @@ -597,7 +597,7 @@ subroutine calculate_Z_transport(uh_int, vh_int, h, dt, G, GV, CS) ! meridional transport if (CS%id_vh_Z > 0) then ; do J=Jsq,Jeq do i=is,ie - kz(i) = nk_z ; z_int_above(i) = -0.5*(G%bathyT(i,j)+G%bathyT(i,j+1)) + kz(i) = nk_z ; z_int_above(i) = -0.5*G%Zd_to_m*(G%bathyT(i,j)+G%bathyT(i,j+1)) enddo do k=nk_z,1,-1 ; do i=is,ie vh_Z(i,k) = 0.0 @@ -769,8 +769,8 @@ subroutine calc_Zint_diags(h, in_ptrs, ids, num_diags, G, GV, CS) do k=1,nk ; do i=is,ie ; htot(i) = htot(i) + h(i,j,k) ; enddo ; enddo do i=is,ie dilate(i) = 0.0 - if (htot(i)*GV%H_to_m > 0.5) dilate(i) = (G%bathyT(i,j) - 0.0) / htot(i) - e(i,nk+1) = -G%bathyT(i,j) + if (htot(i)*GV%H_to_m > 0.5) dilate(i) = (G%Zd_to_m*G%bathyT(i,j) - 0.0) / htot(i) + e(i,nk+1) = -G%Zd_to_m*G%bathyT(i,j) enddo do k=nk,1,-1 ; do i=is,ie e(i,k) = e(i,k+1) + h(i,j,k) * dilate(i) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 8e18ed5a01..5e40fad81e 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -291,12 +291,12 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (associated(CS%e_D)) then if (associated(CS%e)) then do k=1,nz+1 ; do j=js,je ; do i=is,ie - CS%e_D(i,j,k) = CS%e(i,j,k) + G%bathyT(i,j) + CS%e_D(i,j,k) = CS%e(i,j,k) + G%Zd_to_m*G%bathyT(i,j) enddo ; enddo ; enddo else call find_eta(h, tv, GV%g_Earth, G, GV, CS%e_D, eta_bt) do k=1,nz+1 ; do j=js,je ; do i=is,ie - CS%e_D(i,j,k) = CS%e_D(i,j,k) + G%bathyT(i,j) + CS%e_D(i,j,k) = CS%e_D(i,j,k) + G%Zd_to_m*G%bathyT(i,j) enddo ; enddo ; enddo endif @@ -810,7 +810,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, CS) if (CS%id_col_ht > 0) then call find_eta(h, tv, GV%g_Earth, G, GV, z_top) do j=js,je ; do i=is,ie - z_bot(i,j) = z_top(i,j) + G%bathyT(i,j) + z_bot(i,j) = z_top(i,j) + G%Zd_to_m*G%bathyT(i,j) enddo ; enddo call post_data(CS%id_col_ht, z_bot, CS%diag) endif @@ -1209,7 +1209,7 @@ subroutine post_surface_thermo_diags(IDs, G, GV, diag, dt_int, sfc_state, tv, & ! post total volume of the liquid ocean if (IDs%id_volo > 0) then do j=js,je ; do i=is,ie - work_2d(i,j) = G%mask2dT(i,j)*(ssh(i,j) + G%bathyT(i,j)) + work_2d(i,j) = G%mask2dT(i,j)*(ssh(i,j) + G%Zd_to_m*G%bathyT(i,j)) enddo ; enddo volo = global_area_integral(work_2d, G) call post_data(IDs%id_volo, volo, diag) @@ -1898,7 +1898,15 @@ subroutine write_static_fields(G, GV, tv, diag) cmor_standard_name='sea_floor_depth_below_geoid',& area=diag%axesT1%id_area, & x_cell_method='mean', y_cell_method='mean', area_cell_method='mean') - if (id > 0) call post_data(id, G%bathyT, diag, .true., mask=G%mask2dT) + if (id > 0) then + if (G%Zd_to_m == 1.0) then + call post_data(id, G%bathyT, diag, .true., mask=G%mask2dT) + else + tmp_h(:,:) = 0. + tmp_h(G%isc:G%iec,G%jsc:G%jec) = G%bathyT(G%isc:G%iec,G%jsc:G%jec) / G%Zd_to_m + call post_data(id, tmp_h, diag, .true., mask=G%mask2dT) + endif + endif id = register_static_field('ocean_model', 'wet', diag%axesT1, & '0 if land, 1 if ocean at tracer points', 'none', area=diag%axesT1%id_area) diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 3392f85437..e21fb3da3d 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -640,8 +640,8 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp, OBC, dt_forc hbelow = 0.0 do k=nz,1,-1 hbelow = hbelow + h(i,j,k) * H_to_m - hint = H_0APE(K) + (hbelow - G%bathyT(i,j)) - hbot = H_0APE(K) - G%bathyT(i,j) + hint = H_0APE(K) + (hbelow - G%Zd_to_m*G%bathyT(i,j)) + hbot = H_0APE(K) - G%Zd_to_m*G%bathyT(i,j) hbot = (hbot + ABS(hbot)) * 0.5 PE_pt(i,j,K) = 0.5 * areaTm(i,j) * (GV%Rho0*GV%g_prime(K)) * & (hint * hint - hbot * hbot) @@ -652,7 +652,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp, OBC, dt_forc hbelow = 0.0 do k=nz,1,-1 hint = H_0APE(K) + eta(i,j,K) ! eta and H_0 have opposite signs. - hbot = max(H_0APE(K) - G%bathyT(i,j), 0.0) + hbot = max(H_0APE(K) - G%Zd_to_m*G%bathyT(i,j), 0.0) PE_pt(i,j,K) = 0.5 * (areaTm(i,j) * (GV%Rho0*GV%g_prime(K))) * & (hint * hint - hbot * hbot) enddo @@ -1088,7 +1088,7 @@ subroutine create_depth_list(G, CS) i_global = i + G%idg_offset - (G%isg-1) list_pos = (j_global-1)*G%Domain%niglobal + i_global - Dlist(list_pos) = G%bathyT(i,j) + Dlist(list_pos) = G%Zd_to_m*G%bathyT(i,j) Arealist(list_pos) = G%mask2dT(i,j)*G%areaT(i,j) enddo ; enddo diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 0ca8201ebe..29ea15021c 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -318,7 +318,8 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & hw = 0.5*(Hc(k-1)+Hc(k)) gp = gprime(K) if (l_mono_N2_column_fraction>0. .or. l_mono_N2_depth>=0.) then - if (G%bathyT(i,j)-sum_hcN2min*hw) then + if (G%Zd_to_m*G%bathyT(i,j)-sum_hc < l_mono_N2_column_fraction*G%Zd_to_m*G%bathyT(i,j) .and. & + gp>N2min*hw) then ! Filters out regions where N2 increases with depth but only in a lower fraction of water column gp = N2min/hw elseif (l_mono_N2_depth>=0. .and. sum_hc>l_mono_N2_depth .and. gp>N2min*hw) then diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index 737e7a3fbf..7f311811e4 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -269,22 +269,22 @@ subroutine diag_remap_update(remap_cs, G, GV, h, T, S, eqn_of_state) if (remap_cs%vertical_coord == coordinateMode('ZSTAR')) then call build_zstar_column(get_zlike_CS(remap_cs%regrid_cs), & - G%bathyT(i,j)*GV%m_to_H, sum(h(i,j,:)), & + G%Zd_to_m*GV%m_to_H*G%bathyT(i,j), sum(h(i,j,:)), & zInterfaces, zScale=GV%m_to_H) elseif (remap_cs%vertical_coord == coordinateMode('SIGMA')) then call build_sigma_column(get_sigma_CS(remap_cs%regrid_cs), & - GV%m_to_H*G%bathyT(i,j), sum(h(i,j,:)), zInterfaces) + G%Zd_to_m*GV%m_to_H*G%bathyT(i,j), sum(h(i,j,:)), zInterfaces) elseif (remap_cs%vertical_coord == coordinateMode('RHO')) then call build_rho_column(get_rho_CS(remap_cs%regrid_cs), G%ke, & - G%bathyT(i,j), h(i,j,:), T(i, j, :), S(i, j, :), & + G%Zd_to_m*G%bathyT(i,j), h(i,j,:), T(i, j, :), S(i, j, :), & eqn_of_state, zInterfaces, h_neglect, h_neglect_edge) elseif (remap_cs%vertical_coord == coordinateMode('SLIGHT')) then ! call build_slight_column(remap_cs%regrid_cs,remap_cs%remap_cs, nz, & -! G%bathyT(i,j), sum(h(i,j,:)), zInterfaces) +! G%Zd_to_m*G%bathyT(i,j), sum(h(i,j,:)), zInterfaces) call MOM_error(FATAL,"diag_remap_update: SLIGHT coordinate not coded for diagnostics yet!") elseif (remap_cs%vertical_coord == coordinateMode('HYCOM1')) then ! call build_hycom1_column(remap_cs%regrid_cs, nz, & -! G%bathyT(i,j), sum(h(i,j,:)), zInterfaces) +! G%Zd_to_m*G%bathyT(i,j), sum(h(i,j,:)), zInterfaces) call MOM_error(FATAL,"diag_remap_update: HYCOM1 coordinate not coded for diagnostics yet!") endif remap_cs%h(i,j,:) = zInterfaces(1:nz) - zInterfaces(2:nz+1) diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index c7befad3b3..afadf6bdfa 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -446,7 +446,7 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, allocate(mask_in(id,jdp)) ; mask_in(:,:)=0.0 allocate(last_row(id)) ; last_row(:)=0.0 - max_depth = maxval(G%bathyT) + max_depth = G%Zd_to_m*maxval(G%bathyT) call mpp_max(max_depth) if (z_edges_in(kd+1)= 0) then ! ice thickness does not take up whole ocean column -> floating CS%OD_av(i,j) = OD @@ -829,7 +829,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) do k=0,1 do l=0,1 if ((ISS%hmask(i,j) == 1) .and. & - (rhoi/rhow * H_node(i-1+k,j-1+l) - G%bathyT(i,j) <= 0)) then + (rhoi/rhow * H_node(i-1+k,j-1+l) - G%Zd_to_m*G%bathyT(i,j) <= 0)) then nodefloat = nodefloat + 1 endif enddo @@ -888,7 +888,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, 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%Zd_to_m*G%bathyT(:,:), CS%taub_beta_eff, 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 @@ -947,7 +947,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, 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%Zd_to_m*G%bathyT(:,:), CS%taub_beta_eff, G%areaT, & G, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi/rhow) err_max = 0 @@ -1111,7 +1111,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, u, v, taudx, taudy, H_node, float_c call pass_vector(DIAGu, DIAGv, G%domain, TO_ALL, BGRID_NE) 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, & + H_node, CS%ice_visc, float_cond, G%Zd_to_m*G%bathyT(:,:), CS%taub_beta_eff, & 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) @@ -1182,7 +1182,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, u, v, taudx, taudy, H_node, float_c Au(:,:) = 0 ; Av(:,:) = 0 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, & + H_node, CS%ice_visc, float_cond, G%Zd_to_m*G%bathyT(:,:), CS%taub_beta_eff, & G%areaT, G, is, ie, js, je, CS%density_ice/CS%density_ocean_avg) ! Au, Av valid region moves in by 1 @@ -2123,7 +2123,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, TAUD_X, TAUD_Y, OD) ! prelim - go through and calculate S ! or is this faster? - BASE(:,:) = -G%bathyT(:,:) + OD(:,:) + BASE(:,:) = -G%Zd_to_m*G%bathyT(:,:) + OD(:,:) S(:,:) = BASE(:,:) + ISS%h_shelf(:,:) do j=jsc-1,jec+1 @@ -2222,7 +2222,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, TAUD_X, TAUD_Y, OD) taud_y(I,J) = taud_y(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * dxdyh if (CS%float_frac(i,j) == 1) then - neumann_val = .5 * grav * (rho * ISS%h_shelf(i,j) ** 2 - rhow * G%bathyT(i,j) ** 2) + neumann_val = .5 * grav * (rho * ISS%h_shelf(i,j) ** 2 - rhow * (G%Zd_to_m*G%bathyT(i,j)) ** 2) else neumann_val = .5 * grav * (1-rho/rhow) * rho * ISS%h_shelf(i,j) ** 2 endif @@ -2738,7 +2738,7 @@ subroutine matrix_diagonal(CS, G, float_cond, H_node, nu, beta, hmask, dens_rati enddo ; enddo enddo ; enddo if (float_cond(i,j) == 1) then - Usubcontr = 0.0 ; Vsubcontr = 0.0 ; basel = G%bathyT(i,j) + Usubcontr = 0.0 ; Vsubcontr = 0.0 ; basel = G%Zd_to_m*G%bathyT(i,j) Hcell(:,:) = H_node(i-1:i,j-1:j) call CG_diagonal_subgrid_basal & (Phisub, Hcell, dxdyh, basel, dens_ratio, Usubcontr, Vsubcontr) @@ -2953,7 +2953,7 @@ subroutine apply_boundary_values(CS, ISS, G, time, Phisub, H_node, nu, beta, flo enddo ; enddo if (float_cond(i,j) == 1) then - Usubcontr = 0.0 ; Vsubcontr = 0.0 ; basel = G%bathyT(i,j) + Usubcontr = 0.0 ; Vsubcontr = 0.0 ; basel = G%Zd_to_m*G%bathyT(i,j) Ucell(:,:) = CS%u_bdry_val(i-1:i,j-1:j) ; Vcell(:,:) = CS%v_bdry_val(i-1:i,j-1:j) Hcell(:,:) = H_node(i-1:i,j-1:j) call CG_action_subgrid_basal & @@ -3089,7 +3089,7 @@ subroutine update_OD_ffrac_uncoupled(CS, G, h_shelf) do j=jsd,jed do i=isd,ied - OD = G%bathyT(i,j) - rhoi/rhow * h_shelf(i,j) + OD = G%Zd_to_m*G%bathyT(i,j) - rhoi/rhow * h_shelf(i,j) if (OD >= 0) then ! ice thickness does not take up whole ocean column -> floating CS%OD_av(i,j) = OD diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index ba64d8e75c..b754b19bcb 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -165,7 +165,8 @@ subroutine MOM_initialize_fixed(G, OBC, PF, write_geom, output_dir) end subroutine MOM_initialize_fixed -!> MOM_initialize_topography makes the appropriate call to set up the bathymetry. +!> MOM_initialize_topography makes the appropriate call to set up the bathymetry. At this +!! point the topography is in units of m, but this can be changed later. subroutine MOM_initialize_topography(D, max_depth, G, PF) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & @@ -176,7 +177,6 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF) ! This subroutine makes the appropriate call to set up the bottom depth. ! This is a separate subroutine so that it can be made public and shared with ! the ice-sheet code or other components. -! Set up the bottom depth, G%bathyT either analytically or from file character(len=40) :: mdl = "MOM_initialize_topography" ! This subroutine's name. character(len=200) :: config diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 9f7c5dcc28..f0626cbd02 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -1209,7 +1209,8 @@ subroutine initialize_masks(G, PF) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type type(param_file_type), intent(in) :: PF !< Parameter file structure ! Local variables - real :: Dmin, min_depth, mask_depth + real :: Dmin ! The depth for masking in the same units as G%bathyT. + real :: min_depth, mask_depth ! Depths in m. character(len=40) :: mdl = "MOM_grid_init initialize_masks" integer :: i, j @@ -1225,8 +1226,8 @@ subroutine initialize_masks(G, PF) "fluxes are zeroed out. MASKING_DEPTH is ignored if negative.", & units="m", default=-9999.0) - Dmin = min_depth - if (mask_depth>=0.) Dmin = mask_depth + Dmin = min_depth / G%Zd_to_m + if (mask_depth>=0.) Dmin = mask_depth / G%Zd_to_m G%mask2dCu(:,:) = 0.0 ; G%mask2dCv(:,:) = 0.0 ; G%mask2dBu(:,:) = 0.0 diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index e818c33acd..2554d86cfd 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -1099,12 +1099,8 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file) character(len=*), intent(in) :: directory !< The directory into which to place the geometry file. character(len=*), optional, intent(in) :: geom_file !< If present, the name of the geometry file !! (otherwise the file is "ocean_geometry") -! This subroutine writes out a file containing all of the ocean geometry -! and grid data uses by the MOM ocean model. -! Arguments: G - The ocean's grid structure. Effectively intent in. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) directory - The directory into which to place the file. + + ! Local variables. character(len=240) :: filepath character(len=40) :: mdl = "write_ocean_geometry_file" integer, parameter :: nFlds=23 @@ -1194,7 +1190,8 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file) call write_field(unit, fields(3), G%Domain%mpp_domain, G%geoLatT) call write_field(unit, fields(4), G%Domain%mpp_domain, G%geoLonT) - call write_field(unit, fields(5), G%Domain%mpp_domain, G%bathyT) + do j=js,je ; do i=is,ie ; out_h(i,j) = G%Zd_to_m*G%bathyT(i,j) ; enddo ; enddo + call write_field(unit, fields(5), G%Domain%mpp_domain, out_h) call write_field(unit, fields(6), G%Domain%mpp_domain, G%CoriolisBu) ! I think that all of these copies are holdovers from a much earlier diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index c612970361..120f990224 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -669,7 +669,7 @@ subroutine initialize_thickness_from_file(h, G, GV, param_file, file_has_thickne enddo ; enddo ; enddo do j=js,je ; do i=is,ie - if (abs(eta(i,j,nz+1) + G%bathyT(i,j)) > 1.0) & + if (abs(eta(i,j,nz+1) + G%Zd_to_m*G%bathyT(i,j)) > 1.0) & inconsistent = inconsistent + 1 enddo ; enddo call sum_across_PEs(inconsistent) @@ -708,8 +708,8 @@ subroutine adjustEtaToFitBathymetry(G, GV, eta, h) contractions = 0 do j=js,je ; do i=is,ie - if (-eta(i,j,nz+1) > G%bathyT(i,j) + hTolerance) then - eta(i,j,nz+1) = -G%bathyT(i,j) + if (-eta(i,j,nz+1) > G%Zd_to_m*G%bathyT(i,j) + hTolerance) then + eta(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) contractions = contractions + 1 endif enddo ; enddo @@ -738,12 +738,12 @@ subroutine adjustEtaToFitBathymetry(G, GV, eta, h) ! The whole column is dilated to accommodate deeper topography than ! the bathymetry would indicate. ! This should be... if ((G%mask2dt(i,j)*(eta(i,j,1)-eta(i,j,nz+1)) > 0.0) .and. & - if (-eta(i,j,nz+1) < G%bathyT(i,j) - hTolerance) then + if (-eta(i,j,nz+1) < G%Zd_to_m*G%bathyT(i,j) - hTolerance) then dilations = dilations + 1 if (eta(i,j,1) <= eta(i,j,nz+1)) then - do k=1,nz ; h(i,j,k) = (eta(i,j,1)+G%bathyT(i,j)) / real(nz) ; enddo + do k=1,nz ; h(i,j,k) = (eta(i,j,1) + G%Zd_to_m*G%bathyT(i,j)) / real(nz) ; enddo else - dilate = (eta(i,j,1)+G%bathyT(i,j)) / (eta(i,j,1)-eta(i,j,nz+1)) + dilate = (eta(i,j,1) + G%Zd_to_m*G%bathyT(i,j)) / (eta(i,j,1) - eta(i,j,nz+1)) do k=1,nz ; h(i,j,k) = h(i,j,k) * dilate ; enddo endif do k=nz,2,-1 ; eta(i,j,K) = eta(i,j,K+1) + h(i,j,k) ; enddo @@ -804,7 +804,7 @@ subroutine initialize_thickness_uniform(h, G, GV, param_file, just_read_params) ! Angstrom thick, and 2. the interfaces are where they should be ! based on the resting depths and interface height perturbations, ! as long at this doesn't interfere with 1. - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = e0(K) if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_m)) then @@ -882,7 +882,7 @@ subroutine initialize_thickness_list(h, G, GV, param_file, just_read_params) ! Angstrom thick, and 2. the interfaces are where they should be ! based on the resting depths and interface height perturbations, ! as long at this doesn't interfere with 1. - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = e0(K) if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_m)) then @@ -1134,9 +1134,9 @@ subroutine trim_for_ice(PF, G, GV, ALE_CSp, tv, h, just_read_params) endif do j=G%jsc,G%jec ; do i=G%isc,G%iec - call cut_off_column_top(GV%ke, tv, GV%Rho0, GV%g_Earth, G%bathyT(i,j), min_thickness, & - tv%T(i,j,:), T_t(i,j,:), T_b(i,j,:), tv%S(i,j,:), S_t(i,j,:), S_b(i,j,:), & - p_surf(i,j), h(i,j,:), remap_CS) + call cut_off_column_top(GV%ke, tv, GV%Rho0, GV%g_Earth, G%Zd_to_m*G%bathyT(i,j), & + min_thickness, tv%T(i,j,:), T_t(i,j,:), T_b(i,j,:), & + tv%S(i,j,:), S_t(i,j,:), S_b(i,j,:), p_surf(i,j), h(i,j,:), remap_CS) enddo ; enddo end subroutine trim_for_ice @@ -1754,7 +1754,7 @@ subroutine initialize_sponges_file(G, GV, use_temperature, tv, param_file, CSp, call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain) do j=js,je ; do i=is,ie - eta(i,j,nz+1) = -G%bathyT(i,j) + eta(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) enddo ; enddo do k=nz,1,-1 ; do j=js,je ; do i=is,ie if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_m)) & @@ -1779,7 +1779,7 @@ subroutine initialize_sponges_file(G, GV, use_temperature, tv, param_file, CSp, call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain) do j=js,je ; do i=is,ie - eta(i,j,nz+1) = -G%bathyT(i,j) + eta(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) enddo ; enddo do k=nz,1,-1 ; do j=js,je ; do i=is,ie @@ -2152,11 +2152,11 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) tmp_mask_in(i,j,1:kd) = mask_z(i,j,:) do k = 1, nkd if (tmp_mask_in(i,j,k)>0. .and. k<=kd) then - zBottomOfCell = max( -z_edges_in(k+1), -G%bathyT(i,j) ) + zBottomOfCell = max( -z_edges_in(k+1), -G%Zd_to_m*G%bathyT(i,j) ) tmpT1dIn(i,j,k) = temp_z(i,j,k) tmpS1dIn(i,j,k) = salt_z(i,j,k) elseif (k>1) then - zBottomOfCell = -G%bathyT(i,j) + zBottomOfCell = -G%Zd_to_m*G%bathyT(i,j) tmpT1dIn(i,j,k) = tmpT1dIn(i,j,k-1) tmpS1dIn(i,j,k) = tmpS1dIn(i,j,k-1) else ! This next block should only ever be reached over land @@ -2166,7 +2166,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) h1(i,j,k) = GV%m_to_H * (zTopOfCell - zBottomOfCell) zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k enddo - h1(i,j,kd) = h1(i,j,kd) + GV%m_to_H * max(0., zTopOfCell + G%bathyT(i,j) ) + h1(i,j,kd) = h1(i,j,kd) + GV%m_to_H * max(0., zTopOfCell + G%Zd_to_m*G%bathyT(i,j) ) ! The max here is in case the data data is shallower than model endif ! mask2dT enddo ; enddo @@ -2189,7 +2189,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) ! Build the target grid combining hTarget and topography zTopOfCell = 0. ; zBottomOfCell = 0. do k = 1, nz - zBottomOfCell = max( zTopOfCell - hTarget(k), -G%bathyT(i,j) ) + zBottomOfCell = max( zTopOfCell - hTarget(k), -G%Zd_to_m*G%bathyT(i,j) ) h(i,j,k) = GV%m_to_H * (zTopOfCell - zBottomOfCell) zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k enddo @@ -2239,7 +2239,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) do k=2,nz ; Rb(k)=0.5*(GV%Rlay(k-1)+GV%Rlay(k)) ; enddo Rb(1) = 0.0 ; Rb(nz+1) = 2.0*GV%Rlay(nz) - GV%Rlay(nz-1) - zi(is:ie,js:je,:) = find_interfaces(rho_z(is:ie,js:je,:), z_in, Rb, G%bathyT(is:ie,js:je), & + zi(is:ie,js:je,:) = find_interfaces(rho_z(is:ie,js:je,:), z_in, Rb, G%Zd_to_m*G%bathyT(is:ie,js:je), & nlevs(is:ie,js:je), nkml, nkbl, min_depth) if (correct_thickness) then @@ -2255,7 +2255,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) enddo ; enddo ; enddo inconsistent=0 do j=js,je ; do i=is,ie - if (abs(zi(i,j,nz+1) + G%bathyT(i,j)) > 1.0) & + if (abs(zi(i,j,nz+1) + G%Zd_to_m*G%bathyT(i,j)) > 1.0) & inconsistent = inconsistent + 1 enddo ; enddo call sum_across_PEs(inconsistent) diff --git a/src/initialization/MOM_tracer_initialization_from_Z.F90 b/src/initialization/MOM_tracer_initialization_from_Z.F90 index 07be1ee340..95041d814d 100644 --- a/src/initialization/MOM_tracer_initialization_from_Z.F90 +++ b/src/initialization/MOM_tracer_initialization_from_Z.F90 @@ -82,7 +82,7 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam, ! Local variables for ALE remapping real, dimension(:), allocatable :: h1, h2, hTarget, deltaE, tmpT1d real, dimension(:), allocatable :: tmpT1dIn - real :: zTopOfCell, zBottomOfCell + real :: zTopOfCell, zBottomOfCell, z_bathy ! Heights in m. type(remapping_CS) :: remapCS ! Remapping parameters and work arrays real, dimension(:,:,:), allocatable :: hSrc @@ -154,12 +154,13 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam, if (G%mask2dT(i,j)>0.) then ! Build the source grid zTopOfCell = 0. ; zBottomOfCell = 0. ; nPoints = 0 + z_bathy = G%Zd_to_m*G%bathyT(i,j) do k = 1, kd if (mask_z(i,j,k) > 0.) then - zBottomOfCell = -min( z_edges_in(k+1), G%bathyT(i,j) ) + zBottomOfCell = -min( z_edges_in(k+1), z_bathy ) tmpT1dIn(k) = tr_z(i,j,k) elseif (k>1) then - zBottomOfCell = -G%bathyT(i,j) + zBottomOfCell = -z_bathy tmpT1dIn(k) = tmpT1dIn(k-1) else ! This next block should only ever be reached over land tmpT1dIn(k) = -99.9 @@ -168,7 +169,7 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam, if (h1(k)>0.) nPoints = nPoints + 1 zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k enddo - h1(kd) = h1(kd) + ( zTopOfCell + G%bathyT(i,j) ) ! In case data is deeper than model + h1(kd) = h1(kd) + ( zTopOfCell + z_bathy ) ! In case data is deeper than model else tr(i,j,:) = 0. endif ! mask2dT diff --git a/src/initialization/midas_vertmap.F90 b/src/initialization/midas_vertmap.F90 index 4da55554d3..ccc71fa5e1 100644 --- a/src/initialization/midas_vertmap.F90 +++ b/src/initialization/midas_vertmap.F90 @@ -111,7 +111,7 @@ end function alpha_wright_eos_2d function beta_wright_eos_2d(T,S,p) result(drho_dS) real(kind=8), dimension(:,:), intent(in) :: T,S !< temperature (degC) and salinity (psu) real, intent(in) :: p !< pressure (Pa) - real(kind=8), dimension(size(T,1),size(T,2)) :: drho_dS !< partial derivative of density with + real(kind=8), dimension(size(T,1),size(T,2)) :: drho_dS !< partial derivative of density with !! respect to salinity (kg m-3 PSU-1) ! Local variables real(kind=8) :: a0,a1,a2,b0,b1,b2,b3,b4,b5,c0,c1,c2,c3,c4,c5 diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 7e68eac52a..21d6c21328 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -612,7 +612,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, SN_u, SN_v, drag_rate_visc, I_mass) do while (resid>0.) n1 = n1 + 1 EKE = EKEmax - call MEKE_lengthScales_0d(CS, G%areaT(i,j), beta, G%bathyT(i,j), & + call MEKE_lengthScales_0d(CS, G%areaT(i,j), beta, G%Zd_to_m*G%bathyT(i,j), & MEKE%Rd_dx_h(i,j), SN, EKE, & bottomFac2, barotrFac2, LmixScale, & Lrhines, Leady) @@ -717,7 +717,7 @@ subroutine MEKE_lengthScales(CS, MEKE, G, SN_u, SN_v, & beta = sqrt( G%dF_dx(i,j)**2 + G%dF_dy(i,j)**2 ) endif ! Returns bottomFac2, barotrFac2 and LmixScale - call MEKE_lengthScales_0d(CS, G%areaT(i,j), beta, G%bathyT(i,j), & + call MEKE_lengthScales_0d(CS, G%areaT(i,j), beta, G%Zd_to_m*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)) diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 822c11470e..ed8245d2be 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -348,7 +348,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Extract the energy for mixing due to bottom drag------------------------------- if (CS%apply_bottom_drag) then do j=jsd,jed ; do i=isd,ied - I_D_here = 1.0 / max(G%bathyT(i,j), 1.0) + ! Note the 1 m dimensional scale here. Should this be a parameter? + I_D_here = 1.0 / (GV%Z_to_m*max(G%bathyT(i,j), 1.0*GV%m_to_Z)) drag_scale(i,j) = CS%cdrag * sqrt(max(0.0, vel_btTide(i,j)**2 + & tot_En(i,j) * I_rho0 * I_D_here)) * I_D_here enddo ; enddo @@ -2312,7 +2313,7 @@ subroutine internal_tides_init(Time, G, GV, param_file, diag, CS) call MOM_read_data(filename, 'h2', h2, G%domain, timelevel=1) do j=G%jsc,G%jec ; do i=G%isc,G%iec ! Restrict rms topo to 10 percent of column depth. - h2(i,j) = min(0.01*G%bathyT(i,j)**2, h2(i,j)) + h2(i,j) = min(0.01*(G%Zd_to_m*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*& diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 738c6dd2f0..34a5436f34 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -691,10 +691,11 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) enddo ; enddo ! SN above contains S^2*N^2*H, convert to vertical average of S*N do I=is-1,ie - !SN_u(I,j) = sqrt( SN_u(I,j) / ( max(G%bathyT(I,j), G%bathyT(I+1,j)) + GV%Angstrom_H ) ) + !SN_u(I,j) = sqrt( SN_u(I,j) / (G%Zd_to_m*( 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_m ) then - 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)) ) + 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) * sqrt( CS%SN_u(I,j) / & + (G%Zd_to_m*max(G%bathyT(I,j), G%bathyT(I+1,j))) ) else CS%SN_u(I,j) = 0.0 endif @@ -706,10 +707,11 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) CS%SN_v(i,J) = CS%SN_v(i,J) + SN_v_local(i,J,k) enddo ; enddo do i=is,ie - !SN_v(i,J) = sqrt( SN_v(i,J) / ( max(G%bathyT(i,J), G%bathyT(i,J+1)) + GV%Angstrom_H ) ) + !SN_v(i,J) = sqrt( SN_v(i,J) / (G%Zd_to_m*( 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_m ) then - 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)) ) + 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) * sqrt( CS%SN_v(i,J) / & + (G%Zd_to_m*max(G%bathyT(i,J), G%bathyT(i,J+1))) ) else CS%SN_v(I,j) = 0.0 endif diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index ec285072ed..97d7d12f7e 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -18,10 +18,11 @@ module MOM_ALE_sponge use MOM_error_handler, only : MOM_error, FATAL, NOTE, WARNING, is_root_pe use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type +use MOM_horizontal_regridding, only : horiz_interp_and_extrap_tracer use MOM_spatial_means, only : global_i_mean use MOM_time_manager, only : time_type, init_external_field, get_external_field_size, time_interp_external_init use MOM_remapping, only : remapping_cs, remapping_core_h, initialize_remapping -use MOM_horizontal_regridding, only : horiz_interp_and_extrap_tracer +use MOM_verticalGrid, only : verticalGrid_type ! GMM - Planned extension: Support for time varying sponge targets. implicit none ; private @@ -666,10 +667,10 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, f_ptr, zTopOfCell = 0. ; zBottomOfCell = 0. ; nPoints = 0; hsrc(:) = 0.0; tmpT1d(:) = -99.9 do k=1,nz_data if (mask_z(CS%col_i(col),CS%col_j(col),k) == 1.0) then - zBottomOfCell = -min( z_edges_in(k+1), G%bathyT(CS%col_i(col),CS%col_j(col)) ) + zBottomOfCell = -min( z_edges_in(k+1), G%Zd_to_m*G%bathyT(CS%col_i(col),CS%col_j(col)) ) ! tmpT1d(k) = sp_val(CS%col_i(col),CS%col_j(col),k) elseif (k>1) then - zBottomOfCell = -G%bathyT(CS%col_i(col),CS%col_j(col)) + zBottomOfCell = -G%Zd_to_m*G%bathyT(CS%col_i(col),CS%col_j(col)) ! tmpT1d(k) = tmpT1d(k-1) ! else ! This next block should only ever be reached over land ! tmpT1d(k) = -99.9 @@ -679,7 +680,7 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, f_ptr, zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k enddo ! In case data is deeper than model - hsrc(nz_data) = hsrc(nz_data) + ( zTopOfCell + G%bathyT(CS%col_i(col),CS%col_j(col)) ) + hsrc(nz_data) = hsrc(nz_data) + ( zTopOfCell + G%Zd_to_m*G%bathyT(CS%col_i(col),CS%col_j(col)) ) CS%Ref_val(CS%fldno)%h(1:nz_data,col) = 0. CS%Ref_val(CS%fldno)%p(1:nz_data,col) = -1.e24 CS%Ref_val(CS%fldno)%h(1:nz_data,col) = hsrc(1:nz_data) @@ -736,7 +737,8 @@ end subroutine set_up_ALE_sponge_vel_field_fixed !> This subroutine stores the reference profile at uand v points for the variable !! whose address is given by u_ptr and v_ptr. -subroutine set_up_ALE_sponge_vel_field_varying(filename_u,fieldname_u,filename_v,fieldname_v, Time, G, CS, u_ptr, v_ptr) +subroutine set_up_ALE_sponge_vel_field_varying(filename_u, fieldname_u, filename_v, fieldname_v, & + Time, G, CS, u_ptr, v_ptr) character(len=*), intent(in) :: filename_u !< File name for u field character(len=*), intent(in) :: fieldname_u !< Name of u variable in file character(len=*), intent(in) :: filename_v !< File name for v field diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index 55834769aa..b05dfed2aa 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -255,8 +255,7 @@ subroutine int_tide_input_init(Time, G, GV, param_file, diag, CS, itide) ! tidal amplitude file is not present. real :: kappa_h2_factor ! factor for the product of wavenumber * rms sgs height. real :: kappa_itides ! topographic wavenumber and non-dimensional scaling - real :: min_zbot_itides ! Minimum ocean depth for internal tide conversion, - ! in m. + real :: min_zbot_itides ! Minimum ocean depth for internal tide conversion, in m. integer :: i, j, is, ie, js, je, isd, ied, jsd, jed if (associated(CS)) then @@ -334,12 +333,12 @@ subroutine int_tide_input_init(Time, G, GV, param_file, diag, CS, itide) do j=js,je ; do i=is,ie mask_itidal = 1.0 - if (G%bathyT(i,j) < min_zbot_itides) mask_itidal = 0.0 + if (G%bathyT(i,j) < min_zbot_itides*GV%m_to_Z) mask_itidal = 0.0 itide%tideamp(i,j) = itide%tideamp(i,j) * mask_itidal * G%mask2dT(i,j) ! Restrict rms topo to 10 percent of column depth. - itide%h2(i,j) = min(0.01*G%bathyT(i,j)**2, itide%h2(i,j)) + itide%h2(i,j) = min(0.01*(G%bathyT(i,j)*G%Zd_to_m)**2, itide%h2(i,j)) ! Compute the fixed part of internal tidal forcing; units are [J m-2] here. CS%TKE_itidal_coef(i,j) = 0.5*kappa_h2_factor*GV%Rho0*& diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 96ed14280c..8f9e325ddc 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -160,11 +160,11 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) real :: Rhtot ! Running sum of thicknesses times the ! layer potential densities in H kg m-3. real, dimension(SZIB_(G),SZJ_(G)) :: & - D_u, & ! Bottom depth interpolated to u points, in m. + D_u, & ! Bottom depth interpolated to u points, in depth units (m). mask_u ! A mask that disables any contributions from u points that ! are land or past open boundary conditions, nondim., 0 or 1. real, dimension(SZI_(G),SZJB_(G)) :: & - D_v, & ! Bottom depth interpolated to v points, in m. + D_v, & ! Bottom depth interpolated to v points, in depth units (m). mask_v ! A mask that disables any contributions from v points that ! are land or past open boundary conditions, nondim., 0 or 1. real, dimension(SZIB_(G),SZK_(G)) :: & @@ -696,7 +696,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) if (Dm > Dp) then ; tmp = Dp ; Dp = Dm ; Dm = tmp ; endif ! Convert the D's to the units of thickness. - Dp = m_to_H*Dp ; Dm = m_to_H*Dm ; D_vel = m_to_H*D_vel + Dp = GV%Z_to_H*Dp ; Dm = GV%Z_to_H*Dm ; D_vel = GV%Z_to_H*D_vel a_3 = (Dp + Dm - 2.0*D_vel) ; a = 3.0*a_3 ; a_12 = 0.25*a_3 slope = Dp - Dm diff --git a/src/parameterizations/vertical/MOM_sponge.F90 b/src/parameterizations/vertical/MOM_sponge.F90 index ce7471f9e1..77a2d109d6 100644 --- a/src/parameterizations/vertical/MOM_sponge.F90 +++ b/src/parameterizations/vertical/MOM_sponge.F90 @@ -334,25 +334,12 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) ! layer buoyancy, and a variety of tracers for every column where ! there is damping. -! Arguments: h - Layer thickness, in m. -! (in) dt - The amount of time covered by this call, in s. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (out) ea - an array to which the amount of fluid entrained -! from the layer above during this call will be -! added, in H. -! (out) eb - an array to which the amount of fluid entrained -! from the layer below during this call will be -! added, in H. -! (in) CS - A pointer to the control structure for this module that is -! set by a previous call to initialize_sponge. -! (inout,opt) Rcv_ml - The coordinate density of the mixed layer. - + ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(G)+1) :: & w_int, & ! Water moved upward across an interface within a timestep, ! in H. e_D ! Interface heights that are dilated to have a value of 0 - ! at the surface, in m. + ! at the surface, in the same units as G%bathyT (m or Z). real, dimension(SZI_(G), SZJ_(G)) :: & eta_anom, & ! Anomalies in the interface height, relative to the i-mean ! target value, in m. @@ -407,7 +394,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) do j=js,je ; do i=is,ie ; e_D(i,j,nz+1) = -G%bathyT(i,j) ; enddo ; enddo do k=nz,1,-1 ; do j=js,je ; do i=is,ie - e_D(i,j,K) = e_D(i,j,K+1) + h(i,j,k)*GV%H_to_m + e_D(i,j,K) = e_D(i,j,K+1) + h(i,j,k)*GV%H_to_Z enddo ; enddo ; enddo do j=js,je do i=is,ie @@ -420,8 +407,8 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) do k=2,nz do j=js,je ; do i=is,ie - eta_anom(i,j) = e_D(i,j,k) - CS%Ref_eta_im(j,k) - if (CS%Ref_eta_im(j,K) < -G%bathyT(i,j)) eta_anom(i,j) = 0.0 + eta_anom(i,j) = e_D(i,j,k)*G%Zd_to_m - CS%Ref_eta_im(j,k) + if (CS%Ref_eta_im(j,K) < -G%bathyT(i,j)*G%Zd_to_m) eta_anom(i,j) = 0.0 enddo ; enddo call global_i_mean(eta_anom(:,:), eta_mean_anom(:,K), G) enddo diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 7c712e8010..cc6d73e3eb 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -205,7 +205,6 @@ module MOM_tidal_mixing !> Initializes internal tidal dissipation scheme for diapycnal mixing logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, CS) - type(time_type), intent(in) :: Time !< The current time. type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. @@ -452,11 +451,11 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, call MOM_read_data(filename, 'h2', CS%h2, G%domain, timelevel=1) do j=js,je ; do i=is,ie - if (G%bathyT(i,j) < CS%min_zbot_itides) CS%mask_itidal(i,j) = 0.0 + if (G%bathyT(i,j)*G%Zd_to_m < CS%min_zbot_itides) CS%mask_itidal(i,j) = 0.0 CS%tideamp(i,j) = CS%tideamp(i,j) * CS%mask_itidal(i,j) * G%mask2dT(i,j) ! Restrict rms topo to 10 percent of column depth. - zbot = G%bathyT(i,j) + zbot = G%bathyT(i,j)*G%Zd_to_m hamp = sqrt(CS%h2(i,j)) hamp = min(0.1*zbot,hamp) CS%h2(i,j) = hamp*hamp @@ -1500,10 +1499,10 @@ end subroutine post_tidal_diagnostics ! TODO: move this subroutine to MOM_internal_tide_input module (?) !> This subroutine read tidal energy inputs from a file. subroutine read_tidal_energy(G, tidal_energy_type, tidal_energy_file, CS) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - character(len=20), intent(in) :: tidal_energy_type !< The type of tidal energy inputs to read - character(len=200), intent(in) :: tidal_energy_file !< The file from which to read tidalinputs - type(tidal_mixing_cs), pointer :: CS !< The control structure for this module + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + character(len=20), intent(in) :: tidal_energy_type !< The type of tidal energy inputs to read + character(len=200), intent(in) :: tidal_energy_file !< The file from which to read tidalinputs + type(tidal_mixing_cs), pointer :: CS !< The control structure for this module ! local integer :: isd, ied, jsd, jed, nz real, allocatable, dimension(:,:) :: tidal_energy_flux_2d ! input tidal energy flux at T-grid points (W/m^2) @@ -1571,6 +1570,7 @@ subroutine read_tidal_constituents(G, tidal_energy_file, CS) call MOM_read_data(tidal_energy_file, 'z_t', z_t) call MOM_read_data(tidal_energy_file, 'z_w', z_w) + !### THE USE OF WHERE STTAEMENTS IS STRONGLY DISCOURAGED IN MOM6! where (abs(G%geoLatT(:,:)) < 30.0) tidal_qk1(:,:) = p33 tidal_qo1(:,:) = p33 @@ -1584,7 +1584,8 @@ subroutine read_tidal_constituents(G, tidal_energy_file, CS) ! input cell thickness CS%h_src(k) = (z_t(k)-z_w(k))*2.0 *1e-2 ! form tidal_qe_3d_in from weighted tidal constituents - where ( (z_t(k)*1e-2) <= G%bathyT(:,:) .and. (z_w(k)*1e-2) > CS%tidal_diss_lim_tc) + !### THE USE OF WHERE STATEMENTS IS STRONGLY DISCOURAGED IN MOM6! + where (((z_t(k)*1e-2) <= G%bathyT(:,:)*G%Zd_to_m) .and. (z_w(k)*1e-2 > CS%tidal_diss_lim_tc)) CS%tidal_qe_3d_in(:,:,k) = p33*tc_m2(:,:,k) + p33*tc_s2(:,:,k) + & tidal_qk1*tc_k1(:,:,k) + tidal_qo1*tc_o1(:,:,k) endwhere @@ -1598,7 +1599,7 @@ subroutine read_tidal_constituents(G, tidal_energy_file, CS) ! do k=50,nz_in(1) ! write(1905,*) i,j,k ! write(1905,*) CS%tidal_qe_3d_in(i,j,k), tc_m2(i,j,k) - ! write(1905,*) z_t(k), G%bathyT(i,j), z_w(k),CS%tidal_diss_lim_tc + ! write(1905,*) z_t(k), G%bathyT(i,j)*G%Zd_to_m, z_w(k),CS%tidal_diss_lim_tc ! end do ! endif ! enddo @@ -1607,13 +1608,13 @@ subroutine read_tidal_constituents(G, tidal_energy_file, CS) ! test if qE is positive if (any(CS%tidal_qe_3d_in<0.0)) then - call MOM_error(FATAL, "read_tidal_constituents: Negative tidal_qe_3d_in terms.") + call MOM_error(FATAL, "read_tidal_constituents: Negative tidal_qe_3d_in terms.") endif !! collapse 3D q*E to 2D q*E !CS%tidal_qe_2d = 0.0 !do k=1,nz_in(1) - ! where (z_t(k) <= G%bathyT(:,:)) + ! where (z_t(k) <= G%bathyT(:,:)*G%Zd_to_m) ! CS%tidal_qe_2d(:,:) = CS%tidal_qe_2d(:,:) + CS%tidal_qe_3d_in(:,:,k) ! endwhere !enddo diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 69d7f4b7e2..cb8f784615 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -691,7 +691,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) h_delta(I,k) = h(i+1,j,k) - h(i,j,k) endif ; enddo ; enddo do I=Isq,Ieq - Dmin(I) = min(G%bathyT(i,j), G%bathyT(i+1,j)) * m_to_H + Dmin(I) = min(G%bathyT(i,j), G%bathyT(i+1,j)) * G%Zd_to_m*GV%m_to_H zi_dir(I) = 0 enddo @@ -700,11 +700,11 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) do I=Isq,Ieq ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then do k=1,nz ; h_harm(I,k) = h(i,j,k) ; h_arith(I,k) = h(i,j,k) ; h_delta(I,k) = 0. ; enddo - Dmin(I) = G%bathyT(i,j) * m_to_H + Dmin(I) = G%bathyT(i,j) * G%Zd_to_m*GV%m_to_H zi_dir(I) = -1 elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then do k=1,nz ; h_harm(I,k) = h(i+1,j,k) ; h_arith(I,k) = h(i+1,j,k) ; h_delta(I,k) = 0. ; enddo - Dmin(I) = G%bathyT(i+1,j) * m_to_H + Dmin(I) = G%bathyT(i+1,j) * G%Zd_to_m*GV%m_to_H zi_dir(I) = 1 endif endif ; enddo @@ -727,7 +727,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) endif ; enddo ; enddo ! i & k loops else ! Not harmonic_visc do I=Isq,Ieq ; zh(I) = 0.0 ; z_i(I,nz+1) = 0.0 ; enddo - do i=Isq,Ieq+1 ; zcol(i) = -G%bathyT(i,j) * m_to_H ; enddo + do i=Isq,Ieq+1 ; zcol(i) = -G%bathyT(i,j) * G%Zd_to_m*GV%m_to_H ; enddo do k=nz,1,-1 do i=Isq,Ieq+1 ; zcol(i) = zcol(i) + h(i,j,k) ; enddo do I=Isq,Ieq ; if (do_i(I)) then @@ -858,7 +858,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) h_delta(i,k) = h(i,j+1,k) - h(i,j,k) endif ; enddo ; enddo do i=is,ie - Dmin(i) = min(G%bathyT(i,j), G%bathyT(i,j+1)) * m_to_H + Dmin(i) = min(G%bathyT(i,j), G%bathyT(i,j+1)) * G%Zd_to_m*GV%m_to_H zi_dir(i) = 0 enddo @@ -867,11 +867,11 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then do k=1,nz ; h_harm(I,k) = h(i,j,k) ; h_arith(I,k) = h(i,j,k) ; h_delta(i,k) = 0. ; enddo - Dmin(I) = G%bathyT(i,j) * m_to_H + Dmin(I) = G%bathyT(i,j) * G%Zd_to_m*GV%m_to_H zi_dir(I) = -1 elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then do k=1,nz ; h_harm(i,k) = h(i,j+1,k) ; h_arith(i,k) = h(i,j+1,k) ; h_delta(i,k) = 0. ; enddo - Dmin(i) = G%bathyT(i,j+1) * m_to_H + Dmin(i) = G%bathyT(i,j+1) * G%Zd_to_m*GV%m_to_H zi_dir(i) = 1 endif endif ; enddo @@ -896,8 +896,8 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) else ! Not harmonic_visc do i=is,ie zh(i) = 0.0 ; z_i(i,nz+1) = 0.0 - zcol1(i) = -G%bathyT(i,j) * m_to_H - zcol2(i) = -G%bathyT(i,j+1) * m_to_H + zcol1(i) = -G%bathyT(i,j) * G%Zd_to_m*GV%m_to_H + zcol2(i) = -G%bathyT(i,j+1) * G%Zd_to_m*GV%m_to_H enddo do k=nz,1,-1 ; do i=is,ie ; if (do_i(i)) then zh(i) = zh(i) + h_harm(i,k) diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index 749962b17f..0a59eb1c92 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -213,7 +213,7 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, h, diag, OBC, CS, & if (NTR > 7) then do j=js,je ; do i=is,ie - e(nz+1) = -G%bathyT(i,j) + e(nz+1) = -G%Zd_to_m*G%bathyT(i,j) do k=nz,1,-1 e(K) = e(K+1) + h(i,j,k)*GV%H_to_m do m=7,NTR diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index 0f7c5c1224..88b1ba37ce 100644 --- a/src/tracer/MOM_tracer_Z_init.F90 +++ b/src/tracer/MOM_tracer_Z_init.F90 @@ -128,8 +128,8 @@ function tracer_Z_init(tr, h, filename, tr_name, G, missing_val, land_val) do i=is,ie ; if (G%mask2dT(i,j)*htot(i) > 0.0) then ! Determine the z* heights of the model interfaces. - dilate = (G%bathyT(i,j) - 0.0) / htot(i) - e(nz+1) = -G%bathyT(i,j) + dilate = (G%Zd_to_m*G%bathyT(i,j) - 0.0) / htot(i) + e(nz+1) = -G%Zd_to_m*G%bathyT(i,j) do k=nz,1,-1 ; e(K) = e(K+1) + dilate * h(i,j,k) ; enddo ! Create a single-column copy of tr_in. ### CHANGE THIS LATER? @@ -203,8 +203,8 @@ function tracer_Z_init(tr, h, filename, tr_name, G, missing_val, land_val) do i=is,ie ; if (G%mask2dT(i,j)*htot(i) > 0.0) then ! Determine the z* heights of the model interfaces. - dilate = (G%bathyT(i,j) - 0.0) / htot(i) - e(nz+1) = -G%bathyT(i,j) + dilate = (G%Zd_to_m*G%bathyT(i,j) - 0.0) / htot(i) + e(nz+1) = -G%Zd_to_m*G%bathyT(i,j) do k=nz,1,-1 ; e(K) = e(K+1) + dilate * h(i,j,k) ; enddo ! Create a single-column copy of tr_in. ### CHANGE THIS LATER? diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index 0e1b9a06b9..489fba76fa 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -222,7 +222,7 @@ subroutine initialize_dye_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_C CS%dye_source_minlat(m)=G%geoLatT(i,j) .and. & G%mask2dT(i,j) > 0.0 ) then - z_bot = -G%bathyT(i,j) + z_bot = -G%Zd_to_m*G%bathyT(i,j) do k = GV%ke, 1, -1 z_center = z_bot + 0.5*h(i,j,k)*GV%H_to_m if ( z_center > -CS%dye_source_maxdepth(m) .and. & @@ -305,7 +305,7 @@ subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS CS%dye_source_minlat(m)=G%geoLatT(i,j) .and. & G%mask2dT(i,j) > 0.0 ) then - z_bot = -G%bathyT(i,j) + z_bot = -G%Zd_to_m*G%bathyT(i,j) do k=nz,1,-1 z_center = z_bot + 0.5*h_new(i,j,k)*GV%H_to_m if ( z_center > -CS%dye_source_maxdepth(m) .and. & diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index 605d4706ca..b76aeb0c5b 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -146,7 +146,7 @@ subroutine BFB_initialize_sponges_southonly(G, use_temperature, tv, param_file, ! endif eta(i,j,nz+1) = -G%max_depth - if (G%bathyT(i,j) > min_depth) then + if (G%Zd_to_m*G%bathyT(i,j) > min_depth) then Idamp(i,j) = damp/86400.0 else ; Idamp(i,j) = 0.0 ; endif enddo ; enddo diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index 1c5c1e5b7f..cb49286887 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -143,7 +143,7 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, param_file, just_read_params case ( REGRIDDING_LAYER, REGRIDDING_RHO ) do j=js,je ; do i=is,ie - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then @@ -165,7 +165,7 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, param_file, just_read_params ! case ( IC_RHO_C ) ! ! do j=js,je ; do i=is,ie - ! eta1D(nz+1) = -1.0*G%bathyT(i,j) + ! eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) ! do k=nz,1,-1 ! eta1D(k) = e0(k) ! if (eta1D(k) < (eta1D(k+1) + min_thickness)) then @@ -187,7 +187,7 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, param_file, just_read_params case ( REGRIDDING_ZSTAR ) do j=js,je ; do i=is,ie - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -GV%Z_to_H*G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then @@ -201,8 +201,7 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, param_file, just_read_params case ( REGRIDDING_SIGMA ) do j=js,je ; do i=is,ie - delta_h = G%bathyT(i,j) / nz - h(i,j,:) = GV%m_to_H * delta_h + h(i,j,:) = GV%Z_to_H*G%bathyT(i,j) / nz enddo ; enddo case default @@ -359,7 +358,7 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) 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 :: RHO(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for RHO - real :: h(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for thickness + real :: h(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for thickness, in m. real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for thickness real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. real :: S_ref, T_ref ! Reference salinity and temerature within surface layer @@ -444,7 +443,7 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) enddo e0(nz+1) = -G%max_depth do j=js,je ; do i=is,ie - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then @@ -461,7 +460,7 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) ! Construct temperature and salinity on the arbitrary grid T(:,:,:) = 0.0 ; S(:,:,:) = 0.0 do j=js,je ; do i=is,ie - z = -G%bathyT(i,j) + z = -G%Zd_to_m*G%bathyT(i,j) do k = nz,1,-1 z = z + 0.5 * h(i,j,k) ! Position of the center of layer k S(i,j,k) = 34.0 - 1.0 * (z/G%max_depth) @@ -482,7 +481,7 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) ! Construct thicknesses to restore to do j=js,je ; do i=is,ie - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then @@ -495,11 +494,11 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) x = ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon if ( x <= dome2d_width_bay ) then - h(i,j,1:nz-1) = GV%Angstrom_H - h(i,j,nz) = dome2d_depth_bay * G%max_depth - (nz-1) * GV%Angstrom_H + h(i,j,1:nz-1) = GV%Angstrom_m + h(i,j,nz) = dome2d_depth_bay * G%max_depth - (nz-1) * GV%Angstrom_m endif - eta(i,j,nz+1) = -G%bathyT(i,j) + eta(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) do K=nz,1,-1 eta(i,j,K) = eta(i,j,K+1) + h(i,j,k) enddo diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 03274c0d8c..661b6a9978 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -113,7 +113,7 @@ subroutine DOME_initialize_thickness(h, G, GV, param_file, just_read_params) ! Angstrom thick, and 2. the interfaces are where they should be ! ! based on the resting depths and interface height perturbations, ! ! as long at this doesn't interfere with 1. ! - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = e0(K) if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_m)) then @@ -190,16 +190,16 @@ subroutine DOME_initialize_sponges(G, GV, tv, PF, CSp) ! depth space for Boussinesq or non-Boussinesq models. eta(i,j,1) = 0.0 do k=2,nz -! eta(i,j,K)=max(H0(k), -G%bathyT(i,j), GV%Angstrom_m*(nz-k+1)-G%bathyT(i,j)) - e_dense = -G%bathyT(i,j) +! eta(i,j,K)=max(H0(k), -G%Zd_to_m*G%bathyT(i,j), GV%Angstrom_m*(nz-k+1)-G%bathyT(i,j)) + e_dense = -G%Zd_to_m*G%bathyT(i,j) if (e_dense >= H0(k)) then ; eta(i,j,K) = e_dense else ; eta(i,j,K) = H0(k) ; endif - if (eta(i,j,K) < GV%Angstrom_m*(nz-k+1)-G%bathyT(i,j)) & - eta(i,j,K) = GV%Angstrom_m*(nz-k+1)-G%bathyT(i,j) + if (eta(i,j,K) < GV%Angstrom_m*(nz-k+1) - G%Zd_to_m*G%bathyT(i,j)) & + eta(i,j,K) = GV%Angstrom_m*(nz-k+1) - G%Zd_to_m*G%bathyT(i,j) enddo - eta(i,j,nz+1) = -G%bathyT(i,j) + eta(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) - if (G%bathyT(i,j) > min_depth) then + if (G%Zd_to_m*G%bathyT(i,j) > min_depth) then Idamp(i,j) = damp/86400.0 else ; Idamp(i,j) = 0.0 ; endif enddo ; enddo diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index f65ba242b0..ad65384750 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -136,7 +136,7 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par ! positive upward, in m. ! integer :: i, j, k, is, ie, js, je, nz, tmp1 real :: x - real :: delta_h, rho_range + real :: rho_range real :: min_thickness, s_sur, s_bot, t_sur, t_bot, rho_sur, rho_bot logical :: just_read ! If true, just read parameters but set nothing. character(len=256) :: mesg ! The text of an error message @@ -192,7 +192,7 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par ! Calculate thicknesses do j=js,je ; do i=is,ie - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then @@ -207,7 +207,7 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR ) ! Initial thicknesses for z coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then @@ -222,8 +222,7 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie - delta_h = G%bathyT(i,j) / dfloat(nz) - h(i,j,:) = GV%m_to_H * delta_h + h(i,j,:) = GV%m_to_H * G%Zd_to_m*G%bathyT(i,j) / dfloat(nz) enddo ; enddo case default @@ -249,7 +248,8 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, ! Local variables integer :: i, j, k, is, ie, js, je, nz, itt real :: x, ds, dt, rho_sur, rho_bot - real :: xi0, xi1, dxi, r, S_sur, T_sur, S_bot, T_bot, S_range, T_range + real :: xi0, xi1, dxi ! Heights in m., r + real :: S_sur, T_sur, S_bot, T_bot, S_range, T_range real :: z ! vertical position in z space character(len=256) :: mesg ! The text of an error message character(len=40) :: verticalCoordinate, density_profile @@ -298,7 +298,7 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, S_range = S_range / G%max_depth ! Convert S_range into dS/dz T_range = T_range / G%max_depth ! Convert T_range into dT/dz do j=js,je ; do i=is,ie - xi0 = -G%bathyT(i,j) + xi0 = -G%Zd_to_m * G%bathyT(i,j) do k = nz,1,-1 xi0 = xi0 + 0.5 * h(i,j,k) * GV%H_to_m ! Depth in middle of layer S(i,j,k) = S_sur + S_range * xi0 @@ -339,13 +339,13 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, do j=js,je ; do i=is,ie xi0 = 0.0 do k = 1,nz - !T0(k) = T_Ref; S0(k) = S_Ref - xi1 = xi0 + 0.5 * h(i,j,k) * GV%H_to_m - S0(k) = S_sur + S_range * xi1 - T0(k) = T_sur + T_range * xi1 - xi0 = xi0 + h(i,j,k) * GV%H_to_m - ! write(mesg,*) 'S,T,xi0,xi1,k',S0(k),T0(k),xi0,xi1,k - ! call MOM_mesg(mesg,5) + !T0(k) = T_Ref; S0(k) = S_Ref + xi1 = xi0 + 0.5 * h(i,j,k) * GV%H_to_m + S0(k) = S_sur + S_range * xi1 + T0(k) = T_sur + T_range * xi1 + xi0 = xi0 + h(i,j,k) * GV%H_to_m + ! write(mesg,*) 'S,T,xi0,xi1,k',S0(k),T0(k),xi0,xi1,k + ! call MOM_mesg(mesg,5) enddo call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,1,eqn_of_state) @@ -439,7 +439,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta. ! positive upward, in m. - real :: min_depth, dummy1, z, delta_h + real :: min_depth, dummy1, z real :: damp, rho_dummy, min_thickness, rho_tmp, xi0 character(len=40) :: verticalCoordinate, filename, state_file character(len=40) :: temp_var, salt_var, eta_var, inputdir @@ -500,8 +500,8 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) endif ! convert to 1 / seconds - if (G%bathyT(i,j) > min_depth) then - Idamp(i,j) = damp/86400.0 + if (G%Zd_to_m * G%bathyT(i,j) > min_depth) then + Idamp(i,j) = damp/86400.0 else ; Idamp(i,j) = 0.0 ; endif @@ -536,7 +536,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) ! Calculate thicknesses do j=js,je ; do i=is,ie - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%Zd_to_m * G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then @@ -550,7 +550,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR ) ! Initial thicknesses for z coordinates do j=js,je ; do i=is,ie - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%Zd_to_m * G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then @@ -564,8 +564,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates do j=js,je ; do i=is,ie - delta_h = G%bathyT(i,j) / dfloat(nz) - h(i,j,:) = delta_h + h(i,j,:) = G%Zd_to_m * (G%bathyT(i,j) / dfloat(nz)) enddo ; enddo case default @@ -580,7 +579,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) S_range = S_range / G%max_depth ! Convert S_range into dS/dz T_range = T_range / G%max_depth ! Convert T_range into dT/dz do j=js,je ; do i=is,ie - xi0 = -G%bathyT(i,j) + xi0 = -G%Zd_to_m * G%bathyT(i,j) do k = nz,1,-1 xi0 = xi0 + 0.5 * h(i,j,k) ! Depth in middle of layer S(i,j,k) = S_sur + S_range * xi0 diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index 8cf56a42ac..92f25463aa 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -223,11 +223,11 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, h, Time) x = (x1 - CS%coast_offset1) * cosa + y1 * sina y = - (x1 - CS%coast_offset1) * sina + y1 * cosa if (CS%mode == 0) then - cff = sqrt(G%g_Earth * 0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j))) + cff = sqrt(G%g_Earth * 0.5 * G%Zd_to_m * (G%bathyT(i+1,j) + G%bathyT(i,j))) val2 = fac * exp(- CS%F_0 * y / cff) segment%eta(I,j) = val2 * cos(CS%omega * time_sec) segment%normal_vel_bt(I,j) = val1 * cff * cosa / & - (0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j))) * val2 + (0.5 * G%Zd_to_m * (G%bathyT(i+1,j) + G%bathyT(i,j))) * val2 else ! Not rotated yet segment%eta(I,j) = 0.0 @@ -257,9 +257,13 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, h, Time) y = - (x1 - CS%coast_offset1) * sina + y1 * cosa if (CS%mode == 0) then do k=1,nz - segment%tangential_vel(I,J,k) = 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))) * val2 + segment%tangential_vel(I,J,k) = val1 * cff * sina / & + (0.25 * G%Zd_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j) + & + G%bathyT(i+1,j+1) + G%bathyT(i,j+1))) * val2 +!### This should be: +! segment%tangential_vel(I,J,k) = val1 * cff * sina / & +! ( 0.25*G%Zd_to_m*((G%bathyT(i,j) + G%bathyT(i+1,j+1)) +& +! (G%bathyT(i+1,j) + G%bathyT(i,j+1))) ) * val2 enddo endif enddo ; enddo @@ -273,11 +277,11 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, h, Time) x = (x1 - CS%coast_offset1) * cosa + y1 * sina y = - (x1 - CS%coast_offset1) * sina + y1 * cosa if (CS%mode == 0) then - cff = sqrt(G%g_Earth * 0.5 * (G%bathyT(i,j+1) + G%bathyT(i,j))) + cff = sqrt(G%g_Earth * 0.5 * G%Zd_to_m*(G%bathyT(i,j+1) + G%bathyT(i,j))) val2 = fac * exp(- 0.5 * (G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) * y / cff) segment%eta(I,j) = val2 * cos(CS%omega * time_sec) - segment%normal_vel_bt(I,j) = val1 * cff * sina / & - (0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j))) * val2 + segment%normal_vel_bt(I,j) = val1 * cff * sina / & + (0.5 * G%Zd_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j))) * val2 else ! Not rotated yet segment%eta(i,J) = 0.0 @@ -305,9 +309,13 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, h, Time) y = - (x1 - CS%coast_offset1) * sina + y1 * cosa if (CS%mode == 0) then do k=1,nz - segment%tangential_vel(I,J,k) = 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))) * val2 + segment%tangential_vel(I,J,k) = val1 * cff * sina / & + (0.25 * G%Zd_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j) + & + G%bathyT(i+1,j+1) + G%bathyT(i,j+1))) * val2 +!### This should be: +! segment%tangential_vel(I,J,k) = val1 * cff * sina / & +! ( 0.25*G%Zd_to_m*((G%bathyT(i,j) + G%bathyT(i+1,j+1)) +& +! (G%bathyT(i+1,j) + G%bathyT(i,j+1))) ) * val2 enddo endif enddo ; enddo diff --git a/src/user/Neverland_initialization.F90 b/src/user/Neverland_initialization.F90 index 40c0f81ff4..11271543b9 100644 --- a/src/user/Neverland_initialization.F90 +++ b/src/user/Neverland_initialization.F90 @@ -135,7 +135,7 @@ subroutine Neverland_initialize_thickness(h, G, GV, param_file, eqn_of_state, P_ enddo do j=js,je ; do i=is,ie - e_interface = -G%bathyT(i,j) + e_interface = -G%Zd_to_m * G%bathyT(i,j) do k=nz,1,-1 h(i,j,k) = max( GV%Angstrom_H, GV%m_to_H * (e0(k) - e_interface) ) e_interface = max( e0(k), e_interface - GV%H_to_m * h(i,j,k) ) diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index 6d2aa72e90..ebd20c7f7d 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -95,7 +95,7 @@ subroutine Phillips_initialize_thickness(h, G, GV, param_file, just_read_params) ! Angstrom thick, and 2. the interfaces are where they should be ! ! based on the resting depths and interface height perturbations, ! ! as long at this doesn't interfere with 1. ! - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%Zd_to_m * G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = eta_im(j,K) if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_m)) then diff --git a/src/user/adjustment_initialization.F90 b/src/user/adjustment_initialization.F90 index cd65def7d7..6049aa971a 100644 --- a/src/user/adjustment_initialization.F90 +++ b/src/user/adjustment_initialization.F90 @@ -241,7 +241,7 @@ subroutine adjustment_initialize_temperature_salinity ( T, S, h, G, GV, param_fi case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA ) dSdz = -delta_S_strat/G%max_depth do j=js,je ; do i=is,ie - eta1d(nz+1) = -G%bathyT(i,j) + eta1d(nz+1) = -G%Zd_to_m*G%bathyT(i,j) do k=nz,1,-1 eta1d(k) = eta1d(k+1) + h(i,j,k)*GV%H_to_m enddo diff --git a/src/user/baroclinic_zone_initialization.F90 b/src/user/baroclinic_zone_initialization.F90 index 708c412c65..381828e49c 100644 --- a/src/user/baroclinic_zone_initialization.F90 +++ b/src/user/baroclinic_zone_initialization.F90 @@ -97,7 +97,7 @@ subroutine baroclinic_zone_init_temperature_salinity(T, S, h, G, GV, param_file, PI = 4.*atan(1.) do j = G%jsc,G%jec ; do i = G%isc,G%iec - zi = -G%bathyT(i,j) + zi = -G%Zd_to_m*G%bathyT(i,j) x = G%geoLonT(i,j) - (G%west_lon + 0.5*G%len_lon) ! Relative to center of domain xd = x / G%len_lon ! -1/2 < xd 1/2 y = G%geoLatT(i,j) - (G%south_lat + 0.5*G%len_lat) ! Relative to center of domain diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index 8823f211c0..04e8cd014b 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -161,7 +161,7 @@ subroutine benchmark_initialize_thickness(h, G, GV, param_file, eqn_of_state, & ! Gv%Angstrom_m thick, and 2. the interfaces are where they should be ! ! based on the resting depths and interface height perturbations, ! ! as long at this doesn't interfere with 1. ! - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) do k=nz,2,-1 T_int = 0.5*(T0(k) + T0(k-1)) diff --git a/src/user/circle_obcs_initialization.F90 b/src/user/circle_obcs_initialization.F90 index 5c8d67d937..1d6611035e 100644 --- a/src/user/circle_obcs_initialization.F90 +++ b/src/user/circle_obcs_initialization.F90 @@ -70,7 +70,7 @@ subroutine circle_obcs_initialize_thickness(h, G, GV, param_file, just_read_para ! Uniform thicknesses for base state do j=js,je ; do i=is,ie ! - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = e0(K) if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_m)) then diff --git a/src/user/dense_water_initialization.F90 b/src/user/dense_water_initialization.F90 index 59f11dd98d..913bb108c9 100644 --- a/src/user/dense_water_initialization.F90 +++ b/src/user/dense_water_initialization.F90 @@ -225,7 +225,7 @@ subroutine dense_water_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, A do j = G%jsc,G%jec do i = G%isc,G%iec - eta1D(nz+1) = -G%bathyT(i,j) + eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) do k = nz,1,-1 eta1D(k) = e0(k) diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index d0109a8b6c..7acf5c09af 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -139,7 +139,7 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, param_file, just_read_param e0(K) = max(-G%max_depth, e0(K)) ! Bound by bottom enddo do j=js,je ; do i=is,ie - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%Zd_to_m * G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then @@ -154,7 +154,7 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, param_file, just_read_param case ( REGRIDDING_ZSTAR ) ! Initial thicknesses for z coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then @@ -169,8 +169,7 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, param_file, just_read_param case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie - delta_h = G%bathyT(i,j) / dfloat(nz) - h(i,j,:) = delta_h + h(i,j,:) = G%Zd_to_m * G%bathyT(i,j) / dfloat(nz) enddo ; enddo end select @@ -305,7 +304,7 @@ subroutine dumbbell_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp if (use_ALE) then ! construct a uniform grid for the sponge do j=G%jsc,G%jec ; do i=G%isc,G%iec - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%Zd_to_m * G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index 3243c94d0f..0e32bb1e7e 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -142,7 +142,7 @@ subroutine seamount_initialize_thickness ( h, G, GV, param_file, just_read_param e0(K) = max(-G%max_depth, e0(K)) ! Bound by bottom enddo do j=js,je ; do i=is,ie - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%Zd_to_m * G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then @@ -157,7 +157,7 @@ subroutine seamount_initialize_thickness ( h, G, GV, param_file, just_read_param case ( REGRIDDING_ZSTAR ) ! Initial thicknesses for z coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%Zd_to_m * G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then @@ -172,8 +172,7 @@ subroutine seamount_initialize_thickness ( h, G, GV, param_file, just_read_param case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie - delta_h = G%bathyT(i,j) / dfloat(nz) - h(i,j,:) = GV%m_to_H * delta_h + h(i,j,:) = G%Zd_to_m * GV%m_to_H * (G%bathyT(i,j) / dfloat(nz)) enddo ; enddo end select diff --git a/src/user/sloshing_initialization.F90 b/src/user/sloshing_initialization.F90 index f70bbc1619..c204d049bc 100644 --- a/src/user/sloshing_initialization.F90 +++ b/src/user/sloshing_initialization.F90 @@ -39,13 +39,9 @@ subroutine sloshing_initialize_topography ( D, G, param_file, max_depth ) ! Local variables integer :: i, j - do i=G%isc,G%iec - do j=G%jsc,G%jec - - D(i,j) = max_depth - - enddo - enddo + do i=G%isc,G%iec ; do j=G%jsc,G%jec + D(i,j) = max_depth + enddo ; enddo end subroutine sloshing_initialize_topography @@ -69,11 +65,11 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param !! only read parameters without changing h. real :: displ(SZK_(G)+1) - real :: z_unif(SZK_(G)+1) - real :: z_inter(SZK_(G)+1) + real :: z_unif(SZK_(G)+1) ! Fractional uniform interface heights, nondim. + real :: z_inter(SZK_(G)+1) ! Interface heights, in depth units. real :: x real :: a0 - real :: deltah + real :: m_to_Z ! A conversion factor from m to depth units. real :: total_height real :: weight_z real :: x1, y1, x2, y2 @@ -86,10 +82,9 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (just_read) return ! This subroutine has no run-time parameters. - deltah = G%max_depth / nz + m_to_Z = 1.0 / G%Zd_to_m ! Define thicknesses do j=G%jsc,G%jec ; do i=G%isc,G%iec @@ -121,18 +116,19 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param t = - z_unif(k) - z_inter(k) = -t * G%max_depth + z_inter(k) = -t * (G%max_depth * GV%m_to_Z) enddo ! 2. Define displacement - a0 = 75.0; ! Displacement amplitude (meters) + a0 = 75.0 * m_to_Z ! 75m Displacement amplitude in depth units. do k = 1,nz+1 - weight_z = - 4.0 * ( z_unif(k) + 0.5 )**2 + 1 + weight_z = - 4.0 * ( z_unif(k) + 0.5 )**2 + 1.0 x = G%geoLonT(i,j) / G%len_lon - displ(k) = a0 * cos(acos(-1.0)*x) + weight_z + !### Perhaps the '+ weight_z' here should be '* weight_z' - RWH + displ(k) = a0 * cos(acos(-1.0)*x) + weight_z * m_to_Z if ( k == 1 ) then displ(k) = 0.0 @@ -149,12 +145,11 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param ! 3. The last interface must coincide with the seabed z_inter(nz+1) = -G%bathyT(i,j) - ! Modify interface heights to make sure all thicknesses - ! are strictly positive + ! Modify interface heights to make sure all thicknesses are strictly positive do k = nz,1,-1 - if ( z_inter(k) < (z_inter(k+1) + GV%Angstrom_m) ) then - z_inter(k) = z_inter(k+1) + GV%Angstrom_m + if ( z_inter(k) < (z_inter(k+1) + GV%Angstrom_Z) ) then + z_inter(k) = z_inter(k+1) + GV%Angstrom_Z endif enddo @@ -162,7 +157,7 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param ! 4. Define layers total_height = 0.0 do k = 1,nz - h(i,j,k) = GV%m_to_H * (z_inter(k) - z_inter(k+1)) + h(i,j,k) = G%Zd_to_m*GV%m_to_H * (z_inter(k) - z_inter(k+1)) total_height = total_height + h(i,j,k) enddo @@ -255,6 +250,5 @@ end subroutine sloshing_initialize_temperature_salinity !> \namespace sloshing_initialization !! -!! The module configures the model for the non-rotating sloshing -!! test case. +!! The module configures the model for the non-rotating sloshing test case. end module sloshing_initialization diff --git a/src/user/soliton_initialization.F90 b/src/user/soliton_initialization.F90 index e258b87bf1..4d463803f3 100644 --- a/src/user/soliton_initialization.F90 +++ b/src/user/soliton_initialization.F90 @@ -53,7 +53,7 @@ subroutine soliton_initialize_thickness(h, G, GV) y = G%geoLatT(i,j)-y0 val3 = exp(-val1*x) val4 = val2*((2.0*val3/(1.0+(val3*val3)))**2) - h(i,j,k) = GV%m_to_H * (0.25*val4 * (6.0*y*y+3.0) * exp(-0.5*y*y) + G%bathyT(i,j)) + h(i,j,k) = GV%m_to_H * (0.25*val4 * (6.0*y*y+3.0) * exp(-0.5*y*y) + G%Zd_to_m*G%bathyT(i,j)) enddo enddo ; enddo From 10487f4081d60d0239ab9daea56a32cab732c2cb Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 28 Aug 2018 17:58:53 -0400 Subject: [PATCH 051/174] Restructured code to avoid array syntax multiplies Mildly restructured the code in PressureForce_AFV_Bouss and write_static_fields to avoid doing array syntax multiplication. All answers are bitwise identical. --- src/core/MOM_PressureForce_analytic_FV.F90 | 16 ++++++++++------ src/core/MOM_PressureForce_blocked_AFV.F90 | 12 ++++++++---- src/diagnostics/MOM_diagnostics.F90 | 12 ++++++++---- 3 files changed, 26 insertions(+), 14 deletions(-) diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index 9a50cd78e6..9bf98856d8 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -455,6 +455,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p real, dimension(SZI_(G),SZJ_(G)) :: & e_tidal, & ! The bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading, in m. + z_bathy, & ! The height of the bathymetry, in m. dM ! The barotropic adjustment to the Montgomery potential to ! account for a reduced gravity model, in m2 s-2. real, dimension(SZI_(G)) :: & @@ -525,6 +526,10 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p G_Rho0 = GV%g_Earth/GV%Rho0 rho_ref = CS%Rho0 + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + z_bathy(i,j) = G%Zd_to_m*G%bathyT(i,j) + enddo ; enddo + if (CS%tides) then ! Determine the surface height anomaly for calculating self attraction ! and loading. This should really be based on bottom pressure anomalies, @@ -667,23 +672,22 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p if ( CS%Recon_Scheme == 1 ) then call int_density_dz_generic_plm( T_t(:,:,k), T_b(:,:,k), & S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref, CS%Rho0, GV%g_Earth, & - dz_neglect, G%Zd_to_m*G%bathyT(:,:), G%HI, G%HI, & + rho_ref, CS%Rho0, GV%g_Earth, & + dz_neglect, z_bathy, G%HI, G%HI, & tv%eqn_of_state, dpa, intz_dpa, intx_dpa, inty_dpa, & useMassWghtInterp = CS%useMassWghtInterp) elseif ( CS%Recon_Scheme == 2 ) then call int_density_dz_generic_ppm( tv%T(:,:,k), T_t(:,:,k), T_b(:,:,k), & tv%S(:,:,k), S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & rho_ref, CS%Rho0, GV%g_Earth, & - G%HI, G%HI, tv%eqn_of_state, dpa, intz_dpa, & + G%HI, G%HI, tv%eqn_of_state, dpa, intz_dpa, & intx_dpa, inty_dpa) endif else - call int_density_dz(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), & - e(:,:,K), e(:,:,K+1), & + call int_density_dz(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), e(:,:,K), e(:,:,K+1), & rho_ref, CS%Rho0, GV%g_Earth, G%HI, G%HI, tv%eqn_of_state, & dpa, intz_dpa, intx_dpa, inty_dpa, & - G%Zd_to_m*G%bathyT(:,:), dz_neglect, CS%useMassWghtInterp) + z_bathy, dz_neglect, CS%useMassWghtInterp) endif !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index 318f4126f1..1d2d84e98c 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -438,6 +438,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at real, dimension(SZI_(G),SZJ_(G)) :: & e_tidal, & ! The bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading, in m. + z_bathy, & ! The height of the bathymetry, in m. dM ! The barotropic adjustment to the Montgomery potential to ! account for a reduced gravity model, in m2 s-2. real, dimension(SZI_(G)) :: & @@ -510,6 +511,10 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at G_Rho0 = GV%g_Earth/GV%Rho0 rho_ref = CS%Rho0 + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + z_bathy(i,j) = G%Zd_to_m*G%bathyT(i,j) + enddo ; enddo + if (CS%tides) then ! Determine the surface height anomaly for calculating self attraction ! and loading. This should really be based on bottom pressure anomalies, @@ -666,7 +671,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at call int_density_dz_generic_plm( T_t(:,:,k), T_b(:,:,k), & S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & rho_ref, CS%Rho0, GV%g_Earth, & - dz_neglect, G%Zd_to_m*G%bathyT(:,:), G%HI, G%Block(n), & + dz_neglect, z_bathy, G%HI, G%Block(n), & tv%eqn_of_state, dpa_bk, intz_dpa_bk, intx_dpa_bk, inty_dpa_bk, & useMassWghtInterp = CS%useMassWghtInterp) elseif ( CS%Recon_Scheme == 2 ) then @@ -677,11 +682,10 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at intx_dpa_bk, inty_dpa_bk) endif else - call int_density_dz(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), & - e(:,:,K), e(:,:,K+1), & + call int_density_dz(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), e(:,:,K), e(:,:,K+1), & rho_ref, CS%Rho0, GV%g_Earth, G%HI, G%Block(n), tv%eqn_of_state, & dpa_bk, intz_dpa_bk, intx_dpa_bk, inty_dpa_bk, & - G%Zd_to_m*G%bathyT(:,:), dz_neglect, CS%useMassWghtInterp) + z_bathy, dz_neglect, CS%useMassWghtInterp) endif do jb=Jsq_bk,Jeq_bk+1 ; do ib=Isq_bk,Ieq_bk+1 intz_dpa_bk(ib,jb) = intz_dpa_bk(ib,jb)*GV%m_to_H diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 5e40fad81e..e5ffdbff02 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -1822,6 +1822,8 @@ subroutine write_static_fields(G, GV, tv, diag) real :: tmp_h(SZI_(G),SZJ_(G)) integer :: id, i, j + tmp_h(:,:) = 0.0 + id = register_static_field('ocean_model', 'geolat', diag%axesT1, & 'Latitude of tracer (T) points', 'degrees_north') if (id > 0) call post_data(id, G%geoLatT, diag, .true.) @@ -1902,8 +1904,9 @@ subroutine write_static_fields(G, GV, tv, diag) if (G%Zd_to_m == 1.0) then call post_data(id, G%bathyT, diag, .true., mask=G%mask2dT) else - tmp_h(:,:) = 0. - tmp_h(G%isc:G%iec,G%jsc:G%jec) = G%bathyT(G%isc:G%iec,G%jsc:G%jec) / G%Zd_to_m + do j=G%jsc,G%jec ; do i=G%isc,G%iec + tmp_h(i,j) = G%bathyT(i,j) * G%Zd_to_m + enddo ; enddo call post_data(id, tmp_h, diag, .true., mask=G%mask2dT) endif endif @@ -1977,8 +1980,9 @@ subroutine write_static_fields(G, GV, tv, diag) cmor_long_name='Sea Area Fraction', & x_cell_method='mean', y_cell_method='mean', area_cell_method='mean') if (id > 0) then - tmp_h(:,:) = 0. - tmp_h(G%isc:G%iec,G%jsc:G%jec) = 100. * G%mask2dT(G%isc:G%iec,G%jsc:G%jec) + do j=G%jsc,G%jec ; do i=G%isc,G%iec + tmp_h(i,j) = 100. * G%mask2dT(i,j) + enddo ; enddo call post_data(id, tmp_h, diag, .true.) endif From b858a190de3b7d7e19a7a686f2ff5bdd3c38add4 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 28 Aug 2018 18:00:50 -0400 Subject: [PATCH 052/174] Removed Zd_to_m from the barotropic_CS Removed Zd_to_m from the barotropic_CS. Also combined unit conversion factors to go directly from Z to H, and standardized the conversion factors to come from the verticalGrid_type. All answers are bitwise identical. --- src/core/MOM_barotropic.F90 | 71 ++++++++++++++++++------------------- 1 file changed, 35 insertions(+), 36 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 7e5045a087..15dee28aeb 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -131,7 +131,6 @@ module MOM_barotropic ua_polarity, & !< Test vector components for checking grid polarity. va_polarity, & !< Test vector components for checking grid polarity. bathyT !< A copy of bathyT (ocean bottom depth) with wide halos, in depth units - real :: Zd_to_m = 1.0 !< The conversion factor between the units of bathyT and m. real ALLOCABLE_, dimension(NIMEMW_,NJMEMW_) :: IareaT !< This is a copy of G%IareaT with wide halos, but will !! still utilize the macro IareaT when referenced, m-2. @@ -805,17 +804,17 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & ! ### bathyT here should be replaced with bathyT+eta(Bous) or eta(non-Bous). !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - DCor_u(I,j) = 0.5 * G%Zd_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j)) + DCor_u(I,j) = 0.5 * GV%Z_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j)) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - DCor_v(i,J) = 0.5 * G%Zd_to_m*(G%bathyT(i,j+1) + G%bathyT(i,j)) + DCor_v(i,J) = 0.5 * GV%Z_to_m*(G%bathyT(i,j+1) + G%bathyT(i,j)) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do I=is-1,ie q(I,J) = 0.25 * G%CoriolisBu(I,J) * & ((G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i+1,j) + G%areaT(i,j+1))) / & - (G%Zd_to_m*((G%areaT(i,j) * G%bathyT(i,j) + G%areaT(i+1,j+1) * G%bathyT(i+1,j+1)) + & + (GV%Z_to_m*((G%areaT(i,j) * G%bathyT(i,j) + G%areaT(i+1,j+1) * G%bathyT(i+1,j+1)) + & (G%areaT(i+1,j) * G%bathyT(i+1,j) + G%areaT(i,j+1) * G%bathyT(i,j+1)))) enddo ; enddo @@ -1292,7 +1291,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & do j=js,je ; do I=is-1,ie ; if (CS%lin_drag_u(I,j) > 0.0) then Htot = 0.5 * (eta(i,j) + eta(i+1,j)) if (GV%Boussinesq) & - Htot = Htot + 0.5*CS%Zd_to_m*GV%m_to_H * (CS%bathyT(i,j) + CS%bathyT(i+1,j)) + Htot = Htot + 0.5*GV%Z_to_H * (CS%bathyT(i,j) + CS%bathyT(i+1,j)) bt_rem_u(I,j) = bt_rem_u(I,j) * (Htot / (Htot + CS%lin_drag_u(I,j) * dtbt)) Rayleigh_u(I,j) = CS%lin_drag_u(I,j) / Htot @@ -1301,7 +1300,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & do J=js-1,je ; do i=is,ie ; if (CS%lin_drag_v(i,J) > 0.0) then Htot = 0.5 * (eta(i,j) + eta(i,j+1)) if (GV%Boussinesq) & - Htot = Htot + 0.5*CS%Zd_to_m*GV%m_to_H * (CS%bathyT(i,j) + CS%bathyT(i+1,j+1)) + Htot = Htot + 0.5*GV%Z_to_H * (CS%bathyT(i,j) + CS%bathyT(i+1,j+1)) bt_rem_v(i,J) = bt_rem_v(i,J) * (Htot / (Htot + CS%lin_drag_v(i,J) * dtbt)) Rayleigh_v(i,J) = CS%lin_drag_v(i,J) / Htot @@ -1354,7 +1353,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & ! Limit the sink (inward) correction to the amount of mass that is already ! inside the cell. Htot = eta(i,j) - if (GV%Boussinesq) Htot = CS%bathyT(i,j)*CS%Zd_to_m*GV%m_to_H + eta(i,j) + if (GV%Boussinesq) Htot = CS%bathyT(i,j)*GV%Z_to_H + eta(i,j) CS%eta_cor(i,j) = max(CS%eta_cor(i,j), -max(0.0,Htot)) endif @@ -2634,21 +2633,21 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, MS, halo, use_BT_co else ! This is assuming Flather as only other option if (GV%Boussinesq) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then - BT_OBC%H_u(I,j) = G%bathyT(i,j)*G%Zd_to_m*GV%m_to_H + eta(i,j) + BT_OBC%H_u(I,j) = G%bathyT(i,j)*GV%Z_to_H + eta(i,j) elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then - BT_OBC%H_u(I,j) = G%bathyT(i+1,j)*G%Zd_to_m*GV%m_to_H + eta(i+1,j) + BT_OBC%H_u(I,j) = G%bathyT(i+1,j)*GV%Z_to_H + eta(i+1,j) endif else if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then BT_OBC%H_u(i,j) = eta(i,j) - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%Zd_to_m*G%bathyT(i,j) + eta(i,j))) + BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (GV%Z_to_m*G%bathyT(i,j) + eta(i,j))) !### * GV%H_to_m? elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then BT_OBC%H_u(i,j) = eta(i+1,j) - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%Zd_to_m*G%bathyT(i+1,j) + eta(i+1,j))) + BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (GV%Z_to_m*G%bathyT(i+1,j) + eta(i+1,j))) !### * GV%H_to_m? endif endif if (GV%Boussinesq) then - BT_OBC%Cg_u(I,j) = SQRT(GV%g_prime(1) * BT_OBC%H_u(i,j)) + BT_OBC%Cg_u(I,j) = SQRT(GV%g_prime(1) * BT_OBC%H_u(i,j)) !### * GV%H_to_m? endif endif endif ; enddo ; enddo @@ -2690,21 +2689,21 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, MS, halo, use_BT_co else ! This is assuming Flather as only other option if (GV%Boussinesq) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then - BT_OBC%H_v(i,J) = G%bathyT(i,j)*G%Zd_to_m*GV%m_to_H + eta(i,j) + BT_OBC%H_v(i,J) = G%bathyT(i,j)*GV%Z_to_H + eta(i,j) elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then - BT_OBC%H_v(i,J) = G%bathyT(i,j+1)*G%Zd_to_m*GV%m_to_H + eta(i,j+1) + BT_OBC%H_v(i,J) = G%bathyT(i,j+1)*GV%Z_to_H + eta(i,j+1) endif else if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then BT_OBC%H_v(i,J) = eta(i,j) - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%Zd_to_m*G%bathyT(i,j) + eta(i,j))) + BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (GV%Z_to_m*G%bathyT(i,j) + eta(i,j))) !### * GV%H_to_m? elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then BT_OBC%H_v(i,J) = eta(i,j+1) - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%Zd_to_m*G%bathyT(i,j+1) + eta(i,j+1))) + BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (GV%Z_to_m*G%bathyT(i,j+1) + eta(i,j+1))) !### * GV%H_to_m? endif endif if (GV%Boussinesq) then - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * BT_OBC%H_v(i,J)) + BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * BT_OBC%H_v(i,J)) !### * GV%H_to_m? endif endif endif ; enddo ; enddo @@ -2858,8 +2857,8 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) enddo ; enddo elseif (CS%hvel_scheme == HYBRID .or. use_default) then do I=is-1,ie - e_u(I,nz+1) = -0.5 * G%Zd_to_m*GV%m_to_H * (G%bathyT(i+1,j) + G%bathyT(i,j)) - D_shallow_u(I) = -G%Zd_to_m*GV%m_to_H * min(G%bathyT(i+1,j), G%bathyT(i,j)) + e_u(I,nz+1) = -0.5 * GV%Z_to_H * (G%bathyT(i+1,j) + G%bathyT(i,j)) + D_shallow_u(I) = -GV%Z_to_H * min(G%bathyT(i+1,j), G%bathyT(i,j)) hatutot(I) = 0.0 enddo do k=nz,1,-1 ; do I=is-1,ie @@ -2921,8 +2920,8 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) enddo ; enddo elseif (CS%hvel_scheme == HYBRID .or. use_default) then do i=is,ie - e_v(i,nz+1) = -0.5 * G%Zd_to_m*GV%m_to_H * (G%bathyT(i,j+1) + G%bathyT(i,j)) - D_shallow_v(I) = -G%Zd_to_m*GV%m_to_H * min(G%bathyT(i,j+1), G%bathyT(i,j)) + e_v(i,nz+1) = -0.5 * GV%Z_to_H * (G%bathyT(i,j+1) + G%bathyT(i,j)) + D_shallow_v(I) = -GV%Z_to_H * min(G%bathyT(i,j+1), G%bathyT(i,j)) hatvtot(I) = 0.0 enddo do k=nz,1,-1 ; do i=is,ie @@ -3558,14 +3557,14 @@ subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max) if (GV%Boussinesq) then !$OMP do do j=js-hs,je+hs ; do I=is-1-hs,ie+hs - H1 = CS%bathyT(i,j)*CS%Zd_to_m*GV%m_to_H + eta(i,j) ; H2 = CS%bathyT(i+1,j)*CS%Zd_to_m*GV%m_to_H + eta(i+1,j) + H1 = CS%bathyT(i,j)*GV%Z_to_H + eta(i,j) ; H2 = CS%bathyT(i+1,j)*GV%Z_to_H + eta(i+1,j) Datu(I,j) = 0.0 ; if ((H1 > 0.0) .and. (H2 > 0.0)) & Datu(I,j) = CS%dy_Cu(I,j) * (2.0 * H1 * H2) / (H1 + H2) ! Datu(I,j) = CS%dy_Cu(I,j) * 0.5 * (H1 + H2) enddo ; enddo !$OMP do do J=js-1-hs,je+hs ; do i=is-hs,ie+hs - H1 = CS%bathyT(i,j)*CS%Zd_to_m*GV%m_to_H + eta(i,j) ; H2 = CS%bathyT(i,j+1)*CS%Zd_to_m*GV%m_to_H + eta(i,j+1) + H1 = CS%bathyT(i,j)*GV%Z_to_H + eta(i,j) ; H2 = CS%bathyT(i,j+1)*GV%Z_to_H + eta(i,j+1) Datv(i,J) = 0.0 ; if ((H1 > 0.0) .and. (H2 > 0.0)) & Datv(i,J) = CS%dx_Cv(i,J) * (2.0 * H1 * H2) / (H1 + H2) ! Datv(i,J) = CS%dy_v(i,J) * 0.5 * (H1 + H2) @@ -3590,12 +3589,12 @@ subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max) !$OMP do do j=js-hs,je+hs ; do I=is-1-hs,ie+hs Datu(I,j) = CS%dy_Cu(I,j) * GV%m_to_H * & - (CS%Zd_to_m*max(CS%bathyT(i+1,j), CS%bathyT(i,j)) + add_max) + (GV%Z_to_m*max(CS%bathyT(i+1,j), CS%bathyT(i,j)) + add_max) enddo ; enddo !$OMP do do J=js-1-hs,je+hs ; do i=is-hs,ie+hs Datv(i,J) = CS%dx_Cv(i,J) * GV%m_to_H * & - (CS%Zd_to_m*max(CS%bathyT(i,j+1), CS%bathyT(i,j)) + add_max) + (GV%Z_to_m*max(CS%bathyT(i,j+1), CS%bathyT(i,j)) + add_max) enddo ; enddo else !$OMP do @@ -3603,7 +3602,7 @@ subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max) Datu(I, j) = 0.0 !Would be "if (G%mask2dCu(I,j)>0.) &" is G was valid on BT domain if (CS%bathyT(i+1,j)+CS%bathyT(i,j)>0.) & - Datu(I,j) = 2.0*CS%dy_Cu(I,j) * CS%Zd_to_m*GV%m_to_H * & + Datu(I,j) = 2.0*CS%dy_Cu(I,j) * GV%Z_to_H * & (CS%bathyT(i+1,j) * CS%bathyT(i,j)) / & (CS%bathyT(i+1,j) + CS%bathyT(i,j)) enddo ; enddo @@ -3612,7 +3611,7 @@ subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max) Datv(i, J) = 0.0 !Would be "if (G%mask2dCv(i,J)>0.) &" is G was valid on BT domain if (CS%bathyT(i,j+1)+CS%bathyT(i,j)>0.) & - Datv(i,J) = 2.0*CS%dx_Cv(i,J) * CS%Zd_to_m*GV%m_to_H * & + Datv(i,J) = 2.0*CS%dx_Cv(i,J) * GV%Z_to_H * & (CS%bathyT(i,j+1) * CS%bathyT(i,j)) / & (CS%bathyT(i,j+1) + CS%bathyT(i,j)) enddo ; enddo @@ -3659,7 +3658,7 @@ subroutine bt_mass_source(h, eta, set_cor, G, GV, CS) do j=js,je do i=is,ie ; h_tot(i) = h(i,j,1) ; enddo if (GV%Boussinesq) then - do i=is,ie ; eta_h(i) = h(i,j,1) - G%bathyT(i,j)*G%Zd_to_m*GV%m_to_H ; enddo + do i=is,ie ; eta_h(i) = h(i,j,1) - G%bathyT(i,j)*GV%Z_to_H ; enddo else do i=is,ie ; eta_h(i) = h(i,j,1) ; enddo endif @@ -4066,7 +4065,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & CS%IareaT(i,j) = G%IareaT(i,j) CS%bathyT(i,j) = G%bathyT(i,j) enddo ; enddo - CS%Zd_to_m = G%Zd_to_m + ! Note: G%IdxCu & G%IdyCv may be smaller than CS%IdxCu & CS%IdyCv, even without ! wide halos. do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB @@ -4089,16 +4088,16 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & ALLOC_(CS%D_v_Cor(CS%isdw:CS%iedw,CS%jsdw-1:CS%jedw)) CS%q_D(:,:) = 0.0 ; CS%D_u_Cor(:,:) = 0.0 ; CS%D_v_Cor(:,:) = 0.0 do j=js,je ; do I=is-1,ie - CS%D_u_Cor(I,j) = 0.5 * G%Zd_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j)) + CS%D_u_Cor(I,j) = 0.5 * GV%Z_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j)) enddo ; enddo do J=js-1,je ; do i=is,ie - CS%D_v_Cor(i,J) = 0.5 * G%Zd_to_m*(G%bathyT(i,j+1) + G%bathyT(i,j)) + CS%D_v_Cor(i,J) = 0.5 * GV%Z_to_m*(G%bathyT(i,j+1) + G%bathyT(i,j)) enddo ; enddo do J=js-1,je ; do I=is-1,ie if (G%mask2dT(i,j)+G%mask2dT(i,j+1)+G%mask2dT(i+1,j)+G%mask2dT(i+1,j+1)>0.) then CS%q_D(I,J) = 0.25 * G%CoriolisBu(I,J) * & ((G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i+1,j) + G%areaT(i,j+1))) / & - (G%Zd_to_m*((G%areaT(i,j) * G%bathyT(i,j) + G%areaT(i+1,j+1) * G%bathyT(i+1,j+1)) + & + (GV%Z_to_m*((G%areaT(i,j) * G%bathyT(i,j) + G%areaT(i+1,j+1) * G%bathyT(i+1,j+1)) + & (G%areaT(i+1,j) * G%bathyT(i+1,j) + G%areaT(i,j+1) * G%bathyT(i,j+1)))) else ! All four h points are masked out so q_D(I,J) will is meaningless CS%q_D(I,J) = 0. @@ -4296,24 +4295,24 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & ! if (GV%Boussinesq) then do j=js,je ; do I=is-1,ie if (G%mask2dCu(I,j)>0.) then - CS%IDatu(I,j) = G%mask2dCu(I,j) * 2.0 / (G%Zd_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j))) + CS%IDatu(I,j) = G%mask2dCu(I,j) * 2.0 / (GV%Z_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j))) else ! Both neighboring H points are masked out so IDatu(I,j) is meaningless CS%IDatu(I,j) = 0. endif enddo ; enddo do J=js-1,je ; do i=is,ie if (G%mask2dCv(i,J)>0.) then - CS%IDatv(i,J) = G%mask2dCv(i,J) * 2.0 / (G%Zd_to_m*(G%bathyT(i,j+1) + G%bathyT(i,j))) + CS%IDatv(i,J) = G%mask2dCv(i,J) * 2.0 / (GV%Z_to_m*(G%bathyT(i,j+1) + G%bathyT(i,j))) else ! Both neighboring H points are masked out so IDatu(I,j) is meaningless CS%IDatv(i,J) = 0. endif enddo ; enddo ! else ! do j=js,je ; do I=is-1,ie -! CS%IDatu(I,j) = G%mask2dCu(I,j) * 2.0 / (G%Zd_to_m*GV%Rho0*(G%bathyT(i+1,j) + G%bathyT(i,j))) +! CS%IDatu(I,j) = G%mask2dCu(I,j) * 2.0 / (GV%Z_to_m*GV%Rho0*(G%bathyT(i+1,j) + G%bathyT(i,j))) ! enddo ; enddo ! do J=js-1,je ; do i=is,ie -! CS%IDatv(i,J) = G%mask2dCv(i,J) * 2.0 / (G%Zd_to_m*GV%Rho0*(G%bathyT(i,j+1) + G%bathyT(i,j))) +! CS%IDatv(i,J) = G%mask2dCv(i,J) * 2.0 / (GV%Z_to_m*GV%Rho0*(G%bathyT(i,j+1) + G%bathyT(i,j))) ! enddo ; enddo ! endif From 096d9a35298c329c0171be47b0d6c8839b247b91 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 28 Aug 2018 18:04:18 -0400 Subject: [PATCH 053/174] Combined unit conversion factors Combined unit conversion factors to go directly from Z to H, and standardized the conversion factors to come from the verticalGrid_type. Also use G%max_depth in place of GV%max_depth in several places. All answers are bitwise identical. --- src/ALE/MOM_regridding.F90 | 12 +++---- src/core/MOM.F90 | 4 +-- src/core/MOM_dynamics_split_RK2.F90 | 2 +- src/framework/MOM_diag_remap.F90 | 6 ++-- .../vertical/MOM_full_convection.F90 | 2 +- .../vertical/MOM_vert_friction.F90 | 27 +++++++------- src/user/ISOMIP_initialization.F90 | 6 ++-- src/user/dense_water_initialization.F90 | 8 ++--- src/user/seamount_initialization.F90 | 6 ++-- src/user/sloshing_initialization.F90 | 35 ++++++------------- 10 files changed, 47 insertions(+), 61 deletions(-) diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index 16dfb9140e..cfdbd45812 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -1147,7 +1147,7 @@ subroutine build_zstar_grid( CS, G, GV, h, dzInterface, frac_shelf_h) endif ! Local depth (G%bathyT is positive) - nominalDepth = G%bathyT(i,j)*G%Zd_to_m*GV%m_to_H + nominalDepth = G%bathyT(i,j)*GV%Z_to_H ! Determine water column thickness totalThickness = 0.0 @@ -1236,7 +1236,7 @@ subroutine build_sigma_grid( CS, G, GV, h, dzInterface ) endif ! The rest of the model defines grids integrating up from the bottom - nominalDepth = G%bathyT(i,j)*G%Zd_to_m*GV%m_to_H + nominalDepth = G%bathyT(i,j)*GV%Z_to_H ! Determine water column height totalThickness = 0.0 @@ -1340,7 +1340,7 @@ subroutine build_rho_grid( G, GV, h, tv, dzInterface, remapCS, CS ) ! Local depth (G%bathyT is positive) - nominalDepth = G%bathyT(i,j)*G%Zd_to_m*GV%m_to_H + nominalDepth = G%bathyT(i,j)*GV%Z_to_H call build_rho_column(CS%rho_CS, nz, nominalDepth, h(i, j, :), & tv%T(i, j, :), tv%S(i, j, :), tv%eqn_of_state, zNew, & @@ -1445,7 +1445,7 @@ subroutine build_grid_HyCOM1( G, GV, h, tv, h_new, dzInterface, CS ) do j = G%jsc-1,G%jec+1 ; do i = G%isc-1,G%iec+1 if (G%mask2dT(i,j)>0.) then - depth = G%bathyT(i,j) * G%Zd_to_m*GV%m_to_H + depth = G%bathyT(i,j) * GV%Z_to_H z_col(1) = 0. ! Work downward rather than bottom up do K = 1, GV%ke @@ -1576,7 +1576,7 @@ subroutine build_grid_SLight(G, GV, h, tv, dzInterface, CS) do j = G%jsc-1,G%jec+1 ; do i = G%isc-1,G%iec+1 if (G%mask2dT(i,j)>0.) then - depth = G%bathyT(i,j) * G%Zd_to_m*GV%m_to_H + depth = G%bathyT(i,j) * GV%Z_to_H z_col(1) = 0. ! Work downward rather than bottom up do K=1,nz z_col(K+1) = z_col(K) + h(i, j, k) ! Work in units of h (m or Pa) @@ -1704,7 +1704,7 @@ subroutine build_grid_arbitrary( G, GV, h, dzInterface, h_new, CS ) do i = G%isc-1,G%iec+1 ! Local depth - local_depth = G%bathyT(i,j)*G%Zd_to_m*GV%m_to_H + local_depth = G%bathyT(i,j)*GV%Z_to_H ! Determine water column height total_height = 0.0 diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index eb7d8925b6..0f2334a290 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2136,8 +2136,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call copy_dyngrid_to_MOM_grid(dG, G) call destroy_dyn_horgrid(dG) - ! This could be moved earlier, perhaps just after MOM_initialize_fixed. -! if (G%Zd_to_m /= GV%Z_to_m) call rescale_grid_bathymetry(G, GV%Z_to_m) + ! This could replace an earlier call to rescale_dyn_horgrid_bathymetry just after MOM_initialize_fixed. + ! if (G%Zd_to_m /= GV%Z_to_m) call rescale_grid_bathymetry(G, GV%Z_to_m) ! Set a few remaining fields that are specific to the ocean grid type. call set_first_direction(G, first_direction) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index df60234ca3..30db43cc0c 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -1110,7 +1110,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_fil ! dimensions as h, either m or kg m-3. ! CS%eta(:,:) = 0.0 already from initialization. if (GV%Boussinesq) then - do j=js,je ; do i=is,ie ; CS%eta(i,j) = -G%bathyT(i,j) * G%Zd_to_m*GV%m_to_H ; enddo ; enddo + do j=js,je ; do i=is,ie ; CS%eta(i,j) = -GV%Z_to_H * G%bathyT(i,j) ; enddo ; enddo endif do k=1,nz ; do j=js,je ; do i=is,ie CS%eta(i,j) = CS%eta(i,j) + h(i,j,k) diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index 7f311811e4..be3a02f777 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -269,14 +269,14 @@ subroutine diag_remap_update(remap_cs, G, GV, h, T, S, eqn_of_state) if (remap_cs%vertical_coord == coordinateMode('ZSTAR')) then call build_zstar_column(get_zlike_CS(remap_cs%regrid_cs), & - G%Zd_to_m*GV%m_to_H*G%bathyT(i,j), sum(h(i,j,:)), & + GV%Z_to_H*G%bathyT(i,j), sum(h(i,j,:)), & zInterfaces, zScale=GV%m_to_H) elseif (remap_cs%vertical_coord == coordinateMode('SIGMA')) then call build_sigma_column(get_sigma_CS(remap_cs%regrid_cs), & - G%Zd_to_m*GV%m_to_H*G%bathyT(i,j), sum(h(i,j,:)), zInterfaces) + GV%Z_to_H*G%bathyT(i,j), sum(h(i,j,:)), zInterfaces) elseif (remap_cs%vertical_coord == coordinateMode('RHO')) then call build_rho_column(get_rho_CS(remap_cs%regrid_cs), G%ke, & - G%Zd_to_m*G%bathyT(i,j), h(i,j,:), T(i, j, :), S(i, j, :), & + G%Zd_to_m*G%bathyT(i,j), h(i,j,:), T(i,j,:), S(i,j,:), & eqn_of_state, zInterfaces, h_neglect, h_neglect_edge) elseif (remap_cs%vertical_coord == coordinateMode('SLIGHT')) then ! call build_slight_column(remap_cs%regrid_cs,remap_cs%remap_cs, nz, & diff --git a/src/parameterizations/vertical/MOM_full_convection.F90 b/src/parameterizations/vertical/MOM_full_convection.F90 index 75e6cd8570..55ea1cabe9 100644 --- a/src/parameterizations/vertical/MOM_full_convection.F90 +++ b/src/parameterizations/vertical/MOM_full_convection.F90 @@ -99,7 +99,7 @@ subroutine full_convection(G, GV, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, & h_neglect = GV%H_subroundoff kap_dt_x2 = 0.0 if (present(Kddt_convect)) kap_dt_x2 = 2.0*Kddt_convect - mix_len = (1.0e20 * nz) * (GV%max_depth * GV%m_to_H) + mix_len = (1.0e20 * nz) * (G%max_depth * GV%m_to_H) h0 = 1.0e-16*sqrt(Kddt_smooth) + h_neglect do j=js,je diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index cb8f784615..a19ec5c215 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -614,10 +614,11 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) zh, & ! An estimate of the interface's distance from the bottom ! based on harmonic mean thicknesses, in m or kg m-2. h_ml ! The mixed layer depth, in m or kg m-2. - real, allocatable, dimension(:,:) :: hML_u, hML_v - real, allocatable, dimension(:,:,:) :: Kv_v, & !< Total vertical viscosity at u-points - Kv_u !< Total vertical viscosity at v-points - real :: zcol(SZI_(G)) ! The height of an interface at h-points, in m or kg m-2. + real, allocatable, dimension(:,:) :: hML_u ! Diagnostic of the mixed layer depth at u points, in m. + real, allocatable, dimension(:,:) :: hML_v ! Diagnostic of the mixed layer depth at v points, in m. + real, allocatable, dimension(:,:,:) :: Kv_u !< Total vertical viscosity at u-points, in m2 s-1. + real, allocatable, dimension(:,:,:) :: Kv_v !< Total vertical viscosity at v-points, in m2 s-1. + real :: zcol(SZI_(G)) ! The height of an interface at h-points, in H (m or kg m-2). real :: botfn ! A function which goes from 1 at the bottom to 0 much more ! than Hbbl into the interior. real :: topfn ! A function which goes from 1 at the top to 0 much more @@ -691,7 +692,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) h_delta(I,k) = h(i+1,j,k) - h(i,j,k) endif ; enddo ; enddo do I=Isq,Ieq - Dmin(I) = min(G%bathyT(i,j), G%bathyT(i+1,j)) * G%Zd_to_m*GV%m_to_H + Dmin(I) = min(G%bathyT(i,j), G%bathyT(i+1,j)) * GV%Z_to_H zi_dir(I) = 0 enddo @@ -700,11 +701,11 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) do I=Isq,Ieq ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then do k=1,nz ; h_harm(I,k) = h(i,j,k) ; h_arith(I,k) = h(i,j,k) ; h_delta(I,k) = 0. ; enddo - Dmin(I) = G%bathyT(i,j) * G%Zd_to_m*GV%m_to_H + Dmin(I) = G%bathyT(i,j) * GV%Z_to_H zi_dir(I) = -1 elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then do k=1,nz ; h_harm(I,k) = h(i+1,j,k) ; h_arith(I,k) = h(i+1,j,k) ; h_delta(I,k) = 0. ; enddo - Dmin(I) = G%bathyT(i+1,j) * G%Zd_to_m*GV%m_to_H + Dmin(I) = G%bathyT(i+1,j) * GV%Z_to_H zi_dir(I) = 1 endif endif ; enddo @@ -727,7 +728,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) endif ; enddo ; enddo ! i & k loops else ! Not harmonic_visc do I=Isq,Ieq ; zh(I) = 0.0 ; z_i(I,nz+1) = 0.0 ; enddo - do i=Isq,Ieq+1 ; zcol(i) = -G%bathyT(i,j) * G%Zd_to_m*GV%m_to_H ; enddo + do i=Isq,Ieq+1 ; zcol(i) = -G%bathyT(i,j) * GV%Z_to_H ; enddo do k=nz,1,-1 do i=Isq,Ieq+1 ; zcol(i) = zcol(i) + h(i,j,k) ; enddo do I=Isq,Ieq ; if (do_i(I)) then @@ -858,7 +859,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) h_delta(i,k) = h(i,j+1,k) - h(i,j,k) endif ; enddo ; enddo do i=is,ie - Dmin(i) = min(G%bathyT(i,j), G%bathyT(i,j+1)) * G%Zd_to_m*GV%m_to_H + Dmin(i) = min(G%bathyT(i,j), G%bathyT(i,j+1)) * GV%Z_to_H zi_dir(i) = 0 enddo @@ -867,11 +868,11 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then do k=1,nz ; h_harm(I,k) = h(i,j,k) ; h_arith(I,k) = h(i,j,k) ; h_delta(i,k) = 0. ; enddo - Dmin(I) = G%bathyT(i,j) * G%Zd_to_m*GV%m_to_H + Dmin(I) = G%bathyT(i,j) * GV%Z_to_H zi_dir(I) = -1 elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then do k=1,nz ; h_harm(i,k) = h(i,j+1,k) ; h_arith(i,k) = h(i,j+1,k) ; h_delta(i,k) = 0. ; enddo - Dmin(i) = G%bathyT(i,j+1) * G%Zd_to_m*GV%m_to_H + Dmin(i) = G%bathyT(i,j+1) * GV%Z_to_H zi_dir(i) = 1 endif endif ; enddo @@ -896,8 +897,8 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) else ! Not harmonic_visc do i=is,ie zh(i) = 0.0 ; z_i(i,nz+1) = 0.0 - zcol1(i) = -G%bathyT(i,j) * G%Zd_to_m*GV%m_to_H - zcol2(i) = -G%bathyT(i,j+1) * G%Zd_to_m*GV%m_to_H + zcol1(i) = -G%bathyT(i,j) * GV%Z_to_H + zcol2(i) = -G%bathyT(i,j+1) * GV%Z_to_H enddo do k=nz,1,-1 ; do i=is,ie ; if (do_i(i)) then zh(i) = zh(i) + h_harm(i,k) diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index ad65384750..8ddd12bed3 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -169,10 +169,10 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par if (just_read) return ! All run-time parameters have been read, so return. ! Compute min/max density using T_SUR/S_SUR and T_BOT/S_BOT - call calculate_density(t_sur,s_sur,0.0,rho_sur,tv%eqn_of_state) + call calculate_density(t_sur, s_sur, 0.0, rho_sur, tv%eqn_of_state) ! write(mesg,*) 'Surface density is:', rho_sur ! call MOM_mesg(mesg,5) - call calculate_density(t_bot,s_bot,0.0,rho_bot,tv%eqn_of_state) + call calculate_density(t_bot, s_bot, 0.0, rho_bot, tv%eqn_of_state) ! write(mesg,*) 'Bottom density is:', rho_bot ! call MOM_mesg(mesg,5) rho_range = rho_bot - rho_sur @@ -222,7 +222,7 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie - h(i,j,:) = GV%m_to_H * G%Zd_to_m*G%bathyT(i,j) / dfloat(nz) + h(i,j,:) = GV%Z_to_H * G%bathyT(i,j) / dfloat(nz) enddo ; enddo case default diff --git a/src/user/dense_water_initialization.F90 b/src/user/dense_water_initialization.F90 index 913bb108c9..fed83a382b 100644 --- a/src/user/dense_water_initialization.F90 +++ b/src/user/dense_water_initialization.F90 @@ -219,9 +219,9 @@ subroutine dense_water_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, A if (use_ALE) then ! construct a uniform grid for the sponge do k = 1,nz - e0(k) = -GV%max_depth * (real(k - 1) / real(nz)) + e0(k) = -G%max_depth * (real(k - 1) / real(nz)) enddo - e0(nz+1) = -GV%max_depth + e0(nz+1) = -G%max_depth do j = G%jsc,G%jec do i = G%isc,G%iec @@ -253,7 +253,7 @@ subroutine dense_water_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, A x = (G%geoLonT(i,j) - G%west_lon) / G%len_lon do k = 1,nz ! nondimensional middle of layer - zmid = zi + 0.5 * h(i,j,k) / GV%max_depth + zmid = zi + 0.5 * h(i,j,k) / G%max_depth if (x > (1. - east_sponge_width)) then !if (zmid >= 0.9 * sill_height) & @@ -264,7 +264,7 @@ subroutine dense_water_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, A S(i,j,k) = S_ref + S_range * (zmid - mld) / (1.0 - mld) endif - zi = zi + h(i,j,k) / GV%max_depth + zi = zi + h(i,j,k) / G%max_depth enddo enddo enddo diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index 0e32bb1e7e..5f6e66d5be 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -87,12 +87,10 @@ subroutine seamount_initialize_thickness ( h, G, GV, param_file, just_read_param ! negative because it is positive upward. ! real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface ! ! positive upward, in m. ! - integer :: i, j, k, is, ie, js, je, nz - real :: x - real :: delta_h real :: min_thickness, S_surf, S_range, S_ref, S_light, S_dense character(len=20) :: verticalCoordinate logical :: just_read ! If true, just read parameters but set nothing. + integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -172,7 +170,7 @@ subroutine seamount_initialize_thickness ( h, G, GV, param_file, just_read_param case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie - h(i,j,:) = G%Zd_to_m * GV%m_to_H * (G%bathyT(i,j) / dfloat(nz)) + h(i,j,:) = GV%Z_to_H * G%bathyT(i,j) / dfloat(nz) enddo ; enddo end select diff --git a/src/user/sloshing_initialization.F90 b/src/user/sloshing_initialization.F90 index c204d049bc..1237ae3c14 100644 --- a/src/user/sloshing_initialization.F90 +++ b/src/user/sloshing_initialization.F90 @@ -64,18 +64,14 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. - real :: displ(SZK_(G)+1) - real :: z_unif(SZK_(G)+1) ! Fractional uniform interface heights, nondim. - real :: z_inter(SZK_(G)+1) ! Interface heights, in depth units. - real :: x - real :: a0 - real :: m_to_Z ! A conversion factor from m to depth units. - real :: total_height - real :: weight_z - real :: x1, y1, x2, y2 - real :: t - logical :: just_read ! If true, just read parameters but set nothing. - integer :: n + real :: displ(SZK_(G)+1) ! The interface displacement in depth units. + real :: z_unif(SZK_(G)+1) ! Fractional uniform interface heights, nondim. + real :: z_inter(SZK_(G)+1) ! Interface heights, in depth units. + real :: a0 ! The displacement amplitude in depth units. + real :: weight_z ! A (misused?) depth-space weighting, in inconsistent units. + real :: x1, y1, x2, y2 ! Dimensonless parameters. + real :: x, t ! Dimensionless depth coordinates? + logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, is, ie, js, je, nx, nz @@ -84,8 +80,6 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param just_read = .false. ; if (present(just_read_params)) just_read = just_read_params if (just_read) return ! This subroutine has no run-time parameters. - m_to_Z = 1.0 / G%Zd_to_m - ! Define thicknesses do j=G%jsc,G%jec ; do i=G%isc,G%iec @@ -95,7 +89,6 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param enddo ! 1. Define stratification - n = 3 do k = 1,nz+1 ! Thin pycnocline in the middle @@ -121,14 +114,14 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param enddo ! 2. Define displacement - a0 = 75.0 * m_to_Z ! 75m Displacement amplitude in depth units. + a0 = 75.0 * GV%m_to_Z ! 75m Displacement amplitude in depth units. do k = 1,nz+1 weight_z = - 4.0 * ( z_unif(k) + 0.5 )**2 + 1.0 x = G%geoLonT(i,j) / G%len_lon !### Perhaps the '+ weight_z' here should be '* weight_z' - RWH - displ(k) = a0 * cos(acos(-1.0)*x) + weight_z * m_to_Z + displ(k) = a0 * cos(acos(-1.0)*x) + weight_z * GV%m_to_Z if ( k == 1 ) then displ(k) = 0.0 @@ -144,22 +137,16 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param ! 3. The last interface must coincide with the seabed z_inter(nz+1) = -G%bathyT(i,j) - ! Modify interface heights to make sure all thicknesses are strictly positive do k = nz,1,-1 - if ( z_inter(k) < (z_inter(k+1) + GV%Angstrom_Z) ) then z_inter(k) = z_inter(k+1) + GV%Angstrom_Z endif - enddo ! 4. Define layers - total_height = 0.0 do k = 1,nz - h(i,j,k) = G%Zd_to_m*GV%m_to_H * (z_inter(k) - z_inter(k+1)) - - total_height = total_height + h(i,j,k) + h(i,j,k) = GV%Z_to_H * (z_inter(k) - z_inter(k+1)) enddo enddo ; enddo From 59c7e221c11db7681a613c0ca5bb2a4a66bb929c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 29 Aug 2018 10:50:16 -0400 Subject: [PATCH 054/174] +Rescaled G%max_depth into depth units Changed the internal units of G%max_depth from m to depth units, which can be rescaled back to m by multiplication by G%Zd_to_m or GV%Z_to_m. In many initialization routines, this also involved recasting internal calculations from units of m to depth units. All answers are bitwise identical for no Z-rescaling or for rescaling by 2^93 or 2^-93. --- src/ALE/MOM_regridding.F90 | 8 +- src/core/MOM.F90 | 4 +- src/core/MOM_barotropic.F90 | 2 +- src/core/MOM_grid.F90 | 3 +- src/framework/MOM_dyn_horgrid.F90 | 3 +- .../MOM_state_initialization.F90 | 14 +- .../vertical/MOM_full_convection.F90 | 2 +- src/user/BFB_initialization.F90 | 9 +- src/user/DOME2d_initialization.F90 | 65 ++-- src/user/DOME_initialization.F90 | 18 +- src/user/ISOMIP_initialization.F90 | 335 +++++++++--------- src/user/Phillips_initialization.F90 | 47 +-- src/user/Rossby_front_2d_initialization.F90 | 8 +- src/user/adjustment_initialization.F90 | 60 ++-- src/user/benchmark_initialization.F90 | 2 +- src/user/circle_obcs_initialization.F90 | 16 +- src/user/dense_water_initialization.F90 | 16 +- src/user/dumbbell_initialization.F90 | 46 +-- src/user/external_gwave_initialization.F90 | 9 +- src/user/lock_exchange_initialization.F90 | 13 +- src/user/seamount_initialization.F90 | 22 +- src/user/sloshing_initialization.F90 | 4 +- 22 files changed, 357 insertions(+), 349 deletions(-) diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index cfdbd45812..9cf69a2485 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -1677,7 +1677,7 @@ subroutine build_grid_arbitrary( G, GV, h, dzInterface, h_new, CS ) ! Arguments 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_(GV)), intent(in) :: h !< Original ayer thicknesses, in H + real, dimension(SZI_(G),SZJ_(G), SZK_(GV)), intent(in) :: h !< Original layer thicknesses, in H real, dimension(SZI_(G),SZJ_(G), SZK_(GV)+1), intent(inout) :: dzInterface !< The change in interface depth in H real, intent(inout) :: h_new !< New layer thicknesses, in H type(regridding_CS), intent(in) :: CS !< Regridding control structure @@ -1697,8 +1697,8 @@ subroutine build_grid_arbitrary( G, GV, h, dzInterface, h_new, CS ) nz = GV%ke - max_depth = G%max_depth - min_thickness = CS%min_thickness + max_depth = G%max_depth*GV%Z_to_H + min_thickness = CS%min_thickness !### May need *GV%m_to_H ? do j = G%jsc-1,G%jec+1 do i = G%isc-1,G%iec+1 @@ -1998,7 +1998,7 @@ subroutine set_regrid_max_depths( CS, max_depths, units_to_H ) if (.not.allocated(CS%max_interface_depths)) allocate(CS%max_interface_depths(1:CS%nk+1)) - val_to_H = 1.0 ; if (present( units_to_H)) val_to_H = units_to_H + val_to_H = 1.0 ; if (present(units_to_H)) val_to_H = units_to_H if (max_depths(CS%nk+1) < max_depths(1)) val_to_H = -1.0*val_to_H ! Check for sign reversals in the depths. diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 0f2334a290..f004bfcbd3 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2120,11 +2120,11 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! Initialize dynamically evolving fields, perhaps from restart files. call cpu_clock_begin(id_clock_MOM_init) call MOM_initialize_coord(GV, param_file, write_geom_files, & - dirs%output_directory, CS%tv, dG%max_depth) + dirs%output_directory, CS%tv, dG%max_depth*dG%Zd_to_m) call callTree_waypoint("returned from MOM_initialize_coord() (initialize_MOM)") if (CS%use_ALE_algorithm) then - call ALE_init(param_file, GV, dG%max_depth, CS%ALE_CSp) + call ALE_init(param_file, GV, dG%max_depth*dG%Zd_to_m, CS%ALE_CSp) call callTree_waypoint("returned from ALE_init() (initialize_MOM)") endif diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 15dee28aeb..0168af9df4 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -3958,7 +3958,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & "An estimate of how much higher SSH might get, for use \n"//& "in calculating the safe external wave speed. The \n"//& "default is the minimum of 10 m or 5% of MAXIMUM_DEPTH.", & - units="m", default=min(10.0,0.05*G%max_depth)) + units="m", default=min(10.0,0.05*G%max_depth*GV%Z_to_m)) call get_param(param_file, mdl, "DEBUG", CS%debug, & "If true, write out verbose debugging data.", & diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index c92730ec33..c0ca264d68 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -165,7 +165,7 @@ module MOM_grid real :: len_lat = 0. !< The latitudinal (or y-coord) extent of physical domain real :: len_lon = 0. !< The longitudinal (or x-coord) extent of physical domain real :: Rad_Earth = 6.378e6 !< The radius of the planet in meters. - real :: max_depth !< The maximum depth of the ocean in meters. + real :: max_depth !< The maximum depth of the ocean in depth units (scaled by Zd_to_m). end type ocean_grid_type contains @@ -375,6 +375,7 @@ subroutine rescale_grid_bathymetry(G, m_in_new_units) if (G%bathymetry_at_vel) then ; do J=JsdB,JedB ; do i=isd,ied G%Dblock_v(i,J) = rescale*G%Dblock_v(i,J) ; G%Dopen_v(i,J) = rescale*G%Dopen_v(i,J) enddo ; enddo ; endif + G%max_depth = rescale*G%max_depth G%Zd_to_m = m_in_new_units end subroutine rescale_grid_bathymetry diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 2ff129ce66..37500d31c2 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -160,7 +160,7 @@ module MOM_dyn_horgrid real :: len_lat = 0. !< The latitudinal (or y-coord) extent of physical domain real :: len_lon = 0. !< The longitudinal (or x-coord) extent of physical domain real :: Rad_Earth = 6.378e6 !< The radius of the planet in meters. - real :: max_depth !< The maximum depth of the ocean in meters. + real :: max_depth !< The maximum depth of the ocean in depth units (scaled by Zd_to_m). end type dyn_horgrid_type contains @@ -303,6 +303,7 @@ subroutine rescale_dyn_horgrid_bathymetry(G, m_in_new_units) if (G%bathymetry_at_vel) then ; do J=JsdB,JedB ; do i=isd,ied G%Dblock_v(i,J) = rescale*G%Dblock_v(i,J) ; G%Dopen_v(i,J) = rescale*G%Dopen_v(i,J) enddo ; enddo ; endif + G%max_depth = rescale*G%max_depth G%Zd_to_m = m_in_new_units end subroutine rescale_dyn_horgrid_bathymetry diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 120f990224..a9745c0064 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -776,10 +776,10 @@ subroutine initialize_thickness_uniform(h, G, GV, param_file, just_read_params) !! only read parameters without changing h. ! Local variables character(len=40) :: mdl = "initialize_thickness_uniform" ! This subroutine's name. - real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually + real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units, usually ! negative because it is positive upward. real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface - ! positive upward, in m. + ! positive upward, in depth units. logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, is, ie, js, je, nz @@ -804,14 +804,14 @@ subroutine initialize_thickness_uniform(h, G, GV, param_file, just_read_params) ! Angstrom thick, and 2. the interfaces are where they should be ! based on the resting depths and interface height perturbations, ! as long at this doesn't interfere with 1. - eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = e0(K) - if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_m)) then - eta1D(K) = eta1D(K+1) + GV%Angstrom_m + if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_Z)) then + eta1D(K) = eta1D(K+1) + GV%Angstrom_Z h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = GV%m_to_H * (eta1D(K) - eta1D(K+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(K) - eta1D(K+1)) endif enddo enddo ; enddo @@ -2177,7 +2177,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) ! Build the target grid (and set the model thickness to it) ! This call can be more general but is hard-coded for z* coordinates... ???? - call ALE_initRegridding( GV, G%max_depth, PF, mdl, regridCS ) ! sets regridCS + call ALE_initRegridding( GV, GV%Z_to_m*G%max_depth, PF, mdl, regridCS ) ! sets regridCS if (.not. remap_general) then ! This is the old way of initializing to z* coordinates only diff --git a/src/parameterizations/vertical/MOM_full_convection.F90 b/src/parameterizations/vertical/MOM_full_convection.F90 index 55ea1cabe9..299c230e0b 100644 --- a/src/parameterizations/vertical/MOM_full_convection.F90 +++ b/src/parameterizations/vertical/MOM_full_convection.F90 @@ -99,7 +99,7 @@ subroutine full_convection(G, GV, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, & h_neglect = GV%H_subroundoff kap_dt_x2 = 0.0 if (present(Kddt_convect)) kap_dt_x2 = 2.0*Kddt_convect - mix_len = (1.0e20 * nz) * (G%max_depth * GV%m_to_H) + mix_len = (1.0e20 * nz) * (G%max_depth * GV%Z_to_H) h0 = 1.0e-16*sqrt(Kddt_smooth) + h_neglect do j=js,je diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index b76aeb0c5b..76d3484563 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -115,10 +115,10 @@ subroutine BFB_initialize_sponges_southonly(G, use_temperature, tv, param_file, call get_param(param_file, mdl, "LENLON", lenlon, & "The longitudinal length of the domain.", units="degrees") nlat = slat + lenlat - do k=1,nz ; H0(k) = -G%max_depth * real(k-1) / real(nz) ; enddo + do k=1,nz ; H0(k) = -G%Zd_to_m*G%max_depth * real(k-1) / real(nz) ; enddo ! Use for meridional thickness profile initialization -! do k=1,nz ; H0(k) = -G%max_depth * real(k-1) / real(nz-1) ; enddo +! do k=1,nz ; H0(k) = -G%Zd_to_m*G%max_depth * real(k-1) / real(nz-1) ; enddo do i=is,ie; do j=js,je if (G%geoLatT(i,j) < slat+2.0) then ; damp = 1.0 @@ -141,10 +141,11 @@ subroutine BFB_initialize_sponges_southonly(G, use_temperature, tv, param_file, ! enddo ! elseif (G%geoLatT(i,j) > 20.0) then ! do k = 1,nz - ! eta(i,j,k) = min(H0(k) + (G%geoLatT(i,j) - 20.0)*(G%max_depth - nz*G%Angstrom_m)/20.0, -(k-1)*G%Angstrom_m) + ! eta(i,j,k) = min(H0(k) + (G%geoLatT(i,j) - 20.0)*(GV%Z_to_m*G%max_depth - nz*G%Angstrom_m)/20.0, & + ! -(k-1)*G%Angstrom_m) ! enddo ! endif - eta(i,j,nz+1) = -G%max_depth + eta(i,j,nz+1) = -G%Zd_to_m*G%max_depth if (G%Zd_to_m*G%bathyT(i,j) > min_depth) then Idamp(i,j) = damp/86400.0 diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index cb49286887..d5b789d266 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -95,10 +95,10 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, param_file, just_read_params !! only read parameters without changing h. ! Local variables - real :: e0(SZK_(GV)) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! - real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface ! - ! positive upward, in m. ! + real :: e0(SZK_(GV)) ! The resting interface heights, in depth units (Z), usually + ! negative because it is positive upward. + real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface + ! positive upward, in depth units (Z). integer :: i, j, k, is, ie, js, je, nz real :: x real :: delta_h @@ -115,7 +115,8 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, param_file, just_read_params call MOM_mesg("MOM_initialization.F90, DOME2d_initialize_thickness: setting thickness") call get_param(param_file, mdl,"MIN_THICKNESS",min_thickness, & - default=1.e-3, do_not_log=.true.) + default=1.e-3, units="m", do_not_log=.true.) + min_thickness = GV%m_to_Z*min_thickness call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=.true.) call get_param(param_file, mdl, "DOME2D_SHELF_WIDTH", dome2d_width_bay, & @@ -143,21 +144,21 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, param_file, just_read_params case ( REGRIDDING_LAYER, REGRIDDING_RHO ) do j=js,je ; do i=is,ie - eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_m + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then + eta1D(k) = eta1D(k+1) + GV%Angstrom_Z h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = GV%m_to_H * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif enddo x = ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon if ( x <= dome2d_width_bay ) then h(i,j,1:nz-1) = GV%Angstrom_H - h(i,j,nz) = GV%m_to_H * dome2d_depth_bay * G%max_depth - (nz-1) * GV%Angstrom_H + h(i,j,nz) = GV%Z_to_H * dome2d_depth_bay * G%max_depth - (nz-1) * GV%Angstrom_H endif enddo ; enddo @@ -165,21 +166,21 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, param_file, just_read_params ! case ( IC_RHO_C ) ! ! do j=js,je ; do i=is,ie - ! eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) + ! eta1D(nz+1) = -G%bathyT(i,j) ! do k=nz,1,-1 ! eta1D(k) = e0(k) ! if (eta1D(k) < (eta1D(k+1) + min_thickness)) then ! eta1D(k) = eta1D(k+1) + min_thickness - ! h(i,j,k) = GV%m_to_H * min_thickness + ! h(i,j,k) = GV%Z_to_H * min_thickness ! else - ! h(i,j,k) = GV%m_to_H * (eta1D(k) - eta1D(k+1)) + ! h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) ! endif ! enddo ! ! x = G%geoLonT(i,j) / G%len_lon ! if ( x <= dome2d_width_bay ) then - ! h(i,j,1:nz-1) = GV%m_to_H * min_thickness - ! h(i,j,nz) = GV%m_to_H * (dome2d_depth_bay * G%max_depth - (nz-1) * min_thickness) + ! h(i,j,1:nz-1) = GV%Z_to_H * min_thickness + ! h(i,j,nz) = GV%Z_to_H * (dome2d_depth_bay * G%max_depth - (nz-1) * min_thickness) ! endif ! ! enddo ; enddo @@ -187,14 +188,14 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, param_file, just_read_params case ( REGRIDDING_ZSTAR ) do j=js,je ; do i=is,ie - eta1D(nz+1) = -GV%Z_to_H*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then eta1D(k) = eta1D(k+1) + min_thickness - h(i,j,k) = GV%m_to_H * min_thickness + h(i,j,k) = GV%Z_to_H * min_thickness else - h(i,j,k) = GV%m_to_H * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo @@ -273,7 +274,7 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, param_file, do j=js,je ; do i=is,ie xi0 = 0.0 do k = 1,nz - xi1 = xi0 + (GV%H_to_m * h(i,j,k)) / G%max_depth + xi1 = xi0 + (GV%H_to_Z * h(i,j,k)) / G%max_depth S(i,j,k) = 34.0 + 0.5 * S_range * (xi0 + xi1) xi0 = xi1 enddo @@ -284,7 +285,7 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, param_file, do j=js,je ; do i=is,ie xi0 = 0.0 do k = 1,nz - xi1 = xi0 + (GV%H_to_m * h(i,j,k)) / G%max_depth + xi1 = xi0 + (GV%H_to_Z * h(i,j,k)) / G%max_depth S(i,j,k) = 34.0 + 0.5 * S_range * (xi0 + xi1) xi0 = xi1 enddo @@ -443,14 +444,14 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) enddo e0(nz+1) = -G%max_depth do j=js,je ; do i=is,ie - eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_m + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then + eta1D(k) = eta1D(k+1) + GV%Angstrom_Z h(i,j,k) = GV%Angstrom_m else - h(i,j,k) = eta1D(k) - eta1D(k+1) + h(i,j,k) = GV%Z_to_m * (eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo @@ -460,13 +461,13 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) ! Construct temperature and salinity on the arbitrary grid T(:,:,:) = 0.0 ; S(:,:,:) = 0.0 do j=js,je ; do i=is,ie - z = -G%Zd_to_m*G%bathyT(i,j) + z = -G%bathyT(i,j) do k = nz,1,-1 - z = z + 0.5 * h(i,j,k) ! Position of the center of layer k + z = z + 0.5 * GV%m_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) 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 * h(i,j,k) ! Position of the interface k + z = z + 0.5 * GV%m_to_Z *h(i,j,k) ! Position of the interface k enddo enddo ; enddo @@ -481,21 +482,21 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) ! Construct thicknesses to restore to do j=js,je ; do i=is,ie - eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = -G%max_depth * real(k-1) / real(nz) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_m + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then + eta1D(k) = eta1D(k+1) + GV%Angstrom_Z h(i,j,k) = GV%Angstrom_m else - h(i,j,k) = eta1D(k) - eta1D(k+1) + h(i,j,k) = GV%Z_to_m * (eta1D(k) - eta1D(k+1)) endif enddo x = ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon if ( x <= dome2d_width_bay ) then h(i,j,1:nz-1) = GV%Angstrom_m - h(i,j,nz) = dome2d_depth_bay * G%max_depth - (nz-1) * GV%Angstrom_m + h(i,j,nz) = dome2d_depth_bay * GV%Z_to_m*G%max_depth - (nz-1) * GV%Angstrom_m endif eta(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 661b6a9978..20cdfc388d 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -86,10 +86,10 @@ subroutine DOME_initialize_thickness(h, G, GV, param_file, just_read_params) logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. - real :: e0(SZK_(GV)+1) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! - real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface ! - ! positive upward, in m. ! + real :: e0(SZK_(GV)+1) ! The resting interface heights, in m, usually + ! negative because it is positive upward, in depth units (Z). + real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface + ! positive upward, in depth units (Z). logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: mdl = "DOME_initialize_thickness" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, nz @@ -113,14 +113,14 @@ subroutine DOME_initialize_thickness(h, G, GV, param_file, just_read_params) ! Angstrom thick, and 2. the interfaces are where they should be ! ! based on the resting depths and interface height perturbations, ! ! as long at this doesn't interfere with 1. ! - eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = e0(K) - if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_m)) then - eta1D(K) = eta1D(K+1) + GV%Angstrom_m + if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_Z)) then + eta1D(K) = eta1D(K+1) + GV%Angstrom_Z h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = GV%m_to_H * (eta1D(K) - eta1D(K+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(K) - eta1D(K+1)) endif enddo enddo ; enddo @@ -170,7 +170,7 @@ subroutine DOME_initialize_sponges(G, GV, tv, PF, CSp) "The minimum depth of the ocean.", units="m", default=0.0) H0(1) = 0.0 - do k=2,nz ; H0(k) = -(real(k-1)-0.5)*G%max_depth/real(nz-1) ; enddo + do k=2,nz ; H0(k) = -(real(k-1)-0.5)*(GV%Z_to_m*G%max_depth) / real(nz-1) ; enddo do i=is,ie; do j=js,je if (G%geoLonT(i,j) < 100.0) then ; damp = 10.0 elseif (G%geoLonT(i,j) < 200.0) then diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index 8ddd12bed3..5376dcca21 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -130,10 +130,10 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. ! Local variables - real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! - real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface ! - ! positive upward, in m. ! + real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z), + ! usually negative because it is positive upward. + real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface + ! positive upward, in depth units (Z). integer :: i, j, k, is, ie, js, je, nz, tmp1 real :: x real :: rho_range @@ -153,6 +153,7 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par 'Minimum layer thickness', units='m', default=1.e-3, do_not_log=just_read) call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) + min_thickness = GV%m_to_Z*min_thickness select case ( coordinateMode(verticalCoordinate) ) @@ -192,14 +193,14 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par ! Calculate thicknesses do j=js,je ; do i=is,ie - eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_m + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then + eta1D(k) = eta1D(k+1) + GV%Angstrom_Z h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = GV%m_to_H * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo @@ -207,14 +208,14 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR ) ! Initial thicknesses for z coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie - eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then eta1D(k) = eta1D(k+1) + min_thickness - h(i,j,k) = GV%m_to_H * min_thickness + h(i,j,k) = GV%Z_to_H * min_thickness else - h(i,j,k) = GV%m_to_H * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo @@ -248,8 +249,9 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, ! Local variables integer :: i, j, k, is, ie, js, je, nz, itt real :: x, ds, dt, rho_sur, rho_bot - real :: xi0, xi1, dxi ! Heights in m., r - real :: S_sur, T_sur, S_bot, T_bot, S_range, T_range + real :: xi0, xi1 ! Heights in depth units (Z). + real :: S_sur, T_sur, S_bot, T_bot + real :: dT_dz, dS_dz ! Gradients of T and S in degC/Z and PPT/Z. real :: z ! vertical position in z space character(len=256) :: mesg ! The text of an error message character(len=40) :: verticalCoordinate, density_profile @@ -290,105 +292,96 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, case ( REGRIDDING_RHO, REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR, REGRIDDING_SIGMA ) if (just_read) return ! All run-time parameters have been read, so return. - S_range = s_sur - s_bot - T_range = t_sur - t_bot - ! write(mesg,*) 'S_range,T_range',S_range,T_range - ! call MOM_mesg(mesg,5) - - S_range = S_range / G%max_depth ! Convert S_range into dS/dz - T_range = T_range / G%max_depth ! Convert T_range into dT/dz + dS_dz = (s_sur - s_bot) / G%max_depth + dT_dz = (t_sur - t_bot) / G%max_depth do j=js,je ; do i=is,ie xi0 = -G%Zd_to_m * G%bathyT(i,j) do k = nz,1,-1 - xi0 = xi0 + 0.5 * h(i,j,k) * GV%H_to_m ! Depth in middle of layer - S(i,j,k) = S_sur + S_range * xi0 - T(i,j,k) = T_sur + T_range * xi0 - xi0 = xi0 + 0.5 * h(i,j,k) * GV%H_to_m ! Depth at top of layer + xi0 = xi0 + 0.5 * h(i,j,k) * GV%H_to_Z ! Depth in middle of layer + S(i,j,k) = S_sur + dS_dz * xi0 + T(i,j,k) = T_sur + dT_dz * xi0 + xi0 = xi0 + 0.5 * h(i,j,k) * GV%H_to_Z ! Depth at top of layer enddo enddo ; enddo case ( REGRIDDING_LAYER ) - call get_param(param_file, mdl, "FIT_SALINITY", fit_salin, & - "If true, accept the prescribed temperature and fit the \n"//& - "salinity; otherwise take salinity and fit temperature.", & - default=.false., do_not_log=just_read) - call get_param(param_file, mdl, "DRHO_DS", drho_dS1, & - "Partial derivative of density with salinity.", & - units="kg m-3 PSU-1", fail_if_missing=.not.just_read, do_not_log=just_read) - call get_param(param_file, mdl, "DRHO_DT", drho_dT1, & - "Partial derivative of density with temperature.", & - units="kg m-3 K-1", fail_if_missing=.not.just_read, do_not_log=just_read) - call get_param(param_file, mdl, "T_REF", T_Ref, & - "A reference temperature used in initialization.", & - units="degC", fail_if_missing=.not.just_read, do_not_log=just_read) - call get_param(param_file, mdl, "S_REF", S_Ref, & - "A reference salinity used in initialization.", units="PSU", & - default=35.0, do_not_log=just_read) - if (just_read) return ! All run-time parameters have been read, so return. - - ! write(mesg,*) 'read drho_dS, drho_dT', drho_dS1, drho_dT1 - ! call MOM_mesg(mesg,5) - - S_range = s_bot - s_sur - T_range = t_bot - t_sur - ! write(mesg,*) 'S_range,T_range',S_range,T_range - ! call MOM_mesg(mesg,5) - S_range = S_range / G%max_depth ! Convert S_range into dS/dz - T_range = T_range / G%max_depth ! Convert T_range into dT/dz - - do j=js,je ; do i=is,ie - xi0 = 0.0 - do k = 1,nz - !T0(k) = T_Ref; S0(k) = S_Ref - xi1 = xi0 + 0.5 * h(i,j,k) * GV%H_to_m - S0(k) = S_sur + S_range * xi1 - T0(k) = T_sur + T_range * xi1 - xi0 = xi0 + h(i,j,k) * GV%H_to_m - ! write(mesg,*) 'S,T,xi0,xi1,k',S0(k),T0(k),xi0,xi1,k - ! call MOM_mesg(mesg,5) - enddo + call get_param(param_file, mdl, "FIT_SALINITY", fit_salin, & + "If true, accept the prescribed temperature and fit the \n"//& + "salinity; otherwise take salinity and fit temperature.", & + default=.false., do_not_log=just_read) + call get_param(param_file, mdl, "DRHO_DS", drho_dS1, & + "Partial derivative of density with salinity.", & + units="kg m-3 PSU-1", fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl, "DRHO_DT", drho_dT1, & + "Partial derivative of density with temperature.", & + units="kg m-3 K-1", fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl, "T_REF", T_Ref, & + "A reference temperature used in initialization.", & + units="degC", fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl, "S_REF", S_Ref, & + "A reference salinity used in initialization.", units="PSU", & + default=35.0, do_not_log=just_read) + if (just_read) return ! All run-time parameters have been read, so return. - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,1,eqn_of_state) - ! write(mesg,*) 'computed drho_dS, drho_dT', drho_dS(1), drho_dT(1) - ! call MOM_mesg(mesg,5) - call calculate_density(T0(1),S0(1),0.,rho_guess(1),eqn_of_state) + ! write(mesg,*) 'read drho_dS, drho_dT', drho_dS1, drho_dT1 + ! call MOM_mesg(mesg,5) - if (fit_salin) then - ! A first guess of the layers' salinity. - do k=nz,1,-1 - S0(k) = max(0.0, S0(1) + (GV%Rlay(k) - rho_guess(1)) / drho_dS1) - enddo - ! Refine the guesses for each layer. - do itt=1,6 - call calculate_density(T0,S0,pres,rho_guess,1,nz,eqn_of_state) - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,eqn_of_state) - do k=1,nz - S0(k) = max(0.0, S0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dS1) - enddo - enddo + dS_dz = (s_sur - s_bot) / G%max_depth + dT_dz = (t_sur - t_bot) / G%max_depth - else - ! A first guess of the layers' temperatures. - do k=nz,1,-1 - T0(k) = T0(1) + (GV%Rlay(k) - rho_guess(1)) / drho_dT1 - enddo + do j=js,je ; do i=is,ie + xi0 = 0.0 + do k = 1,nz + !T0(k) = T_Ref; S0(k) = S_Ref + xi1 = xi0 + 0.5 * h(i,j,k) * GV%H_to_Z + S0(k) = S_sur + dS_dz * xi1 + T0(k) = T_sur + dT_dz * xi1 + xi0 = xi0 + h(i,j,k) * GV%H_to_Z + ! write(mesg,*) 'S,T,xi0,xi1,k',S0(k),T0(k),xi0,xi1,k + ! call MOM_mesg(mesg,5) + enddo - do itt=1,6 - call calculate_density(T0,S0,pres,rho_guess,1,nz,eqn_of_state) - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,eqn_of_state) - do k=1,nz - T0(k) = T0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dT(k) - enddo - enddo - endif + call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,1,eqn_of_state) + ! write(mesg,*) 'computed drho_dS, drho_dT', drho_dS(1), drho_dT(1) + ! call MOM_mesg(mesg,5) + call calculate_density(T0(1),S0(1),0.,rho_guess(1),eqn_of_state) + + if (fit_salin) then + ! A first guess of the layers' salinity. + do k=nz,1,-1 + S0(k) = max(0.0, S0(1) + (GV%Rlay(k) - rho_guess(1)) / drho_dS1) + enddo + ! Refine the guesses for each layer. + do itt=1,6 + call calculate_density(T0,S0,pres,rho_guess,1,nz,eqn_of_state) + call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,eqn_of_state) + do k=1,nz + S0(k) = max(0.0, S0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dS1) + enddo + enddo - do k=1,nz - T(i,j,k) = T0(k) ; S(i,j,k) = S0(k) - enddo + else + ! A first guess of the layers' temperatures. + do k=nz,1,-1 + T0(k) = T0(1) + (GV%Rlay(k) - rho_guess(1)) / drho_dT1 + enddo + + do itt=1,6 + call calculate_density(T0,S0,pres,rho_guess,1,nz,eqn_of_state) + call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,eqn_of_state) + do k=1,nz + T0(k) = T0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dT(k) + enddo + enddo + endif + + do k=1,nz + T(i,j,k) = T0(k) ; S(i,j,k) = S0(k) + enddo - enddo ; enddo + enddo ; enddo - case default + case default call MOM_error(FATAL,"isomip_initialize: "// & "Unrecognized i.c. setup - set REGRIDDING_COORDINATE_MODE") @@ -428,10 +421,11 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) real :: h(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for thickness real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. real :: TNUDG ! Nudging time scale, days - real :: S_sur, T_sur; ! Surface salinity and temerature in sponge - real :: S_bot, T_bot; ! Bottom salinity and temerature in sponge - real :: t_ref, s_ref ! reference T and S - real :: rho_sur, rho_bot, rho_range, t_range, s_range + real :: S_sur, T_sur ! Surface salinity and temerature in sponge + real :: S_bot, T_bot ! Bottom salinity and temerature in sponge + real :: t_ref, s_ref ! reference T and S + real :: rho_sur, rho_bot, rho_range + real :: dT_dz, dS_dz ! Gradients of T and S in degC/Z and PPT/Z. real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! ! negative because it is positive upward. ! @@ -451,6 +445,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed call get_param(PF, mdl,"MIN_THICKNESS",min_thickness,'Minimum layer thickness',units='m',default=1.e-3) + min_thickness = GV%m_to_Z * min_thickness call get_param(PF, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE) @@ -463,17 +458,15 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) call get_param(PF, mdl, "S_REF", s_ref, 'Reference salinity', default=35.0,& do_not_log=.true.) - call get_param(PF, mdl, "ISOMIP_S_SUR_SPONGE", s_sur, 'Surface salinity in sponge layer.', default=s_ref) + call get_param(PF, mdl, "ISOMIP_S_SUR_SPONGE", s_sur, 'Surface salinity in sponge layer.', default=s_ref) - call get_param(PF, mdl, "ISOMIP_S_BOT_SPONGE", s_bot, 'Bottom salinity in sponge layer.', default=s_ref) + call get_param(PF, mdl, "ISOMIP_S_BOT_SPONGE", s_bot, 'Bottom salinity in sponge layer.', default=s_ref) - call get_param(PF, mdl, "ISOMIP_T_SUR_SPONGE", t_sur, 'Surface temperature in sponge layer.', default=t_ref) + call get_param(PF, mdl, "ISOMIP_T_SUR_SPONGE", t_sur, 'Surface temperature in sponge layer.', default=t_ref) - call get_param(PF, mdl, "ISOMIP_T_BOT_SPONGE", t_bot, 'Bottom temperature in sponge layer.', default=t_ref) + call get_param(PF, mdl, "ISOMIP_T_BOT_SPONGE", t_bot, 'Bottom temperature in sponge layer.', default=t_ref) T(:,:,:) = 0.0 ; S(:,:,:) = 0.0 ; Idamp(:,:) = 0.0; RHO(:,:,:) = 0.0 - S_range = s_sur - s_bot - T_range = t_sur - t_bot ! Set up sponges for ISOMIP configuration call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, & @@ -504,7 +497,6 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) Idamp(i,j) = damp/86400.0 else ; Idamp(i,j) = 0.0 ; endif - enddo ; enddo ! Compute min/max density using T_SUR/S_SUR and T_BOT/S_BOT @@ -536,55 +528,56 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) ! Calculate thicknesses do j=js,je ; do i=is,ie - eta1D(nz+1) = -G%Zd_to_m * G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_m + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then + eta1D(k) = eta1D(k+1) + GV%Angstrom_Z h(i,j,k) = GV%Angstrom_m else - h(i,j,k) = eta1D(k) - eta1D(k+1) + h(i,j,k) = GV%Z_to_m*(eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR ) ! Initial thicknesses for z coordinates do j=js,je ; do i=is,ie - eta1D(nz+1) = -G%Zd_to_m * G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then eta1D(k) = eta1D(k+1) + min_thickness - h(i,j,k) = min_thickness + h(i,j,k) = min_thickness * GV%Z_to_m else - h(i,j,k) = eta1D(k) - eta1D(k+1) + h(i,j,k) = GV%Z_to_m*(eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates - do j=js,je ; do i=is,ie - h(i,j,:) = G%Zd_to_m * (G%bathyT(i,j) / dfloat(nz)) - enddo ; enddo + do j=js,je ; do i=is,ie + h(i,j,:) = G%Zd_to_m * (G%bathyT(i,j) / dfloat(nz)) + enddo ; enddo case default call MOM_error(FATAL,"ISOMIP_initialize_sponges: "// & "Unrecognized i.c. setup - set REGRIDDING_COORDINATE_MODE") end select + ! This call sets up the damping rates and interface heights. ! This sets the inverse damping timescale fields in the sponges. call initialize_ALE_sponge(Idamp, G, PF, ACSp, h, nz) - S_range = S_range / G%max_depth ! Convert S_range into dS/dz - T_range = T_range / G%max_depth ! Convert T_range into dT/dz + dS_dz = (s_sur - s_bot) / G%max_depth + dT_dz = (t_sur - t_bot) / G%max_depth do j=js,je ; do i=is,ie xi0 = -G%Zd_to_m * G%bathyT(i,j) do k = nz,1,-1 - xi0 = xi0 + 0.5 * h(i,j,k) ! Depth in middle of layer - S(i,j,k) = S_sur + S_range * xi0 - T(i,j,k) = T_sur + T_range * xi0 - xi0 = xi0 + 0.5 * h(i,j,k) ! Depth at top of layer + xi0 = xi0 + 0.5 * h(i,j,k) * GV%m_to_Z ! Depth in middle of layer + S(i,j,k) = S_sur + dS_dz * xi0 + T(i,j,k) = T_sur + dT_dz * xi0 + xi0 = xi0 + 0.5 * h(i,j,k) * GV%m_to_Z ! Depth at top of layer enddo enddo ; enddo ! for debugging @@ -601,57 +594,57 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) ! The remaining calls to set_up_sponge_field can be in any order. ! if ( associated(tv%T) ) then - call set_up_ALE_sponge_field(T,G,tv%T,ACSp) + call set_up_ALE_sponge_field(T, G, tv%T, ACSp) endif if ( associated(tv%S) ) then - call set_up_ALE_sponge_field(S,G,tv%S,ACSp) + call set_up_ALE_sponge_field(S, G, tv%S, ACSp) endif else ! layer mode - ! 1) Read eta, salt and temp from IC file - call get_param(PF, mdl, "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, mdl, "ISOMIP_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, mdl, "SPONGE_PTEMP_VAR", temp_var, & - "The name of the potential temperature variable in \n"//& - "SPONGE_STATE_FILE.", default="Temp") - call get_param(PF, mdl, "SPONGE_SALT_VAR", salt_var, & - "The name of the salinity variable in \n"//& - "SPONGE_STATE_FILE.", default="Salt") - call get_param(PF, mdl, "SPONGE_ETA_VAR", eta_var, & - "The name of the interface height variable in \n"//& - "SPONGE_STATE_FILE.", default="eta") - - !read temp and eta - filename = trim(inputdir)//trim(state_file) - if (.not.file_exists(filename, G%Domain)) & - call MOM_error(FATAL, " ISOMIP_initialize_sponges: Unable to open "//trim(filename)) - call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain) - call MOM_read_data(filename, temp_var, T(:,:,:), G%Domain) - call MOM_read_data(filename, salt_var, S(:,:,:), G%Domain) - - ! for debugging - !i=G%iec; j=G%jec - !do k = 1,nz - ! call calculate_density(T(i,j,k),S(i,j,k),0.0,rho_tmp,tv%eqn_of_state) - ! write(mesg,*) 'Sponge - k,eta,T,S,rho,Rlay',k,eta(i,j,k),T(i,j,k),& - ! S(i,j,k),rho_tmp,GV%Rlay(k) - ! call MOM_mesg(mesg,5) - !enddo - - ! 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) - ! 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) + ! 1) Read eta, salt and temp from IC file + call get_param(PF, mdl, "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, mdl, "ISOMIP_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, mdl, "SPONGE_PTEMP_VAR", temp_var, & + "The name of the potential temperature variable in \n"//& + "SPONGE_STATE_FILE.", default="Temp") + call get_param(PF, mdl, "SPONGE_SALT_VAR", salt_var, & + "The name of the salinity variable in \n"//& + "SPONGE_STATE_FILE.", default="Salt") + call get_param(PF, mdl, "SPONGE_ETA_VAR", eta_var, & + "The name of the interface height variable in \n"//& + "SPONGE_STATE_FILE.", default="eta") + + !read temp and eta + filename = trim(inputdir)//trim(state_file) + if (.not.file_exists(filename, G%Domain)) & + call MOM_error(FATAL, " ISOMIP_initialize_sponges: Unable to open "//trim(filename)) + call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain) + call MOM_read_data(filename, temp_var, T(:,:,:), G%Domain) + call MOM_read_data(filename, salt_var, S(:,:,:), G%Domain) + + ! for debugging + !i=G%iec; j=G%jec + !do k = 1,nz + ! call calculate_density(T(i,j,k),S(i,j,k),0.0,rho_tmp,tv%eqn_of_state) + ! write(mesg,*) 'Sponge - k,eta,T,S,rho,Rlay',k,eta(i,j,k),T(i,j,k),& + ! S(i,j,k),rho_tmp,GV%Rlay(k) + ! call MOM_mesg(mesg,5) + !enddo + + ! 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) + ! 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/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index ebd20c7f7d..5832df78fc 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -39,10 +39,10 @@ subroutine Phillips_initialize_thickness(h, G, GV, param_file, just_read_params) logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. - real :: eta0(SZK_(G)+1) ! The 1-d nominal positions of the interfaces. - real :: eta_im(SZJ_(G),SZK_(G)+1) ! A temporary array for zonal-mean eta, m. + real :: eta0(SZK_(G)+1) ! The 1-d nominal positions of the interfaces, in depth units (Z). + real :: eta_im(SZJ_(G),SZK_(G)+1) ! A temporary array for zonal-mean eta, in depth units (Z). real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface - ! positive upward, in m. + ! positive upward, in in depth units (Z). real :: damp_rate, jet_width, jet_height, y_2 real :: half_strat, half_depth logical :: just_read ! If true, just read parameters but set nothing. @@ -70,6 +70,7 @@ subroutine Phillips_initialize_thickness(h, G, GV, param_file, just_read_params) if (just_read) return ! All run-time parameters have been read, so return. + jet_height = jet_height*GV%m_to_Z half_depth = G%max_depth*half_strat eta0(1) = 0.0 ; eta0(nz+1) = -G%max_depth do k=2,1+nz/2 ; eta0(k) = -half_depth*(2.0*(k-1)/real(nz)) ; enddo @@ -82,27 +83,26 @@ subroutine Phillips_initialize_thickness(h, G, GV, param_file, just_read_params) enddo do K=2,nz ; do j=js,je y_2 = G%geoLatT(is,j) - G%south_lat - 0.5*G%len_lat - eta_im(j,K) = eta0(k) + & - jet_height * tanh(y_2 / jet_width) -! jet_height * atan(y_2 / jet_width) + eta_im(j,K) = eta0(k) + jet_height * tanh(y_2 / jet_width) + ! or ... + jet_height * atan(y_2 / jet_width) if (eta_im(j,K) > 0.0) eta_im(j,K) = 0.0 if (eta_im(j,K) < -G%max_depth) eta_im(j,K) = -G%max_depth enddo ; enddo do j=js,je ; do i=is,ie -! This sets the initial thickness (in m) of the layers. The ! +! This sets the initial thickness (in H) of the layers. The ! ! thicknesses are set to insure that: 1. each layer is at least an ! ! Angstrom thick, and 2. the interfaces are where they should be ! ! based on the resting depths and interface height perturbations, ! ! as long at this doesn't interfere with 1. ! - eta1D(nz+1) = -G%Zd_to_m * G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = eta_im(j,K) - if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_m)) then - eta1D(K) = eta1D(K+1) + GV%Angstrom_m + if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_Z)) then + eta1D(K) = eta1D(K+1) + GV%Angstrom_Z h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = GV%m_to_H * (eta1D(K) - eta1D(K+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(K) - eta1D(K+1)) endif enddo enddo ; enddo @@ -200,16 +200,20 @@ subroutine Phillips_initialize_sponges(G, use_temperature, tv, param_file, CSp, type(sponge_CS), pointer :: CSp !< A pointer that is set to point to !! the control structure for the !! sponge module. - real, intent(in), dimension(SZI_(G),SZJ_(G), SZK_(G)) :: h !< Thickness field. + real, intent(in), dimension(SZI_(G),SZJ_(G), SZK_(G)) :: h !< Thickness field, in units of H. real :: eta0(SZK_(G)+1) ! The 1-d nominal positions of the interfaces. real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, m. - real :: temp(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for other variables. ! + real :: temp(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for other variables. real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. real :: eta_im(SZJ_(G),SZK_(G)+1) ! A temporary array for zonal-mean eta, m. real :: Idamp_im(SZJ_(G)) ! The inverse zonal-mean damping rate, in s-1. - real :: damp_rate, jet_width, jet_height, y_2 - real :: half_strat, half_depth + real :: damp_rate ! The inverse zonal-mean damping rate, in s-1. + real :: jet_width ! The width of the zonal mean jet, in km. + real :: jet_height ! The interface height scale associated with the zonal-mean jet, in depth units. + real :: y_2 ! The y-position relative to the channel center, in km. + real :: half_strat ! The fractional depth where the straficiation is centered, ND. + real :: half_depth ! The depth where the stratification is centered, in depth units. character(len=40) :: mdl = "Phillips_initialize_sponges" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz @@ -224,8 +228,8 @@ subroutine Phillips_initialize_sponges(G, use_temperature, tv, param_file, CSp, if (first_call) call log_version(param_file, mdl, version) first_call = .false. call get_param(param_file, mdl, "HALF_STRAT_DEPTH", half_strat, & - "The maximum depth of the ocean.", units="nondim", & - default = 0.5) + "The fractional depth where the stratificaiton is centered.", & + units="nondim", default = 0.5) call get_param(param_file, mdl, "SPONGE_RATE", damp_rate, & "The rate at which the zonal-mean sponges damp.", units="s-1", & default = 1.0/(10.0*86400.0)) @@ -238,6 +242,7 @@ subroutine Phillips_initialize_sponges(G, use_temperature, tv, param_file, CSp, "zonal-mean jet.", units="m", & fail_if_missing=.true.) + jet_height = jet_height / G%Zd_to_m half_depth = G%max_depth*half_strat eta0(1) = 0.0 ; eta0(nz+1) = -G%max_depth do k=2,1+nz/2 ; eta0(k) = -half_depth*(2.0*(k-1)/real(nz)) ; enddo @@ -247,15 +252,15 @@ subroutine Phillips_initialize_sponges(G, use_temperature, tv, param_file, CSp, do j=js,je Idamp_im(j) = damp_rate - eta_im(j,1) = 0.0 ; eta_im(j,nz+1) = -G%max_depth + eta_im(j,1) = 0.0 ; eta_im(j,nz+1) = -G%Zd_to_m*G%max_depth enddo do K=2,nz ; do j=js,je y_2 = G%geoLatT(is,j) - G%south_lat - 0.5*G%len_lat - eta_im(j,K) = eta0(k) + & - jet_height * tanh(y_2 / jet_width) + eta_im(j,K) = eta0(k) + jet_height * tanh(y_2 / jet_width) ! jet_height * atan(y_2 / jet_width) if (eta_im(j,K) > 0.0) eta_im(j,K) = 0.0 if (eta_im(j,K) < -G%max_depth) eta_im(j,K) = -G%max_depth + eta_im(j,K) = eta_im(j,K) * G%Zd_to_m enddo ; enddo call initialize_sponge(Idamp, eta, G, param_file, CSp, Idamp_im, eta_im) @@ -295,7 +300,7 @@ subroutine Phillips_initialize_topography(D, G, param_file, max_depth) call get_param(param_file, mdl, "PHILLIPS_HTOP", Htop, & "The maximum height of the topography.", units="m", & fail_if_missing=.true.) -! Htop=0.375*G%max_depth ! max height of topog. above max_depth +! Htop=0.375*max_depth ! max height of topog. above max_depth Wtop=0.5*G%len_lat ! meridional width of drake and mount Ltop=0.25*G%len_lon ! zonal width of topographic features offset=0.1*G%len_lat ! meridional offset from center diff --git a/src/user/Rossby_front_2d_initialization.F90 b/src/user/Rossby_front_2d_initialization.F90 index b2e4f35881..6c1410da3f 100644 --- a/src/user/Rossby_front_2d_initialization.F90 +++ b/src/user/Rossby_front_2d_initialization.F90 @@ -81,7 +81,7 @@ subroutine Rossby_front_initialize_thickness(h, G, GV, param_file, just_read_par stretch = ( ( G%max_depth + eta ) / G%max_depth ) h0 = ( G%max_depth / real(nz) ) * stretch do k = 1, nz - h(i,j,k) = h0 * GV%m_to_H + h(i,j,k) = h0 * GV%Z_to_H enddo enddo ; enddo @@ -92,7 +92,7 @@ subroutine Rossby_front_initialize_thickness(h, G, GV, param_file, just_read_par stretch = ( ( G%max_depth + eta ) / G%max_depth ) h0 = ( G%max_depth / real(nz) ) * stretch do k = 1, nz - h(i,j,k) = h0 * GV%m_to_H + h(i,j,k) = h0 * GV%Z_to_H enddo enddo ; enddo @@ -149,7 +149,7 @@ subroutine Rossby_front_initialize_temperature_salinity(T, S, h, G, GV, & zi = 0. do k = 1, nz zi = zi - h(i,j,k) ! Bottom interface position - zc = GV%H_to_m * (zi - 0.5*h(i,j,k)) ! Position of middle of cell + zc = GV%H_to_Z * (zi - 0.5*h(i,j,k)) ! Position of middle of cell zc = min( zc, -Hml(G, G%geoLatT(i,j)) ) ! Bound by depth of mixed layer T(i,j,k) = T_ref + dTdz * zc ! Linear temperature profile enddo @@ -203,7 +203,7 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, param_file, just_rea f = 0.5*( G%CoriolisBu(I,j) + G%CoriolisBu(I,j-1) ) dUdT = 0.0 ; if (abs(f) > 0.0) & dUdT = ( GV%g_Earth * dRho_dT ) / ( f * GV%Rho0 ) - Dml = Hml( G, G%geoLatT(i,j) ) + Dml = GV%Z_to_m*Hml( G, G%geoLatT(i,j) ) Ty = dTdy( G, T_range, G%geoLatT(i,j) ) zi = 0. do k = 1, nz diff --git a/src/user/adjustment_initialization.F90 b/src/user/adjustment_initialization.F90 index 6049aa971a..e33b1d17ed 100644 --- a/src/user/adjustment_initialization.F90 +++ b/src/user/adjustment_initialization.F90 @@ -36,10 +36,10 @@ subroutine adjustment_initialize_thickness ( h, G, GV, param_file, just_read_par logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. ! Local variables - real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! - real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface ! - ! positive upward, in m. ! + real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z), usually + ! negative because it is positive upward. + real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface + ! positive upward, in depth units (Z). real :: x, y, yy, delta_S_strat, dSdz, delta_S, S_ref real :: min_thickness, adjustment_width, adjustment_delta, adjustment_deltaS real :: front_wave_amp, front_wave_length, front_wave_asym @@ -61,7 +61,8 @@ subroutine adjustment_initialize_thickness ( h, G, GV, param_file, just_read_par if (.not.just_read) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl,"S_REF",S_ref,fail_if_missing=.true.,do_not_log=.true.) call get_param(param_file, mdl,"MIN_THICKNESS",min_thickness,'Minimum layer thickness', & - units='m',default=1.0e-3, do_not_log=just_read) + units='m', default=1.0e-3, do_not_log=just_read) + min_thickness = min_thickness*GV%m_to_Z ! Parameters specific to this experiment configuration call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE",verticalCoordinate, & @@ -95,28 +96,29 @@ subroutine adjustment_initialize_thickness ( h, G, GV, param_file, just_read_par ! vanished and the other thicknesses uniformly distributed, use: ! e0(k) = -G%max_depth * real(k-1) / real(nz-1) - dSdz = -delta_S_strat/G%max_depth + dSdz = -delta_S_strat / G%max_depth select case ( coordinateMode(verticalCoordinate) ) case ( REGRIDDING_LAYER, REGRIDDING_RHO ) if (delta_S_strat /= 0.) then - adjustment_delta = adjustment_deltaS / delta_S_strat * G%max_depth + ! This was previously coded ambiguously. + adjustment_delta = (adjustment_deltaS / delta_S_strat) * G%max_depth do k=1,nz+1 - e0(k) = adjustment_delta-(G%max_depth+2*adjustment_delta) * (real(k-1) / real(nz)) + e0(k) = adjustment_delta - (G%max_depth + 2*adjustment_delta) * (real(k-1) / real(nz)) enddo else adjustment_delta = 2.*G%max_depth do k=1,nz+1 - e0(k) = -(G%max_depth) * (real(k-1) / real(nz)) + e0(k) = -G%max_depth * (real(k-1) / real(nz)) enddo endif - target_values(1) = GV%Rlay(1)+0.5*(GV%Rlay(1)-GV%Rlay(2)) - target_values(nz+1) = GV%Rlay(nz)+0.5*(GV%Rlay(nz)-GV%Rlay(nz-1)) + target_values(1) = GV%Rlay(1) + 0.5*(GV%Rlay(1)-GV%Rlay(2)) + target_values(nz+1) = GV%Rlay(nz) + 0.5*(GV%Rlay(nz)-GV%Rlay(nz-1)) do k = 2,nz target_values(k) = target_values(k-1) + ( GV%Rlay(nz) - GV%Rlay(1) ) / (nz-1) enddo - target_values = target_values - 1000. + target_values(:) = target_values(:) - 1000. do j=js,je ; do i=is,ie if (front_wave_length /= 0.) then y = ( 0.125 + G%geoLatT(i,j) / front_wave_length ) * ( 4. * acos(0.) ) @@ -140,28 +142,28 @@ subroutine adjustment_initialize_thickness ( h, G, GV, param_file, just_read_par eta1D(k) = max( eta1D(k), -G%max_depth ) eta1D(k) = min( eta1D(k), 0. ) enddo - eta1D(1)=0.; eta1D(nz+1)=-G%max_depth + eta1D(1) = 0.; eta1D(nz+1) = -G%max_depth do k=nz,1,-1 if (eta1D(k) > 0.) then eta1D(k) = max( eta1D(k+1) + min_thickness, 0. ) - h(i,j,k) = GV%m_to_H * max( eta1D(k) - eta1D(k+1), min_thickness ) + h(i,j,k) = GV%Z_to_H * max( eta1D(k) - eta1D(k+1), min_thickness ) elseif (eta1D(k) <= (eta1D(k+1) + min_thickness)) then eta1D(k) = eta1D(k+1) + min_thickness - h(i,j,k) = GV%m_to_H * min_thickness + h(i,j,k) = GV%Z_to_H * min_thickness else - h(i,j,k) = GV%m_to_H * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA ) do k=1,nz+1 - eta1D(k) = -(G%max_depth) * (real(k-1) / real(nz)) - eta1D(k) = max(min(eta1D(k),0.),-G%max_depth) + eta1D(k) = -G%max_depth * (real(k-1) / real(nz)) + eta1D(k) = max(min(eta1D(k), 0.), -G%max_depth) enddo do j=js,je ; do i=is,ie do k=nz,1,-1 - h(i,j,k) = GV%m_to_H * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) enddo enddo ; enddo @@ -174,15 +176,15 @@ subroutine adjustment_initialize_thickness ( h, G, GV, param_file, just_read_par end subroutine adjustment_initialize_thickness !> Initialization of temperature and salinity in the adjustment test case -subroutine adjustment_initialize_temperature_salinity ( T, S, h, G, GV, param_file, & - eqn_of_state, just_read_params) +subroutine adjustment_initialize_temperature_salinity(T, S, h, G, GV, param_file, & + eqn_of_state, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< The temperature that is being initialized. real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< The salinity that is being initialized. real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< The model thicknesses in H (m or kg m-2). - type(param_file_type), intent(in) :: param_file !< A structure indicating the - !! open file to parse for model parameter values. + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to + !! parse for model parameter values. type(EOS_type), pointer :: eqn_of_state !< Equation of state. logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing T & S. @@ -226,7 +228,7 @@ subroutine adjustment_initialize_temperature_salinity ( T, S, h, G, GV, param_fi call get_param(param_file, mdl,"FRONT_WAVE_AMP", front_wave_amp, default=0., & do_not_log=.true.) call get_param(param_file, mdl,"FRONT_WAVE_LENGTH",front_wave_length, & - default=0.,do_not_log=.true.) + default=0., do_not_log=.true.) call get_param(param_file, mdl,"FRONT_WAVE_ASYM", front_wave_asym, default=0., & do_not_log=.true.) @@ -239,11 +241,11 @@ subroutine adjustment_initialize_temperature_salinity ( T, S, h, G, GV, param_fi select case ( coordinateMode(verticalCoordinate) ) case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA ) - dSdz = -delta_S_strat/G%max_depth + dSdz = -delta_S_strat / G%max_depth do j=js,je ; do i=is,ie - eta1d(nz+1) = -G%Zd_to_m*G%bathyT(i,j) + eta1d(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 - eta1d(k) = eta1d(k+1) + h(i,j,k)*GV%H_to_m + eta1d(k) = eta1d(k+1) + h(i,j,k)*GV%H_to_Z enddo if (front_wave_length /= 0.) then y = ( 0.125 + G%geoLatT(i,j) / front_wave_length ) * ( 4. * acos(0.) ) @@ -264,8 +266,8 @@ subroutine adjustment_initialize_temperature_salinity ( T, S, h, G, GV, param_fi x = 1. - min(1., x) T(i,j,k) = x enddo - ! x=sum(T(i,j,:)*h(i,j,:)) - ! T(i,j,:)=T(i,j,:)/x*(G%max_depth*1.5/real(nz)) + ! x = GV%H_to_Z*sum(T(i,j,:)*h(i,j,:)) + ! T(i,j,:) = (T(i,j,:) / x) * (G%max_depth*1.5/real(nz)) enddo ; enddo case ( REGRIDDING_LAYER, REGRIDDING_RHO ) diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index 04e8cd014b..decb94963c 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -147,7 +147,7 @@ subroutine benchmark_initialize_thickness(h, G, GV, param_file, eqn_of_state, & pi = 4.0*atan(1.0) I_ts = 1.0 / thermocline_scale - I_md = 1.0 / G%max_depth + I_md = 1.0 / (G%max_depth * GV%Z_to_m) do j=js,je ; do i=is,ie SST = 0.5*(T0(k1)+T0(nz)) - 0.9*0.5*(T0(k1)-T0(nz)) * & cos(pi*(G%geoLatT(i,j)-G%south_lat)/(G%len_lat)) diff --git a/src/user/circle_obcs_initialization.F90 b/src/user/circle_obcs_initialization.F90 index 1d6611035e..f72a6e1830 100644 --- a/src/user/circle_obcs_initialization.F90 +++ b/src/user/circle_obcs_initialization.F90 @@ -33,10 +33,10 @@ subroutine circle_obcs_initialize_thickness(h, G, GV, param_file, just_read_para logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. - real :: e0(SZK_(GV)+1) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! - real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface ! - ! positive upward, in m. ! + real :: e0(SZK_(GV)+1) ! The resting interface heights, in depth units (Z), usually + ! negative because it is positive upward. + real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface + ! positive upward, in in depth units (Z). real :: diskrad, rad, xCenter, xRadius, lonC, latC, xOffset logical :: just_read ! This include declares and sets the variable "version". @@ -70,14 +70,14 @@ subroutine circle_obcs_initialize_thickness(h, G, GV, param_file, just_read_para ! Uniform thicknesses for base state do j=js,je ; do i=is,ie ! - eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = e0(K) - if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_m)) then - eta1D(K) = eta1D(K+1) + GV%Angstrom_m + if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_Z)) then + eta1D(K) = eta1D(K+1) + GV%Angstrom_Z h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = GV%m_to_H * (eta1D(K) - eta1D(K+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(K) - eta1D(K+1)) endif enddo enddo ; enddo diff --git a/src/user/dense_water_initialization.F90 b/src/user/dense_water_initialization.F90 index fed83a382b..260caf2f53 100644 --- a/src/user/dense_water_initialization.F90 +++ b/src/user/dense_water_initialization.F90 @@ -129,7 +129,7 @@ subroutine dense_water_initialize_TS(G, GV, param_file, eqn_of_state, T, S, h, j zi = 0. do k = 1,nz ! nondimensional middle of layer - zmid = zi + 0.5 * h(i,j,k) / G%max_depth + zmid = zi + 0.5 * h(i,j,k) / (GV%Z_to_H * G%max_depth) if (zmid < mld) then ! use reference salinity in the mixed layer @@ -139,7 +139,7 @@ subroutine dense_water_initialize_TS(G, GV, param_file, eqn_of_state, T, S, h, j S(i,j,k) = S_ref + S_range * (zmid - mld) / (1.0 - mld) endif - zi = zi + h(i,j,k) / G%max_depth + zi = zi + h(i,j,k) / (GV%Z_to_H * G%max_depth) enddo enddo enddo @@ -225,16 +225,16 @@ subroutine dense_water_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, A do j = G%jsc,G%jec do i = G%isc,G%iec - eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k = nz,1,-1 eta1D(k) = e0(k) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then ! is this layer vanished? - eta1D(k) = eta1D(k+1) + GV%Angstrom_m + eta1D(k) = eta1D(k+1) + GV%Angstrom_Z h(i,j,k) = GV%Angstrom_m else - h(i,j,k) = eta1D(k) - eta1D(k+1) + h(i,j,k) = GV%Z_to_m * (eta1D(k) - eta1D(k+1)) endif enddo enddo @@ -253,7 +253,7 @@ subroutine dense_water_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, A x = (G%geoLonT(i,j) - G%west_lon) / G%len_lon do k = 1,nz ! nondimensional middle of layer - zmid = zi + 0.5 * h(i,j,k) / G%max_depth + zmid = zi + 0.5 * h(i,j,k) / (GV%Z_to_m * G%max_depth) if (x > (1. - east_sponge_width)) then !if (zmid >= 0.9 * sill_height) & @@ -264,7 +264,7 @@ subroutine dense_water_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, A S(i,j,k) = S_ref + S_range * (zmid - mld) / (1.0 - mld) endif - zi = zi + h(i,j,k) / G%max_depth + zi = zi + h(i,j,k) / (GV%Z_to_m * G%max_depth) enddo enddo enddo diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index 7acf5c09af..51a0776900 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -55,12 +55,12 @@ subroutine dumbbell_initialize_topography ( D, G, param_file, max_depth ) dblen=dblen*1.e3 endif - do i=G%isc,G%iec + do i=G%isc,G%iec do j=G%jsc,G%jec ! Compute normalized zonal coordinates (x,y=0 at center of domain) x = ( G%geoLonT(i,j) ) / dblen y = ( G%geoLatT(i,j) ) / G%len_lat - D(i,j)=G%max_depth + D(i,j) = G%max_depth if ((x>=-0.25 .and. x<=0.25) .and. (y <= -0.5*dbfrac .or. y >= 0.5*dbfrac)) then D(i,j) = 0.0 endif @@ -80,10 +80,10 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, param_file, just_read_param logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. - real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! - real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface ! - ! positive upward, in m. ! + real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z), usually + ! negative because it is positive upward. + real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface + ! positive upward, in depth units (Z). integer :: i, j, k, is, ie, js, je, nz real :: x real :: delta_h @@ -98,10 +98,10 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, param_file, just_read_param if (.not.just_read) & call MOM_mesg("MOM_initialization.F90, initialize_thickness_uniform: setting thickness") - call get_param(param_file, mdl,"MIN_THICKNESS",min_thickness, & + call get_param(param_file, mdl,"MIN_THICKNESS", min_thickness, & 'Minimum thickness for layer',& units='m', default=1.0e-3, do_not_log=just_read) - call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE",verticalCoordinate, & + call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) ! WARNING: this routine specifies the interface heights so that the last layer @@ -134,34 +134,36 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, param_file, just_read_param ! Equating: z/max_depth = - ( S_light - S_surf + (K-3/2)/(nz-1) * (S_dense - S_light) ) / S_range e0(K) = - G%max_depth * ( ( S_light - S_surf ) + ( S_dense - S_light ) * & ( (real(K)-1.5) / real(nz-1) ) ) / S_range - e0(K) = nint(2048.*e0(K))/2048. ! Force round numbers ... the above expression has irrational factors ... - e0(K) = min(real(1-K)*GV%Angstrom_m, e0(K)) ! Bound by surface + ! Force round numbers ... the above expression has irrational factors ... + e0(K) = nint(2048.*GV%Z_to_m*e0(K)) / (2048.*GV%Z_to_m) + e0(K) = min(real(1-K)*GV%Angstrom_Z, e0(K)) ! Bound by surface e0(K) = max(-G%max_depth, e0(K)) ! Bound by bottom enddo do j=js,je ; do i=is,ie - eta1D(nz+1) = -G%Zd_to_m * G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_m - h(i,j,k) = GV%Angstrom_m + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then + eta1D(k) = eta1D(k+1) + GV%Angstrom_Z + h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = eta1D(k) - eta1D(k+1) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo case ( REGRIDDING_ZSTAR ) ! Initial thicknesses for z coordinates if (just_read) return ! All run-time parameters have been read, so return. + min_thickness = GV%m_to_Z * min_thickness do j=js,je ; do i=is,ie - eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then eta1D(k) = eta1D(k+1) + min_thickness h(i,j,k) = min_thickness else - h(i,j,k) = eta1D(k) - eta1D(k+1) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo @@ -169,7 +171,7 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, param_file, just_read_param case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie - h(i,j,:) = G%Zd_to_m * G%bathyT(i,j) / dfloat(nz) + h(i,j,:) = GV%Z_to_m * G%bathyT(i,j) / dfloat(nz) enddo ; enddo end select @@ -278,7 +280,7 @@ subroutine dumbbell_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp units="s", default=0.) call get_param(param_file, mdl, "DUMBBELL_SREF", S_ref, do_not_log=.true.) call get_param(param_file, mdl, "DUMBBELL_S_RANGE", S_range, do_not_log=.true.) - call get_param(param_file, mdl,"MIN_THICKNESS",min_thickness, & + call get_param(param_file, mdl,"MIN_THICKNESS", min_thickness, & 'Minimum thickness for layer',& units='m', default=1.0e-3, do_not_log=.true.) @@ -304,14 +306,14 @@ subroutine dumbbell_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp if (use_ALE) then ! construct a uniform grid for the sponge do j=G%jsc,G%jec ; do i=G%isc,G%iec - eta1D(nz+1) = -G%Zd_to_m * G%bathyT(i,j) + eta1D(nz+1) = -GV%Z_to_m * G%bathyT(i,j) do k=nz,1,-1 - eta1D(k) = -G%max_depth * real(k-1) / real(nz) + eta1D(k) = -GV%Z_to_m*G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then eta1D(k) = eta1D(k+1) + min_thickness h(i,j,k) = min_thickness else - h(i,j,k) = eta1D(k) - eta1D(k+1) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo diff --git a/src/user/external_gwave_initialization.F90 b/src/user/external_gwave_initialization.F90 index 0882eb510f..139f4c1945 100644 --- a/src/user/external_gwave_initialization.F90 +++ b/src/user/external_gwave_initialization.F90 @@ -29,12 +29,8 @@ subroutine external_gwave_initialize_thickness(h, G, GV, param_file, just_read_p logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. ! Local variables - real :: e0(SZK_(G)) ! The resting interface heights, in m, usually - ! negative because it is positive upward. - real :: e_pert(SZK_(G)) ! Interface height perturbations, positive - ! upward, in m. real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface - ! positive upward, in m. + ! positive upward, in depth units (Z). real :: ssh_anomaly_height ! Vertical height of ssh anomaly real :: ssh_anomaly_width ! Lateral width of anomaly logical :: just_read ! If true, just read parameters but set nothing. @@ -62,6 +58,7 @@ subroutine external_gwave_initialize_thickness(h, G, GV, param_file, just_read_p if (just_read) return ! All run-time parameters have been read, so return. PI = 4.0*atan(1.0) + ssh_anomaly_height = GV%m_to_Z*ssh_anomaly_height do j=G%jsc,G%jec ; do i=G%isc,G%iec Xnondim = (G%geoLonT(i,j)-G%west_lon-0.5*G%len_lon) / ssh_anomaly_width Xnondim = min(1., abs(Xnondim)) @@ -72,7 +69,7 @@ subroutine external_gwave_initialize_thickness(h, G, GV, param_file, just_read_p enddo eta1D(nz+1) = -G%max_depth ! Force bottom interface to bottom do k=1,nz - h(i,j,k) = GV%m_to_H * (eta1D(K) - eta1D(K+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(K) - eta1D(K+1)) enddo enddo ; enddo diff --git a/src/user/lock_exchange_initialization.F90 b/src/user/lock_exchange_initialization.F90 index 3c48bc9b9a..b4bb1e296f 100644 --- a/src/user/lock_exchange_initialization.F90 +++ b/src/user/lock_exchange_initialization.F90 @@ -66,26 +66,29 @@ subroutine lock_exchange_initialize_thickness(h, G, GV, param_file, just_read_pa if (just_read) return ! All run-time parameters have been read, so return. + thermocline_thickness = GV%m_to_Z*thermocline_thickness + front_displacement = GV%m_to_Z*front_displacement + do j=G%jsc,G%jec ; do i=G%isc,G%iec do k=2,nz eta1D(K) = -0.5 * G%max_depth & ! Middle of column - thermocline_thickness * ( (real(k-1))/real(nz) -0.5 ) ! Stratification if (G%geoLonT(i,j)-G%west_lon < 0.5 * G%len_lon) then - eta1D(K)=eta1D(K) + 0.5 * front_displacement + eta1D(K) = eta1D(K) + 0.5 * front_displacement elseif (G%geoLonT(i,j)-G%west_lon > 0.5 * G%len_lon) then - eta1D(K)=eta1D(K) - 0.5 * front_displacement + eta1D(K) = eta1D(K) - 0.5 * front_displacement endif enddo eta1D(nz+1) = -G%max_depth ! Force bottom interface to bottom do k=nz,2,-1 ! Make sure interfaces increase upwards - eta1D(K) = max( eta1D(K), eta1D(K+1) + GV%Angstrom_m ) + eta1D(K) = max( eta1D(K), eta1D(K+1) + GV%Angstrom_Z ) enddo eta1D(1) = 0. ! Force bottom interface to bottom do k=2,nz ! Make sure interfaces decrease downwards - eta1D(K) = min( eta1D(K), eta1D(K-1) - GV%Angstrom_m ) + eta1D(K) = min( eta1D(K), eta1D(K-1) - GV%Angstrom_Z ) enddo do k=nz,1,-1 - h(i,j,k) = GV%m_to_H * (eta1D(K) - eta1D(K+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(K) - eta1D(K+1)) enddo enddo ; enddo diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index 5f6e66d5be..f4411f749d 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -135,34 +135,36 @@ subroutine seamount_initialize_thickness ( h, G, GV, param_file, just_read_param ! Equating: z/max_depth = - ( S_light - S_surf + (K-3/2)/(nz-1) * (S_dense - S_light) ) / S_range e0(K) = - G%max_depth * ( ( S_light - S_surf ) + ( S_dense - S_light ) * & ( (real(K)-1.5) / real(nz-1) ) ) / S_range - e0(K) = nint(2048.*e0(K))/2048. ! Force round numbers ... the above expression has irrational factors ... - e0(K) = min(real(1-K)*GV%Angstrom_m, e0(K)) ! Bound by surface + ! Force round numbers ... the above expression has irrational factors ... + e0(K) = nint(2048.*GV%Z_to_m*e0(K))/(2048.*GV%Z_to_m) + e0(K) = min(real(1-K)*GV%Angstrom_Z, e0(K)) ! Bound by surface e0(K) = max(-G%max_depth, e0(K)) ! Bound by bottom enddo do j=js,je ; do i=is,ie - eta1D(nz+1) = -G%Zd_to_m * G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_m + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then + eta1D(k) = eta1D(k+1) + GV%Angstrom_Z h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = GV%m_to_H * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo case ( REGRIDDING_ZSTAR ) ! Initial thicknesses for z coordinates if (just_read) return ! All run-time parameters have been read, so return. + min_thickness = min_thickness * GV%m_to_Z do j=js,je ; do i=is,ie - eta1D(nz+1) = -G%Zd_to_m * G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then eta1D(k) = eta1D(k+1) + min_thickness - h(i,j,k) = GV%m_to_H * min_thickness + h(i,j,k) = GV%Z_to_H * min_thickness else - h(i,j,k) = GV%m_to_H * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo @@ -248,7 +250,7 @@ subroutine seamount_initialize_temperature_salinity ( T, S, h, G, GV, param_file do j=js,je ; do i=is,ie xi0 = 0.0 do k = 1,nz - xi1 = xi0 + GV%H_to_m * h(i,j,k) / G%max_depth + xi1 = xi0 + GV%H_to_Z * h(i,j,k) / G%max_depth select case ( trim(density_profile) ) case ('linear') !S(i,j,k) = S_surf + S_range * 0.5 * (xi0 + xi1) diff --git a/src/user/sloshing_initialization.F90 b/src/user/sloshing_initialization.F90 index 1237ae3c14..4340d9dcda 100644 --- a/src/user/sloshing_initialization.F90 +++ b/src/user/sloshing_initialization.F90 @@ -109,7 +109,7 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param t = - z_unif(k) - z_inter(k) = -t * (G%max_depth * GV%m_to_Z) + z_inter(k) = -t * G%max_depth enddo @@ -217,7 +217,7 @@ subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, param_file do j=js,je ; do i=is,ie xi0 = 0.0 do k = 1,nz - xi1 = xi0 + deltah / G%max_depth + xi1 = xi0 + deltah / G%max_depth ! = xi0 + 1.0 / real(nz) S(i,j,k) = 34.0 + 0.5 * S_range * (xi0 + xi1) xi0 = xi1 enddo From b4e8fe21e7b7fc45d7b6f26f9344116cee350f7f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 30 Aug 2018 10:07:12 -0400 Subject: [PATCH 055/174] +Use interface heights in Z units in sponges Changed the MOM_sponge code to use interface heights in Z units instead of m, and added an optional vertical grid type argument to initalize_sponge. To supply this, several of the ..._initialize_sponges have a new GV argument. All answers are bitwise identical for no Z-rescaling or for rescaling by 2^93 or 2^-93, but there are interface changes in the optional argument lists to initialize_sponge and an argument added to several of the user sponge initialization routines that call it. --- .../MOM_state_initialization.F90 | 33 ++--- src/parameterizations/vertical/MOM_sponge.F90 | 58 +++++---- src/user/BFB_initialization.F90 | 34 ++--- src/user/DOME2d_initialization.F90 | 37 +++--- src/user/DOME_initialization.F90 | 23 ++-- src/user/ISOMIP_initialization.F90 | 119 +++++++++--------- src/user/Phillips_initialization.F90 | 32 ++--- src/user/user_initialization.F90 | 54 ++++---- 8 files changed, 202 insertions(+), 188 deletions(-) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index a9745c0064..30d6c88ab6 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -523,19 +523,17 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & case ("DOME2D"); call DOME2d_initialize_sponges(G, GV, tv, PF, useALE, & sponge_CSp, ALE_sponge_CSp) case ("ISOMIP"); call ISOMIP_initialize_sponges(G, GV, tv, PF, useALE, & - sponge_CSp, ALE_sponge_CSp) - case ("USER"); call user_initialize_sponges(G, use_temperature, tv, & - PF, sponge_CSp, h) - case ("BFB"); call BFB_initialize_sponges_southonly(G, use_temperature, tv, & - PF, sponge_CSp, h) - case ("DUMBBELL"); call dumbbell_initialize_sponges(G, GV, tv, & - PF, useALE, sponge_CSp, ALE_sponge_CSp) - case ("phillips"); call Phillips_initialize_sponges(G, use_temperature, tv, & - PF, sponge_CSp, h) + sponge_CSp, ALE_sponge_CSp) + case ("USER"); call user_initialize_sponges(G, GV, use_temperature, tv, PF, sponge_CSp, h) + case ("BFB"); call BFB_initialize_sponges_southonly(G, GV, use_temperature, tv, PF, & + sponge_CSp, h) + case ("DUMBBELL"); call dumbbell_initialize_sponges(G, GV, tv, PF, useALE, & + sponge_CSp, ALE_sponge_CSp) + case ("phillips"); call Phillips_initialize_sponges(G, GV, tv, PF, sponge_CSp, h) case ("dense"); call dense_water_initialize_sponges(G, GV, tv, PF, useALE, & - sponge_CSp, ALE_sponge_CSp) - case ("file"); call initialize_sponges_file(G, GV, use_temperature, tv, & - PF, sponge_CSp, ALE_sponge_CSp, Time) + sponge_CSp, ALE_sponge_CSp) + case ("file"); call initialize_sponges_file(G, GV, use_temperature, tv, PF, & + sponge_CSp, ALE_sponge_CSp, Time) case default ; call MOM_error(FATAL, "MOM_initialize_state: "//& "Unrecognized sponge configuration "//trim(config)) end select @@ -1752,17 +1750,20 @@ subroutine initialize_sponges_file(G, GV, use_temperature, tv, param_file, CSp, if (.not. use_ALE) then allocate(eta(isd:ied,jsd:jed,nz+1)) call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain) + if (GV%m_to_Z /= 1.0) then ; do k=1,nz+1 ; do j=js,je ; do i=is,ie + eta(i,j,k) = GV%m_to_Z*eta(i,j,k) + enddo ; enddo ; enddo ; endif do j=js,je ; do i=is,ie - eta(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) + eta(i,j,nz+1) = -G%bathyT(i,j) enddo ; enddo do k=nz,1,-1 ; do j=js,je ; do i=is,ie - if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_m)) & - eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_m + if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_Z)) & + eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_Z enddo ; enddo ; enddo ! 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, param_file, CSp) + call initialize_sponge(Idamp, eta, G, param_file, CSp, GV) deallocate(eta) elseif (.not. new_sponges) then ! ALE mode diff --git a/src/parameterizations/vertical/MOM_sponge.F90 b/src/parameterizations/vertical/MOM_sponge.F90 index 77a2d109d6..70f7a9216d 100644 --- a/src/parameterizations/vertical/MOM_sponge.F90 +++ b/src/parameterizations/vertical/MOM_sponge.F90 @@ -53,7 +53,8 @@ module MOM_sponge real, pointer :: Rcv_ml_ref(:) => NULL() !< The value toward which the mixed layer !! coordinate-density is being damped, in kg m-3. real, pointer :: Ref_eta(:,:) => NULL() !< The value toward which the interface - !! heights are being damped, in m. + !! heights are being damped, in depth units (Z). + real :: eta_Z_to_m !< The conversion factor between the units for depths (Z) and m. type(p3d) :: var(MAX_FIELDS_) !< Pointers to the fields that are being damped. type(p2d) :: Ref_val(MAX_FIELDS_) !< The values to which the fields are damped. @@ -63,7 +64,7 @@ module MOM_sponge real, pointer :: Rcv_ml_ref_im(:) => NULL() !! The value toward which the i-mean !< mixed layer coordinate-density is being damped, in kg m-3. real, pointer :: Ref_eta_im(:,:) => NULL() !< The value toward which the i-mean - !! interface heights are being damped, in m. + !! interface heights are being damped, in depth units (Z). type(p2d) :: Ref_val_im(MAX_FIELDS_) !< The values toward which the i-means of !! fields are damped. @@ -79,22 +80,24 @@ module MOM_sponge !! positive values of Iresttime and which mask2dT indicates are ocean !! points are included in the sponges. It also stores the target interface !! heights. -subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, & +subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, GV, & Iresttime_i_mean, int_height_i_mean) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: Iresttime !< The inverse of the restoring time, in s-1. + intent(in) :: Iresttime !< The inverse of the restoring time, in s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & - intent(in) :: int_height !< The interface heights to damp back toward, in m. - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(sponge_CS), pointer :: CS !< A pointer that is set to point to the control - !! structure for this module + intent(in) :: int_height !< The interface heights to damp back toward, in depth units (Z). + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(sponge_CS), pointer :: CS !< A pointer that is set to point to the control + !! structure for this module + type(verticalGrid_type), & + optional, intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZJ_(G)), & - optional, intent(in) :: Iresttime_i_mean !< The inverse of the restoring time for - !! the zonal mean properties, in s-1. + optional, intent(in) :: Iresttime_i_mean !< The inverse of the restoring time for + !! the zonal mean properties, in s-1. real, dimension(SZJ_(G),SZK_(G)+1), & - optional, intent(in) :: int_height_i_mean !< The interface heights toward which to - !! damp the zonal mean heights, in m. + optional, intent(in) :: int_height_i_mean !< The interface heights toward which to + !! damp the zonal mean heights, in depth units (Z). ! This include declares and sets the variable "version". @@ -132,6 +135,8 @@ subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, & ! CS%bulkmixedlayer may be set later via a call to set_up_sponge_ML_density. CS%bulkmixedlayer = .false. + CS%eta_Z_to_m = 1.0 ; if (present(GV)) CS%eta_Z_to_m = GV%Z_to_m + CS%num_col = 0 ; CS%fldno = 0 do j=G%jsc,G%jec ; do i=G%isc,G%iec if ((Iresttime(i,j)>0.0) .and. (G%mask2dT(i,j)>0)) & @@ -342,11 +347,11 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) ! at the surface, in the same units as G%bathyT (m or Z). real, dimension(SZI_(G), SZJ_(G)) :: & eta_anom, & ! Anomalies in the interface height, relative to the i-mean - ! target value, in m. + ! target value, in depth units (Z). fld_anom ! Anomalies in a tracer concentration, relative to the ! i-mean target value. real, dimension(SZJ_(G), SZK_(G)+1) :: & - eta_mean_anom ! The i-mean interface height anomalies, in m. + eta_mean_anom ! The i-mean interface height anomalies, in Z. real, allocatable, dimension(:,:,:) :: & fld_mean_anom ! THe i-mean tracer concentration anomalies. real, dimension(SZI_(G), SZK_(G)+1) :: & @@ -356,8 +361,8 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) dilate ! A nondimensional factor by which to dilate layers to ! give 0 at the surface. - real :: e(SZK_(G)+1) ! The interface heights, in m, usually negative. - real :: e0 ! The height of the free surface in m. + real :: e(SZK_(G)+1) ! The interface heights, in Z, usually negative. + real :: e0 ! The height of the free surface in Z. real :: e_str ! A nondimensional amount by which the reference ! profile must be stretched for the free surfaces ! heights in the two profiles to agree. @@ -380,6 +385,9 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) call MOM_error(FATAL, "Rml must be provided to apply_sponge when using "//& "a bulk mixed layer.") + if (CS%eta_Z_to_m /= GV%Z_to_m) call MOM_error(FATAL, & + "There are inconsistent depth units between calls to set_up_sponge and apply_sponge.") + if ((CS%id_w_sponge > 0) .or. CS%do_i_mean_sponge) then do k=1,nz+1 ; do j=js,je ; do i=is,ie w_int(i,j,K) = 0.0 @@ -407,8 +415,8 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) do k=2,nz do j=js,je ; do i=is,ie - eta_anom(i,j) = e_D(i,j,k)*G%Zd_to_m - CS%Ref_eta_im(j,k) - if (CS%Ref_eta_im(j,K) < -G%bathyT(i,j)*G%Zd_to_m) eta_anom(i,j) = 0.0 + eta_anom(i,j) = e_D(i,j,k) - CS%Ref_eta_im(j,k) + if (CS%Ref_eta_im(j,K) < -G%bathyT(i,j)) eta_anom(i,j) = 0.0 enddo ; enddo call global_i_mean(eta_anom(:,:), eta_mean_anom(:,K), G) enddo @@ -436,7 +444,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) do K=2,nz ! w is positive for an upward (lightward) flux of mass, resulting ! in the downward movement of an interface. - w = damp_1pdamp * eta_mean_anom(j,K) * GV%m_to_H + w = damp_1pdamp * eta_mean_anom(j,K) * GV%Z_to_H do i=is,ie if (w > 0.0) then w_int(i,j,K) = min(w, h_below(i,K)) @@ -474,7 +482,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) e(1) = 0.0 ; e0 = 0.0 do K=1,nz - e(K+1) = e(K) - h(i,j,k)*GV%H_to_m + e(K+1) = e(K) - h(i,j,k)*GV%H_to_Z enddo e_str = e(nz+1) / CS%Ref_eta(nz+1,c) @@ -492,7 +500,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) wpb = 0.0; wb = 0.0 do k=nz,nkmb+1,-1 if (GV%Rlay(k) > Rcv_ml(i,j)) then - w = MIN((((e(K)-e0) - e_str*CS%Ref_eta(K,c)) * damp)*GV%m_to_H, & + w = MIN((((e(K)-e0) - e_str*CS%Ref_eta(K,c)) * damp)*GV%Z_to_H, & ((wb + h(i,j,k)) - GV%Angstrom_H)) wm = 0.5*(w-ABS(w)) do m=1,CS%fldno @@ -548,7 +556,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) wpb = 0.0 wb = 0.0 do k=nz,1,-1 - w = MIN((((e(K)-e0) - e_str*CS%Ref_eta(K,c)) * damp)*GV%m_to_H, & + w = MIN((((e(K)-e0) - e_str*CS%Ref_eta(K,c)) * damp)*GV%Z_to_H, & ((wb + h(i,j,k)) - GV%Angstrom_H)) wm = 0.5*(w - ABS(w)) do m=1,CS%fldno @@ -568,9 +576,9 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) if (associated(CS%diag)) then ; if (query_averaging_enabled(CS%diag)) then if (CS%id_w_sponge > 0) then - Idt = 1.0 / dt + Idt = GV%H_to_m / dt do k=1,nz+1 ; do j=js,je ; do i=is,ie - w_int(i,j,K) = w_int(i,j,K) * Idt * GV%H_to_m ! Scale values by clobbering array since it is local + w_int(i,j,K) = w_int(i,j,K) * Idt ! Scale values by clobbering array since it is local enddo ; enddo ; enddo call post_data(CS%id_w_sponge, w_int(:,:,:), CS%diag) endif diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index 76d3484563..20cf21f07b 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -70,19 +70,18 @@ end subroutine BFB_set_coord !> This subroutine sets up the sponges for the southern bouundary of the domain. Maximum damping occurs !! within 2 degrees lat of the boundary. The damping linearly decreases northward over the next 2 degrees. -subroutine BFB_initialize_sponges_southonly(G, use_temperature, tv, param_file, CSp, h) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - logical, intent(in) :: use_temperature !< If true, temperature and salinity are used as +subroutine BFB_initialize_sponges_southonly(G, GV, use_temperature, tv, param_file, CSp, h) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + logical, intent(in) :: use_temperature !< If true, temperature and salinity are used as !! state variables. - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(sponge_CS), pointer :: CSp !< A pointer to the sponge control structure + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(sponge_CS), pointer :: CSp !< A pointer to the sponge control structure real, dimension(NIMEM_, NJMEM_, NKMEM_), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - !call MOM_error(FATAL, & - ! "BFB_initialization.F90, BFB_initialize_sponges: " // & - ! "Unmodified user routine called - you must edit the routine to use it") + intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + ! Local variables real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta. real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. @@ -105,6 +104,7 @@ subroutine BFB_initialize_sponges_southonly(G, use_temperature, tv, param_file, ! Set up sponges for DOME configuration call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & "The minimum depth of the ocean.", units="m", default=0.0) + min_depth = GV%m_to_Z*min_depth call get_param(param_file, mdl, "SOUTHLAT", slat, & "The southern latitude of the domain.", units="degrees") @@ -115,7 +115,7 @@ subroutine BFB_initialize_sponges_southonly(G, use_temperature, tv, param_file, call get_param(param_file, mdl, "LENLON", lenlon, & "The longitudinal length of the domain.", units="degrees") nlat = slat + lenlat - do k=1,nz ; H0(k) = -G%Zd_to_m*G%max_depth * real(k-1) / real(nz) ; enddo + do k=1,nz ; H0(k) = -G%max_depth * real(k-1) / real(nz) ; enddo ! Use for meridional thickness profile initialization ! do k=1,nz ; H0(k) = -G%Zd_to_m*G%max_depth * real(k-1) / real(nz-1) ; enddo @@ -137,24 +137,24 @@ subroutine BFB_initialize_sponges_southonly(G, use_temperature, tv, param_file, ! do k = 1,nz; eta(i,j,k) = H0(k); enddo ! if (G%geoLatT(i,j) > 40.0) then ! do k = 1,nz - ! eta(i,j,k) = -G%Angstrom_m*(k-1) + ! eta(i,j,k) = -G%Angstrom_Z*(k-1) ! enddo ! elseif (G%geoLatT(i,j) > 20.0) then ! do k = 1,nz - ! eta(i,j,k) = min(H0(k) + (G%geoLatT(i,j) - 20.0)*(GV%Z_to_m*G%max_depth - nz*G%Angstrom_m)/20.0, & - ! -(k-1)*G%Angstrom_m) + ! eta(i,j,k) = min(H0(k) + (G%geoLatT(i,j) - 20.0)*(G%max_depth - nz*G%Angstrom_Z)/20.0, & + ! -(k-1)*G%Angstrom_Z) ! enddo ! endif - eta(i,j,nz+1) = -G%Zd_to_m*G%max_depth + eta(i,j,nz+1) = -G%max_depth - if (G%Zd_to_m*G%bathyT(i,j) > min_depth) then + if (G%bathyT(i,j) > min_depth) then Idamp(i,j) = damp/86400.0 else ; Idamp(i,j) = 0.0 ; endif enddo ; enddo ! This call sets up the damping rates and interface heights. ! This sets the inverse damping timescale fields in the sponges. ! - call initialize_sponge(Idamp, eta, G, param_file, CSp) + call initialize_sponge(Idamp, eta, G, param_file, CSp, GV) ! Now register all of the fields which are damped in the sponge. ! ! By default, momentum is advected vertically within the sponge, but ! diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index d5b789d266..1e0f34f9a0 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -364,10 +364,11 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. real :: S_ref, T_ref ! Reference salinity and temerature within surface layer real :: S_range, T_range ! Range of salinities and temperatures over the vertical - real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! - real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface ! - ! positive upward, in m. + real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z), + ! usually negative because it is positive upward. + real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface + ! positive upward, in Z. + real :: d_eta(SZK_(G)) ! The layer thickness in a column, in Z. real :: dome2d_width_bay, dome2d_width_bottom, dome2d_depth_bay real :: dome2d_west_sponge_time_scale, dome2d_east_sponge_time_scale real :: dome2d_west_sponge_width, dome2d_east_sponge_width @@ -467,44 +468,44 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) 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%m_to_Z *h(i,j,k) ! Position of the interface k + z = z + 0.5 * GV%m_to_Z * h(i,j,k) ! Position of the interface k enddo enddo ; enddo if ( associated(tv%T) ) then - call set_up_ALE_sponge_field(T,G,tv%T,ACSp) + call set_up_ALE_sponge_field(T, G, tv%T, ACSp) endif if ( associated(tv%S) ) then - call set_up_ALE_sponge_field(S,G,tv%S,ACSp) + call set_up_ALE_sponge_field(S, G, tv%S, ACSp) endif else - ! Construct thicknesses to restore to + ! Construct interface heights to restore toward do j=js,je ; do i=is,ie eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 - eta1D(k) = -G%max_depth * real(k-1) / real(nz) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_Z - h(i,j,k) = GV%Angstrom_m + eta1D(K) = -G%max_depth * real(k-1) / real(nz) + if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_Z)) then + eta1D(K) = eta1D(K+1) + GV%Angstrom_Z + d_eta(k) = GV%Angstrom_Z else - h(i,j,k) = GV%Z_to_m * (eta1D(k) - eta1D(k+1)) + d_eta(k) = (eta1D(K) - eta1D(K+1)) endif enddo x = ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon if ( x <= dome2d_width_bay ) then - h(i,j,1:nz-1) = GV%Angstrom_m - h(i,j,nz) = dome2d_depth_bay * GV%Z_to_m*G%max_depth - (nz-1) * GV%Angstrom_m + do k=1,nz-1 ; d_eta(k) = GV%Angstrom_Z ; enddo + d_eta(nz) = dome2d_depth_bay * G%max_depth - (nz-1) * GV%Angstrom_Z endif - eta(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) + eta(i,j,nz+1) = -G%bathyT(i,j) do K=nz,1,-1 - eta(i,j,K) = eta(i,j,K+1) + h(i,j,k) + eta(i,j,K) = eta(i,j,K+1) + d_eta(k) enddo enddo ; enddo - call initialize_sponge(Idamp, eta, G, param_file, CSp) + call initialize_sponge(Idamp, eta, G, param_file, CSp, GV) endif diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 20cdfc388d..bcb6a83dd9 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -138,8 +138,8 @@ subroutine DOME_initialize_sponges(G, GV, tv, PF, CSp) 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(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available - !! thermodynamic fields, including potential temperature and - !! salinity or mixed layer density. Absent fields have NULL ptrs. + !! thermodynamic fields, including potential temperature and + !! salinity or mixed layer density. Absent fields have NULL ptrs. type(param_file_type), intent(in) :: PF !< A structure indicating the open file to !! parse for model parameter values. type(sponge_CS), pointer :: CSp !< A pointer that is set to point to the control @@ -149,7 +149,7 @@ subroutine DOME_initialize_sponges(G, GV, tv, PF, CSp) real :: temp(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for other variables. ! real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. - real :: H0(SZK_(G)) + real :: H0(SZK_(G)) ! Interface heights in depth units (Z) real :: min_depth real :: damp, e_dense, damp_new character(len=40) :: mdl = "DOME_initialize_sponges" ! This subroutine's name. @@ -168,9 +168,10 @@ subroutine DOME_initialize_sponges(G, GV, tv, PF, CSp) ! Set up sponges for DOME configuration call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, & "The minimum depth of the ocean.", units="m", default=0.0) + min_depth = GV%m_to_Z * min_depth H0(1) = 0.0 - do k=2,nz ; H0(k) = -(real(k-1)-0.5)*(GV%Z_to_m*G%max_depth) / real(nz-1) ; enddo + do k=2,nz ; H0(k) = -(real(k-1)-0.5)*G%max_depth / real(nz-1) ; enddo do i=is,ie; do j=js,je if (G%geoLonT(i,j) < 100.0) then ; damp = 10.0 elseif (G%geoLonT(i,j) < 200.0) then @@ -190,23 +191,23 @@ subroutine DOME_initialize_sponges(G, GV, tv, PF, CSp) ! depth space for Boussinesq or non-Boussinesq models. eta(i,j,1) = 0.0 do k=2,nz -! eta(i,j,K)=max(H0(k), -G%Zd_to_m*G%bathyT(i,j), GV%Angstrom_m*(nz-k+1)-G%bathyT(i,j)) - e_dense = -G%Zd_to_m*G%bathyT(i,j) +! eta(i,j,K)=max(H0(k), -G%bathyT(i,j), GV%Angstrom_Z*(nz-k+1) - G%bathyT(i,j)) + e_dense = -G%bathyT(i,j) if (e_dense >= H0(k)) then ; eta(i,j,K) = e_dense else ; eta(i,j,K) = H0(k) ; endif - if (eta(i,j,K) < GV%Angstrom_m*(nz-k+1) - G%Zd_to_m*G%bathyT(i,j)) & - eta(i,j,K) = GV%Angstrom_m*(nz-k+1) - G%Zd_to_m*G%bathyT(i,j) + if (eta(i,j,K) < GV%Angstrom_Z*(nz-k+1) - G%bathyT(i,j)) & + eta(i,j,K) = GV%Angstrom_Z*(nz-k+1) - G%bathyT(i,j) enddo - eta(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) + eta(i,j,nz+1) = -G%bathyT(i,j) - if (G%Zd_to_m*G%bathyT(i,j) > min_depth) then + if (G%bathyT(i,j) > min_depth) then Idamp(i,j) = damp/86400.0 else ; Idamp(i,j) = 0.0 ; endif enddo ; enddo ! This call sets up the damping rates and interface heights. ! This sets the inverse damping timescale fields in the sponges. ! - call initialize_sponge(Idamp, eta, G, PF, CSp) + call initialize_sponge(Idamp, eta, G, PF, CSp, GV) ! Now register all of the fields which are damped in the sponge. ! ! By default, momentum is advected vertically within the sponge, but ! diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index 5376dcca21..0ace62ddc0 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -472,32 +472,32 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, & "The minimum depth of the ocean.", units="m", default=0.0) - if (associated(CSp)) call MOM_error(FATAL, & - "ISOMIP_initialize_sponges called with an associated control structure.") - if (associated(ACSp)) call MOM_error(FATAL, & - "ISOMIP_initialize_sponges called with an associated ALE-sponge control structure.") + if (associated(CSp)) call MOM_error(FATAL, & + "ISOMIP_initialize_sponges called with an associated control structure.") + if (associated(ACSp)) call MOM_error(FATAL, & + "ISOMIP_initialize_sponges called with an associated ALE-sponge control structure.") ! Here the inverse damping time, in s-1, is set. Set Idamp to 0 ! ! wherever there is no sponge, and the subroutines that are called ! ! 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) >= 790.0 .AND. G%geoLonT(i,j) <= 800.0) then + do i=is,ie; do j=js,je + if (G%geoLonT(i,j) >= 790.0 .AND. G%geoLonT(i,j) <= 800.0) then ! 1 / day - dummy1=(G%geoLonT(i,j)-790.0)/(800.0-790.0) - damp = 1.0/TNUDG * max(0.0,dummy1) + dummy1=(G%geoLonT(i,j)-790.0)/(800.0-790.0) + damp = 1.0/TNUDG * max(0.0,dummy1) - else ; damp=0.0 - endif + else ; damp=0.0 + endif ! convert to 1 / seconds - if (G%Zd_to_m * G%bathyT(i,j) > min_depth) then - Idamp(i,j) = damp/86400.0 - else ; Idamp(i,j) = 0.0 ; endif + if (G%Zd_to_m * G%bathyT(i,j) > min_depth) then + Idamp(i,j) = damp/86400.0 + else ; Idamp(i,j) = 0.0 ; endif - enddo ; enddo + enddo ; enddo ! Compute min/max density using T_SUR/S_SUR and T_BOT/S_BOT call calculate_density(t_sur,s_sur,0.0,rho_sur,tv%eqn_of_state) @@ -601,50 +601,53 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) endif else ! layer mode - ! 1) Read eta, salt and temp from IC file - call get_param(PF, mdl, "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, mdl, "ISOMIP_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, mdl, "SPONGE_PTEMP_VAR", temp_var, & - "The name of the potential temperature variable in \n"//& - "SPONGE_STATE_FILE.", default="Temp") - call get_param(PF, mdl, "SPONGE_SALT_VAR", salt_var, & - "The name of the salinity variable in \n"//& - "SPONGE_STATE_FILE.", default="Salt") - call get_param(PF, mdl, "SPONGE_ETA_VAR", eta_var, & - "The name of the interface height variable in \n"//& - "SPONGE_STATE_FILE.", default="eta") - - !read temp and eta - filename = trim(inputdir)//trim(state_file) - if (.not.file_exists(filename, G%Domain)) & - call MOM_error(FATAL, " ISOMIP_initialize_sponges: Unable to open "//trim(filename)) - call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain) - call MOM_read_data(filename, temp_var, T(:,:,:), G%Domain) - call MOM_read_data(filename, salt_var, S(:,:,:), G%Domain) - - ! for debugging - !i=G%iec; j=G%jec - !do k = 1,nz - ! call calculate_density(T(i,j,k),S(i,j,k),0.0,rho_tmp,tv%eqn_of_state) - ! write(mesg,*) 'Sponge - k,eta,T,S,rho,Rlay',k,eta(i,j,k),T(i,j,k),& - ! S(i,j,k),rho_tmp,GV%Rlay(k) - ! call MOM_mesg(mesg,5) - !enddo - - ! 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) - ! 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) + ! 1) Read eta, salt and temp from IC file + call get_param(PF, mdl, "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, mdl, "ISOMIP_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, mdl, "SPONGE_PTEMP_VAR", temp_var, & + "The name of the potential temperature variable in \n"//& + "SPONGE_STATE_FILE.", default="Temp") + call get_param(PF, mdl, "SPONGE_SALT_VAR", salt_var, & + "The name of the salinity variable in \n"//& + "SPONGE_STATE_FILE.", default="Salt") + call get_param(PF, mdl, "SPONGE_ETA_VAR", eta_var, & + "The name of the interface height variable in \n"//& + "SPONGE_STATE_FILE.", default="eta") + + !read temp and eta + filename = trim(inputdir)//trim(state_file) + if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & + "ISOMIP_initialize_sponges: Unable to open "//trim(filename)) + call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain) + if (GV%m_to_Z /= 1.0) then ; do k=1,nz+1 ; do j=js,je ; do i=is,ie + eta(i,j,k) = GV%m_to_Z*eta(i,j,k) + enddo ; enddo ; enddo ; endif + call MOM_read_data(filename, temp_var, T(:,:,:), G%Domain) + call MOM_read_data(filename, salt_var, S(:,:,:), G%Domain) + + ! for debugging + !i=G%iec; j=G%jec + !do k = 1,nz + ! call calculate_density(T(i,j,k),S(i,j,k),0.0,rho_tmp,tv%eqn_of_state) + ! write(mesg,*) 'Sponge - k,eta,T,S,rho,Rlay',k,eta(i,j,k),T(i,j,k),& + ! S(i,j,k),rho_tmp,GV%Rlay(k) + ! call MOM_mesg(mesg,5) + !enddo + + ! 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) + ! 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/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index 5832df78fc..5dfbb78914 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -28,7 +28,7 @@ module Phillips_initialization contains -!> Initialize thickness field. +!> Initialize the thickness field for the Phillips model test case. subroutine Phillips_initialize_thickness(h, G, GV, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -109,7 +109,7 @@ subroutine Phillips_initialize_thickness(h, G, GV, param_file, just_read_params) end subroutine Phillips_initialize_thickness -!> Initialize velocity fields. +!> Initialize the velocity fields for the Phillips model test case subroutine Phillips_initialize_velocity(u, v, G, GV, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure @@ -183,12 +183,12 @@ subroutine Phillips_initialize_velocity(u, v, G, GV, param_file, just_read_param end subroutine Phillips_initialize_velocity -!> 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. -subroutine Phillips_initialize_sponges(G, use_temperature, tv, param_file, CSp, h) +!> 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 for the Phillips +!! model test case +subroutine Phillips_initialize_sponges(G, GV, tv, param_file, CSp, h) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - logical, intent(in) :: use_temperature !< Switch for temperature. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers !! to any available thermodynamic !! fields, potential temperature and @@ -200,20 +200,21 @@ subroutine Phillips_initialize_sponges(G, use_temperature, tv, param_file, CSp, type(sponge_CS), pointer :: CSp !< A pointer that is set to point to !! the control structure for the !! sponge module. - real, intent(in), dimension(SZI_(G),SZJ_(G), SZK_(G)) :: h !< Thickness field, in units of H. + real, intent(in), dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h !< Thickness field, in units of H. + ! Local variables real :: eta0(SZK_(G)+1) ! The 1-d nominal positions of the interfaces. - real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, m. + real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, in depth units (Z). real :: temp(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for other variables. real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. - real :: eta_im(SZJ_(G),SZK_(G)+1) ! A temporary array for zonal-mean eta, m. + real :: eta_im(SZJ_(G),SZK_(G)+1) ! A temporary array for zonal-mean eta, in Z. real :: Idamp_im(SZJ_(G)) ! The inverse zonal-mean damping rate, in s-1. real :: damp_rate ! The inverse zonal-mean damping rate, in s-1. real :: jet_width ! The width of the zonal mean jet, in km. - real :: jet_height ! The interface height scale associated with the zonal-mean jet, in depth units. + real :: jet_height ! The interface height scale associated with the zonal-mean jet, in Z. real :: y_2 ! The y-position relative to the channel center, in km. real :: half_strat ! The fractional depth where the straficiation is centered, ND. - real :: half_depth ! The depth where the stratification is centered, in depth units. + real :: half_depth ! The depth where the stratification is centered, in Z. character(len=40) :: mdl = "Phillips_initialize_sponges" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz @@ -241,8 +242,8 @@ subroutine Phillips_initialize_sponges(G, use_temperature, tv, param_file, CSp, "The interface height scale associated with the \n"//& "zonal-mean jet.", units="m", & fail_if_missing=.true.) + jet_height = jet_height * GV%m_to_Z - jet_height = jet_height / G%Zd_to_m half_depth = G%max_depth*half_strat eta0(1) = 0.0 ; eta0(nz+1) = -G%max_depth do k=2,1+nz/2 ; eta0(k) = -half_depth*(2.0*(k-1)/real(nz)) ; enddo @@ -252,7 +253,7 @@ subroutine Phillips_initialize_sponges(G, use_temperature, tv, param_file, CSp, do j=js,je Idamp_im(j) = damp_rate - eta_im(j,1) = 0.0 ; eta_im(j,nz+1) = -G%Zd_to_m*G%max_depth + eta_im(j,1) = 0.0 ; eta_im(j,nz+1) = -G%max_depth enddo do K=2,nz ; do j=js,je y_2 = G%geoLatT(is,j) - G%south_lat - 0.5*G%len_lat @@ -260,10 +261,9 @@ subroutine Phillips_initialize_sponges(G, use_temperature, tv, param_file, CSp, ! jet_height * atan(y_2 / jet_width) if (eta_im(j,K) > 0.0) eta_im(j,K) = 0.0 if (eta_im(j,K) < -G%max_depth) eta_im(j,K) = -G%max_depth - eta_im(j,K) = eta_im(j,K) * G%Zd_to_m enddo ; enddo - call initialize_sponge(Idamp, eta, G, param_file, CSp, Idamp_im, eta_im) + call initialize_sponge(Idamp, eta, G, param_file, CSp, GV, Idamp_im, eta_im) end subroutine Phillips_initialize_sponges diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index b7e1efe6b1..3564ff9f3f 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -44,8 +44,8 @@ subroutine USER_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state) !! equation of state. call MOM_error(FATAL, & - "USER_initialization.F90, USER_set_coord: " // & - "Unmodified user routine called - you must edit the routine to use it") + "USER_initialization.F90, USER_set_coord: " // & + "Unmodified user routine called - you must edit the routine to use it") Rlay(:) = 0.0 g_prime(:) = 0.0 @@ -62,8 +62,8 @@ subroutine USER_initialize_topography(D, G, param_file, max_depth) real, intent(in) :: max_depth !< Maximum depth of model in m call MOM_error(FATAL, & - "USER_initialization.F90, USER_initialize_topography: " // & - "Unmodified user routine called - you must edit the routine to use it") + "USER_initialization.F90, USER_initialize_topography: " // & + "Unmodified user routine called - you must edit the routine to use it") D(:,:) = 0.0 @@ -85,8 +85,8 @@ subroutine USER_initialize_thickness(h, G, GV, param_file, just_read_params) logical :: just_read ! If true, just read parameters but set nothing. call MOM_error(FATAL, & - "USER_initialization.F90, USER_initialize_thickness: " // & - "Unmodified user routine called - you must edit the routine to use it") + "USER_initialization.F90, USER_initialize_thickness: " // & + "Unmodified user routine called - you must edit the routine to use it") just_read = .false. ; if (present(just_read_params)) just_read = just_read_params @@ -112,8 +112,8 @@ subroutine USER_initialize_velocity(u, v, G, param_file, just_read_params) logical :: just_read ! If true, just read parameters but set nothing. call MOM_error(FATAL, & - "USER_initialization.F90, USER_initialize_velocity: " // & - "Unmodified user routine called - you must edit the routine to use it") + "USER_initialization.F90, USER_initialize_velocity: " // & + "Unmodified user routine called - you must edit the routine to use it") just_read = .false. ; if (present(just_read_params)) just_read = just_read_params @@ -137,14 +137,14 @@ subroutine USER_init_temperature_salinity(T, S, G, param_file, eqn_of_state, jus !! parameter values. type(EOS_type), pointer :: eqn_of_state !< Integer that selects the !! equation of state. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, optional, intent(in) :: just_read_params !< If present and true, this call will only + !! read parameters without changing T & S. logical :: just_read ! If true, just read parameters but set nothing. call MOM_error(FATAL, & - "USER_initialization.F90, USER_init_temperature_salinity: " // & - "Unmodified user routine called - you must edit the routine to use it") + "USER_initialization.F90, USER_init_temperature_salinity: " // & + "Unmodified user routine called - you must edit the routine to use it") just_read = .false. ; if (present(just_read_params)) just_read = just_read_params @@ -158,24 +158,24 @@ subroutine USER_init_temperature_salinity(T, S, G, param_file, eqn_of_state, jus end subroutine USER_init_temperature_salinity !> Set up the sponges. -subroutine USER_initialize_sponges(G, use_temperature, tv, param_file, CSp, h) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. - logical, intent(in) :: use_temperature !< Whether to use potential - !! temperature. - type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers +subroutine USER_initialize_sponges(G, GV, use_temp, tv, param_file, CSp, h) + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + logical, intent(in) :: use_temp !< If true, temperature and salinity are state variables. + type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers !! to any available thermodynamic !! fields, potential temperature and !! salinity or mixed layer density. !! Absent fields have NULL ptrs. - type(param_file_type), intent(in) :: param_file !< A structure indicating the + type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model !! parameter values. - type(sponge_CS), pointer :: CSp !< A pointer to the sponge control - !! structure. - real, dimension(SZI_(G), SZJ_(G), SZK_(G)), intent(in) :: h !< Layer thicknesses. + type(sponge_CS), pointer :: CSp !< A pointer to the sponge control structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: h !< Layer thicknesses, in units of H (m or kg m-2). call MOM_error(FATAL, & - "USER_initialization.F90, USER_initialize_sponges: " // & - "Unmodified user routine called - you must edit the routine to use it") + "USER_initialization.F90, USER_initialize_sponges: " // & + "Unmodified user routine called - you must edit the routine to use it") if (first_call) call write_user_log(param_file) @@ -207,8 +207,8 @@ subroutine USER_set_rotation(G, param_file) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters call MOM_error(FATAL, & - "USER_initialization.F90, USER_set_rotation: " // & - "Unmodified user routine called - you must edit the routine to use it") + "USER_initialization.F90, USER_set_rotation: " // & + "Unmodified user routine called - you must edit the routine to use it") if (first_call) call write_user_log(param_file) @@ -237,8 +237,8 @@ end subroutine write_user_log !! here are: !! - u - Zonal velocity in m s-1. !! - v - Meridional velocity in m s-1. -!! - h - Layer thickness in m. (Must be positive.) -!! - G%bathyT - Basin depth in m. (Must be positive.) +!! - h - Layer thickness in H. (Must be positive.) +!! - G%bathyT - Basin depth in Z. (Must be positive.) !! - G%CoriolisBu - The Coriolis parameter, in s-1. !! - GV%g_prime - The reduced gravity at each interface, in m s-2. !! - GV%Rlay - Layer potential density (coordinate variable), kg m-3. From ac0a7d3a9fb0ace1d906c897a53160dc74a5c447 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 30 Aug 2018 13:44:45 -0400 Subject: [PATCH 056/174] Work in Z units in thickness init routines Modified thickness initialization routines to work in depth units instead of m for automated dimensional unit checking. All answers are bitwise identical for no Z-rescaling or for rescaling by 2^93 or 2^-93. --- .../MOM_state_initialization.F90 | 46 +++++++++---------- src/user/BFB_initialization.F90 | 9 ++-- src/user/Kelvin_initialization.F90 | 6 ++- src/user/Neverland_initialization.F90 | 19 ++++---- src/user/Phillips_initialization.F90 | 2 +- src/user/baroclinic_zone_initialization.F90 | 10 ++-- src/user/benchmark_initialization.F90 | 44 +++++++++--------- src/user/soliton_initialization.F90 | 12 ++--- 8 files changed, 74 insertions(+), 74 deletions(-) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 30d6c88ab6..756e192196 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -611,7 +611,7 @@ subroutine initialize_thickness_from_file(h, G, GV, param_file, file_has_thickne !! only read parameters without changing h. ! Local variables - real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) + real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! Interface heights, in depth units. integer :: inconsistent = 0 logical :: correct_thickness logical :: just_read ! If true, just read parameters but set nothing. @@ -653,6 +653,7 @@ subroutine initialize_thickness_from_file(h, G, GV, param_file, file_has_thickne if (just_read) return ! All run-time parameters have been read, so return. call MOM_read_data(filename, "eta", eta(:,:,:), G%Domain) + ! if (GV%m_to_Z /= 1.0) eta(:,:,:) = GV%m_to_Z*eta(:,:,:) if (correct_thickness) then call adjustEtaToFitBathymetry(G, GV, eta, h) @@ -829,10 +830,10 @@ subroutine initialize_thickness_list(h, G, GV, param_file, just_read_params) !! only read parameters without changing h. ! Local variables character(len=40) :: mdl = "initialize_thickness_list" ! This subroutine's name. - real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually - ! negative because it is positive upward. + real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z), + ! usually negative because it is positive upward. real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface - ! positive upward, in m. + ! positive upward, in depth units (Z). logical :: just_read ! If true, just read parameters but set nothing. character(len=200) :: filename, eta_file, inputdir ! Strings for file/path character(len=72) :: eta_var @@ -860,6 +861,7 @@ subroutine initialize_thickness_list(h, G, GV, param_file, just_read_params) e0(:) = 0.0 call MOM_read_data(filename, eta_var, e0(:)) + do k=1,nz+1 ; e0(k) = GV%m_to_Z*e0(k) ; enddo if ((abs(e0(1)) - 0.0) > 0.001) then ! This list probably starts with the interior interface, so shift it up. @@ -867,11 +869,8 @@ subroutine initialize_thickness_list(h, G, GV, param_file, just_read_params) e0(1) = 0.0 endif - if (e0(2) > e0(1)) then - ! Switch to the convention for interface heights increasing upward. - do k=1,nz - e0(K) = -e0(K) - enddo + if (e0(2) > e0(1)) then ! Switch to the convention for interface heights increasing upward. + do k=1,nz ; e0(K) = -e0(K) ; enddo endif do j=js,je ; do i=is,ie @@ -880,14 +879,14 @@ subroutine initialize_thickness_list(h, G, GV, param_file, just_read_params) ! Angstrom thick, and 2. the interfaces are where they should be ! based on the resting depths and interface height perturbations, ! as long at this doesn't interfere with 1. - eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = e0(K) - if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_m)) then - eta1D(K) = eta1D(K+1) + GV%Angstrom_m + if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_Z)) then + eta1D(K) = eta1D(K+1) + GV%Angstrom_Z h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = GV%m_to_H * (eta1D(K) - eta1D(K+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(K) - eta1D(K+1)) endif enddo enddo ; enddo @@ -1897,6 +1896,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) !! to parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. + ! Local variables character(len=200) :: filename !< The name of an input file containing temperature !! and salinity in z-space; also used for ice shelf area. @@ -1911,8 +1911,8 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) type(EOS_type), pointer :: eos => NULL() type(thermo_var_ptrs) :: tv_loc ! A temporary thermo_var container type(verticalGrid_type) :: GV_loc ! A temporary vertical grid 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 = "MOM_initialize_layers_from_Z" ! This module's name. integer :: is, ie, js, je, nz ! compute domain indices @@ -2085,10 +2085,10 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) ! to the North/South Pole past the limits of the input data, they are extrapolated using the average ! value at the northernmost/southernmost latitude. - call horiz_interp_and_extrap_tracer(tfilename, potemp_var,1.0,1, & + call horiz_interp_and_extrap_tracer(tfilename, potemp_var, 1.0, 1, & G, temp_z, mask_z, z_in, z_edges_in, missing_value_temp, reentrant_x, tripolar_n, homogenize) - call horiz_interp_and_extrap_tracer(sfilename, salin_var,1.0,1, & + call horiz_interp_and_extrap_tracer(sfilename, salin_var, 1.0, 1, & G, salt_z, mask_z, z_in, z_edges_in, missing_value_salt, reentrant_x, tripolar_n, homogenize) kd = size(z_in,1) @@ -2100,13 +2100,11 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) press(:) = tv%p_ref ! Convert T&S to Absolute Salinity and Conservative Temperature if using TEOS10 or NEMO - call convert_temp_salt_for_TEOS10(temp_z,salt_z, press, G, kd, mask_z, eos) + call convert_temp_salt_for_TEOS10(temp_z, salt_z, press, G, kd, mask_z, eos) - do k=1,kd - do j=js,je - call calculate_density(temp_z(:,j,k),salt_z(:,j,k), press, rho_z(:,j,k), is, ie, eos) - enddo - enddo ! kd + do k=1,kd ; do j=js,je + call calculate_density(temp_z(:,j,k), salt_z(:,j,k), press, rho_z(:,j,k), is, ie, eos) + enddo ; enddo call pass_var(temp_z,G%Domain) call pass_var(salt_z,G%Domain) @@ -2316,7 +2314,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) endif - deallocate(z_in,z_edges_in,temp_z,salt_z,mask_z) + deallocate(z_in, z_edges_in, temp_z, salt_z, mask_z) deallocate(rho_z) ; deallocate(area_shelf_h, frac_shelf_h) call pass_var(h, G%Domain) diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index 20cf21f07b..2a14f502ef 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -82,11 +82,10 @@ subroutine BFB_initialize_sponges_southonly(G, GV, use_temperature, tv, param_fi intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) ! Local variables - real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta. + real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, in depth units (Z). real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. - - real :: H0(SZK_(G)) - real :: min_depth + real :: H0(SZK_(G)) ! Resting layer thickesses in depth units (Z). + real :: min_depth ! The minimum ocean depth in depth units (Z). real :: damp, e_dense, damp_new, slat, wlon, lenlat, lenlon, nlat character(len=40) :: mdl = "BFB_initialize_sponges_southonly" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz @@ -118,7 +117,7 @@ subroutine BFB_initialize_sponges_southonly(G, GV, use_temperature, tv, param_fi do k=1,nz ; H0(k) = -G%max_depth * real(k-1) / real(nz) ; enddo ! Use for meridional thickness profile initialization -! do k=1,nz ; H0(k) = -G%Zd_to_m*G%max_depth * real(k-1) / real(nz-1) ; enddo +! do k=1,nz ; H0(k) = -G%max_depth * real(k-1) / real(nz-1) ; enddo do i=is,ie; do j=js,je if (G%geoLatT(i,j) < slat+2.0) then ; damp = 1.0 diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index 92f25463aa..8315833391 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -255,12 +255,14 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, h, Time) y1 = 1000. * G%geoLatBu(I,J) x = (x1 - CS%coast_offset1) * cosa + y1 * sina y = - (x1 - CS%coast_offset1) * sina + y1 * cosa + !### Problem: val2 & cff could be a functions of space, but are not set in this loop. + !### Problem: Is val2 in the numerator or denominator below? if (CS%mode == 0) then do k=1,nz segment%tangential_vel(I,J,k) = val1 * cff * sina / & (0.25 * G%Zd_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j) + & G%bathyT(i+1,j+1) + G%bathyT(i,j+1))) * val2 -!### This should be: +!### For rotational symmetry, this should be: ! segment%tangential_vel(I,J,k) = val1 * cff * sina / & ! ( 0.25*G%Zd_to_m*((G%bathyT(i,j) + G%bathyT(i+1,j+1)) +& ! (G%bathyT(i+1,j) + G%bathyT(i,j+1))) ) * val2 @@ -307,6 +309,8 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, h, Time) y1 = 1000. * G%geoLatBu(I,J) x = (x1 - CS%coast_offset1) * cosa + y1 * sina y = - (x1 - CS%coast_offset1) * sina + y1 * cosa + !### Problem: val2 & cff could be a functions of space, but are not set in this loop. + !### Problem: Is val2 in the numerator or denominator below? if (CS%mode == 0) then do k=1,nz segment%tangential_vel(I,J,k) = val1 * cff * sina / & diff --git a/src/user/Neverland_initialization.F90 b/src/user/Neverland_initialization.F90 index 11271543b9..cb641c9cb9 100644 --- a/src/user/Neverland_initialization.F90 +++ b/src/user/Neverland_initialization.F90 @@ -78,7 +78,7 @@ end subroutine Neverland_initialize_topography ! ----------------------------------------------------------------------------- !> Returns the value of a cosine-bell function evaluated at x/L -real function cosbell(x,L) +real function cosbell(x, L) real , intent(in) :: x !< non-dimensional position real , intent(in) :: L !< non-dimensional width real :: PI !< 3.1415926... calculated as 4*atan(1) @@ -88,7 +88,7 @@ real function cosbell(x,L) end function cosbell !> Returns the value of a sin-spike function evaluated at x/L -real function spike(x,L) +real function spike(x, L) real , intent(in) :: x !< non-dimensional position real , intent(in) :: L !< non-dimensional width @@ -115,8 +115,8 @@ subroutine Neverland_initialize_thickness(h, G, GV, param_file, eqn_of_state, P_ real, intent(in) :: P_Ref !< The coordinate-density !! reference pressure in Pa. ! Local variables - real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! + real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z), + ! usually negative because it is positive upward. real, dimension(SZK_(G)) :: h_profile ! Vector of initial thickness profile (m) real :: e_interface ! Current interface positoin (m) character(len=40) :: mod = "Neverland_initialize_thickness" ! This subroutine's name. @@ -128,19 +128,18 @@ subroutine Neverland_initialize_thickness(h, G, GV, param_file, eqn_of_state, P_ call get_param(param_file, mod, "INIT_THICKNESS_PROFILE", h_profile, & "Profile of initial layer thicknesses.", units="m", fail_if_missing=.true.) -! e0 is the notional position of interfaces + ! e0 is the notional position of interfaces e0(1) = 0. ! The surface do k=1,nz - e0(k+1) = e0(k) - h_profile(k) + e0(k+1) = e0(k) - GV%m_to_Z*h_profile(k) enddo do j=js,je ; do i=is,ie - e_interface = -G%Zd_to_m * G%bathyT(i,j) + e_interface = -G%bathyT(i,j) do k=nz,1,-1 - h(i,j,k) = max( GV%Angstrom_H, GV%m_to_H * (e0(k) - e_interface) ) - e_interface = max( e0(k), e_interface - GV%H_to_m * h(i,j,k) ) + h(i,j,k) = max( GV%Angstrom_H, GV%Z_to_H * (e0(k) - e_interface) ) + e_interface = max( e0(k), e_interface - GV%H_to_Z * h(i,j,k) ) enddo - enddo ; enddo end subroutine Neverland_initialize_thickness diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index 5dfbb78914..719b9cd6ee 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -200,7 +200,7 @@ subroutine Phillips_initialize_sponges(G, GV, tv, param_file, CSp, h) type(sponge_CS), pointer :: CSp !< A pointer that is set to point to !! the control structure for the !! sponge module. - real, intent(in), dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h !< Thickness field, in units of H. + real, intent(in), dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h !< Thickness field, in units of H. ! Local variables real :: eta0(SZK_(G)+1) ! The 1-d nominal positions of the interfaces. diff --git a/src/user/baroclinic_zone_initialization.F90 b/src/user/baroclinic_zone_initialization.F90 index 381828e49c..1a9f99b840 100644 --- a/src/user/baroclinic_zone_initialization.F90 +++ b/src/user/baroclinic_zone_initialization.F90 @@ -81,7 +81,8 @@ subroutine baroclinic_zone_init_temperature_salinity(T, S, h, G, GV, param_file, real :: T_ref, dTdz, dTdx, delta_T ! Parameters describing temperature distribution real :: S_ref, dSdz, dSdx, delta_S ! Parameters describing salinity distribution real :: L_zone ! Width of baroclinic zone - real :: zc, zi, x, xd, xs, y, yd, fn + real :: zc, zi ! Depths in depth units (Z). + real :: x, xd, xs, y, yd, fn real :: PI ! 3.1415926... calculated as 4*atan(1) logical :: just_read ! If true, just read parameters but set nothing. @@ -89,6 +90,7 @@ subroutine baroclinic_zone_init_temperature_salinity(T, S, h, G, GV, param_file, just_read = .false. ; if (present(just_read_params)) just_read = just_read_params call bcz_params(G, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, dTdz, delta_T, dTdx, L_zone, just_read_params) + dTdz = GV%Z_to_m*dTdz ; dSdz = GV%Z_to_m*dSdz if (just_read) return ! All run-time parameters have been read, so return. @@ -97,7 +99,7 @@ subroutine baroclinic_zone_init_temperature_salinity(T, S, h, G, GV, param_file, PI = 4.*atan(1.) do j = G%jsc,G%jec ; do i = G%isc,G%iec - zi = -G%Zd_to_m*G%bathyT(i,j) + zi = -G%bathyT(i,j) x = G%geoLonT(i,j) - (G%west_lon + 0.5*G%len_lon) ! Relative to center of domain xd = x / G%len_lon ! -1/2 < xd 1/2 y = G%geoLatT(i,j) - (G%south_lat + 0.5*G%len_lat) ! Relative to center of domain @@ -110,8 +112,8 @@ subroutine baroclinic_zone_init_temperature_salinity(T, S, h, G, GV, param_file, fn = xs endif do k = nz, 1, -1 - zc = zi + 0.5*h(i,j,k)*GV%H_to_m ! Position of middle of cell - zi = zi + h(i,j,k)*GV%H_to_m ! Top interface position + zc = zi + 0.5*h(i,j,k)*GV%H_to_Z ! Position of middle of cell + zi = zi + h(i,j,k)*GV%H_to_Z ! Top interface position T(i,j,k) = T_ref + dTdz * zc & ! Linear temperature stratification + dTdx * x & ! Linear gradient + delta_T * fn ! Smooth fn of width L_zone diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index decb94963c..8e0e03ad94 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -86,19 +86,19 @@ subroutine benchmark_initialize_thickness(h, G, GV, param_file, eqn_of_state, & logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. ! Local variables - real :: e0(SZK_(GV)+1) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! - real :: e_pert(SZK_(GV)+1) ! Interface height perturbations, positive ! - ! upward, in m. ! - real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface ! - ! positive upward, in m. ! + real :: e0(SZK_(GV)+1) ! The resting interface heights, in depth units (Z), + ! usually negative because it is positive upward. + real :: e_pert(SZK_(GV)+1) ! Interface height perturbations, positive upward, + ! in depth units (Z). + real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface + ! positive upward, in depth units (Z). real :: SST ! The initial sea surface temperature, in deg C. real :: T_int ! The initial temperature of an interface, in deg C. - real :: ML_depth ! The specified initial mixed layer depth, in m. - real :: thermocline_scale ! The e-folding scale of the thermocline, in m. + real :: ML_depth ! The specified initial mixed layer depth, in depth units (Z). + real :: thermocline_scale ! The e-folding scale of the thermocline, in depth units (Z). real, dimension(SZK_(GV)) :: T0, pres, S0, rho_guess, drho, drho_dT, drho_dS real :: a_exp ! The fraction of the overall stratification that is exponential. - real :: I_ts, I_md ! Inverse lengthscales in m-1. + real :: I_ts, I_md ! Inverse lengthscales in Z-1. real :: T_frac ! A ratio of the interface temperature to the range ! between SST and the bottom temperature. real :: err, derr_dz ! The error between the profile's temperature and the @@ -118,8 +118,8 @@ subroutine benchmark_initialize_thickness(h, G, GV, param_file, eqn_of_state, & k1 = GV%nk_rho_varies + 1 - ML_depth = 50.0 - thermocline_scale = 500.0 + ML_depth = 50.0 * GV%m_to_Z + thermocline_scale = 500.0 * GV%m_to_Z a_exp = 0.9 ! This block calculates T0(k) for the purpose of diagnosing where the @@ -128,8 +128,8 @@ subroutine benchmark_initialize_thickness(h, G, GV, param_file, eqn_of_state, & pres(k) = P_Ref ; S0(k) = 35.0 enddo T0(k1) = 29.0 - call calculate_density(T0(k1),S0(k1),pres(k1),rho_guess(k1),eqn_of_state) - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,k1,1,eqn_of_state) + call calculate_density(T0(k1), S0(k1), pres(k1), rho_guess(k1), eqn_of_state) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, k1, 1, eqn_of_state) ! A first guess of the layers' temperatures. do k=1,nz @@ -138,8 +138,8 @@ subroutine benchmark_initialize_thickness(h, G, GV, param_file, eqn_of_state, & ! Refine the guesses for each layer. do itt=1,6 - call calculate_density(T0,S0,pres,rho_guess,1,nz,eqn_of_state) - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,eqn_of_state) + call calculate_density(T0, S0, pres, rho_guess, 1, nz, eqn_of_state) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, eqn_of_state) do k=1,nz T0(k) = T0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dT(k) enddo @@ -147,7 +147,7 @@ subroutine benchmark_initialize_thickness(h, G, GV, param_file, eqn_of_state, & pi = 4.0*atan(1.0) I_ts = 1.0 / thermocline_scale - I_md = 1.0 / (G%max_depth * GV%Z_to_m) + I_md = 1.0 / G%max_depth do j=js,je ; do i=is,ie SST = 0.5*(T0(k1)+T0(nz)) - 0.9*0.5*(T0(k1)-T0(nz)) * & cos(pi*(G%geoLatT(i,j)-G%south_lat)/(G%len_lat)) @@ -156,12 +156,12 @@ subroutine benchmark_initialize_thickness(h, G, GV, param_file, eqn_of_state, & ! The remainder of this subroutine should not be changed. ! -! This sets the initial thickness (in m) of the layers. The ! +! This sets the initial thickness (in H) of the layers. The ! ! thicknesses are set to insure that: 1. each layer is at least ! ! Gv%Angstrom_m thick, and 2. the interfaces are where they should be ! ! based on the resting depths and interface height perturbations, ! ! as long at this doesn't interfere with 1. ! - eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,2,-1 T_int = 0.5*(T0(k) + T0(k-1)) @@ -180,12 +180,12 @@ subroutine benchmark_initialize_thickness(h, G, GV, param_file, eqn_of_state, & if (eta1D(K) > -ML_depth) eta1D(K) = -ML_depth - if (eta1D(K) < eta1D(K+1) + GV%Angstrom_m) & - eta1D(K) = eta1D(K+1) + GV%Angstrom_m + if (eta1D(K) < eta1D(K+1) + GV%Angstrom_Z) & + eta1D(K) = eta1D(K+1) + GV%Angstrom_Z - h(i,j,k) = max(GV%m_to_H * (eta1D(K) - eta1D(K+1)), GV%Angstrom_H) + h(i,j,k) = max(GV%Z_to_H * (eta1D(K) - eta1D(K+1)), GV%Angstrom_H) enddo - h(i,j,1) = max(GV%m_to_H * (0.0 - eta1D(2)), GV%Angstrom_H) + h(i,j,1) = max(GV%Z_to_H * (0.0 - eta1D(2)), GV%Angstrom_H) enddo ; enddo diff --git a/src/user/soliton_initialization.F90 b/src/user/soliton_initialization.F90 index 4d463803f3..96e7170bb6 100644 --- a/src/user/soliton_initialization.F90 +++ b/src/user/soliton_initialization.F90 @@ -45,15 +45,15 @@ subroutine soliton_initialize_thickness(h, G, GV) x0 = 2.0*G%len_lon/3.0 y0 = 0.0 val1 = 0.395 - val2 = 0.771*(val1*val1) + val2 = GV%m_to_Z * 0.771*(val1*val1) do j = G%jsc,G%jec ; do i = G%isc,G%iec do k = 1, nz x = G%geoLonT(i,j)-x0 y = G%geoLatT(i,j)-y0 val3 = exp(-val1*x) - val4 = val2*((2.0*val3/(1.0+(val3*val3)))**2) - h(i,j,k) = GV%m_to_H * (0.25*val4 * (6.0*y*y+3.0) * exp(-0.5*y*y) + G%Zd_to_m*G%bathyT(i,j)) + val4 = val2 * ( 2.0*val3 / (1.0 + (val3*val3)) )**2 + h(i,j,k) = GV%Z_to_H * (0.25*val4*(6.0*y*y + 3.0) * exp(-0.5*y*y) + G%bathyT(i,j)) enddo enddo ; enddo @@ -87,8 +87,7 @@ subroutine soliton_initialize_velocity(u, v, h, G) y = 0.5*(G%geoLatT(i+1,j)+G%geoLatT(i,j))-y0 val3 = exp(-val1*x) val4 = val2*((2.0*val3/(1.0+(val3*val3)))**2) - u(I,j,k) = 0.25*val4*(6.0*y*y-9.0)* & - exp(-0.5*y*y) + u(I,j,k) = 0.25*val4*(6.0*y*y-9.0) * exp(-0.5*y*y) enddo enddo ; enddo do j = G%jsc-1,G%jec+1 ; do I = G%isc,G%iec @@ -97,8 +96,7 @@ subroutine soliton_initialize_velocity(u, v, h, G) y = 0.5*(G%geoLatT(i,j+1)+G%geoLatT(i,j))-y0 val3 = exp(-val1*x) val4 = val2*((2.0*val3/(1.0+(val3*val3)))**2) - v(i,J,k) = 2.0*val4*y*(-2.0*val1*tanh(val1*x))* & - exp(-0.5*y*y) + v(i,J,k) = 2.0*val4*y*(-2.0*val1*tanh(val1*x)) * exp(-0.5*y*y) enddo enddo ; enddo From c0f79021120dc476075167ff3e29a3b33545567a Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 30 Aug 2018 15:13:28 -0400 Subject: [PATCH 057/174] Code cleanup in midas_vertmap Cleaned up code in determine_temperature, find_overlap, and find_limite_slope to follow MOM6 standards for indents and spacing, and to avoid unneccessary temporary variables. All answers are bitwise identical. --- src/initialization/midas_vertmap.F90 | 255 ++++++++++++--------------- 1 file changed, 113 insertions(+), 142 deletions(-) diff --git a/src/initialization/midas_vertmap.F90 b/src/initialization/midas_vertmap.F90 index ccc71fa5e1..0124c767b5 100644 --- a/src/initialization/midas_vertmap.F90 +++ b/src/initialization/midas_vertmap.F90 @@ -361,10 +361,9 @@ end function bisect_fast #ifdef PY_SOLO ! Only for stand-alone python -!> This subroutine determines the potential temperature and -!! salinity that is consistent with the target density -!! using provided initial guess -subroutine determine_temperature(temp,salt,R,p_ref,niter,land_fill,h,k_start) +!> This subroutine determines the potential temperature and salinity that +!! is consistent with the target density using provided initial guess +subroutine determine_temperature(temp, salt, R, p_ref, niter, land_fill, h, k_start) real(kind=8), dimension(:,:,:), intent(inout) :: temp !< potential temperature (degC) real(kind=8), dimension(:,:,:), intent(inout) :: salt !< salinity (PSU) real(kind=8), dimension(size(temp,3)), intent(in) :: R !< desired potential density, in kg m-3. @@ -373,49 +372,40 @@ subroutine determine_temperature(temp,salt,R,p_ref,niter,land_fill,h,k_start) integer, intent(in) :: k_start !< starting index (i.e. below the buffer layer) real, intent(in) :: land_fill !< land fill value real(kind=8), dimension(:,:,:), intent(in) :: h !< layer thickness . Do not iterate for massless layers + ! Local variables - real(kind=8), dimension(size(temp,1),size(temp,3)) :: T,S,dT,dS,rho,hin - real(kind=8), dimension(size(temp,1),size(temp,3)) :: drho_dT,drho_dS - real(kind=8), dimension(size(temp,1)) :: press - integer :: nx,ny,nz,nt,i,j,k,n,itt - logical :: adjust_salt , old_fit - real :: dT_dS real, parameter :: T_max = 35.0, T_min = -2.0 - real, parameter :: S_min = 0.5, S_max=65.0 - real, parameter :: tol=1.e-4, max_t_adj=1.0, max_s_adj = 0.5 #else -!> This subroutine determines the potential temperature and -!! salinity that is consistent with the target density -!! using provided initial guess -subroutine determine_temperature(temp,salt,R,p_ref,niter,land_fill,h,k_start,eos) - real, dimension(:,:,:), intent(inout) :: temp !< potential temperature (degC) - real, dimension(:,:,:), intent(inout) :: salt !< salinity (PSU) - real, dimension(size(temp,3)), intent(in) :: R !< desired potential density, in kg m-3. - real, intent(in) :: p_ref !< reference pressure, in Pa. - integer, intent(in) :: niter !< maximum number of iterations - integer, intent(in) :: k_start !< starting index (i.e. below the buffer layer) - real, intent(in) :: land_fill !< land fill value - real, dimension(:,:,:), intent(in) :: h !< layer thickness . Do not iterate for massless layers - type(eos_type), pointer :: eos !< seawater equation of state control structure - ! Local variables - real(kind=8), dimension(size(temp,1),size(temp,3)) :: T,S,dT,dS,rho,hin - real(kind=8), dimension(size(temp,1),size(temp,3)) :: drho_dT,drho_dS +!> This subroutine determines the potential temperature and salinity that +!! is consistent with the target density using provided initial guess +subroutine determine_temperature(temp, salt, R, p_ref, niter, land_fill, h, k_start, eos) + real, dimension(:,:,:), intent(inout) :: temp !< potential temperature (degC) + real, dimension(:,:,:), intent(inout) :: salt !< salinity (PSU) + real, dimension(size(temp,3)), intent(in) :: R !< desired potential density, in kg m-3. + real, intent(in) :: p_ref !< reference pressure, in Pa. + integer, intent(in) :: niter !< maximum number of iterations + integer, intent(in) :: k_start !< starting index (i.e. below the buffer layer) + real, intent(in) :: land_fill !< land fill value + real, dimension(:,:,:), intent(in) :: h !< layer thickness, used only to avoid working on massless layers + type(eos_type), pointer :: eos !< seawater equation of state control structure + + real, parameter :: T_max = 31.0, T_min = -2.0 +#endif + ! Local variables (All of which need documentation!) + real(kind=8), dimension(size(temp,1),size(temp,3)) :: T, S, dT, dS, rho, hin + real(kind=8), dimension(size(temp,1),size(temp,3)) :: drho_dT, drho_dS real(kind=8), dimension(size(temp,1)) :: press - integer :: nx,ny,nz,nt,i,j,k,n,itt + integer :: nx, ny, nz, nt, i, j, k, n, itt real :: dT_dS - logical :: adjust_salt , old_fit - real, parameter :: T_max = 31.0, T_min = -2.0 + logical :: adjust_salt, old_fit real, parameter :: S_min = 0.5, S_max=65.0 real, parameter :: tol=1.e-4, max_t_adj=1.0, max_s_adj = 0.5 -#endif old_fit = .true. ! reproduces siena behavior - ! will switch to the newer - ! method which simultaneously adjusts - ! temp and salt based on the ratio - ! of the thermal and haline coefficients. + ! will switch to the newer method which simultaneously adjusts + ! temp and salt based on the ratio of the thermal and haline coefficients. - nx=size(temp,1);ny=size(temp,2); nz=size(temp,3) + nx=size(temp,1) ; ny=size(temp,2) ; nz=size(temp,3) press(:) = p_ref @@ -432,72 +422,59 @@ subroutine determine_temperature(temp,salt,R,p_ref,niter,land_fill,h,k_start,eos drho_dT=alpha_wright_eos_2d(T,S,p_ref) #else do k=1, nz - call calculate_density(T(:,k),S(:,k),press,rho(:,k),1,nx,eos) - call calculate_density_derivs(T(:,k),S(:,k),press,drho_dT(:,k),drho_dS(:,k),1,nx,eos) + call calculate_density(T(:,k), S(:,k), press, rho(:,k), 1, nx, eos) + call calculate_density_derivs(T(:,k), S(:,k), press, drho_dT(:,k), drho_dS(:,k), 1, nx, eos) enddo #endif - do k=k_start,nz - do i=1,nx - -! if (abs(rho(i,k)-R(k))>tol .and. hin(i,k)>epsln .and. abs(T(i,k)-land_fill) < epsln) then - if (abs(rho(i,k)-R(k))>tol) then - if (old_fit) then - dT(i,k)=(R(k)-rho(i,k))/drho_dT(i,k) - if (dT(i,k)>max_t_adj) dT(i,k)=max_t_adj - if (dT(i,k)<-1.0*max_t_adj) dT(i,k)=-1.0*max_t_adj - T(i,k)=max(min(T(i,k)+dT(i,k),T_max),T_min) - else - dT_dS = 10.0 - min(-drho_dT(i,k)/drho_dS(i,k),10.) - dS(i,k) = (R(k)-rho(i,k))/(drho_dS(i,k) - drho_dT(i,k)*dT_dS ) - dT(i,k)= -dT_dS*dS(i,k) -! if (dT(i,k)>max_t_adj) dT(i,k)=max_t_adj -! if (dT(i,k)<-1.0*max_t_adj) dT(i,k)=-1.0*max_t_adj - T(i,k)=max(min(T(i,k)+dT(i,k),T_max),T_min) - S(i,k)=max(min(S(i,k)+dS(i,k),S_max),S_min) - endif + do k=k_start,nz ; do i=1,nx + +! if (abs(rho(i,k)-R(k))>tol .and. hin(i,k)>epsln .and. abs(T(i,k)-land_fill) < epsln) then + if (abs(rho(i,k)-R(k))>tol) then + if (old_fit) then + dT(i,k) = max(min((R(k)-rho(i,k)) / drho_dT(i,k), max_t_adj), -max_t_adj) + T(i,k) = max(min(T(i,k)+dT(i,k), T_max), T_min) + else + dT_dS = 10.0 - min(-drho_dT(i,k)/drho_dS(i,k),10.) + !### RWH: Based on the dimensions alone, the expression above should be: + ! dT_dS = 10.0 - min(-drho_dS(i,k)/drho_dT(i,k),10.) + dS(i,k) = (R(k)-rho(i,k)) / (drho_dS(i,k) - drho_dT(i,k)*dT_dS ) + dT(i,k) = -dT_dS*dS(i,k) + ! dT(i,k) = max(min(dT(i,k), max_t_adj), -max_t_adj) + T(i,k) = max(min(T(i,k)+dT(i,k), T_max), T_min) + S(i,k) = max(min(S(i,k)+dS(i,k), S_max), S_min) endif - enddo - enddo + endif + enddo ; enddo if (maxval(abs(dT)) < tol) then adjust_salt = .false. exit iter_loop endif enddo iter_loop - if (adjust_salt .and. old_fit) then - iter_loop2: do itt = 1,niter + if (adjust_salt .and. old_fit) then ; do itt = 1,niter #ifdef PY_SOLO - rho=wright_eos_2d(T,S,p_ref) - drho_dS=beta_wright_eos_2d(T,S,p_ref) + rho = wright_eos_2d(T,S,p_ref) + drho_dS = beta_wright_eos_2d(T,S,p_ref) #else - do k=1, nz - call calculate_density(T(:,k),S(:,k),press,rho(:,k),1,nx,eos) - call calculate_density_derivs(T(:,k),S(:,k),press,drho_dT(:,k),drho_dS(:,k),1,nx,eos) - enddo + do k=1, nz + call calculate_density(T(:,k),S(:,k),press,rho(:,k),1,nx,eos) + call calculate_density_derivs(T(:,k),S(:,k),press,drho_dT(:,k),drho_dS(:,k),1,nx,eos) + enddo #endif - do k=k_start,nz - do i=1,nx -! if (abs(rho(i,k)-R(k))>tol .and. hin(i,k)>epsln .and. abs(T(i,k)-land_fill) < epsln ) then - if (abs(rho(i,k)-R(k))>tol ) then - dS(i,k)=(R(k)-rho(i,k))/drho_dS(i,k) - if (dS(i,k)>max_s_adj) dS(i,k)=max_s_adj - if (dS(i,k)<-1.0*max_s_adj) dS(i,k)=-1.0*max_s_adj - S(i,k)=max(min(S(i,k)+dS(i,k),S_max),S_min) - endif - enddo - enddo - if (maxval(abs(dS)) < tol) then - exit iter_loop2 - endif - enddo iter_loop2 - endif + do k=k_start,nz ; do i=1,nx +! if (abs(rho(i,k)-R(k))>tol .and. hin(i,k)>epsln .and. abs(T(i,k)-land_fill) < epsln ) then + if (abs(rho(i,k)-R(k)) > tol) then + dS(i,k) = max(min((R(k)-rho(i,k)) / drho_dS(i,k), max_s_adj), -max_s_adj) + S(i,k) = max(min(S(i,k)+dS(i,k), S_max), S_min) + endif + enddo ; enddo + if (maxval(abs(dS)) < tol) exit + enddo ; endif temp(:,j,:)=T(:,:) salt(:,j,:)=S(:,:) enddo - return - end subroutine determine_temperature !> This subroutine determines the layers bounded by interfaces e that overlap @@ -520,43 +497,42 @@ subroutine find_overlap(e, Z_top, Z_bot, k_max, k_start, k_top, k_bot, wt, z1, z real :: Ih, e_c, tot_wt, I_totwt integer :: k - wt(:)=0.0; z1(:)=0.0; z2(:)=0.0 - k_top = k_start; k_bot= k_start; wt(1) = 1.0; z1(1)=-0.5; z2(1) = 0.5 - - do k=k_start,k_max ;if (e(k+1)k_max) return - - ! Determine the fractional weights of each layer. - ! Note that by convention, e and Z_int decrease with increasing k. - if (e(k+1)<=Z_bot) then - wt(k) = 1.0 ; k_bot = k - Ih = 1.0 / (e(k)-e(k+1)) - e_c = 0.5*(e(k)+e(k+1)) - z1(k) = (e_c - MIN(e(k),Z_top)) * Ih - z2(k) = (e_c - Z_bot) * Ih - else - wt(k) = MIN(e(k),Z_top) - e(k+1) ; tot_wt = wt(k) ! These are always > 0. - z1(k) = (0.5*(e(k)+e(k+1)) - MIN(e(k),Z_top)) / (e(k)-e(k+1)) - z2(k) = 0.5 - k_bot = k_max - do k=k_top+1,k_max - if (e(k+1)<=Z_bot) then - k_bot = k - wt(k) = e(k) - Z_bot ; z1(k) = -0.5 - z2(k) = (0.5*(e(k)+e(k+1)) - Z_bot) / (e(k)-e(k+1)) - else - wt(k) = e(k) - e(k+1) ; z1(k) = -0.5 ; z2(k) = 0.5 - endif - tot_wt = tot_wt + wt(k) ! wt(k) is always > 0. - if (k>=k_bot) exit - enddo - - I_totwt = 1.0 / tot_wt - do k=k_top,k_bot ; wt(k) = I_totwt*wt(k) ; enddo + wt(:)=0.0 ; z1(:)=0.0 ; z2(:)=0.0 + k_top = k_start ; k_bot = k_start ; wt(1) = 1.0 ; z1(1) = -0.5 ; z2(1) = 0.5 + + do k=k_start,k_max ; if (e(k+1) < Z_top) exit ; enddo + k_top = k + + if (k>k_max) return + + ! Determine the fractional weights of each layer. + ! Note that by convention, e and Z_int decrease with increasing k. + if (e(k+1) <= Z_bot) then + wt(k) = 1.0 ; k_bot = k + Ih = 1.0 / (e(k)-e(k+1)) + e_c = 0.5*(e(k)+e(k+1)) + z1(k) = (e_c - MIN(e(k),Z_top)) * Ih + z2(k) = (e_c - Z_bot) * Ih + else + wt(k) = MIN(e(k),Z_top) - e(k+1) ; tot_wt = wt(k) ! These are always > 0. + z1(k) = (0.5*(e(k)+e(k+1)) - MIN(e(k),Z_top)) / (e(k)-e(k+1)) + z2(k) = 0.5 + k_bot = k_max + do k=k_top+1,k_max + if (e(k+1) <= Z_bot) then + k_bot = k + wt(k) = e(k) - Z_bot ; z1(k) = -0.5 + z2(k) = (0.5*(e(k)+e(k+1)) - Z_bot) / (e(k)-e(k+1)) + else + wt(k) = e(k) - e(k+1) ; z1(k) = -0.5 ; z2(k) = 0.5 endif + tot_wt = tot_wt + wt(k) ! wt(k) is always > 0. + if (k>=k_bot) exit + enddo - return + I_totwt = 0.0 ; if (tot_wt > 0.0) I_totwt = 1.0 / tot_wt + do k=k_top,k_bot ; wt(k) = I_totwt*wt(k) ; enddo + endif end subroutine find_overlap @@ -564,33 +540,28 @@ end subroutine find_overlap !! a piecewise limited scheme. function find_limited_slope(val, e, k) result(slope) real, dimension(:), intent(in) :: val !< An column the values that are being interpolated. - real, dimension(:), intent(in) :: e !< A column's interface heights, in m. - integer, intent(in) :: k !< The layer whose slope is being determined. + real, dimension(:), intent(in) :: e !< A column's interface heights, in m. + integer, intent(in) :: k !< The layer whose slope is being determined. real :: slope !< The normalized slope in the intracell distribution of val. ! Local variables - real :: amx,bmx,amn,bmn,cmn,dmn + real :: amn, cmn real :: d1, d2 if ((val(k)-val(k-1)) * (val(k)-val(k+1)) >= 0.0) then - slope = 0.0 ! ; curvature = 0.0 + slope = 0.0 ! ; curvature = 0.0 else - d1 = 0.5*(e(k-1)-e(k+1)) ; d2 = 0.5*(e(k)-e(k+2)) - slope = ((d1**2)*(val(k+1) - val(k)) + (d2**2)*(val(k) - val(k-1))) * & - (e(k) - e(k+1)) / (d1*d2*(d1+d2)) - ! slope = 0.5*(val(k+1) - val(k-1)) - ! This is S.J. Lin's form of the PLM limiter. - amx=max(val(k-1),val(k)) - bmx = max(amx,val(k+1)) - amn = min(abs(slope),2.0*(bmx-val(k))) - bmn = min(val(k-1),val(k)) - cmn = 2.0*(val(k)-min(bmn,val(k+1))) - dmn = min(amn,cmn) - slope = sign(1.0,slope) * dmn - - ! min(abs(slope), & - ! 2.0*(max(val(k-1),val(k),val(k+1)) - val(k)), & - ! 2.0*(val(k) - min(val(k-1),val(k),val(k+1)))) - ! curvature = 0.0 + d1 = 0.5*(e(k-1)-e(k+1)) ; d2 = 0.5*(e(k)-e(k+2)) + slope = ((d1**2)*(val(k+1) - val(k)) + (d2**2)*(val(k) - val(k-1))) * & + (e(k) - e(k+1)) / (d1*d2*(d1+d2)) + ! slope = 0.5*(val(k+1) - val(k-1)) + ! This is S.J. Lin's form of the PLM limiter. + amn = min(abs(slope), 2.0*(max(val(k-1), val(k), val(k+1)) - val(k))) + cmn = 2.0*(val(k) - min(val(k-1), val(k), val(k+1))) + slope = sign(1.0, slope) * min(amn, cmn) + + ! min(abs(slope), 2.0*(max(val(k-1),val(k),val(k+1)) - val(k)), & + ! 2.0*(val(k) - min(val(k-1),val(k),val(k+1)))) + ! curvature = 0.0 endif return From 953df9d8cc433302a5863c02f8e1308cbb097beb Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 30 Aug 2018 16:55:58 -0400 Subject: [PATCH 058/174] +Added optional arg. m_to_Z to calc_tidal_forcing Added a new optional argument, m_to_Z, to calc_tidal_forcing to enable the interface height and tidal height anomaly to use units other than m. All answers are bitwise identical, but there is a new optional argument. --- .../lateral/MOM_tidal_forcing.F90 | 31 +++++++++++-------- 1 file changed, 18 insertions(+), 13 deletions(-) diff --git a/src/parameterizations/lateral/MOM_tidal_forcing.F90 b/src/parameterizations/lateral/MOM_tidal_forcing.F90 index 95c9b10047..a552bfe1ca 100644 --- a/src/parameterizations/lateral/MOM_tidal_forcing.F90 +++ b/src/parameterizations/lateral/MOM_tidal_forcing.F90 @@ -393,28 +393,31 @@ end subroutine tidal_forcing_sensitivity !> This subroutine calculates the geopotential anomalies that drive the tides, !! including self-attraction and loading. Optionally, it also returns the !! partial derivative of the local geopotential height with the input sea surface -!! height. For now, eta and eta_tidal are both geopotential heights in m, but -!! probably the input for eta should really be replaced with the column mass -!! anomalies. -subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, deta_tidal_deta) +!! height. For now, eta and eta_tidal are both geopotential heights in depth +!! units, but probably the input for eta should really be replaced with the +!! column mass anomalies. +subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, deta_tidal_deta, m_to_Z) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(time_type), intent(in) :: Time !< The time for the caluculation. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta !< The sea surface height anomaly from - !! a time-mean geoid in m. - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_tidal !< The tidal forcing geopotential - !! anomalies, in m. + !! a time-mean geoid in depth units (Z). + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_tidal !< The tidal forcing geopotential height + !! anomalies, in depth units (Z). type(tidal_forcing_CS), pointer :: CS !< The control structure returned by a !! previous call to tidal_forcing_init. real, optional, intent(out) :: deta_tidal_deta !< The partial derivative of !! eta_tidal with the local value of !! eta, nondim. + real, optional, intent(in) :: m_to_Z !< A scaling factor from m to the units of eta. + ! Local variables real :: eta_astro(SZI_(G),SZJ_(G)) real :: eta_SAL(SZI_(G),SZJ_(G)) real :: now ! The relative time in seconds. real :: amp_cosomegat, amp_sinomegat real :: cosomegat, sinomegat - real :: eta_prop + real :: m_Z ! A scaling factor from m to depth units. + real :: eta_prop ! The nondimenional constant of proportionality beteen eta and eta_tidal. integer :: i, j, c, m, is, ie, js, je, Isq, Ieq, Jsq, Jeq is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -447,10 +450,12 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, deta_tidal_deta) enddo ; enddo endif + m_Z = 1.0 ; if (present(m_to_Z)) m_Z = m_to_Z + do c=1,CS%nc m = CS%struct(c) - amp_cosomegat = CS%amp(c)*CS%love_no(c)*cos(CS%freq(c)*now + CS%phase0(c)) - amp_sinomegat = CS%amp(c)*CS%love_no(c)*sin(CS%freq(c)*now + CS%phase0(c)) + amp_cosomegat = m_Z*CS%amp(c)*CS%love_no(c) * cos(CS%freq(c)*now + CS%phase0(c)) + amp_sinomegat = m_Z*CS%amp(c)*CS%love_no(c) * sin(CS%freq(c)*now + CS%phase0(c)) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 eta_tidal(i,j) = eta_tidal(i,j) + (amp_cosomegat*CS%cos_struct(i,j,m) + & amp_sinomegat*CS%sin_struct(i,j,m)) @@ -461,7 +466,7 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, deta_tidal_deta) cosomegat = cos(CS%freq(c)*now) sinomegat = sin(CS%freq(c)*now) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta_tidal(i,j) = eta_tidal(i,j) + CS%ampsal(i,j,c) * & + eta_tidal(i,j) = eta_tidal(i,j) + m_Z*CS%ampsal(i,j,c) * & (cosomegat*CS%cosphasesal(i,j,c) + sinomegat*CS%sinphasesal(i,j,c)) enddo ; enddo enddo ; endif @@ -470,8 +475,8 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, deta_tidal_deta) cosomegat = cos(CS%freq(c)*now) sinomegat = sin(CS%freq(c)*now) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta_tidal(i,j) = eta_tidal(i,j) - CS%SAL_SCALAR*CS%amp_prev(i,j,c) * & - (cosomegat*CS%cosphase_prev(i,j,c)+sinomegat*CS%sinphase_prev(i,j,c)) + eta_tidal(i,j) = eta_tidal(i,j) - m_Z*CS%SAL_SCALAR*CS%amp_prev(i,j,c) * & + (cosomegat*CS%cosphase_prev(i,j,c) + sinomegat*CS%sinphase_prev(i,j,c)) enddo ; enddo enddo ; endif From caf426313ef3fbb8cf51af8dbb82b930b9de7912 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 30 Aug 2018 16:59:50 -0400 Subject: [PATCH 059/174] Calculate e_tidal in depth units Change e_tidal from m to depth units in the Boussinesq pressure gradient force calculations. Also simplified MOM_PressureForce_Montgomery openMP directives. All answers are bitwise identical for no Z-rescaling or for rescaling by 2^93 or 2^-93. --- src/core/MOM_PressureForce.F90 | 2 +- src/core/MOM_PressureForce_Montgomery.F90 | 108 +++++++++------------ src/core/MOM_PressureForce_analytic_FV.F90 | 22 ++--- src/core/MOM_PressureForce_blocked_AFV.F90 | 20 ++-- 4 files changed, 66 insertions(+), 86 deletions(-) diff --git a/src/core/MOM_PressureForce.F90 b/src/core/MOM_PressureForce.F90 index d1a2a41a38..ebefd38bcf 100644 --- a/src/core/MOM_PressureForce.F90 +++ b/src/core/MOM_PressureForce.F90 @@ -16,7 +16,7 @@ module MOM_PressureForce use MOM_PressureForce_Mont, only : PressureForce_Mont_Bouss, PressureForce_Mont_nonBouss use MOM_PressureForce_Mont, only : PressureForce_Mont_init, PressureForce_Mont_end use MOM_PressureForce_Mont, only : PressureForce_Mont_CS -use MOM_tidal_forcing, only : calc_tidal_forcing, tidal_forcing_CS +use MOM_tidal_forcing, only : tidal_forcing_CS use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_ALE, only: ALE_CS diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 1e9e41eb9a..0548cc0dd2 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -143,36 +143,30 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, I_gEarth = 1.0 / GV%g_Earth dp_neglect = GV%H_to_Pa * GV%H_subroundoff -!$OMP parallel default(none) shared(nz,alpha_Lay,GV,dalpha_int) -!$OMP do do k=1,nz ; alpha_Lay(k) = 1.0 / GV%Rlay(k) ; enddo -!$OMP do do k=2,nz ; dalpha_int(K) = alpha_Lay(k-1) - alpha_Lay(k) ; enddo -!$OMP end parallel -!$OMP parallel default(none) shared(Isq,Ieq,Jsq,Jeq,nz,p,p_atm,GV,h,use_p_atm) if (use_p_atm) then -!$OMP do + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 ; p(i,j,1) = p_atm(i,j) ; enddo ; enddo else -!$OMP do + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 ; p(i,j,1) = 0.0 ; enddo ; enddo endif -!$OMP do + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do k=1,nz ; do i=Isq,Ieq+1 p(i,j,K+1) = p(i,j,K) + GV%H_to_Pa * h(i,j,k) enddo ; enddo ; enddo -!$OMP end parallel if (present(eta)) then Pa_to_H = 1.0 / GV%H_to_Pa if (use_p_atm) then -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,eta,p,p_atm,Pa_to_H) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 eta(i,j) = (p(i,j,nz+1) - p_atm(i,j))*Pa_to_H ! eta has the same units as h. enddo ; enddo else -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,eta,p,Pa_to_H) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 eta(i,j) = p(i,j,nz+1)*Pa_to_H ! eta has the same units as h. enddo ; enddo @@ -182,39 +176,36 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, if (CS%tides) then ! Determine the sea surface height anomalies, to enable the calculation ! of self-attraction and loading. -!$OMP parallel default(none) shared(Isq,Ieq,Jsq,Jeq,nz,SSH,G,GV,use_EOS,tv,p,dz_geo, & -!$OMP I_gEarth,h,alpha_Lay) -!$OMP do + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - SSH(i,j) = -G%Zd_to_m*G%bathyT(i,j) + SSH(i,j) = -GV%Z_to_m*G%bathyT(i,j) enddo ; enddo if (use_EOS) then -!$OMP do + !$OMP parallel do default(shared) do k=1,nz call int_specific_vol_dp(tv%T(:,:,k), tv%S(:,:,k), p(:,:,k), p(:,:,k+1), & 0.0, G%HI, tv%eqn_of_state, dz_geo(:,:,k), halo_size=1) enddo -!$OMP do + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do k=1,nz; do i=Isq,Ieq+1 SSH(i,j) = SSH(i,j) + I_gEarth * dz_geo(i,j,k) enddo ; enddo ; enddo else -!$OMP do + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do k=1,nz ; do i=Isq,Ieq+1 SSH(i,j) = SSH(i,j) + GV%H_to_kg_m2*h(i,j,k)*alpha_Lay(k) enddo ; enddo ; enddo endif -!$OMP end parallel - call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp) -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,geopot_bot,G,GV,e_tidal) + call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=1.0) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - geopot_bot(i,j) = -GV%g_Earth*(e_tidal(i,j) + G%Zd_to_m*G%bathyT(i,j)) + geopot_bot(i,j) = -GV%g_Earth*(e_tidal(i,j) + GV%Z_to_m*G%bathyT(i,j)) enddo ; enddo else -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,geopot_bot,G,GV) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - geopot_bot(i,j) = -GV%g_Earth*G%Zd_to_m*G%bathyT(i,j) + geopot_bot(i,j) = -GV%g_Earth*GV%Z_to_m*G%bathyT(i,j) enddo ; enddo endif @@ -229,8 +220,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, tv_tmp%T => T_tmp ; tv_tmp%S => S_tmp tv_tmp%eqn_of_state => tv%eqn_of_state do i=Isq,Ieq+1 ; p_ref(i) = tv%P_Ref ; enddo -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,nkmb,tv_tmp,tv,p_ref,GV) & -!$OMP private(Rho_cv_BL) + !$OMP parallel do default(shared) private(Rho_cv_BL) do j=Jsq,Jeq+1 do k=1,nkmb ; do i=Isq,Ieq+1 tv_tmp%T(i,j,k) = tv%T(i,j,k) ; tv_tmp%S(i,j,k) = tv%S(i,j,k) @@ -250,8 +240,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, tv_tmp%eqn_of_state => tv%eqn_of_state do i=Isq,Ieq+1 ; p_ref(i) = 0 ; enddo endif -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,tv_tmp,p_ref,tv,alpha_star) & -!$OMP private(rho_in_situ) + !$OMP parallel do default(shared) private(rho_in_situ) do k=1,nz ; do j=Jsq,Jeq+1 call calculate_density(tv_tmp%T(:,j,k),tv_tmp%S(:,j,k),p_ref, & rho_in_situ,Isq,Ieq-Isq+2,tv%eqn_of_state) @@ -260,7 +249,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, endif ! use_EOS if (use_EOS) then -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,M,geopot_bot,p,alpha_star) + !$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) @@ -270,8 +259,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, enddo ; enddo enddo else ! not use_EOS -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,M,geopot_bot,p,& -!$OMP alpha_Lay,dalpha_int) + !$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) @@ -284,11 +272,11 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, if (CS%GFS_scale < 1.0) then ! Adjust the Montgomery potential to make this a reduced gravity model. -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,dM,CS,M) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 dM(i,j) = (CS%GFS_scale - 1.0) * M(i,j,1) enddo ; enddo -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,dM,M) + !$OMP parallel do default(shared) do k=1,nz ; do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 M(i,j,k) = M(i,j,k) + dM(i,j) enddo ; enddo ; enddo @@ -319,9 +307,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, ! Calculate the pressure force. On a Cartesian grid, ! PFu = - dM/dx and PFv = - dM/dy. if (use_EOS) then -!$OMP parallel do default(none) shared(is,ie,js,je,Isq,Ieq,Jsq,Jeq,nz,p,dp_neglect, & -!$OMP alpha_star,G,PFu,PFv,M,CS) & -!$OMP private(dp_star,PFu_bc,PFv_bc) + !$OMP parallel do default(shared) private(dp_star,PFu_bc,PFv_bc) do k=1,nz do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 dp_star(i,j) = (p(i,j,K+1) - p(i,j,K)) + dp_neglect @@ -343,7 +329,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, enddo ; enddo enddo ! k-loop else ! .not. use_EOS -!$OMP parallel do default(none) shared(is,ie,js,je,Isq,Ieq,Jsq,Jeq,nz,PFu,PFv,M,G) + !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * G%IdxCu(I,j) @@ -405,7 +391,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta ! for compressibility, in m. real :: e_tidal(SZI_(G),SZJ_(G)) ! Bottom geopotential anomaly due to tidal ! forces from astronomical sources and self- - ! attraction and loading, in m. + ! attraction and loading, in depth units (Z). real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density, in Pa (usually 2e7 Pa = 2000 dbar). real :: I_Rho0 ! 1/Rho0. @@ -451,36 +437,34 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta ! and loading. This should really be based on bottom pressure anomalies, ! but that is not yet implemented, and the current form is correct for ! barotropic tides. -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,e,h,G,GV) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 - do i=Isq,Ieq+1 ; e(i,j,1) = -G%Zd_to_m*G%bathyT(i,j) ; enddo + do i=Isq,Ieq+1 ; e(i,j,1) = -G%bathyT(i,j) ; enddo do k=1,nz ; do i=Isq,Ieq+1 - e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_m + e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_Z enddo ; enddo enddo - call calc_tidal_forcing(CS%Time, e(:,:,1), e_tidal, G, CS%tides_CSp) + call calc_tidal_forcing(CS%Time, e(:,:,1), e_tidal, G, CS%tides_CSp, m_to_Z=GV%m_to_Z) endif ! Here layer interface heights, e, are calculated. -!$OMP parallel default(none) shared(Isq,Ieq,Jsq,Jeq,nz,e,h,G,GV,e_tidal,CS) if (CS%tides) then -!$OMP do + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) - e_tidal(i,j) + e(i,j,nz+1) = -GV%Z_to_m*(G%bathyT(i,j) + e_tidal(i,j)) enddo ; enddo else -!$OMP do + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) + e(i,j,nz+1) = -GV%Z_to_m*G%bathyT(i,j) enddo ; enddo endif -!$OMP do + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do k=nz,1,-1 ; do i=Isq,Ieq+1 e(i,j,K) = e(i,j,K+1) + h(i,j,k)*GV%H_to_m enddo ; enddo ; enddo -!$OMP end parallel - if (use_EOS) then + if (use_EOS) then ! Calculate in-situ densities (rho_star). ! With a bulk mixed layer, replace the T & S of any layers that are @@ -493,8 +477,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta tv_tmp%eqn_of_state => tv%eqn_of_state do i=Isq,Ieq+1 ; p_ref(i) = tv%P_Ref ; enddo -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,nkmb,tv_tmp,tv,p_ref,GV) & -!$OMP private(Rho_cv_BL) + !$OMP parallel do default(shared) private(Rho_cv_BL) do j=Jsq,Jeq+1 do k=1,nkmb ; do i=Isq,Ieq+1 tv_tmp%T(i,j,k) = tv%T(i,j,k) ; tv_tmp%S(i,j,k) = tv%S(i,j,k) @@ -518,7 +501,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta ! This no longer includes any pressure dependency, since this routine ! will come down with a fatal error if there is any compressibility. -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,tv_tmp,p_ref,rho_star,tv,G_Rho0) + !$OMP parallel do default(shared) do k=1,nz+1 ; do j=Jsq,Jeq+1 call calculate_density(tv_tmp%T(:,j,k), tv_tmp%S(:,j,k), p_ref, rho_star(:,j,k), & Isq,Ieq-Isq+2,tv%eqn_of_state) @@ -528,8 +511,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta ! Here the layer Montgomery potentials, M, are calculated. if (use_EOS) then -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,M,CS,rho_star,e,use_p_atm, & -!$OMP p_atm,I_Rho0) + !$OMP parallel do default(shared) 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)) @@ -540,7 +522,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta enddo ; enddo enddo else ! not use_EOS -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,M,GV,e,use_p_atm,p_atm,I_Rho0) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 M(i,j,1) = GV%g_prime(1) * e(i,j,1) @@ -560,9 +542,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta ! Calculate the pressure force. On a Cartesian grid, ! PFu = - dM/dx and PFv = - dM/dy. if (use_EOS) then -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,js,je,is,ie,nz,e,h_neglect, & -!$OMP rho_star,G,PFu,CS,PFv,M) & -!$OMP private(h_star,PFu_bc,PFv_bc) + !$OMP parallel do default(shared) private(h_star,PFu_bc,PFv_bc) do k=1,nz do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 h_star(i,j) = (e(i,j,K) - e(i,j,K+1)) + h_neglect @@ -583,7 +563,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta enddo ; enddo enddo ! k-loop else ! .not. use_EOS -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,is,ie,js,je,nz,PFu,PFv,M,G) + !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * G%IdxCu(I,j) @@ -599,12 +579,12 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta ! eta is the sea surface height relative to a time-invariant geoid, for ! comparison with what is used for eta in btstep. See how e was calculated ! about 200 lines above. -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,eta,e,e_tidal,GV) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta(i,j) = e(i,j,1)*GV%m_to_H + e_tidal(i,j)*GV%m_to_H + eta(i,j) = e(i,j,1)*GV%m_to_H + e_tidal(i,j)*GV%Z_to_H enddo ; enddo else -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,eta,e,GV) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 eta(i,j) = e(i,j,1)*GV%m_to_H enddo ; enddo @@ -613,7 +593,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta if (CS%id_PFu_bc>0) call post_data(CS%id_PFu_bc, CS%PFu_bc, CS%diag) if (CS%id_PFv_bc>0) call post_data(CS%id_PFv_bc, CS%PFv_bc, CS%diag) - if (CS%id_e_tidal>0) call post_data(CS%id_e_tidal, e_tidal, CS%diag) + if (CS%id_e_tidal>0) call post_data(CS%id_e_tidal, GV%Z_to_m*e_tidal(:,:), CS%diag) end subroutine PressureForce_Mont_Bouss diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index 9bf98856d8..2158d98b3f 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -302,7 +302,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - za(i,j) = alpha_ref*p(i,j,nz+1) - GV%g_Earth*G%Zd_to_m*G%bathyT(i,j) + za(i,j) = alpha_ref*p(i,j,nz+1) - GV%g_Earth*GV%Z_to_m*G%bathyT(i,j) enddo do k=nz,1,-1 ; do i=Isq,Ieq+1 za(i,j) = za(i,j) + dza(i,j,k) @@ -315,7 +315,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 SSH(i,j) = (za(i,j) - alpha_ref*p(i,j,1)) * I_gEarth enddo ; enddo - call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp) + call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=1.0) !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 za(i,j) = za(i,j) - GV%g_Earth*e_tidal(i,j) @@ -455,7 +455,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p real, dimension(SZI_(G),SZJ_(G)) :: & e_tidal, & ! The bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading, in m. - z_bathy, & ! The height of the bathymetry, in m. + z_bathy, & ! The height of the bathymetry, in depth units (Z). dM ! The barotropic adjustment to the Montgomery potential to ! account for a reduced gravity model, in m2 s-2. real, dimension(SZI_(G)) :: & @@ -527,7 +527,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p rho_ref = CS%Rho0 do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - z_bathy(i,j) = G%Zd_to_m*G%bathyT(i,j) + z_bathy(i,j) = GV%Z_to_m*G%bathyT(i,j) enddo ; enddo if (CS%tides) then @@ -538,25 +538,25 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - e(i,j,1) = -G%Zd_to_m*G%bathyT(i,j) + e(i,j,1) = -G%bathyT(i,j) enddo do k=1,nz ; do i=Isq,Ieq+1 - e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_m + e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_Z enddo ; enddo enddo - call calc_tidal_forcing(CS%Time, e(:,:,1), e_tidal, G, CS%tides_CSp) + call calc_tidal_forcing(CS%Time, e(:,:,1), e_tidal, G, CS%tides_CSp, m_to_Z=GV%m_to_Z) endif ! Here layer interface heights, e, are calculated. if (CS%tides) then !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) - e_tidal(i,j) + e(i,j,nz+1) = -GV%Z_to_m*(G%bathyT(i,j) + e_tidal(i,j)) enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) + e(i,j,nz+1) = -GV%Z_to_m*G%bathyT(i,j) enddo ; enddo endif !$OMP parallel do default(shared) @@ -762,7 +762,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p ! about 200 lines above. !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta(i,j) = e(i,j,1)*GV%m_to_H + e_tidal(i,j)*GV%m_to_H + eta(i,j) = e(i,j,1)*GV%m_to_H + e_tidal(i,j)*GV%Z_to_H enddo ; enddo else !$OMP parallel do default(shared) @@ -772,7 +772,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p endif endif - if (CS%id_e_tidal>0) call post_data(CS%id_e_tidal, e_tidal, CS%diag) + if (CS%id_e_tidal>0) call post_data(CS%id_e_tidal, GV%Z_to_m*e_tidal(:,:), CS%diag) end subroutine PressureForce_AFV_Bouss diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index 1d2d84e98c..8c173fff4b 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -269,7 +269,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - za(i,j) = alpha_ref*p(i,j,nz+1) - GV%g_Earth*G%Zd_to_m*G%bathyT(i,j) + za(i,j) = alpha_ref*p(i,j,nz+1) - GV%g_Earth*GV%Z_to_m*G%bathyT(i,j) enddo do k=nz,1,-1 ; do i=Isq,Ieq+1 za(i,j) = za(i,j) + dza(i,j,k) @@ -282,7 +282,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 SSH(i,j) = (za(i,j) - alpha_ref*p(i,j,1)) * I_gEarth enddo ; enddo - call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp) + call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=1.0) !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 za(i,j) = za(i,j) - GV%g_Earth*e_tidal(i,j) @@ -437,7 +437,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: e ! Interface height in m. real, dimension(SZI_(G),SZJ_(G)) :: & e_tidal, & ! The bottom geopotential anomaly due to tidal forces from - ! astronomical sources and self-attraction and loading, in m. + ! astronomical sources and self-attraction and loading, in depth units (Z). z_bathy, & ! The height of the bathymetry, in m. dM ! The barotropic adjustment to the Montgomery potential to ! account for a reduced gravity model, in m2 s-2. @@ -512,7 +512,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at rho_ref = CS%Rho0 do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - z_bathy(i,j) = G%Zd_to_m*G%bathyT(i,j) + z_bathy(i,j) = GV%Z_to_m*G%bathyT(i,j) enddo ; enddo if (CS%tides) then @@ -523,25 +523,25 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - e(i,j,1) = -G%Zd_to_m*G%bathyT(i,j) + e(i,j,1) = -GV%Z_to_m*G%bathyT(i,j) enddo do k=1,nz ; do i=Isq,Ieq+1 e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_m enddo ; enddo enddo - call calc_tidal_forcing(CS%Time, e(:,:,1), e_tidal, G, CS%tides_CSp) + call calc_tidal_forcing(CS%Time, e(:,:,1), e_tidal, G, CS%tides_CSp, m_to_Z=GV%m_to_Z) endif ! Here layer interface heights, e, are calculated. if (CS%tides) then !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) - e_tidal(i,j) + e(i,j,nz+1) = -GV%Z_to_m*(G%bathyT(i,j) + e_tidal(i,j)) enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) + e(i,j,nz+1) = -GV%Z_to_m*G%bathyT(i,j) enddo ; enddo endif !$OMP parallel do default(shared) @@ -755,7 +755,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at ! about 200 lines above. !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta(i,j) = e(i,j,1)*GV%m_to_H + e_tidal(i,j)*GV%m_to_H + eta(i,j) = e(i,j,1)*GV%m_to_H + e_tidal(i,j)*GV%Z_to_H enddo ; enddo else !$OMP parallel do default(shared) @@ -765,7 +765,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at endif endif - if (CS%id_e_tidal>0) call post_data(CS%id_e_tidal, e_tidal, CS%diag) + if (CS%id_e_tidal>0) call post_data(CS%id_e_tidal, GV%Z_to_m*e_tidal(:,:), CS%diag) end subroutine PressureForce_blk_AFV_Bouss From 5907c9e14150e23560b0b246a77253bbeb7fc7f1 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 1 Sep 2018 07:45:40 -0400 Subject: [PATCH 060/174] +Boussinesq Montgomery Press Force in depth units Changed the calculatios in PressureForce_Mont_Bouss to work in depth units and added an optional argument to Set_pbce_Bouss to specify the units of the interface height arguments. All answers are bitwise identical for no Z-rescaling or for rescaling by 2^93 or 2^-93. --- src/core/MOM_PressureForce_Montgomery.F90 | 44 +++++++++++++---------- 1 file changed, 25 insertions(+), 19 deletions(-) diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 0548cc0dd2..cdff786c15 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -428,7 +428,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta "can no longer be used with a compressible EOS. Use #define ANALYTIC_FV_PGF.") endif - h_neglect = GV%H_subroundoff * GV%H_to_m + h_neglect = GV%H_subroundoff * GV%H_to_Z I_Rho0 = 1.0/CS%Rho0 G_Rho0 = GV%g_Earth/GV%Rho0 @@ -451,17 +451,17 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta if (CS%tides) then !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -GV%Z_to_m*(G%bathyT(i,j) + e_tidal(i,j)) + e(i,j,nz+1) = -(G%bathyT(i,j) + e_tidal(i,j)) enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -GV%Z_to_m*G%bathyT(i,j) + e(i,j,nz+1) = -G%bathyT(i,j) enddo ; enddo endif !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do k=nz,1,-1 ; do i=Isq,Ieq+1 - e(i,j,K) = e(i,j,K+1) + h(i,j,k)*GV%H_to_m + e(i,j,K) = e(i,j,K+1) + h(i,j,k)*GV%H_to_Z enddo ; enddo ; enddo if (use_EOS) then @@ -505,7 +505,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta do k=1,nz+1 ; do j=Jsq,Jeq+1 call calculate_density(tv_tmp%T(:,j,k), tv_tmp%S(:,j,k), p_ref, rho_star(:,j,k), & Isq,Ieq-Isq+2,tv%eqn_of_state) - do i=Isq,Ieq+1 ; rho_star(i,j,k) = G_Rho0*rho_star(i,j,k) ; enddo + do i=Isq,Ieq+1 ; rho_star(i,j,k) = GV%Z_to_m*G_Rho0*rho_star(i,j,k) ; enddo enddo ; enddo endif ! use_EOS @@ -525,18 +525,18 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - M(i,j,1) = GV%g_prime(1) * e(i,j,1) + M(i,j,1) = GV%g_prime(1) * GV%Z_to_m*e(i,j,1) if (use_p_atm) M(i,j,1) = M(i,j,1) + 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) + GV%g_prime(K) * e(i,j,K) + M(i,j,k) = M(i,j,k-1) + GV%g_prime(K) * GV%Z_to_m*e(i,j,K) enddo ; enddo enddo endif ! use_EOS if (present(pbce)) then call Set_pbce_Bouss(e, tv_tmp, G, GV, GV%g_Earth, CS%Rho0, CS%GFS_scale, pbce, & - rho_star) + rho_star, GV%m_to_Z) endif ! Calculate the pressure force. On a Cartesian grid, @@ -581,12 +581,12 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta ! about 200 lines above. !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta(i,j) = e(i,j,1)*GV%m_to_H + e_tidal(i,j)*GV%Z_to_H + eta(i,j) = e(i,j,1)*GV%Z_to_H + e_tidal(i,j)*GV%Z_to_H enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta(i,j) = e(i,j,1)*GV%m_to_H + eta(i,j) = e(i,j,1)*GV%Z_to_H enddo ; enddo endif endif @@ -599,10 +599,10 @@ end subroutine PressureForce_Mont_Bouss !> Determines the partial derivative of the acceleration due !! to pressure forces with the free surface height. -subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star) +subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star, m_to_Z) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface height, in H. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface height, in Z. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, intent(in) :: g_Earth !< The gravitational acceleration, in m s-2. real, intent(in) :: Rho0 !< The "Boussinesq" ocean density, in kg m-3. @@ -613,8 +613,10 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star intent(out) :: pbce !< The baroclinic pressure anomaly in each layer due !! to free surface height anomalies, in m2 H-1 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, in m s-2. + optional, intent(in) :: rho_star !< The layer densities (maybe compressibility + !! compensated), times g/rho_0, in m2 Z-1 s-2. + real, optional, intent(in) :: m_to_Z !< The conversion factor from m to the units of e. + ! Local variables real :: Ihtot(SZI_(G)) ! The inverse of the sum of the layer ! thicknesses, in m-1. @@ -628,16 +630,20 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star real :: Rho0xG ! g_Earth * Rho0 in kg s-2 m-2. logical :: use_EOS ! If true, density is calculated from T & S using ! an equation of state. + real :: m_Z ! The conversion factor from m to depth units + real :: Z_to_m ! The conversion factor from depth units to m real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in m. + ! in roundoff and can be neglected, in Z. integer :: Isq, Ieq, Jsq, Jeq, nz, i, j, k Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = G%ke - Rho0xG = Rho0*g_Earth + m_Z = 1.0 ; if (present(m_to_Z)) m_Z = m_to_Z + Z_to_m = 1.0 ; if (present(m_to_Z)) Z_to_m = 1.0 / m_to_Z + Rho0xG = Rho0*g_Earth*Z_to_m G_Rho0 = g_Earth/Rho0 use_EOS = associated(tv%eqn_of_state) - h_neglect = GV%H_subroundoff*GV%H_to_m + h_neglect = GV%H_subroundoff*GV%H_to_m*m_Z if (use_EOS) then if (present(rho_star)) then @@ -646,8 +652,8 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star !$OMP private(Ihtot) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - Ihtot(i) = 1.0 / (((e(i,j,1)-e(i,j,nz+1)) + h_neglect) * GV%m_to_H) - pbce(i,j,1) = GFS_scale * rho_star(i,j,1) * GV%H_to_m + Ihtot(i) = (GV%H_to_m * m_Z) / ((e(i,j,1)-e(i,j,nz+1)) + h_neglect) + pbce(i,j,1) = GFS_scale * rho_star(i,j,1) * (GV%H_to_m * m_Z) enddo do k=2,nz ; do i=Isq,Ieq+1 pbce(i,j,k) = pbce(i,j,k-1) + (rho_star(i,j,k)-rho_star(i,j,k-1)) * & From a60e67dcb4f5161279d93cc14b753a1b0146ec80 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 1 Sep 2018 07:51:26 -0400 Subject: [PATCH 061/174] Boussinesq analytic_FV Press Force in depth units Changed the calculations to use depth units in PressureForce_AFV_Bouss and PressureForce_blk_AFV_Bouss. All answers are bitwise identical for no Z-rescaling or for rescaling by 2^93 or 2^-93. --- src/core/MOM_PressureForce_analytic_FV.F90 | 48 ++++++++++----------- src/core/MOM_PressureForce_blocked_AFV.F90 | 49 +++++++++++----------- 2 files changed, 47 insertions(+), 50 deletions(-) diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index 2158d98b3f..d3f74c7f0c 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -451,10 +451,10 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p !! calculate PFu and PFv, in H, with any tidal !! contributions or compressibility compensation. ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: e ! Interface height in m. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: e ! Interface height in depth units (Z). real, dimension(SZI_(G),SZJ_(G)) :: & e_tidal, & ! The bottom geopotential anomaly due to tidal forces from - ! astronomical sources and self-attraction and loading, in m. + ! astronomical sources and self-attraction and loading, in Z. z_bathy, & ! The height of the bathymetry, in depth units (Z). dM ! The barotropic adjustment to the Montgomery potential to ! account for a reduced gravity model, in m2 s-2. @@ -489,17 +489,16 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p real :: rho_in_situ(SZI_(G)) ! The in situ density, in kg m-3. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density, in Pa (usually 2e7 Pa = 2000 dbar). - real :: p0(SZI_(G)) ! An array of zeros to use for pressure in Pa. + real :: p0(SZI_(G)) ! An array of zeros to use for pressure in Pa. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in m. real :: I_Rho0 ! 1/Rho0. - real :: G_Rho0 ! G_Earth / Rho0 in m4 s-2 kg-1. + real :: G_Rho0 ! G_Earth / Rho0 in m5 Z-1 s-2 kg-1. real :: Rho_ref ! The reference density in kg m-3. - real :: dz_neglect ! A minimal thickness in m, like e. + real :: dz_neglect ! A minimal thickness in Z, like e. logical :: use_p_atm ! If true, use the atmospheric pressure. logical :: use_ALE ! If true, use an ALE pressure reconstruction. - 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. type(thermo_var_ptrs) :: tv_tmp! A structure of temporary T & S. real, parameter :: C1_6 = 1.0/6.0 @@ -521,13 +520,13 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p if (associated(ALE_CSp)) use_ALE = CS%reconstruct .and. use_EOS h_neglect = GV%H_subroundoff - dz_neglect = GV%H_subroundoff * GV%H_to_m + dz_neglect = GV%H_subroundoff * GV%H_to_Z I_Rho0 = 1.0/GV%Rho0 - G_Rho0 = GV%g_Earth/GV%Rho0 + G_Rho0 = GV%Z_to_m*GV%g_Earth/GV%Rho0 rho_ref = CS%Rho0 do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - z_bathy(i,j) = GV%Z_to_m*G%bathyT(i,j) + z_bathy(i,j) = G%bathyT(i,j) enddo ; enddo if (CS%tides) then @@ -551,20 +550,19 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p if (CS%tides) then !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -GV%Z_to_m*(G%bathyT(i,j) + e_tidal(i,j)) + e(i,j,nz+1) = -(G%bathyT(i,j) + e_tidal(i,j)) enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -GV%Z_to_m*G%bathyT(i,j) + e(i,j,nz+1) = -G%bathyT(i,j) enddo ; enddo endif !$OMP parallel do default(shared) do j=Jsq,Jeq+1; do k=nz,1,-1 ; do i=Isq,Ieq+1 - e(i,j,K) = e(i,j,K+1) + h(i,j,k)*GV%H_to_m + e(i,j,K) = e(i,j,K+1) + h(i,j,k)*GV%H_to_Z enddo ; enddo ; enddo - if (use_EOS) then ! With a bulk mixed layer, replace the T & S of any layers that are ! lighter than the the buffer layer with the properties of the buffer @@ -641,12 +639,12 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p if (use_p_atm) then !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - pa(i,j) = (rho_ref*GV%g_Earth)*e(i,j,1) + p_atm(i,j) + pa(i,j) = (rho_ref*GV%g_Earth*GV%Z_to_m)*e(i,j,1) + p_atm(i,j) enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - pa(i,j) = (rho_ref*GV%g_Earth)*e(i,j,1) + pa(i,j) = (rho_ref*GV%g_Earth*GV%Z_to_m)*e(i,j,1) enddo ; enddo endif !$OMP parallel do default(shared) @@ -672,26 +670,26 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p if ( CS%Recon_Scheme == 1 ) then call int_density_dz_generic_plm( T_t(:,:,k), T_b(:,:,k), & S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref, CS%Rho0, GV%g_Earth, & + rho_ref, CS%Rho0, GV%g_Earth*GV%Z_to_m, & dz_neglect, z_bathy, G%HI, G%HI, & tv%eqn_of_state, dpa, intz_dpa, intx_dpa, inty_dpa, & useMassWghtInterp = CS%useMassWghtInterp) elseif ( CS%Recon_Scheme == 2 ) then call int_density_dz_generic_ppm( tv%T(:,:,k), T_t(:,:,k), T_b(:,:,k), & tv%S(:,:,k), S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref, CS%Rho0, GV%g_Earth, & + rho_ref, CS%Rho0, GV%g_Earth*GV%Z_to_m, & G%HI, G%HI, tv%eqn_of_state, dpa, intz_dpa, & intx_dpa, inty_dpa) endif else call int_density_dz(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref, CS%Rho0, GV%g_Earth, G%HI, G%HI, tv%eqn_of_state, & + rho_ref, CS%Rho0, GV%g_Earth*GV%Z_to_m, G%HI, G%HI, tv%eqn_of_state, & dpa, intz_dpa, intx_dpa, inty_dpa, & z_bathy, dz_neglect, CS%useMassWghtInterp) endif !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - intz_dpa(i,j) = intz_dpa(i,j)*GV%m_to_H + intz_dpa(i,j) = intz_dpa(i,j)*GV%Z_to_H enddo ; enddo else !$OMP parallel do default(shared) @@ -716,7 +714,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p PFu(I,j,k) = (((pa(i,j)*h(i,j,k) + intz_dpa(i,j)) - & (pa(i+1,j)*h(i+1,j,k) + intz_dpa(i+1,j))) + & ((h(i+1,j,k) - h(i,j,k)) * intx_pa(I,j) - & - (e(i+1,j,K+1) - e(i,j,K+1)) * intx_dpa(I,j) * GV%m_to_H)) * & + (e(i+1,j,K+1) - e(i,j,K+1)) * intx_dpa(I,j) * GV%Z_to_H)) * & ((2.0*I_Rho0*G%IdxCu(I,j)) / & ((h(i,j,k) + h(i+1,j,k)) + h_neglect)) intx_pa(I,j) = intx_pa(I,j) + intx_dpa(I,j) @@ -727,7 +725,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p PFv(i,J,k) = (((pa(i,j)*h(i,j,k) + intz_dpa(i,j)) - & (pa(i,j+1)*h(i,j+1,k) + intz_dpa(i,j+1))) + & ((h(i,j+1,k) - h(i,j,k)) * inty_pa(i,J) - & - (e(i,j+1,K+1) - e(i,j,K+1)) * inty_dpa(i,J) * GV%m_to_H)) * & + (e(i,j+1,K+1) - e(i,j,K+1)) * inty_dpa(i,J) * GV%Z_to_H)) * & ((2.0*I_Rho0*G%IdyCv(i,J)) / & ((h(i,j,k) + h(i,j+1,k)) + h_neglect)) inty_pa(i,J) = inty_pa(i,J) + inty_dpa(i,J) @@ -752,7 +750,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p endif if (present(pbce)) then - call set_pbce_Bouss(e, tv_tmp, G, GV, GV%g_Earth, CS%Rho0, CS%GFS_scale, pbce) + call set_pbce_Bouss(e, tv_tmp, G, GV, GV%g_Earth, CS%Rho0, CS%GFS_scale, pbce, m_to_Z=GV%m_to_Z) endif if (present(eta)) then @@ -762,12 +760,12 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p ! about 200 lines above. !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta(i,j) = e(i,j,1)*GV%m_to_H + e_tidal(i,j)*GV%Z_to_H + eta(i,j) = e(i,j,1)*GV%Z_to_H + e_tidal(i,j)*GV%Z_to_H enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta(i,j) = e(i,j,1)*GV%m_to_H + eta(i,j) = e(i,j,1)*GV%Z_to_H enddo ; enddo endif endif diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index 8c173fff4b..48b38a3a4e 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -419,7 +419,7 @@ end subroutine PressureForce_blk_AFV_nonBouss subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, pbce, eta) type(ocean_grid_type), intent(in) :: 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 (kg/m2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness in H (m or 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/s2) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration (m/s2) @@ -434,7 +434,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at !! calculate PFu and PFv, in H, with any tidal !! contributions or compressibility compensation. ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: e ! Interface height in m. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: e ! Interface height in depth units (Z). real, dimension(SZI_(G),SZJ_(G)) :: & e_tidal, & ! The bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading, in depth units (Z). @@ -474,11 +474,11 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at ! density, in Pa (usually 2e7 Pa = 2000 dbar). real :: p0(SZI_(G)) ! An array of zeros to use for pressure in Pa. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in m. + ! in roundoff and can be neglected, in H. real :: I_Rho0 ! 1/Rho0. - real :: G_Rho0 ! G_Earth / Rho0 in m4 s-2 kg-1. + real :: G_Rho0 ! G_Earth / Rho0 in m5 Z-1 s-2 kg-1. real :: Rho_ref ! The reference density in kg m-3. - real :: dz_neglect ! A minimal thickness in m, like e. + real :: dz_neglect ! A minimal thickness in Z, like e. logical :: use_p_atm ! If true, use the atmospheric pressure. logical :: use_ALE ! If true, use an ALE pressure reconstruction. logical :: use_EOS ! If true, density is calculated from T & S using an @@ -506,13 +506,13 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at if (associated(ALE_CSp)) use_ALE = CS%reconstruct .and. use_EOS h_neglect = GV%H_subroundoff - dz_neglect = GV%H_subroundoff * GV%H_to_m + dz_neglect = GV%H_subroundoff * GV%H_to_Z I_Rho0 = 1.0/GV%Rho0 - G_Rho0 = GV%g_Earth/GV%Rho0 + G_Rho0 = GV%Z_to_m*GV%g_Earth/GV%Rho0 rho_ref = CS%Rho0 do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - z_bathy(i,j) = GV%Z_to_m*G%bathyT(i,j) + z_bathy(i,j) = G%bathyT(i,j) enddo ; enddo if (CS%tides) then @@ -523,10 +523,10 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - e(i,j,1) = -GV%Z_to_m*G%bathyT(i,j) + e(i,j,1) = -G%bathyT(i,j) enddo do k=1,nz ; do i=Isq,Ieq+1 - e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_m + e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_Z enddo ; enddo enddo call calc_tidal_forcing(CS%Time, e(:,:,1), e_tidal, G, CS%tides_CSp, m_to_Z=GV%m_to_Z) @@ -536,20 +536,19 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at if (CS%tides) then !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -GV%Z_to_m*(G%bathyT(i,j) + e_tidal(i,j)) + e(i,j,nz+1) = -(G%bathyT(i,j) + e_tidal(i,j)) enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -GV%Z_to_m*G%bathyT(i,j) + e(i,j,nz+1) = -G%bathyT(i,j) enddo ; enddo endif !$OMP parallel do default(shared) do j=Jsq,Jeq+1; do k=nz,1,-1 ; do i=Isq,Ieq+1 - e(i,j,K) = e(i,j,K+1) + h(i,j,k)*GV%H_to_m + e(i,j,K) = e(i,j,K+1) + h(i,j,k)*GV%H_to_Z enddo ; enddo ; enddo - if (use_EOS) then ! With a bulk mixed layer, replace the T & S of any layers that are ! lighter than the the buffer layer with the properties of the buffer @@ -641,12 +640,12 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at if (use_p_atm) then do jb=Jsq_bk,Jeq_bk+1 ; do ib=Isq_bk,Ieq_bk+1 i = ib+ioff_bk ; j = jb+joff_bk - pa_bk(ib,jb) = (rho_ref*GV%g_Earth)*e(i,j,1) + p_atm(i,j) + pa_bk(ib,jb) = (rho_ref*GV%g_Earth*GV%Z_to_m)*e(i,j,1) + p_atm(i,j) enddo ; enddo else do jb=Jsq_bk,Jeq_bk+1 ; do ib=Isq_bk,Ieq_bk+1 i = ib+ioff_bk ; j = jb+joff_bk - pa_bk(ib,jb) = (rho_ref*GV%g_Earth)*e(i,j,1) + pa_bk(ib,jb) = (rho_ref*GV%g_Earth*GV%Z_to_m)*e(i,j,1) enddo ; enddo endif do jb=js_bk,je_bk ; do Ib=Isq_bk,Ieq_bk @@ -670,25 +669,25 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at if ( CS%Recon_Scheme == 1 ) then call int_density_dz_generic_plm( T_t(:,:,k), T_b(:,:,k), & S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref, CS%Rho0, GV%g_Earth, & + rho_ref, CS%Rho0, GV%g_Earth*GV%Z_to_m, & dz_neglect, z_bathy, G%HI, G%Block(n), & tv%eqn_of_state, dpa_bk, intz_dpa_bk, intx_dpa_bk, inty_dpa_bk, & useMassWghtInterp = CS%useMassWghtInterp) elseif ( CS%Recon_Scheme == 2 ) then call int_density_dz_generic_ppm( tv%T(:,:,k), T_t(:,:,k), T_b(:,:,k), & tv%S(:,:,k), S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref, CS%Rho0, GV%g_Earth, & + rho_ref, CS%Rho0, GV%g_Earth*GV%Z_to_m, & G%HI, G%Block(n), tv%eqn_of_state, dpa_bk, intz_dpa_bk, & intx_dpa_bk, inty_dpa_bk) endif else call int_density_dz(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref, CS%Rho0, GV%g_Earth, G%HI, G%Block(n), tv%eqn_of_state, & + rho_ref, CS%Rho0, GV%g_Earth*GV%Z_to_m, G%HI, G%Block(n), tv%eqn_of_state, & dpa_bk, intz_dpa_bk, intx_dpa_bk, inty_dpa_bk, & z_bathy, dz_neglect, CS%useMassWghtInterp) endif do jb=Jsq_bk,Jeq_bk+1 ; do ib=Isq_bk,Ieq_bk+1 - intz_dpa_bk(ib,jb) = intz_dpa_bk(ib,jb)*GV%m_to_H + intz_dpa_bk(ib,jb) = intz_dpa_bk(ib,jb)*GV%Z_to_H enddo ; enddo else do jb=Jsq_bk,Jeq_bk+1 ; do ib=Isq_bk,Ieq_bk+1 @@ -711,7 +710,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at PFu(I,j,k) = (((pa_bk(ib,jb)*h(i,j,k) + intz_dpa_bk(ib,jb)) - & (pa_bk(ib+1,jb)*h(i+1,j,k) + intz_dpa_bk(ib+1,jb))) + & ((h(i+1,j,k) - h(i,j,k)) * intx_pa_bk(Ib,jb) - & - (e(i+1,j,K+1) - e(i,j,K+1)) * intx_dpa_bk(Ib,jb) * GV%m_to_H)) * & + (e(i+1,j,K+1) - e(i,j,K+1)) * intx_dpa_bk(Ib,jb) * GV%Z_to_H)) * & ((2.0*I_Rho0*G%IdxCu(I,j)) / & ((h(i,j,k) + h(i+1,j,k)) + h_neglect)) intx_pa_bk(Ib,jb) = intx_pa_bk(Ib,jb) + intx_dpa_bk(Ib,jb) @@ -722,7 +721,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at PFv(i,J,k) = (((pa_bk(ib,jb)*h(i,j,k) + intz_dpa_bk(ib,jb)) - & (pa_bk(ib,jb+1)*h(i,j+1,k) + intz_dpa_bk(ib,jb+1))) + & ((h(i,j+1,k) - h(i,j,k)) * inty_pa_bk(ib,Jb) - & - (e(i,j+1,K+1) - e(i,j,K+1)) * inty_dpa_bk(ib,Jb) * GV%m_to_H)) * & + (e(i,j+1,K+1) - e(i,j,K+1)) * inty_dpa_bk(ib,Jb) * GV%Z_to_H)) * & ((2.0*I_Rho0*G%IdyCv(i,J)) / & ((h(i,j,k) + h(i,j+1,k)) + h_neglect)) inty_pa_bk(ib,Jb) = inty_pa_bk(ib,Jb) + inty_dpa_bk(ib,Jb) @@ -745,7 +744,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at enddo if (present(pbce)) then - call set_pbce_Bouss(e, tv_tmp, G, GV, GV%g_Earth, CS%Rho0, CS%GFS_scale, pbce) + call set_pbce_Bouss(e, tv_tmp, G, GV, GV%g_Earth, CS%Rho0, CS%GFS_scale, pbce, m_to_Z=GV%m_to_Z) endif if (present(eta)) then @@ -755,12 +754,12 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at ! about 200 lines above. !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta(i,j) = e(i,j,1)*GV%m_to_H + e_tidal(i,j)*GV%Z_to_H + eta(i,j) = e(i,j,1)*GV%Z_to_H + e_tidal(i,j)*GV%Z_to_H enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta(i,j) = e(i,j,1)*GV%m_to_H + eta(i,j) = e(i,j,1)*GV%Z_to_H enddo ; enddo endif endif From 16cd71efd3dbc8c1770217988cd19c724d9a3d3a Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 1 Sep 2018 10:37:38 -0400 Subject: [PATCH 062/174] +Removed m_to_Z optional arg from set_pbce_Bouss Removed optional argument m_to_Z from set_pbce_Bouss, and cleaned up code in all of the MOM_PressureForce codes. All answers are bitwise identical. --- src/core/MOM_PressureForce_Montgomery.F90 | 32 +++++++++------------- src/core/MOM_PressureForce_analytic_FV.F90 | 27 ++++++++---------- src/core/MOM_PressureForce_blocked_AFV.F90 | 11 ++------ 3 files changed, 28 insertions(+), 42 deletions(-) diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index cdff786c15..079bab6b19 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -535,8 +535,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta endif ! use_EOS if (present(pbce)) then - call Set_pbce_Bouss(e, tv_tmp, G, GV, GV%g_Earth, CS%Rho0, CS%GFS_scale, pbce, & - rho_star, GV%m_to_Z) + call Set_pbce_Bouss(e, tv_tmp, G, GV, GV%g_Earth, CS%Rho0, CS%GFS_scale, pbce, rho_star) endif ! Calculate the pressure force. On a Cartesian grid, @@ -599,7 +598,7 @@ end subroutine PressureForce_Mont_Bouss !> Determines the partial derivative of the acceleration due !! to pressure forces with the free surface height. -subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star, m_to_Z) +subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface height, in Z. @@ -615,7 +614,6 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: rho_star !< The layer densities (maybe compressibility !! compensated), times g/rho_0, in m2 Z-1 s-2. - real, optional, intent(in) :: m_to_Z !< The conversion factor from m to the units of e. ! Local variables real :: Ihtot(SZI_(G)) ! The inverse of the sum of the layer @@ -627,33 +625,29 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star real :: dR_dS(SZI_(G)) ! and salinity in kg m-3 K-1 and kg m-3 PSU-1. real :: rho_in_situ(SZI_(G)) !In-situ density at the top of a layer. real :: G_Rho0 ! g_Earth / Rho0 in m4 s-2 kg-1. - real :: Rho0xG ! g_Earth * Rho0 in kg s-2 m-2. + real :: Rho0xG ! g_Earth * Rho0 in kg s-2 m-1 Z-1. logical :: use_EOS ! If true, density is calculated from T & S using ! an equation of state. - real :: m_Z ! The conversion factor from m to depth units - real :: Z_to_m ! The conversion factor from depth units to m - real :: h_neglect ! A thickness that is so small it is usually lost + real :: z_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in Z. integer :: Isq, Ieq, Jsq, Jeq, nz, i, j, k Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = G%ke - m_Z = 1.0 ; if (present(m_to_Z)) m_Z = m_to_Z - Z_to_m = 1.0 ; if (present(m_to_Z)) Z_to_m = 1.0 / m_to_Z - Rho0xG = Rho0*g_Earth*Z_to_m + Rho0xG = Rho0*g_Earth*GV%Z_to_m G_Rho0 = g_Earth/Rho0 use_EOS = associated(tv%eqn_of_state) - h_neglect = GV%H_subroundoff*GV%H_to_m*m_Z + z_neglect = GV%H_subroundoff*GV%H_to_Z if (use_EOS) then if (present(rho_star)) then -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,e,h_neglect,pbce,rho_star,& +!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,e,z_neglect,pbce,rho_star,& !$OMP GFS_scale,GV) & !$OMP private(Ihtot) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - Ihtot(i) = (GV%H_to_m * m_Z) / ((e(i,j,1)-e(i,j,nz+1)) + h_neglect) - pbce(i,j,1) = GFS_scale * rho_star(i,j,1) * (GV%H_to_m * m_Z) + Ihtot(i) = GV%H_to_Z / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect) + 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) + (rho_star(i,j,k)-rho_star(i,j,k-1)) * & @@ -661,12 +655,12 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star enddo ; enddo enddo ! end of j loop else -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,e,tv,h_neglect,G_Rho0,Rho0xG,& +!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,e,tv,z_neglect,G_Rho0,Rho0xG,& !$OMP pbce,GFS_scale,GV) & !$OMP private(Ihtot,press,rho_in_situ,T_int,S_int,dR_dT,dR_dS) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - Ihtot(i) = 1.0 / (((e(i,j,1)-e(i,j,nz+1)) + h_neglect) * GV%m_to_H) + Ihtot(i) = GV%H_to_m / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect) press(i) = -Rho0xG*e(i,j,1) enddo call calculate_density(tv%T(:,j,1), tv%S(:,j,1), press, rho_in_situ, & @@ -692,10 +686,10 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star enddo ! end of j loop endif else ! not use_EOS -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,e,GV,h_neglect,pbce) private(Ihtot) +!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,e,GV,z_neglect,pbce) private(Ihtot) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - Ihtot(i) = 1.0 / (((e(i,j,1)-e(i,j,nz+1)) + h_neglect) * GV%m_to_H) + Ihtot(i) = GV%H_to_m / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect) pbce(i,j,1) = GV%g_prime(1) * GV%H_to_m enddo do k=2,nz ; do i=Isq,Ieq+1 diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index d3f74c7f0c..99ffda6a88 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -455,7 +455,6 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p real, dimension(SZI_(G),SZJ_(G)) :: & e_tidal, & ! The bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading, in Z. - z_bathy, & ! The height of the bathymetry, in depth units (Z). dM ! The barotropic adjustment to the Montgomery potential to ! account for a reduced gravity model, in m2 s-2. real, dimension(SZI_(G)) :: & @@ -492,6 +491,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p real :: p0(SZI_(G)) ! An array of zeros to use for pressure in Pa. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in m. + real :: g_Earth_z ! A scaled version of g_Earth, in m2 Z-1 s-2. real :: I_Rho0 ! 1/Rho0. real :: G_Rho0 ! G_Earth / Rho0 in m5 Z-1 s-2 kg-1. real :: Rho_ref ! The reference density in kg m-3. @@ -522,13 +522,10 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff * GV%H_to_Z I_Rho0 = 1.0/GV%Rho0 - G_Rho0 = GV%Z_to_m*GV%g_Earth/GV%Rho0 + g_Earth_z = GV%g_Earth*GV%Z_to_m + G_Rho0 = g_Earth_z/GV%Rho0 rho_ref = CS%Rho0 - do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - z_bathy(i,j) = G%bathyT(i,j) - enddo ; enddo - if (CS%tides) then ! Determine the surface height anomaly for calculating self attraction ! and loading. This should really be based on bottom pressure anomalies, @@ -639,12 +636,12 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p if (use_p_atm) then !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - pa(i,j) = (rho_ref*GV%g_Earth*GV%Z_to_m)*e(i,j,1) + p_atm(i,j) + pa(i,j) = (rho_ref*g_Earth_z)*e(i,j,1) + p_atm(i,j) enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - pa(i,j) = (rho_ref*GV%g_Earth*GV%Z_to_m)*e(i,j,1) + pa(i,j) = (rho_ref*g_Earth_z)*e(i,j,1) enddo ; enddo endif !$OMP parallel do default(shared) @@ -670,22 +667,22 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p if ( CS%Recon_Scheme == 1 ) then call int_density_dz_generic_plm( T_t(:,:,k), T_b(:,:,k), & S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref, CS%Rho0, GV%g_Earth*GV%Z_to_m, & - dz_neglect, z_bathy, G%HI, G%HI, & + rho_ref, CS%Rho0, g_Earth_z, & + dz_neglect, G%bathyT, G%HI, G%HI, & tv%eqn_of_state, dpa, intz_dpa, intx_dpa, inty_dpa, & useMassWghtInterp = CS%useMassWghtInterp) elseif ( CS%Recon_Scheme == 2 ) then call int_density_dz_generic_ppm( tv%T(:,:,k), T_t(:,:,k), T_b(:,:,k), & tv%S(:,:,k), S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref, CS%Rho0, GV%g_Earth*GV%Z_to_m, & + rho_ref, CS%Rho0, g_Earth_z, & G%HI, G%HI, tv%eqn_of_state, dpa, intz_dpa, & intx_dpa, inty_dpa) endif else call int_density_dz(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref, CS%Rho0, GV%g_Earth*GV%Z_to_m, G%HI, G%HI, tv%eqn_of_state, & + rho_ref, CS%Rho0, g_Earth_z, G%HI, G%HI, tv%eqn_of_state, & dpa, intz_dpa, intx_dpa, inty_dpa, & - z_bathy, dz_neglect, CS%useMassWghtInterp) + G%bathyT, dz_neglect, CS%useMassWghtInterp) endif !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 @@ -694,7 +691,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - dz(i,j) = GV%g_Earth*GV%H_to_m*h(i,j,k) + dz(i,j) = g_Earth_z * GV%H_to_Z*h(i,j,k) dpa(i,j) = (GV%Rlay(k) - rho_ref)*dz(i,j) intz_dpa(i,j) = 0.5*(GV%Rlay(k) - rho_ref)*dz(i,j)*h(i,j,k) enddo ; enddo @@ -750,7 +747,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p endif if (present(pbce)) then - call set_pbce_Bouss(e, tv_tmp, G, GV, GV%g_Earth, CS%Rho0, CS%GFS_scale, pbce, m_to_Z=GV%m_to_Z) + call set_pbce_Bouss(e, tv_tmp, G, GV, GV%g_Earth, CS%Rho0, CS%GFS_scale, pbce) endif if (present(eta)) then diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index 48b38a3a4e..cb64f16d48 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -438,7 +438,6 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at real, dimension(SZI_(G),SZJ_(G)) :: & e_tidal, & ! The bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading, in depth units (Z). - z_bathy, & ! The height of the bathymetry, in m. dM ! The barotropic adjustment to the Montgomery potential to ! account for a reduced gravity model, in m2 s-2. real, dimension(SZI_(G)) :: & @@ -511,10 +510,6 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at G_Rho0 = GV%Z_to_m*GV%g_Earth/GV%Rho0 rho_ref = CS%Rho0 - do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - z_bathy(i,j) = G%bathyT(i,j) - enddo ; enddo - if (CS%tides) then ! Determine the surface height anomaly for calculating self attraction ! and loading. This should really be based on bottom pressure anomalies, @@ -670,7 +665,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at call int_density_dz_generic_plm( T_t(:,:,k), T_b(:,:,k), & S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & rho_ref, CS%Rho0, GV%g_Earth*GV%Z_to_m, & - dz_neglect, z_bathy, G%HI, G%Block(n), & + dz_neglect, G%bathyT, G%HI, G%Block(n), & tv%eqn_of_state, dpa_bk, intz_dpa_bk, intx_dpa_bk, inty_dpa_bk, & useMassWghtInterp = CS%useMassWghtInterp) elseif ( CS%Recon_Scheme == 2 ) then @@ -684,7 +679,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at call int_density_dz(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), e(:,:,K), e(:,:,K+1), & rho_ref, CS%Rho0, GV%g_Earth*GV%Z_to_m, G%HI, G%Block(n), tv%eqn_of_state, & dpa_bk, intz_dpa_bk, intx_dpa_bk, inty_dpa_bk, & - z_bathy, dz_neglect, CS%useMassWghtInterp) + G%bathyT, dz_neglect, CS%useMassWghtInterp) endif do jb=Jsq_bk,Jeq_bk+1 ; do ib=Isq_bk,Ieq_bk+1 intz_dpa_bk(ib,jb) = intz_dpa_bk(ib,jb)*GV%Z_to_H @@ -744,7 +739,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at enddo if (present(pbce)) then - call set_pbce_Bouss(e, tv_tmp, G, GV, GV%g_Earth, CS%Rho0, CS%GFS_scale, pbce, m_to_Z=GV%m_to_Z) + call set_pbce_Bouss(e, tv_tmp, G, GV, GV%g_Earth, CS%Rho0, CS%GFS_scale, pbce) endif if (present(eta)) then From efc2f450460c027c51e3e1479b178c2d06fcce17 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 1 Sep 2018 12:23:42 -0400 Subject: [PATCH 063/174] Code cleanup in MOM_PressureForce_blocked_AFV Cleaned up the code in PressureForce_blk_AFV_Bouss by adding new simplifying variables. All answers are bitwise identical. --- src/core/MOM_PressureForce_blocked_AFV.F90 | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index cb64f16d48..7119426871 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -475,6 +475,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in H. real :: I_Rho0 ! 1/Rho0. + real :: g_Earth_z ! A scaled version of g_Earth, in m2 Z-1 s-2. real :: G_Rho0 ! G_Earth / Rho0 in m5 Z-1 s-2 kg-1. real :: Rho_ref ! The reference density in kg m-3. real :: dz_neglect ! A minimal thickness in Z, like e. @@ -507,7 +508,8 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, 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 - G_Rho0 = GV%Z_to_m*GV%g_Earth/GV%Rho0 + g_Earth_z = GV%g_Earth*GV%Z_to_m + G_Rho0 = g_Earth_z / GV%Rho0 rho_ref = CS%Rho0 if (CS%tides) then @@ -635,12 +637,12 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at if (use_p_atm) then do jb=Jsq_bk,Jeq_bk+1 ; do ib=Isq_bk,Ieq_bk+1 i = ib+ioff_bk ; j = jb+joff_bk - pa_bk(ib,jb) = (rho_ref*GV%g_Earth*GV%Z_to_m)*e(i,j,1) + p_atm(i,j) + pa_bk(ib,jb) = (rho_ref*g_Earth_z)*e(i,j,1) + p_atm(i,j) enddo ; enddo else do jb=Jsq_bk,Jeq_bk+1 ; do ib=Isq_bk,Ieq_bk+1 i = ib+ioff_bk ; j = jb+joff_bk - pa_bk(ib,jb) = (rho_ref*GV%g_Earth*GV%Z_to_m)*e(i,j,1) + pa_bk(ib,jb) = (rho_ref*g_Earth_z)*e(i,j,1) enddo ; enddo endif do jb=js_bk,je_bk ; do Ib=Isq_bk,Ieq_bk @@ -664,20 +666,20 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at if ( CS%Recon_Scheme == 1 ) then call int_density_dz_generic_plm( T_t(:,:,k), T_b(:,:,k), & S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref, CS%Rho0, GV%g_Earth*GV%Z_to_m, & + rho_ref, CS%Rho0, g_Earth_z, & dz_neglect, G%bathyT, G%HI, G%Block(n), & tv%eqn_of_state, dpa_bk, intz_dpa_bk, intx_dpa_bk, inty_dpa_bk, & useMassWghtInterp = CS%useMassWghtInterp) elseif ( CS%Recon_Scheme == 2 ) then call int_density_dz_generic_ppm( tv%T(:,:,k), T_t(:,:,k), T_b(:,:,k), & tv%S(:,:,k), S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref, CS%Rho0, GV%g_Earth*GV%Z_to_m, & + rho_ref, CS%Rho0, g_Earth_z, & G%HI, G%Block(n), tv%eqn_of_state, dpa_bk, intz_dpa_bk, & intx_dpa_bk, inty_dpa_bk) endif else call int_density_dz(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref, CS%Rho0, GV%g_Earth*GV%Z_to_m, G%HI, G%Block(n), tv%eqn_of_state, & + rho_ref, CS%Rho0, g_Earth_z, G%HI, G%Block(n), tv%eqn_of_state, & dpa_bk, intz_dpa_bk, intx_dpa_bk, inty_dpa_bk, & G%bathyT, dz_neglect, CS%useMassWghtInterp) endif @@ -687,7 +689,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at else do jb=Jsq_bk,Jeq_bk+1 ; do ib=Isq_bk,Ieq_bk+1 i = ib+ioff_bk ; j = jb+joff_bk - dz_bk(ib,jb) = GV%g_Earth*GV%H_to_m*h(i,j,k) + dz_bk(ib,jb) = g_Earth_z*GV%H_to_Z*h(i,j,k) dpa_bk(ib,jb) = (GV%Rlay(k) - rho_ref)*dz_bk(ib,jb) intz_dpa_bk(ib,jb) = 0.5*(GV%Rlay(k) - rho_ref)*dz_bk(ib,jb)*h(i,j,k) enddo ; enddo From 2edb677558d8b644c19c0654ece07cfa3ef232bd Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 1 Sep 2018 12:24:56 -0400 Subject: [PATCH 064/174] Dimensional consistency testing in MOM_barotropic Changed the calculations and several variables in MOM_barotropic to work in depth units, for improved dimensional consistency testing. All answers are bitwise identical for no Z-rescaling or for rescaling by 2^93 or 2^-93. --- src/core/MOM_barotropic.F90 | 66 ++++++++++++++++++------------------- 1 file changed, 33 insertions(+), 33 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 0168af9df4..f240f4318c 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -97,7 +97,7 @@ module MOM_barotropic real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: frhatv !< The fraction of the total column thickness interpolated to v grid points in each layer, nondim. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: IDatu - !< Inverse of the basin depth at u grid points, in m-1. + !< Inverse of the basin depth at u grid points, in Z-1. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: lin_drag_u !< A spatially varying linear drag coefficient acting on the zonal barotropic flow, in H s-1. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: uhbt_IC @@ -109,7 +109,7 @@ module MOM_barotropic real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: ubtav !< The barotropic zonal velocity averaged over the baroclinic time step, m s-1. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: IDatv - !< Inverse of the basin depth at v grid points, in m-1. + !< Inverse of the basin depth at v grid points, in Z-1. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: lin_drag_v !< A spatially varying linear drag coefficient acting on the zonal barotropic flow, in H s-1. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vhbt_IC @@ -135,15 +135,15 @@ module MOM_barotropic !< This is a copy of G%IareaT with wide halos, but will !! still utilize the macro IareaT when referenced, m-2. real ALLOCABLE_, dimension(NIMEMBW_,NJMEMW_) :: & - D_u_Cor, & !< A simply averaged depth at u points, in m. + D_u_Cor, & !< A simply averaged depth at u points, in Z. dy_Cu, & !< A copy of G%dy_Cu with wide halos, in m. IdxCu !< A copy of G%IdxCu with wide halos, in m-1. real ALLOCABLE_, dimension(NIMEMW_,NJMEMBW_) :: & - D_v_Cor, & !< A simply averaged depth at v points, in m. + D_v_Cor, & !< A simply averaged depth at v points, in Z. dx_Cv, & !< A copy of G%dx_Cv with wide halos, in m. IdyCv !< A copy of G%IdyCv with wide halos, in m-1. real ALLOCABLE_, dimension(NIMEMBW_,NJMEMBW_) :: & - q_D !< f / D at PV points, in m-1 s-1. + q_D !< f / D at PV points, in Z-1 s-1. real, dimension(:,:,:), pointer :: frhatu1 => NULL() !< Predictor step values of frhatu stored for diagnostics. real, dimension(:,:,:), pointer :: frhatv1 => NULL() !< Predictor step values of frhatv stored for diagnostics. @@ -496,7 +496,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & Rayleigh_u, & ! A Rayleigh drag timescale operating at u-points, in s-1. PFu_bt_sum, & ! The summed zonal barotropic pressure gradient force, in m s-2. Coru_bt_sum, & ! The summed zonal barotropic Coriolis acceleration, in m s-2. - DCor_u, & ! A simply averaged depth at u points, in m. + DCor_u, & ! A simply averaged depth at u points, in Z. Datu ! Basin depth at u-velocity grid points times the y-grid ! spacing, in H m. real, dimension(SZIW_(CS),SZJBW_(CS)) :: & @@ -527,7 +527,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & ! in m s-2. Corv_bt_sum, & ! The summed meridional barotropic Coriolis acceleration, ! in m s-2. - DCor_v, & ! A simply averaged depth at v points, in m. + DCor_v, & ! A simply averaged depth at v points, in Z. Datv ! Basin depth at v-velocity grid points times the x-grid ! spacing, in H m. real, target, dimension(SZIW_(CS),SZJW_(CS)) :: & @@ -568,7 +568,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & real, dimension(SZIW_(CS),SZJBW_(CS)) :: & vbt_prev, vhbt_prev, vbt_sum_prev, vhbt_sum_prev, vbt_wtd_prev ! for OBC - real :: I_Rho0 ! The inverse of the mean density (Rho0), in m3 kg-1. + real :: mass_to_Z ! The depth unit converison divided by the mean density (Rho0), in m3 kg-1. real :: visc_rem ! A work variable that may equal visc_rem_[uv]. Nondim. real :: vel_prev ! The previous velocity in m s-1. real :: dtbt ! The barotropic time step in s. @@ -708,7 +708,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & dtbt = dt * Instep bebt = CS%bebt be_proj = CS%bebt - I_Rho0 = 1.0/GV%Rho0 + mass_to_Z = GV%m_to_Z / GV%Rho0 !--- setup the weight when computing vbt_trans and ubt_trans if (project_velocity) then @@ -804,18 +804,18 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & ! ### bathyT here should be replaced with bathyT+eta(Bous) or eta(non-Bous). !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - DCor_u(I,j) = 0.5 * GV%Z_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j)) + DCor_u(I,j) = 0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j)) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - DCor_v(i,J) = 0.5 * GV%Z_to_m*(G%bathyT(i,j+1) + G%bathyT(i,j)) + DCor_v(i,J) = 0.5 * (G%bathyT(i,j+1) + G%bathyT(i,j)) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do I=is-1,ie q(I,J) = 0.25 * G%CoriolisBu(I,J) * & ((G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i+1,j) + G%areaT(i,j+1))) / & - (GV%Z_to_m*((G%areaT(i,j) * G%bathyT(i,j) + G%areaT(i+1,j+1) * G%bathyT(i+1,j+1)) + & - (G%areaT(i+1,j) * G%bathyT(i+1,j) + G%areaT(i,j+1) * G%bathyT(i,j+1)))) + ((G%areaT(i,j) * G%bathyT(i,j) + G%areaT(i+1,j+1) * G%bathyT(i+1,j+1)) + & + (G%areaT(i+1,j) * G%bathyT(i+1,j) + G%areaT(i,j+1) * G%bathyT(i,j+1)) ) enddo ; enddo ! With very wide halos, q and D need to be calculated on the available data @@ -972,24 +972,24 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & ! ### 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) * I_rho0*CS%IDatu(I,j)*visc_rem_u(I,j,1) + BT_force_u(I,j) = forces%taux(I,j) * mass_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) * I_rho0*CS%IDatv(i,J)*visc_rem_v(i,J,1) + BT_force_v(i,J) = forces%tauy(i,J) * mass_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 !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - BT_force_u(I,j) = BT_force_u(I,j) - taux_bot(I,j) * I_rho0 * CS%IDatu(I,j) + BT_force_u(I,j) = BT_force_u(I,j) - taux_bot(I,j) * mass_to_Z * CS%IDatu(I,j) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - BT_force_v(i,J) = BT_force_v(i,J) - tauy_bot(i,J) * I_rho0 * CS%IDatv(i,J) + BT_force_v(i,J) = BT_force_v(i,J) - tauy_bot(i,J) * mass_to_Z * CS%IDatv(i,J) enddo ; enddo endif endif @@ -1459,7 +1459,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & 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 IDat[uv]", CS%IDatu, CS%IDatv, G%HI, haloshift=0) + call uvchksum("BT IDat[uv]", CS%IDatu, CS%IDatv, G%HI, haloshift=0, scale=GV%m_to_Z) call uvchksum("BT visc_rem_[uv]", visc_rem_u, visc_rem_v, & G%HI, haloshift=1) endif @@ -2323,7 +2323,7 @@ subroutine set_dtbt(G, GV, CS, eta, pbce, BT_cont, gtot_est, SSH_add) elseif (CS%Nonlinear_continuity .and. present(eta)) then call find_face_areas(Datu, Datv, G, GV, CS, MS, eta=eta, halo=0) else - call find_face_areas(Datu, Datv, G, GV, CS, MS, halo=0, add_max=add_SSH) + call find_face_areas(Datu, Datv, G, GV, CS, MS, halo=0, add_max=add_SSH*GV%m_to_Z) endif det_de = 0.0 @@ -3542,7 +3542,7 @@ subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max) !! or column mass anomaly, in H (m or kg m-2). integer, optional, intent(in) :: halo !< The halo size to use, default = 1. real, optional, intent(in) :: add_max !< A value to add to the maximum depth (used - !! to overestimate the external wave speed) in m. + !! to overestimate the external wave speed) in Z. ! Local variables real :: H1, H2 ! Temporary total thicknesses, in m or kg m-2. @@ -3588,13 +3588,13 @@ subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max) elseif (present(add_max)) then !$OMP do do j=js-hs,je+hs ; do I=is-1-hs,ie+hs - Datu(I,j) = CS%dy_Cu(I,j) * GV%m_to_H * & - (GV%Z_to_m*max(CS%bathyT(i+1,j), CS%bathyT(i,j)) + add_max) + Datu(I,j) = CS%dy_Cu(I,j) * GV%Z_to_H * & + (max(CS%bathyT(i+1,j), CS%bathyT(i,j)) + add_max) enddo ; enddo !$OMP do do J=js-1-hs,je+hs ; do i=is-hs,ie+hs - Datv(i,J) = CS%dx_Cv(i,J) * GV%m_to_H * & - (GV%Z_to_m*max(CS%bathyT(i,j+1), CS%bathyT(i,j)) + add_max) + Datv(i,J) = CS%dx_Cv(i,J) * GV%Z_to_H * & + (max(CS%bathyT(i,j+1), CS%bathyT(i,j)) + add_max) enddo ; enddo else !$OMP do @@ -4088,17 +4088,17 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & ALLOC_(CS%D_v_Cor(CS%isdw:CS%iedw,CS%jsdw-1:CS%jedw)) CS%q_D(:,:) = 0.0 ; CS%D_u_Cor(:,:) = 0.0 ; CS%D_v_Cor(:,:) = 0.0 do j=js,je ; do I=is-1,ie - CS%D_u_Cor(I,j) = 0.5 * GV%Z_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j)) + CS%D_u_Cor(I,j) = 0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j)) enddo ; enddo do J=js-1,je ; do i=is,ie - CS%D_v_Cor(i,J) = 0.5 * GV%Z_to_m*(G%bathyT(i,j+1) + G%bathyT(i,j)) + CS%D_v_Cor(i,J) = 0.5 * (G%bathyT(i,j+1) + G%bathyT(i,j)) enddo ; enddo do J=js-1,je ; do I=is-1,ie if (G%mask2dT(i,j)+G%mask2dT(i,j+1)+G%mask2dT(i+1,j)+G%mask2dT(i+1,j+1)>0.) then CS%q_D(I,J) = 0.25 * G%CoriolisBu(I,J) * & ((G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i+1,j) + G%areaT(i,j+1))) / & - (GV%Z_to_m*((G%areaT(i,j) * G%bathyT(i,j) + G%areaT(i+1,j+1) * G%bathyT(i+1,j+1)) + & - (G%areaT(i+1,j) * G%bathyT(i+1,j) + G%areaT(i,j+1) * G%bathyT(i,j+1)))) + ((G%areaT(i,j) * G%bathyT(i,j) + G%areaT(i+1,j+1) * G%bathyT(i+1,j+1)) + & + (G%areaT(i+1,j) * G%bathyT(i+1,j) + G%areaT(i,j+1) * G%bathyT(i,j+1)) ) else ! All four h points are masked out so q_D(I,J) will is meaningless CS%q_D(I,J) = 0. endif @@ -4295,24 +4295,24 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & ! if (GV%Boussinesq) then do j=js,je ; do I=is-1,ie if (G%mask2dCu(I,j)>0.) then - CS%IDatu(I,j) = G%mask2dCu(I,j) * 2.0 / (GV%Z_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j))) + CS%IDatu(I,j) = G%mask2dCu(I,j) * 2.0 / (G%bathyT(i+1,j) + G%bathyT(i,j)) else ! Both neighboring H points are masked out so IDatu(I,j) is meaningless CS%IDatu(I,j) = 0. endif enddo ; enddo do J=js-1,je ; do i=is,ie if (G%mask2dCv(i,J)>0.) then - CS%IDatv(i,J) = G%mask2dCv(i,J) * 2.0 / (GV%Z_to_m*(G%bathyT(i,j+1) + G%bathyT(i,j))) - else ! Both neighboring H points are masked out so IDatu(I,j) is meaningless + CS%IDatv(i,J) = G%mask2dCv(i,J) * 2.0 / (G%bathyT(i,j+1) + G%bathyT(i,j)) + else ! Both neighboring H points are masked out so IDatv(I,j) is meaningless CS%IDatv(i,J) = 0. endif enddo ; enddo ! else ! do j=js,je ; do I=is-1,ie -! CS%IDatu(I,j) = G%mask2dCu(I,j) * 2.0 / (GV%Z_to_m*GV%Rho0*(G%bathyT(i+1,j) + G%bathyT(i,j))) +! CS%IDatu(I,j) = G%mask2dCu(I,j) * 2.0 / (GV%Rho0*(G%bathyT(i+1,j) + G%bathyT(i,j))) ! enddo ; enddo ! do J=js-1,je ; do i=is,ie -! CS%IDatv(i,J) = G%mask2dCv(i,J) * 2.0 / (GV%Z_to_m*GV%Rho0*(G%bathyT(i,j+1) + G%bathyT(i,j))) +! CS%IDatv(i,J) = G%mask2dCv(i,J) * 2.0 / (GV%Rho0*(G%bathyT(i,j+1) + G%bathyT(i,j))) ! enddo ; enddo ! endif From cea4c426e7ad1e590ba37b2778336134076422b8 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 4 Sep 2018 16:32:54 -0400 Subject: [PATCH 065/174] Updated comments in int_density_dz routines Updated comments in the various int_density_dz routines to reflect the flexibility of these routines to use different internal representations of the vertical coordinates. Only comments were changed, and all answers are bitwise identical. --- src/equation_of_state/MOM_EOS.F90 | 137 ++++++++++------------- src/equation_of_state/MOM_EOS_Wright.F90 | 35 +++--- src/equation_of_state/MOM_EOS_linear.F90 | 36 +++--- 3 files changed, 91 insertions(+), 117 deletions(-) diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 30ac795c56..7748a8b505 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -625,21 +625,21 @@ subroutine int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, EOS, & real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: S !< Salinity (PSU) real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_t !< Height at the top of the layer in m. + intent(in) :: z_t !< Height at the top of the layer in depth units (Z). real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_b !< Height at the bottom of the layer in m. + intent(in) :: z_b !< Height at the bottom of the layer in Z. real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted out to !! reduce the magnitude of each of the integrals. real, intent(in) :: rho_0 !< A density, in kg m-3, that is used to calculate the !! pressure (as p~=-z*rho_0*G_e) used in the equation of state. - real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m s-2. + real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m2 Z-1 s-2. type(EOS_type), pointer :: EOS !< Equation of state structure real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & intent(out) :: dpa !< The change in the pressure anomaly across the layer, in Pa. real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & optional, intent(out) :: intz_dpa !< The integral through the thickness of the layer of !! the pressure anomaly relative to the anomaly at the - !! top of the layer, in Pa m. + !! top of the layer, in Pa Z. real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), & optional, intent(out) :: intx_dpa !< The integral in x of the difference between the !! pressure anomaly at the top and bottom of the layer @@ -649,9 +649,8 @@ subroutine int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, EOS, & !! pressure anomaly at the top and bottom of the layer !! divided by the y grid spacing, in Pa. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - optional, intent(in) :: bathyT !< The depth of the bathymetry in m - real, optional, intent(in) :: dz_neglect !< A miniscule thickness change with the - !! same units as z_t + optional, intent(in) :: bathyT !< The depth of the bathymetry in units of Z. + real, optional, intent(in) :: dz_neglect !< A miniscule thickness change, in Z. logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to !! interpolate T/S for top and bottom integrals. @@ -877,16 +876,16 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: S !< Salinity of the layer in PSU. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_t !< Height at the top of the layer in m. + intent(in) :: z_t !< Height at the top of the layer in depth units (Z). real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_b !< Height at the bottom of the layer in m. + intent(in) :: z_b !< Height at the bottom of the layer in Z. real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is !! subtracted out to reduce the magnitude !! of each of the integrals. real, intent(in) :: rho_0 !< A density, in kg m-3, that is used !! to calculate the pressure (as p~=-z*rho_0*G_e) !! used in the equation of state. - real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m s-2. + real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m2 Z-1 s-2. type(EOS_type), pointer :: EOS !< Equation of state structure real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & intent(out) :: dpa !< The change in the pressure anomaly @@ -894,7 +893,7 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & optional, intent(out) :: intz_dpa !< The integral through the thickness of the !! layer of the pressure anomaly relative to the - !! anomaly at the top of the layer, in Pa m. + !! anomaly at the top of the layer, in Pa Z. real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), & optional, intent(out) :: intx_dpa !< The integral in x of the difference between !! the pressure anomaly at the top and bottom of the @@ -904,9 +903,8 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, !! the pressure anomaly at the top and bottom of the !! layer divided by the y grid spacing, in Pa. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - optional, intent(in) :: bathyT !< The depth of the bathymetry in m - real, optional, intent(in) :: dz_neglect !< A miniscule thickness change with the - !! same units as z_t + optional, intent(in) :: bathyT !< The depth of the bathymetry in units of Z. + real, optional, intent(in) :: dz_neglect !< A miniscule thickness change, in Z. logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to !! interpolate T/S for top and bottom integrals. real :: T5(5), S5(5), p5(5), r5(5) @@ -914,16 +912,16 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, real :: w_left, w_right real, parameter :: C1_90 = 1.0/90.0 ! Rational constants. real :: GxRho, I_Rho - real :: dz ! The layer thickness, in m. - real :: hWght ! A pressure-thickness below topography, in m. - real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in m. - real :: iDenom ! The inverse of the denominator in the wieghts, in m-2. + real :: dz ! The layer thickness, in Z. + real :: hWght ! A pressure-thickness below topography, in Z. + real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Z. + real :: iDenom ! The inverse of the denominator in the weights, in Z-2. real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column, nonDim. real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column, nonDim. - real :: wt_L, wt_R ! The linear wieghts of the left and right columns, nonDim. + real :: wt_L, wt_R ! The linear weights of the left and right columns, nonDim. real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns, nonDim. - real :: intz(5) ! The integrals of density with height at the - ! 5 sub-column locations, in m2 s-2. + real :: intz(5) ! The gravitational acceleration times the integrals of density + ! with height at the 5 sub-column locations, in Pa. logical :: do_massWeight ! Indicates whether to do mass weighting. integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, i, j, m, n, ioff, joff @@ -1054,7 +1052,6 @@ end subroutine int_density_dz_generic ! ========================================================================== !> Compute pressure gradient force integrals by quadrature for the case where !! T and S are linear profiles. -! ========================================================================== subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & rho_0, G_e, dz_subroundoff, bathyT, HII, HIO, EOS, dpa, & intz_dpa, intx_dpa, inty_dpa, & @@ -1070,27 +1067,26 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: S_b !< Salinity at the cell bottom (ppt) real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_t !< The geometric height at the top - !! of the layer, usually in m + intent(in) :: z_t !< The geometric height at the top of the layer, + !! in depth units (Z), usually m. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_b !< The geometric height at the bottom - !! of the layer, usually in m + intent(in) :: z_b !< The geometric height at the bottom of the layer in Z. real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted out to !! reduce the magnitude of each of the integrals. real, intent(in) :: rho_0 !< A density, in kg m-3, that is used to calculate the !! pressure (as p~=-z*rho_0*G_e) used in the equation of state. - real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m s-2. + real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m2 Z-1 s-2. real, intent(in) :: dz_subroundoff !< A miniscule thickness !! change with the same units as z_t real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: bathyT !< The depth of the bathymetry in m + intent(in) :: bathyT !< The depth of the bathymetry in units of Z. type(EOS_type), pointer :: EOS !< Equation of state structure real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & intent(out) :: dpa !< The change in the pressure anomaly across the layer, in Pa. real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & optional, intent(out) :: intz_dpa !< The integral through the thickness of the layer of !! the pressure anomaly relative to the anomaly at the - !! top of the layer, in Pa m. + !! top of the layer, in Pa Z. real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), & optional, intent(out) :: intx_dpa !< The integral in x of the difference between the !! pressure anomaly at the top and bottom of the layer @@ -1111,53 +1107,34 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & ! It is assumed that the salinity and temperature profiles are linear in the ! vertical. The top and bottom values within each layer are provided and ! a linear interpolation is used to compute intermediate values. -! -! Arguments: T - potential temperature relative to the surface in C -! (the 't' and 'b' subscripts refer to the values at -! the top and the bottom of each layer) -! (in) S - salinity in PSU. -! (the 't' and 'b' subscripts refer to the values at -! the top and the bottom of each layer) -! (in) z_t - height at the top of the layer in m. -! (in) z_b - height at the top of the layer in m. -! (in) rho_ref - A mean density, in kg m-3, that is subtracted out to reduce -! the magnitude of each of the integrals. -! (The pressure is calucated as p~=-z*rho_0*G_e.) -! (in) rho_0 - A density, in kg m-3, that is used to calculate the pressure -! (as p~=-z*rho_0*G_e) used in the equation of state. -! (in) G_e - The Earth's gravitational acceleration, in m s-2. -! (in) G - The ocean's grid structure. -! (in) form_of_eos - integer that selects the eqn of state. -! (out) dpa - The change in the pressure anomaly across the layer, -! in Pa. -! (out,opt) intz_dpa - The integral through the thickness of the layer of the -! pressure anomaly relative to the anomaly at the top of -! the layer, in Pa m. -! (out,opt) intx_dpa - The integral in x of the difference between the -! pressure anomaly at the top and bottom of the layer -! divided by the x grid spacing, in Pa. -! (out,opt) inty_dpa - The integral in y of the difference between the -! pressure anomaly at the top and bottom of the layer -! divided by the y grid spacing, in Pa. -! (in,opt) useMassWghtInterp - If true, uses mass weighting to interpolate -! T/S for top and bottom integrals. - - real :: T5((5*HIO%iscB+1):(5*(HIO%iecB+2))) - real :: S5((5*HIO%iscB+1):(5*(HIO%iecB+2))) - real :: p5((5*HIO%iscB+1):(5*(HIO%iecB+2))) - real :: r5((5*HIO%iscB+1):(5*(HIO%iecB+2))) - real :: T15((15*HIO%iscB+1):(15*(HIO%iecB+1))) - real :: S15((15*HIO%iscB+1):(15*(HIO%iecB+1))) - real :: p15((15*HIO%iscB+1):(15*(HIO%iecB+1))) - real :: r15((15*HIO%iscB+1):(15*(HIO%iecB+1))) - real :: wt_t(5), wt_b(5) - real :: rho_anom - real :: w_left, w_right, intz(5) - real, parameter :: C1_90 = 1.0/90.0 ! Rational constants. - real :: GxRho, I_Rho - real :: dz(HIO%iscB:HIO%iecB+1), dz_x(5,HIO%iscB:HIO%iecB), dz_y(5,HIO%isc:HIO%iec) - real :: weight_t, weight_b, hWght, massWeightToggle - real :: Ttl, Tbl, Ttr, Tbr, Stl, Sbl, Str, Sbr, hL, hR, iDenom + + ! Local variables + real :: T5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Temperatures along a line of subgrid locations, in degC + real :: S5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Salinities along a line of subgrid locations, in ppt + real :: p5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Pressures along a line of subgrid locations, in Pa + real :: r5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Densities along a line of subgrid locations, in kg m-3 + real :: T15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Temperatures at an array of subgrid locations, in degC + real :: S15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Salinities at an array of subgrid locations, in ppt + real :: p15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Pressures at an array of subgrid locations, in Pa + real :: r15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Densities at an array of subgrid locations, in kg m-3 + real :: wt_t(5), wt_b(5) ! Top and bottom weights, ND. + real :: rho_anom ! A density anomaly in kg m-3. + real :: w_left, w_right ! Left and right weights, ND. + real :: intz(5) ! The gravitational acceleration times the integrals of density + ! with height at the 5 sub-column locations, in Pa. + real, parameter :: C1_90 = 1.0/90.0 ! A rational constant, ND. + real :: GxRho ! Gravitational acceleration times density, in kg m-1 Z-1 s-2. + real :: I_Rho ! The inverse of the reference density, in m3 kg-1. + real :: dz(HIO%iscB:HIO%iecB+1) ! Layer thicknesses at tracer points in Z. + real :: dz_x(5,HIO%iscB:HIO%iecB) ! Layer thicknesses along an x-line of subrid locations, in Z. + real :: dz_y(5,HIO%isc:HIO%iec) ! Layer thicknesses along a y-line of subrid locations, in Z. + real :: weight_t, weight_b ! Nondimensional wieghts of the top and bottom. + real :: massWeightToggle ! A nondimensional toggle factor (0 or 1). + real :: Ttl, Tbl, Ttr, Tbr ! Temperatures at the velocity cell corners, in degC. + real :: Stl, Sbl, Str, Sbr ! Salinities at the velocity cell corners, in ppt. + real :: hWght ! A topographically limited thicknes weight, in Z. + real :: hL, hR ! Thicknesses to the left and right, in Z. + real :: iDenom ! The denominator of the thickness weight expressions, in Z-2. integer :: Isq, Ieq, Jsq, Jeq, i, j, m, n integer :: iin, jin, ioff, joff integer :: pos @@ -2009,10 +1986,10 @@ subroutine int_spec_vol_dp_generic(T, S, p_t, p_b, alpha_ref, HI, EOS, & ! real :: dp_90(2:4) ! The pressure change through a layer divided by 90, in Pa. real :: hWght ! A pressure-thickness below topography, in Pa. real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Pa. - real :: iDenom ! The inverse of the denominator in the wieghts, in Pa-2. + real :: iDenom ! The inverse of the denominator in the weights, in Pa-2. real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column, nonDim. real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column, nonDim. - real :: wt_L, wt_R ! The linear wieghts of the left and right columns, nonDim. + real :: wt_L, wt_R ! The linear weights of the left and right columns, nonDim. real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns, nonDim. real :: intp(5) ! The integrals of specific volume with pressure at the ! 5 sub-column locations, in m2 s-2. @@ -2206,10 +2183,10 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, real :: dp_90(2:4) ! The pressure change through a layer divided by 90, in Pa. real :: hWght ! A pressure-thickness below topography, in Pa. real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Pa. - real :: iDenom ! The inverse of the denominator in the wieghts, in Pa-2. + real :: iDenom ! The inverse of the denominator in the weights, in Pa-2. real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column, nonDim. real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column, nonDim. - real :: wt_L, wt_R ! The linear wieghts of the left and right columns, nonDim. + real :: wt_L, wt_R ! The linear weights of the left and right columns, nonDim. real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns, nonDim. real :: intp(5) ! The integrals of specific volume with pressure at the ! 5 sub-column locations, in m2 s-2. diff --git a/src/equation_of_state/MOM_EOS_Wright.F90 b/src/equation_of_state/MOM_EOS_Wright.F90 index d35961b997..a4535ec961 100644 --- a/src/equation_of_state/MOM_EOS_Wright.F90 +++ b/src/equation_of_state/MOM_EOS_Wright.F90 @@ -402,23 +402,23 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: S !< Salinity in PSU. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_t !< Height at the top of the layer in m. + intent(in) :: z_t !< Height at the top of the layer in depth units (Z). real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_b !< Height at the top of the layer in m. + intent(in) :: z_b !< Height at the top of the layer in Z. real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted out !! to reduce the magnitude of each of the integrals. !! (The pressure is calucated as p~=-z*rho_0*G_e.) real, intent(in) :: rho_0 !< Density, in kg m-3, that is used to calculate the !! pressure (as p~=-z*rho_0*G_e) used in the !! equation of state. - real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m s-2. + real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m2 Z-1 s-2. real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & intent(out) :: dpa !< The change in the pressure anomaly across the !! layer, in Pa. real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & optional, intent(out) :: intz_dpa !< The integral through the thickness of the layer !! of the pressure anomaly relative to the anomaly - !! at the top of the layer, in Pa m. + !! at the top of the layer, in Pa Z. real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), & optional, intent(out) :: intx_dpa !< The integral in x of the difference between the !! pressure anomaly at the top and bottom of the @@ -428,11 +428,10 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, !! pressure anomaly at the top and bottom of the !! layer divided by the y grid spacing, in Pa. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - optional, intent(in) :: bathyT !< The depth of the bathymetry in m - real, optional, intent(in) :: dz_neglect !< A miniscule thickness change with the - !! same units as z_t + optional, intent(in) :: bathyT !< The depth of the bathymetry in units of Z. + real, optional, intent(in) :: dz_neglect !< A miniscule thickness change in Z. logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to - !! interpolate T/S for top and bottom integrals. + !! interpolate T/S for top and bottom integrals. ! Local variables real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed) :: al0_2d, p0_2d, lambda_2d @@ -441,16 +440,16 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, real :: eps, eps2, rem real :: GxRho, I_Rho real :: p_ave, I_al0, I_Lzz - real :: dz ! The layer thickness, in m. - real :: hWght ! A pressure-thickness below topography, in m. - real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in m. - real :: iDenom ! The inverse of the denominator in the wieghts, in m-2. + real :: dz ! The layer thickness, in Z. + real :: hWght ! A pressure-thickness below topography, in Z. + real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Z. + real :: iDenom ! The inverse of the denominator in the weights, in m-Z. real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column, nonDim. real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column, nonDim. - real :: wt_L, wt_R ! The linear wieghts of the left and right columns, nonDim. + real :: wt_L, wt_R ! The linear weights of the left and right columns, nonDim. real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns, nonDim. real :: intz(5) ! The integrals of density with height at the - ! 5 sub-column locations, in m2 s-2. + ! 5 sub-column locations, in Pa. logical :: do_massWeight ! Indicates whether to do mass weighting. real, parameter :: C1_3 = 1.0/3.0, C1_7 = 1.0/7.0 ! Rational constants. real, parameter :: C1_9 = 1.0/9.0, C1_90 = 1.0/90.0 ! Rational constants. @@ -634,9 +633,9 @@ subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, spv_ref, HI, dza, & integer, optional, intent(in) :: halo_size !< The width of halo points on which to calculate !! dza. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - optional, intent(in) :: bathyP !< The pressure at the bathymetry in Pa + optional, intent(in) :: bathyP !< The pressure at the bathymetry in Pa real, optional, intent(in) :: dP_neglect !< A miniscule pressure change with - !! the same units as p_t (Pa?) + !! the same units as p_t (Pa?) logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting !! to interpolate T/S for top and bottom integrals. @@ -649,10 +648,10 @@ subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, spv_ref, HI, dza, & real :: dp ! The pressure change through a layer, in Pa. real :: hWght ! A pressure-thickness below topography, in Pa. real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Pa. - real :: iDenom ! The inverse of the denominator in the wieghts, in Pa-2. + real :: iDenom ! The inverse of the denominator in the weights, in Pa-2. real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column, nonDim. real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column, nonDim. - real :: wt_L, wt_R ! The linear wieghts of the left and right columns, nonDim. + real :: wt_L, wt_R ! The linear weights of the left and right columns, nonDim. real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns, nonDim. real :: intp(5) ! The integrals of specific volume with pressure at the ! 5 sub-column locations, in m2 s-2. diff --git a/src/equation_of_state/MOM_EOS_linear.F90 b/src/equation_of_state/MOM_EOS_linear.F90 index 7168e2f2f7..d63929bd62 100644 --- a/src/equation_of_state/MOM_EOS_linear.F90 +++ b/src/equation_of_state/MOM_EOS_linear.F90 @@ -323,9 +323,9 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HII, real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: S !< Salinity in PSU. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_t !< Height at the top of the layer in m. + intent(in) :: z_t !< Height at the top of the layer in depth units (Z). real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_b !< Height at the top of the layer in m. + intent(in) :: z_b !< Height at the top of the layer in Z. real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted !! out to reduce the magnitude of each of the !! integrals. @@ -333,8 +333,7 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HII, !! the pressure (as p~=-z*rho_0_pres*G_e) used in !! the equation of state. rho_0_pres is not used !! here. - real, intent(in) :: G_e !< The Earth's gravitational acceleration, - !! in m s-2. + real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m2 Z-1 s-2. real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0, in kg m-3. real, intent(in) :: dRho_dT !< The derivative of density with temperature, !! in kg m-3 C-1. @@ -346,7 +345,7 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HII, real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & optional, intent(out) :: intz_dpa !< The integral through the thickness of the layer !! of the pressure anomaly relative to the anomaly - !! at the top of the layer, in Pa m. + !! at the top of the layer, in Pa Z. real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), & optional, intent(out) :: intx_dpa !< The integral in x of the difference between the !! pressure anomaly at the top and bottom of the @@ -356,24 +355,23 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HII, !! pressure anomaly at the top and bottom of the !! layer divided by the y grid spacing, in Pa. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - optional, intent(in) :: bathyT !< The depth of the bathymetry in m - real, optional, intent(in) :: dz_neglect !< A miniscule thickness change with the - !! same units as z_t + optional, intent(in) :: bathyT !< The depth of the bathymetry in units of Z. + real, optional, intent(in) :: dz_neglect !< A miniscule thickness change in Z. logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to - !! interpolate T/S for top and bottom integrals. + !! interpolate T/S for top and bottom integrals. ! Local variables real :: rho_anom ! The density anomaly from rho_ref, in kg m-3. real :: raL, raR ! rho_anom to the left and right, in kg m-3. - real :: dz, dzL, dzR ! Layer thicknesses in m. - real :: hWght ! A pressure-thickness below topography, in m. - real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in m. - real :: iDenom ! The inverse of the denominator in the wieghts, in m-2. + real :: dz, dzL, dzR ! Layer thicknesses in Z. + real :: hWght ! A pressure-thickness below topography, in Z. + real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Z. + real :: iDenom ! The inverse of the denominator in the weights, in Z-2. real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column, nonDim. real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column, nonDim. - real :: wt_L, wt_R ! The linear wieghts of the left and right columns, nonDim. + real :: wt_L, wt_R ! The linear weights of the left and right columns, nonDim. real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns, nonDim. real :: intz(5) ! The integrals of density with height at the - ! 5 sub-column locations, in m2 s-2. + ! 5 sub-column locations, in Pa. logical :: do_massWeight ! Indicates whether to do mass weighting. real, parameter :: C1_6 = 1.0/6.0, C1_90 = 1.0/90.0 ! Rational constants. integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, i, j, ioff, joff, m @@ -529,9 +527,9 @@ subroutine int_spec_vol_dp_linear(T, S, p_t, p_b, alpha_ref, HI, Rho_T0_S0, & !! in m2 s-2. integer, optional, intent(in) :: halo_size !< The width of halo points on which to calculate dza. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - optional, intent(in) :: bathyP !< The pressure at the bathymetry in Pa + optional, intent(in) :: bathyP !< The pressure at the bathymetry in Pa real, optional, intent(in) :: dP_neglect !< A miniscule pressure change with - !! the same units as p_t (Pa?) + !! the same units as p_t (Pa?) logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting !! to interpolate T/S for top and bottom integrals. ! Local variables @@ -541,10 +539,10 @@ subroutine int_spec_vol_dp_linear(T, S, p_t, p_b, alpha_ref, HI, Rho_T0_S0, & real :: dp, dpL, dpR ! Layer pressure thicknesses in Pa. real :: hWght ! A pressure-thickness below topography, in Pa. real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Pa. - real :: iDenom ! The inverse of the denominator in the wieghts, in Pa-2. + real :: iDenom ! The inverse of the denominator in the weights, in Pa-2. real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column, nonDim. real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column, nonDim. - real :: wt_L, wt_R ! The linear wieghts of the left and right columns, nonDim. + real :: wt_L, wt_R ! The linear weights of the left and right columns, nonDim. real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns, nonDim. real :: intp(5) ! The integrals of specific volume with pressure at the ! 5 sub-column locations, in m2 s-2. From 626d70563744c2f4337d72c36263c0e2820869a4 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 5 Sep 2018 10:54:58 -0400 Subject: [PATCH 066/174] +Added scale argument to read_ & get_param_real Added scale argument to get_param_real, read_param_real, get_param_real_array and read_param_real array, so that parameters can be rescaled immediately before being returned. Also removed duplicative comments. All answers are bitwise identical, although there is a new optional argument for 4 publicly visible routines. --- src/framework/MOM_file_parser.F90 | 260 ++++++++++++++---------------- 1 file changed, 124 insertions(+), 136 deletions(-) diff --git a/src/framework/MOM_file_parser.F90 b/src/framework/MOM_file_parser.F90 index 72944c4f7a..a4daaa7c40 100644 --- a/src/framework/MOM_file_parser.F90 +++ b/src/framework/MOM_file_parser.F90 @@ -124,6 +124,7 @@ subroutine open_param_file(filename, CS, checkable, component, doc_file_dir) character(len=*), optional, intent(in) :: doc_file_dir !< An optional directory in which to write out !! the documentation files. The default is effectively './'. + ! Local variables logical :: file_exists, unit_in_use, Netcdf_file, may_check integer :: ios, iounit, strlen, i character(len=240) :: doc_path @@ -247,8 +248,8 @@ subroutine close_param_file(CS, quiet_close, component) ! Local variables character(len=128) :: docfile_default character(len=40) :: mdl ! This module's name. -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" integer :: i, n, num_unused if (present(quiet_close)) then ; if (quiet_close) then @@ -339,13 +340,14 @@ subroutine populate_param_data(iounit, filename, param_data) type(file_data_type), intent(inout) :: param_data !< A list of the input lines that set parameters !! after comments have been stripped out. + ! Local variables character(len=INPUT_STR_LENGTH) :: line integer :: num_lines logical :: inMultiLineComment -! Find the number of keyword lines in a parameter file -! Allocate the space to hold the lines in param_data%line -! Populate param_data%line with the keyword lines from parameter file + ! Find the number of keyword lines in a parameter file + ! Allocate the space to hold the lines in param_data%line + ! Populate param_data%line with the keyword lines from parameter file if (iounit <= 0) return @@ -434,8 +436,10 @@ end subroutine populate_param_data function openMultiLineComment(string) character(len=*), intent(in) :: string !< The input string to process logical :: openMultiLineComment -! True if a /* appears on this line without a closing */ + + ! Local variables integer :: icom, last + openMultiLineComment = .false. last = lastNonCommentIndex(string)+1 icom = index(string(last:), "/*") @@ -460,9 +464,11 @@ end function closeMultiLineComment function lastNonCommentIndex(string) character(len=*), intent(in) :: string !< The input string to process integer :: lastNonCommentIndex -! Find position of last character before any comments -! This s/r is the only place where a comment needs to be defined + + ! Local variables integer :: icom, last + + ! This subroutine is the only place where a comment needs to be defined last = len_trim(string) icom = index(string(:last), "!") ; if (icom > 0) last = icom-1 ! F90 style icom = index(string(:last), "//") ; if (icom > 0) last = icom-1 ! C++ style @@ -474,7 +480,7 @@ end function lastNonCommentIndex function lastNonCommentNonBlank(string) character(len=*), intent(in) :: string !< The input string to process integer :: lastNonCommentNonBlank -! Find position of last non-blank character before any comments + lastNonCommentNonBlank = len_trim(string(:lastNonCommentIndex(string))) ! Ignore remaining trailing blanks end function lastNonCommentNonBlank @@ -482,8 +488,9 @@ end function lastNonCommentNonBlank function replaceTabs(string) character(len=*), intent(in) :: string !< The input string to process character(len=len(string)) :: replaceTabs -! Returns string with tabs replaced by a blank + integer :: i + do i=1, len(string) if (string(i:i)==achar(9)) then replaceTabs(i:i)=" " @@ -497,8 +504,9 @@ end function replaceTabs function removeComments(string) character(len=*), intent(in) :: string !< The input string to process character(len=len(string)) :: removeComments -! Trims comments and leading blanks from string + integer :: last + removeComments=repeat(" ",len(string)) last = lastNonCommentNonBlank(string) removeComments(:last)=adjustl(string(:last)) ! Copy only the non-comment part of string @@ -509,11 +517,12 @@ end function removeComments function simplifyWhiteSpace(string) character(len=*), intent(in) :: string !< A string to modify to simpify white space character(len=len(string)+16) :: simplifyWhiteSpace -! Constructs a string with all repeated whitespace replaced with single blanks -! and insert white space where it helps delineate tokens (e.g. around =) + + ! Local variables integer :: i,j logical :: nonBlank = .false., insideString = .false. character(len=1) :: quoteChar=" " + nonBlank = .false.; insideString = .false. ! NOTE: For some reason this line is needed?? i=0 simplifyWhiteSpace=repeat(" ",len(string)+16) @@ -567,11 +576,7 @@ subroutine read_param_int(CS, varname, value, fail_if_missing) !! read from the parameter file logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs !! if this variable is not found in the parameter file -! This subroutine determines the value of an integer model parameter -! from a parameter file. The arguments are the unit of the open file -! which is to be read, the (case-sensitive) variable name, the variable -! where the value is to be stored, and (optionally) a flag indicating -! whether to fail if this parameter can not be found. + ! Local variables character(len=INPUT_STR_LENGTH) :: value_string(1) logical :: found, defined @@ -603,11 +608,7 @@ subroutine read_param_int_array(CS, varname, value, fail_if_missing) !! read from the parameter file logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs !! if this variable is not found in the parameter file -! This subroutine determines the value of an integer model parameter -! from a parameter file. The arguments are the unit of the open file -! which is to be read, the (case-sensitive) variable name, the variable -! where the value is to be stored, and (optionally) a flag indicating -! whether to fail if this parameter can not be found. + ! Local variables character(len=INPUT_STR_LENGTH) :: value_string(1) logical :: found, defined @@ -632,25 +633,25 @@ subroutine read_param_int_array(CS, varname, value, fail_if_missing) end subroutine read_param_int_array !> This subroutine reads the value of a real model parameter from a parameter file. -subroutine read_param_real(CS, varname, value, fail_if_missing) - type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, +subroutine read_param_real(CS, varname, value, fail_if_missing, scale) + type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters - character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read - real, intent(inout) :: value !< The value of the parameter that may be + character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read + real, intent(inout) :: value !< The value of the parameter that may be !! read from the parameter file - logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs + logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs !! if this variable is not found in the parameter file -! This subroutine determines the value of an integer model parameter -! from a parameter file. The arguments are the unit of the open file -! which is to be read, the (case-sensitive) variable name, the variable -! where the value is to be stored, and (optionally) a flag indicating -! whether to fail if this parameter can not be found. + real, optional, intent(in) :: scale !< A scaling factor that the parameter is multiplied + !! by before it is returned. + + ! Local variables character(len=INPUT_STR_LENGTH) :: value_string(1) logical :: found, defined call get_variable_line(CS, varname, found, defined, value_string) if (found .and. defined .and. (LEN_TRIM(value_string(1)) > 0)) then read(value_string(1),*,err=1003) value + if (present(scale)) value = scale*value else if (present(fail_if_missing)) then ; if (fail_if_missing) then if (.not.found) then @@ -668,26 +669,27 @@ subroutine read_param_real(CS, varname, value, fail_if_missing) end subroutine read_param_real !> This subroutine reads the values of an array of real model parameters from a parameter file. -subroutine read_param_real_array(CS, varname, value, fail_if_missing) - type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, +subroutine read_param_real_array(CS, varname, value, fail_if_missing, scale) + type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters - character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read - real, dimension(:), intent(inout) :: value !< The value of the parameter that may be + character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read + real, dimension(:), intent(inout) :: value !< The value of the parameter that may be !! read from the parameter file - logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs + logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs !! if this variable is not found in the parameter file -! This subroutine determines the value of an integer model parameter -! from a parameter file. The arguments are the unit of the open file -! which is to be read, the (case-sensitive) variable name, the variable -! where the value is to be stored, and (optionally) a flag indicating -! whether to fail if this parameter can not be found. + real, optional, intent(in) :: scale !< A scaling factor that the parameter is multiplied + !! by before it is returned. + + ! Local variables character(len=INPUT_STR_LENGTH) :: value_string(1) logical :: found, defined call get_variable_line(CS, varname, found, defined, value_string) if (found .and. defined .and. (LEN_TRIM(value_string(1)) > 0)) then read(value_string(1),*,end=991,err=1004) value - 991 return +991 continue + if (present(scale)) value(:) = scale*value(:) + return else if (present(fail_if_missing)) then ; if (fail_if_missing) then if (.not.found) then @@ -713,11 +715,7 @@ subroutine read_param_char(CS, varname, value, fail_if_missing) !! read from the parameter file logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs !! if this variable is not found in the parameter file -! This subroutine determines the value of an integer model parameter -! from a parameter file. The arguments are the unit of the open file -! which is to be read, the (case-sensitive) variable name, the variable -! where the value is to be stored, and (optionally) a flag indicating -! whether to fail if this parameter can not be found. + ! Local variables character(len=INPUT_STR_LENGTH) :: value_string(1) logical :: found, defined @@ -740,11 +738,8 @@ subroutine read_param_char_array(CS, varname, value, fail_if_missing) !! read from the parameter file logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs !! if this variable is not found in the parameter file -! This subroutine determines the value of an integer model parameter -! from a parameter file. The arguments are the unit of the open file -! which is to be read, the (case-sensitive) variable name, the variable -! where the value is to be stored, and (optionally) a flag indicating -! whether to fail if this parameter can not be found. + + ! Local variables character(len=INPUT_STR_LENGTH) :: value_string(1), loc_string logical :: found, defined integer :: i, i_out @@ -781,11 +776,8 @@ subroutine read_param_logical(CS, varname, value, fail_if_missing) !! read from the parameter file logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs !! if this variable is not found in the parameter file -! This subroutine determines the value of an integer model parameter -! from a parameter file. The arguments are the unit of the open file -! which is to be read, the (case-sensitive) variable name, the variable -! where the value is to be stored, and (optionally) a flag indicating -! whether to fail if this parameter can not be found. + + ! Local variables character(len=INPUT_STR_LENGTH) :: value_string(1) logical :: found, defined @@ -811,12 +803,8 @@ subroutine read_param_time(CS, varname, value, timeunit, fail_if_missing, date_f logical, optional, intent(out) :: date_format !< If present, this indicates whether this !! parameter was read in a date format, so that it can !! later be logged in the same format. -! This subroutine determines the value of an time-type model parameter -! from a parameter file. The arguments are the unit of the open file -! which is to be read, the (case-sensitive) variable name, the variable -! where the value is to be stored, and (optionally) a flag indicating -! whether to fail if this parameter can not be found. The unique argument -! to read time is the number of seconds to use as the unit of time being read. + + ! Local variables character(len=INPUT_STR_LENGTH) :: value_string(1) character(len=240) :: err_msg logical :: found, defined @@ -906,6 +894,7 @@ subroutine get_variable_line(CS, varname, found, defined, value_string, paramIsL logical, optional, intent(in) :: paramIsLogical !< If true, this is a logical parameter !! that can be simply defined without parsing a value_string. + ! Local variables character(len=INPUT_STR_LENGTH) :: val_str, lname, origLine character(len=INPUT_STR_LENGTH) :: line, continuationBuffer, blockName character(len=FILENAME_LENGTH) :: filename @@ -1228,8 +1217,9 @@ function overrideWarningHasBeenIssued(chain, varName) !! override warnings issued character(len=*), intent(in) :: varName !< The name of the variable being queried for warnings logical :: overrideWarningHasBeenIssued -! Returns true if an override warning has been issued for the variable varName + ! Local variables type(link_parameter), pointer :: newLink => NULL(), this => NULL() + overrideWarningHasBeenIssued = .false. this => chain do while( associated(this) ) @@ -1291,15 +1281,14 @@ subroutine log_param_int(CS, modulename, varname, value, desc, units, & character(len=*), intent(in) :: varname !< The name of the parameter to log integer, intent(in) :: value !< The value of the parameter to log character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter integer, optional, intent(in) :: default !< The default value of the parameter - logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is !! logged in the layout parameter file - logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file -! This subroutine writes the value of an integer parameter to a log file, -! along with its name and the module it came from. + character(len=240) :: mesg, myunits write(mesg, '(" ",a," ",a,": ",a)') trim(modulename), trim(varname), trim(left_int(value)) @@ -1324,15 +1313,14 @@ subroutine log_param_int_array(CS, modulename, varname, value, desc, & character(len=*), intent(in) :: varname !< The name of the parameter to log integer, dimension(:), intent(in) :: value !< The value of the parameter to log character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter integer, optional, intent(in) :: default !< The default value of the parameter - logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is !! logged in the layout parameter file - logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file -! This subroutine writes the value of an integer parameter to a log file, -! along with its name and the module it came from. + character(len=1320) :: mesg character(len=240) :: myunits @@ -1358,13 +1346,12 @@ subroutine log_param_real(CS, modulename, varname, value, desc, units, & character(len=*), intent(in) :: varname !< The name of the parameter to log real, intent(in) :: value !< The value of the parameter to log character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter real, optional, intent(in) :: default !< The default value of the parameter - logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file -! This subroutine writes the value of a real parameter to a log file, -! along with its name and the module it came from. + character(len=240) :: mesg, myunits write(mesg, '(" ",a," ",a,": ",a)') & @@ -1390,11 +1377,10 @@ subroutine log_param_real_array(CS, modulename, varname, value, desc, & character(len=*), intent(in) :: varname !< The name of the parameter to log real, dimension(:), intent(in) :: value !< The value of the parameter to log character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter real, optional, intent(in) :: default !< The default value of the parameter -! This subroutine writes the value of a real parameter to a log file, -! along with its name and the module it came from. + character(len=1320) :: mesg character(len=240) :: myunits @@ -1423,15 +1409,14 @@ subroutine log_param_logical(CS, modulename, varname, value, desc, & character(len=*), intent(in) :: varname !< The name of the parameter to log logical, intent(in) :: value !< The value of the parameter to log character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter logical, optional, intent(in) :: default !< The default value of the parameter - logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is !! logged in the layout parameter file - logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file -! This subroutine writes the value of a logical parameter to a log file, -! along with its name and the module it came from. + character(len=240) :: mesg, myunits if (value) then @@ -1460,15 +1445,14 @@ subroutine log_param_char(CS, modulename, varname, value, desc, units, & character(len=*), intent(in) :: varname !< The name of the parameter to log character(len=*), intent(in) :: value !< The value of the parameter to log character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter character(len=*), optional, intent(in) :: default !< The default value of the parameter - logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is !! logged in the layout parameter file - logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file -! This subroutine writes the value of a character string parameter to a log -! file, along with its name and the module it came from. + character(len=240) :: mesg, myunits write(mesg, '(" ",a," ",a,": ",a)') & @@ -1495,18 +1479,19 @@ subroutine log_param_time(CS, modulename, varname, value, desc, units, & character(len=*), intent(in) :: varname !< The name of the parameter to log type(time_type), intent(in) :: value !< The value of the parameter to log character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter type(time_type), optional, intent(in) :: default !< The default value of the parameter real, optional, intent(in) :: timeunit !< The number of seconds in a time unit for !! real-number output. logical, optional, intent(in) :: log_date !< If true, log the time_type in date format. !! If missing the default is false. - logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is !! logged in the layout parameter file - logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file + ! Local variables real :: real_time, real_default logical :: use_timeunit, date_format character(len=240) :: mesg, myunits @@ -1580,6 +1565,7 @@ function convert_date_to_string(date) result(date_string) type(time_type), intent(in) :: date !< The date to be translated into a string. character(len=40) :: date_string !< A date string in a format like YYYY-MM-DD HH:MM:SS.sss + ! Local variables character(len=40) :: sub_string real :: real_secs integer :: yrs, mons, days, hours, mins, secs, ticks, ticks_per_sec @@ -1616,7 +1602,7 @@ subroutine get_param_int(CS, modulename, varname, value, desc, units, & integer, intent(inout) :: value !< The value of the parameter that may be !! read from the parameter file and logged character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter integer, optional, intent(in) :: default !< The default value of the parameter integer, optional, intent(in) :: static_value !< If this parameter is static, it takes @@ -1628,12 +1614,11 @@ subroutine get_param_int(CS, modulename, varname, value, desc, units, & !! value for this parameter, although it might be logged. logical, optional, intent(in) :: do_not_log !< If present and true, do not log this !! parameter to the documentation files - logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is !! logged in the layout parameter file - logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file -! This subroutine writes the value of a real parameter to a log file, -! along with its name and the module it came from. + logical :: do_read, do_log do_read = .true. ; if (present(do_not_read)) do_read = .not.do_not_read @@ -1664,7 +1649,7 @@ subroutine get_param_int_array(CS, modulename, varname, value, desc, units, & integer, dimension(:), intent(inout) :: value !< The value of the parameter that may be reset !! from the parameter file character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter integer, optional, intent(in) :: default !< The default value of the parameter integer, optional, intent(in) :: static_value !< If this parameter is static, it takes @@ -1676,12 +1661,11 @@ subroutine get_param_int_array(CS, modulename, varname, value, desc, units, & !! value for this parameter, although it might be logged. logical, optional, intent(in) :: do_not_log !< If present and true, do not log this !! parameter to the documentation files - logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is !! logged in the layout parameter file - logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file -! This subroutine writes the value of a real parameter to a log file, -! along with its name and the module it came from. + logical :: do_read, do_log do_read = .true. ; if (present(do_not_read)) do_read = .not.do_not_read @@ -1704,7 +1688,7 @@ end subroutine get_param_int_array !! and logs it in documentation files. subroutine get_param_real(CS, modulename, varname, value, desc, units, & default, fail_if_missing, do_not_read, do_not_log, & - static_value, debuggingParam) + static_value, debuggingParam, scale) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters character(len=*), intent(in) :: modulename !< The name of the calling module @@ -1712,7 +1696,7 @@ subroutine get_param_real(CS, modulename, varname, value, desc, units, & real, intent(inout) :: value !< The value of the parameter that may be !! read from the parameter file and logged character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter real, optional, intent(in) :: default !< The default value of the parameter real, optional, intent(in) :: static_value !< If this parameter is static, it takes @@ -1724,10 +1708,11 @@ subroutine get_param_real(CS, modulename, varname, value, desc, units, & !! value for this parameter, although it might be logged. logical, optional, intent(in) :: do_not_log !< If present and true, do not log this !! parameter to the documentation files - logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file -! This subroutine writes the value of a real parameter to a log file, -! along with its name and the module it came from. + real, optional, intent(in) :: scale !< A scaling factor that the parameter is + !! multiplied by before it is returned. + logical :: do_read, do_log do_read = .true. ; if (present(do_not_read)) do_read = .not.do_not_read @@ -1744,12 +1729,14 @@ subroutine get_param_real(CS, modulename, varname, value, desc, units, & default, debuggingParam) endif + if (present(scale)) value = scale*value + end subroutine get_param_real !> This subroutine reads the values of an array of real model parameters from a parameter file !! and logs them in documentation files. subroutine get_param_real_array(CS, modulename, varname, value, desc, units, & - default, fail_if_missing, do_not_read, do_not_log, static_value) + default, fail_if_missing, do_not_read, do_not_log, static_value, scale) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters character(len=*), intent(in) :: modulename !< The name of the calling module @@ -1757,7 +1744,7 @@ subroutine get_param_real_array(CS, modulename, varname, value, desc, units, & real, dimension(:), intent(inout) :: value !< The value of the parameter that may be !! read from the parameter file and logged character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter real, optional, intent(in) :: default !< The default value of the parameter real, optional, intent(in) :: static_value !< If this parameter is static, it takes @@ -1769,6 +1756,8 @@ subroutine get_param_real_array(CS, modulename, varname, value, desc, units, & !! value for this parameter, although it might be logged. logical, optional, intent(in) :: do_not_log !< If present and true, do not log this !! parameter to the documentation files + real, optional, intent(in) :: scale !< A scaling factor that the parameter is + !! multiplied by before it is returned. logical :: do_read, do_log @@ -1786,6 +1775,8 @@ subroutine get_param_real_array(CS, modulename, varname, value, desc, units, & units, default) endif + if (present(scale)) value(:) = scale*value(:) + end subroutine get_param_real_array !> This subroutine reads the value of a character string model parameter from a parameter file @@ -1800,7 +1791,7 @@ subroutine get_param_char(CS, modulename, varname, value, desc, units, & character(len=*), intent(inout) :: value !< The value of the parameter that may be !! read from the parameter file and logged character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter character(len=*), optional, intent(in) :: default !< The default value of the parameter character(len=*), optional, intent(in) :: static_value !< If this parameter is static, it takes @@ -1812,12 +1803,11 @@ subroutine get_param_char(CS, modulename, varname, value, desc, units, & !! value for this parameter, although it might be logged. logical, optional, intent(in) :: do_not_log !< If present and true, do not log this !! parameter to the documentation files - logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is !! logged in the layout parameter file - logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file -! This subroutine writes the value of a real parameter to a log file, -! along with its name and the module it came from. + logical :: do_read, do_log do_read = .true. ; if (present(do_not_read)) do_read = .not.do_not_read @@ -1847,7 +1837,7 @@ subroutine get_param_char_array(CS, modulename, varname, value, desc, units, & character(len=*), dimension(:), intent(inout) :: value !< The value of the parameter that may be !! read from the parameter file and logged character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter character(len=*), optional, intent(in) :: default !< The default value of the parameter character(len=*), optional, intent(in) :: static_value !< If this parameter is static, it takes @@ -1859,8 +1849,8 @@ subroutine get_param_char_array(CS, modulename, varname, value, desc, units, & !! value for this parameter, although it might be logged. logical, optional, intent(in) :: do_not_log !< If present and true, do not log this !! parameter to the documentation files -! This subroutine writes the value of a real parameter to a log file, -! along with its name and the module it came from. + + ! Local variables logical :: do_read, do_log integer :: i, len_tot, len_val character(len=240) :: cat_val @@ -1901,7 +1891,7 @@ subroutine get_param_logical(CS, modulename, varname, value, desc, units, & logical, intent(inout) :: value !< The value of the parameter that may be !! read from the parameter file and logged character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter logical, optional, intent(in) :: default !< The default value of the parameter logical, optional, intent(in) :: static_value !< If this parameter is static, it takes @@ -1913,12 +1903,11 @@ subroutine get_param_logical(CS, modulename, varname, value, desc, units, & !! value for this parameter, although it might be logged. logical, optional, intent(in) :: do_not_log !< If present and true, do not log this !! parameter to the documentation files - logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is !! logged in the layout parameter file - logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file -! This subroutine writes the value of a real parameter to a log file, -! along with its name and the module it came from. + logical :: do_read, do_log do_read = .true. ; if (present(do_not_read)) do_read = .not.do_not_read @@ -1950,7 +1939,7 @@ subroutine get_param_time(CS, modulename, varname, value, desc, units, & type(time_type), intent(inout) :: value !< The value of the parameter that may be !! read from the parameter file and logged character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter type(time_type), optional, intent(in) :: default !< The default value of the parameter type(time_type), optional, intent(in) :: static_value !< If this parameter is static, it takes @@ -1964,14 +1953,13 @@ subroutine get_param_time(CS, modulename, varname, value, desc, units, & !! parameter to the documentation files real, optional, intent(in) :: timeunit !< The number of seconds in a time unit for !! real-number input to be translated to a time. - logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is !! logged in the layout parameter file - logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file logical, optional, intent(in) :: log_as_date !< If true, log the time_type in date !! format. The default is false. -! This subroutine writes the value of a real parameter to a log file, -! along with its name and the module it came from. + logical :: do_read, do_log, date_format, log_date do_read = .true. ; if (present(do_not_read)) do_read = .not.do_not_read @@ -1999,7 +1987,7 @@ end subroutine get_param_time subroutine clearParameterBlock(CS) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters -! Resets the parameter block name to blank + type(parameter_block), pointer :: block => NULL() if (associated(CS%blockName)) then block => CS%blockName @@ -2016,7 +2004,7 @@ subroutine openParameterBlock(CS,blockName,desc) !! it is also a structure to parse for run-time parameters character(len=*), intent(in) :: blockName !< The name of a parameter block being added character(len=*), optional, intent(in) :: desc !< A description of the parameter block being added -! Tags blockName onto the end of the active parameter block name + type(parameter_block), pointer :: block => NULL() if (associated(CS%blockName)) then block => CS%blockName @@ -2032,7 +2020,7 @@ end subroutine openParameterBlock subroutine closeParameterBlock(CS) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters -! Remove the lowest level of recursion from the active block name + type(parameter_block), pointer :: block => NULL() if (associated(CS%blockName)) then @@ -2053,7 +2041,7 @@ function pushBlockLevel(oldblockName,newBlockName) character(len=*), intent(in) :: oldBlockName !< A sequence of hierarchical parameter block names character(len=*), intent(in) :: newBlockName !< A new block name to add to the end of the sequence character(len=len(oldBlockName)+40) :: pushBlockLevel -! Extends block name (deeper level of parameter block) + if (len_trim(oldBlockName)>0) then pushBlockLevel=trim(oldBlockName)//'%'//trim(newBlockName) else @@ -2065,7 +2053,7 @@ end function pushBlockLevel function popBlockLevel(oldblockName) character(len=*), intent(in) :: oldBlockName !< A sequence of hierarchical parameter block names character(len=len(oldBlockName)+40) :: popBlockLevel -! Truncates block name (shallower level of parameter block) + integer :: i i = index(trim(oldBlockName), '%', .true.) if (i>1) then From 43bff9445564ba7bdf4e75ae30f8d0c65ca08d90 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 5 Sep 2018 10:55:35 -0400 Subject: [PATCH 067/174] Corrected MOM_ALE_sponge comments Modified comments to reflect that MOM_ALE_sponges appears to be working with thicknesses in H units, not m. Only comments were changed, and all answers are bitwise identical. --- src/parameterizations/vertical/MOM_ALE_sponge.F90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 97d7d12f7e..c842b813c9 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -140,7 +140,8 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, param_file, CS, data_h, nz_ !! to parse for model parameter values (in). type(ALE_sponge_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module (in/out). - real, dimension(SZI_(G),SZJ_(G),nz_data), intent(in) :: data_h !< The thicknesses of the sponge input layers. + real, dimension(SZI_(G),SZJ_(G),nz_data), intent(in) :: data_h !< The thicknesses of the sponge + !! input layers, in thickness units (H). ! This include declares and sets the variable "version". @@ -331,7 +332,7 @@ end function get_ALE_sponge_nz_data subroutine get_ALE_sponge_thicknesses(G, data_h, sponge_mask, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure (in). real, allocatable, dimension(:,:,:), & - intent(inout) :: data_h !< The thicknesses of the sponge input layers. + intent(inout) :: data_h !< The thicknesses of the sponge input layers, in H. logical, dimension(SZI_(G),SZJ_(G)), & intent(out) :: sponge_mask !< A logical mask that is true where !! sponges are being applied. @@ -837,7 +838,7 @@ end subroutine set_up_ALE_sponge_vel_field_varying subroutine apply_ALE_sponge(h, dt, G, CS, Time) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure (in). real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: h !< Layer thickness, in m (in) + intent(inout) :: h !< Layer thickness, in H (in) real, intent(in) :: dt !< The amount of time covered by this call, in s (in). type(ALE_sponge_CS), pointer :: CS !< A pointer to the control structure for this module !! that is set by a previous call to initialize_sponge (in). From efc0709a71bc6fb8510b120fa907f1377c56aa47 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 5 Sep 2018 10:56:58 -0400 Subject: [PATCH 068/174] Use scale in user get_param calls Use the new argument to rescale the parameters returned by several get_param calls in the user code to take dimensional rescaling into account. All answers are bitwise identical. --- src/user/BFB_initialization.F90 | 3 +-- src/user/DOME2d_initialization.F90 | 11 ++++---- src/user/DOME_initialization.F90 | 3 +-- src/user/ISOMIP_initialization.F90 | 31 ++++++++++------------ src/user/Neverland_initialization.F90 | 9 ++++--- src/user/Phillips_initialization.F90 | 6 ++--- src/user/adjustment_initialization.F90 | 3 +-- src/user/dumbbell_initialization.F90 | 15 +++++------ src/user/external_gwave_initialization.F90 | 3 +-- src/user/lock_exchange_initialization.F90 | 7 ++--- src/user/seamount_initialization.F90 | 3 +-- 11 files changed, 40 insertions(+), 54 deletions(-) diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index 2a14f502ef..ed965393a4 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -102,8 +102,7 @@ subroutine BFB_initialize_sponges_southonly(G, GV, use_temperature, tv, param_fi ! Set up sponges for DOME configuration call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & - "The minimum depth of the ocean.", units="m", default=0.0) - min_depth = GV%m_to_Z*min_depth + "The minimum depth of the ocean.", units="m", default=0.0, scale=GV%m_to_Z) call get_param(param_file, mdl, "SOUTHLAT", slat, & "The southern latitude of the domain.", units="degrees") diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index 1e0f34f9a0..7d282bffd5 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -115,8 +115,7 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, param_file, just_read_params call MOM_mesg("MOM_initialization.F90, DOME2d_initialize_thickness: setting thickness") call get_param(param_file, mdl,"MIN_THICKNESS",min_thickness, & - default=1.e-3, units="m", do_not_log=.true.) - min_thickness = GV%m_to_Z*min_thickness + default=1.e-3, units="m", do_not_log=.true., scale=GV%m_to_Z) call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=.true.) call get_param(param_file, mdl, "DOME2D_SHELF_WIDTH", dome2d_width_bay, & @@ -450,9 +449,9 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) eta1D(k) = e0(k) if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then eta1D(k) = eta1D(k+1) + GV%Angstrom_Z - h(i,j,k) = GV%Angstrom_m + h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = GV%Z_to_m * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo @@ -464,11 +463,11 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) do j=js,je ; do i=is,ie z = -G%bathyT(i,j) do k = nz,1,-1 - z = z + 0.5 * GV%m_to_Z * h(i,j,k) ! Position of the center of layer k + 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) 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%m_to_Z * h(i,j,k) ! Position of the interface k + z = z + 0.5 * GV%H_to_Z * h(i,j,k) ! Position of the interface k enddo enddo ; enddo diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index bcb6a83dd9..a4dc83d9ca 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -167,8 +167,7 @@ subroutine DOME_initialize_sponges(G, GV, tv, PF, CSp) ! Set up sponges for DOME configuration call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, & - "The minimum depth of the ocean.", units="m", default=0.0) - min_depth = GV%m_to_Z * min_depth + "The minimum depth of the ocean.", units="m", default=0.0, scale=GV%m_to_Z) H0(1) = 0.0 do k=2,nz ; H0(k) = -(real(k-1)-0.5)*G%max_depth / real(nz-1) ; enddo diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index 0ace62ddc0..267e4c0558 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -149,11 +149,10 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par if (.not.just_read) & call MOM_mesg("MOM_initialization.F90, initialize_thickness_uniform: setting thickness") - call get_param(param_file, mdl,"MIN_THICKNESS",min_thickness, & - 'Minimum layer thickness', units='m', default=1.e-3, do_not_log=just_read) + call get_param(param_file, mdl,"MIN_THICKNESS", min_thickness, & + 'Minimum layer thickness', units='m', default=1.e-3, do_not_log=just_read, scale=GV%m_to_Z) call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) - min_thickness = GV%m_to_Z*min_thickness select case ( coordinateMode(verticalCoordinate) ) @@ -427,12 +426,10 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) real :: rho_sur, rho_bot, rho_range real :: dT_dz, dS_dz ! Gradients of T and S in degC/Z and PPT/Z. - real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! - real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface ! - real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta. - - ! positive upward, in m. + real :: e0(SZK_(G)+1) ! The resting interface heights, in Z, usually + ! negative because it is positive upward. + real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface, positive upward, in Z. + real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, in Z. real :: min_depth, dummy1, z real :: damp, rho_dummy, min_thickness, rho_tmp, xi0 character(len=40) :: verticalCoordinate, filename, state_file @@ -470,7 +467,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) ! Set up sponges for ISOMIP configuration call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, & - "The minimum depth of the ocean.", units="m", default=0.0) + "The minimum depth of the ocean.", units="m", default=0.0, scale=GV%m_to_Z) if (associated(CSp)) call MOM_error(FATAL, & "ISOMIP_initialize_sponges called with an associated control structure.") @@ -493,7 +490,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) endif ! convert to 1 / seconds - if (G%Zd_to_m * G%bathyT(i,j) > min_depth) then + if (G%bathyT(i,j) > min_depth) then Idamp(i,j) = damp/86400.0 else ; Idamp(i,j) = 0.0 ; endif @@ -547,16 +544,16 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then eta1D(k) = eta1D(k+1) + min_thickness - h(i,j,k) = min_thickness * GV%Z_to_m + h(i,j,k) = min_thickness * GV%Z_to_H else - h(i,j,k) = GV%Z_to_m*(eta1D(k) - eta1D(k+1)) + h(i,j,k) = GV%Z_to_H*(eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates do j=js,je ; do i=is,ie - h(i,j,:) = G%Zd_to_m * (G%bathyT(i,j) / dfloat(nz)) + h(i,j,:) = GV%Z_to_H * (G%bathyT(i,j) / dfloat(nz)) enddo ; enddo case default @@ -572,12 +569,12 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) dS_dz = (s_sur - s_bot) / G%max_depth dT_dz = (t_sur - t_bot) / G%max_depth do j=js,je ; do i=is,ie - xi0 = -G%Zd_to_m * G%bathyT(i,j) + xi0 = -G%bathyT(i,j) do k = nz,1,-1 - xi0 = xi0 + 0.5 * h(i,j,k) * GV%m_to_Z ! Depth in middle of layer + xi0 = xi0 + 0.5 * h(i,j,k) * GV%H_to_Z ! Depth in middle of layer S(i,j,k) = S_sur + dS_dz * xi0 T(i,j,k) = T_sur + dT_dz * xi0 - xi0 = xi0 + 0.5 * h(i,j,k) * GV%m_to_Z ! Depth at top of layer + xi0 = xi0 + 0.5 * h(i,j,k) * GV%H_to_Z ! Depth at top of layer enddo enddo ; enddo ! for debugging diff --git a/src/user/Neverland_initialization.F90 b/src/user/Neverland_initialization.F90 index cb641c9cb9..5e0e7f0af0 100644 --- a/src/user/Neverland_initialization.F90 +++ b/src/user/Neverland_initialization.F90 @@ -117,8 +117,8 @@ subroutine Neverland_initialize_thickness(h, G, GV, param_file, eqn_of_state, P_ ! Local variables real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z), ! usually negative because it is positive upward. - real, dimension(SZK_(G)) :: h_profile ! Vector of initial thickness profile (m) - real :: e_interface ! Current interface positoin (m) + real, dimension(SZK_(G)) :: h_profile ! Vector of initial thickness profile (Z) + real :: e_interface ! Current interface position (m) character(len=40) :: mod = "Neverland_initialize_thickness" ! This subroutine's name. integer :: i, j, k, k1, is, ie, js, je, nz, itt @@ -126,12 +126,13 @@ subroutine Neverland_initialize_thickness(h, G, GV, param_file, eqn_of_state, P_ call MOM_mesg(" Neverland_initialization.F90, Neverland_initialize_thickness: setting thickness", 5) call get_param(param_file, mod, "INIT_THICKNESS_PROFILE", h_profile, & - "Profile of initial layer thicknesses.", units="m", fail_if_missing=.true.) + "Profile of initial layer thicknesses.", units="m", scale=GV%m_to_Z, & + fail_if_missing=.true.) ! e0 is the notional position of interfaces e0(1) = 0. ! The surface do k=1,nz - e0(k+1) = e0(k) - GV%m_to_Z*h_profile(k) + e0(k+1) = e0(k) - h_profile(k) enddo do j=js,je ; do i=is,ie diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index 719b9cd6ee..f94ff86272 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -65,12 +65,11 @@ subroutine Phillips_initialize_thickness(h, G, GV, param_file, just_read_params) fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl, "JET_HEIGHT", jet_height, & "The interface height scale associated with the \n"//& - "zonal-mean jet.", units="m", & + "zonal-mean jet.", units="m", scale=GV%m_to_Z, & fail_if_missing=.not.just_read, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. - jet_height = jet_height*GV%m_to_Z half_depth = G%max_depth*half_strat eta0(1) = 0.0 ; eta0(nz+1) = -G%max_depth do k=2,1+nz/2 ; eta0(k) = -half_depth*(2.0*(k-1)/real(nz)) ; enddo @@ -240,9 +239,8 @@ subroutine Phillips_initialize_sponges(G, GV, tv, param_file, CSp, h) fail_if_missing=.true.) call get_param(param_file, mdl, "JET_HEIGHT", jet_height, & "The interface height scale associated with the \n"//& - "zonal-mean jet.", units="m", & + "zonal-mean jet.", units="m", scale=GV%m_to_Z, & fail_if_missing=.true.) - jet_height = jet_height * GV%m_to_Z half_depth = G%max_depth*half_strat eta0(1) = 0.0 ; eta0(nz+1) = -G%max_depth diff --git a/src/user/adjustment_initialization.F90 b/src/user/adjustment_initialization.F90 index e33b1d17ed..b36b58297c 100644 --- a/src/user/adjustment_initialization.F90 +++ b/src/user/adjustment_initialization.F90 @@ -61,8 +61,7 @@ subroutine adjustment_initialize_thickness ( h, G, GV, param_file, just_read_par if (.not.just_read) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl,"S_REF",S_ref,fail_if_missing=.true.,do_not_log=.true.) call get_param(param_file, mdl,"MIN_THICKNESS",min_thickness,'Minimum layer thickness', & - units='m', default=1.0e-3, do_not_log=just_read) - min_thickness = min_thickness*GV%m_to_Z + units='m', default=1.0e-3, do_not_log=just_read, scale=GV%m_to_Z) ! Parameters specific to this experiment configuration call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE",verticalCoordinate, & diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index 51a0776900..12ca05fded 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -100,7 +100,7 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, param_file, just_read_param call get_param(param_file, mdl,"MIN_THICKNESS", min_thickness, & 'Minimum thickness for layer',& - units='m', default=1.0e-3, do_not_log=just_read) + units='m', default=1.0e-3, do_not_log=just_read, scale=GV%m_to_Z) call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) @@ -154,14 +154,13 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, param_file, just_read_param case ( REGRIDDING_ZSTAR ) ! Initial thicknesses for z coordinates if (just_read) return ! All run-time parameters have been read, so return. - min_thickness = GV%m_to_Z * min_thickness do j=js,je ; do i=is,ie eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then eta1D(k) = eta1D(k+1) + min_thickness - h(i,j,k) = min_thickness + h(i,j,k) = GV%Z_to_H * min_thickness else h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif @@ -171,7 +170,7 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, param_file, just_read_param case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie - h(i,j,:) = GV%Z_to_m * G%bathyT(i,j) / dfloat(nz) + h(i,j,:) = GV%Z_to_H * G%bathyT(i,j) / dfloat(nz) enddo ; enddo end select @@ -282,7 +281,7 @@ subroutine dumbbell_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp call get_param(param_file, mdl, "DUMBBELL_S_RANGE", S_range, do_not_log=.true.) call get_param(param_file, mdl,"MIN_THICKNESS", min_thickness, & 'Minimum thickness for layer',& - units='m', default=1.0e-3, do_not_log=.true.) + units='m', default=1.0e-3, do_not_log=.true., scale=GV%m_to_Z) ! no active sponges if (sponge_time_scale <= 0.) return @@ -306,12 +305,12 @@ subroutine dumbbell_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp if (use_ALE) then ! construct a uniform grid for the sponge do j=G%jsc,G%jec ; do i=G%isc,G%iec - eta1D(nz+1) = -GV%Z_to_m * G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 - eta1D(k) = -GV%Z_to_m*G%max_depth * real(k-1) / real(nz) + eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then eta1D(k) = eta1D(k+1) + min_thickness - h(i,j,k) = min_thickness + h(i,j,k) = GV%Z_to_H * min_thickness else h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif diff --git a/src/user/external_gwave_initialization.F90 b/src/user/external_gwave_initialization.F90 index 139f4c1945..05a64c6069 100644 --- a/src/user/external_gwave_initialization.F90 +++ b/src/user/external_gwave_initialization.F90 @@ -50,7 +50,7 @@ subroutine external_gwave_initialize_thickness(h, G, GV, param_file, just_read_p if (.not.just_read) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "SSH_ANOMALY_HEIGHT", ssh_anomaly_height, & "The vertical displacement of the SSH anomaly. ", units="m", & - fail_if_missing=.not.just_read, do_not_log=just_read) + fail_if_missing=.not.just_read, do_not_log=just_read, scale=GV%m_to_Z) call get_param(param_file, mdl, "SSH_ANOMALY_WIDTH", ssh_anomaly_width, & "The lateral width of the SSH anomaly. ", units="coordinate", & fail_if_missing=.not.just_read, do_not_log=just_read) @@ -58,7 +58,6 @@ subroutine external_gwave_initialize_thickness(h, G, GV, param_file, just_read_p if (just_read) return ! All run-time parameters have been read, so return. PI = 4.0*atan(1.0) - ssh_anomaly_height = GV%m_to_Z*ssh_anomaly_height do j=G%jsc,G%jec ; do i=G%isc,G%iec Xnondim = (G%geoLonT(i,j)-G%west_lon-0.5*G%len_lon) / ssh_anomaly_width Xnondim = min(1., abs(Xnondim)) diff --git a/src/user/lock_exchange_initialization.F90 b/src/user/lock_exchange_initialization.F90 index b4bb1e296f..e6dd3ee900 100644 --- a/src/user/lock_exchange_initialization.F90 +++ b/src/user/lock_exchange_initialization.F90 @@ -57,18 +57,15 @@ subroutine lock_exchange_initialize_thickness(h, G, GV, param_file, just_read_pa call get_param(param_file, mdl, "FRONT_DISPLACEMENT", front_displacement, & "The vertical displacement of interfaces across the front. \n"//& "A value larger in magnitude that MAX_DEPTH is truncated,", & - units="m", fail_if_missing=.not.just_read, do_not_log=just_read) + units="m", fail_if_missing=.not.just_read, do_not_log=just_read, scale=GV%m_to_Z) call get_param(param_file, mdl, "THERMOCLINE_THICKNESS", thermocline_thickness, & "The thickness of the thermocline in the lock exchange \n"//& "experiment. A value of zero creates a two layer system \n"//& "with vanished layers in between the two inflated layers.", & - default=0., units="m", do_not_log=just_read) + default=0., units="m", do_not_log=just_read, scale=GV%m_to_Z) if (just_read) return ! All run-time parameters have been read, so return. - thermocline_thickness = GV%m_to_Z*thermocline_thickness - front_displacement = GV%m_to_Z*front_displacement - do j=G%jsc,G%jec ; do i=G%isc,G%iec do k=2,nz eta1D(K) = -0.5 * G%max_depth & ! Middle of column diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index f4411f749d..7ec04ba302 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -101,7 +101,7 @@ subroutine seamount_initialize_thickness ( h, G, GV, param_file, just_read_param call get_param(param_file, mdl,"MIN_THICKNESS",min_thickness, & 'Minimum thickness for layer',& - units='m', default=1.0e-3, do_not_log=just_read) + units='m', default=1.0e-3, do_not_log=just_read, scale=GV%m_to_Z) call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE",verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) @@ -155,7 +155,6 @@ subroutine seamount_initialize_thickness ( h, G, GV, param_file, just_read_param case ( REGRIDDING_ZSTAR ) ! Initial thicknesses for z coordinates if (just_read) return ! All run-time parameters have been read, so return. - min_thickness = min_thickness * GV%m_to_Z do j=js,je ; do i=is,ie eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 From e0cf6a5d56555303e5c79774ea0e023d8b29d5cb Mon Sep 17 00:00:00 2001 From: Niki Zadeh Date: Wed, 5 Sep 2018 13:55:07 -0400 Subject: [PATCH 069/174] Fix diagnostics bug that cause crash - These diagnostics are posted without properly checking their id>0 Their id's are only checked inside .or. combinations so we run into a crash if they are not registered but the .or.ed companions are. --- src/core/MOM_forcing_type.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 9ac616dac0..7d27841311 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -2133,7 +2133,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (associated(fluxes%frunoff)) res(i,j) = res(i,j)+fluxes%frunoff(i,j) if (associated(fluxes%vprec)) res(i,j) = res(i,j)+fluxes%vprec(i,j) enddo ; enddo - call post_data(handles%id_prcme, res, diag) + if (handles%id_prcme > 0) call post_data(handles%id_prcme, res, diag) if (handles%id_total_prcme > 0) then total_transport = global_area_integral(res,G) call post_data(handles%id_total_prcme, total_transport, diag) @@ -2151,7 +2151,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (fluxes%vprec(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%vprec(i,j) if (fluxes%evap(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%evap(i,j) enddo ; enddo - call post_data(handles%id_net_massout, res, diag) + if (handles%id_net_massout > 0) call post_data(handles%id_net_massout, res, diag) if (handles%id_total_net_massout > 0) then total_transport = global_area_integral(res,G) call post_data(handles%id_total_net_massout, total_transport, diag) @@ -2168,7 +2168,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) ! fluxes%cond is not needed because it is derived from %evap > 0 if (fluxes%evap(i,j) > 0.0) res(i,j) = res(i,j) + fluxes%evap(i,j) enddo ; enddo - call post_data(handles%id_net_massin, res, diag) + if (handles%id_net_massin > 0) call post_data(handles%id_net_massin, res, diag) if (handles%id_total_net_massin > 0) then total_transport = global_area_integral(res,G) call post_data(handles%id_total_net_massin, total_transport, diag) @@ -2322,7 +2322,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (associated(fluxes%sens)) res(i,j) = res(i,j) + fluxes%sens(i,j) if (associated(fluxes%SW)) res(i,j) = res(i,j) + fluxes%SW(i,j) enddo ; enddo - call post_data(handles%id_net_heat_coupler, res, diag) + if (handles%id_net_heat_coupler > 0) call post_data(handles%id_net_heat_coupler, res, diag) if (handles%id_total_net_heat_coupler > 0) then total_transport = global_area_integral(res,G) call post_data(handles%id_total_net_heat_coupler, total_transport, diag) @@ -2382,7 +2382,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (associated(fluxes%heat_content_massout)) res(i,j) = res(i,j) + fluxes%heat_content_massout(i,j) ! endif enddo ; enddo - call post_data(handles%id_heat_content_surfwater, res, diag) + if (handles%id_heat_content_surfwater > 0) call post_data(handles%id_heat_content_surfwater, res, diag) if (handles%id_total_heat_content_surfwater > 0) then total_transport = global_area_integral(res,G) call post_data(handles%id_total_heat_content_surfwater, total_transport, diag) From c09c0a95e25288700d7ab2513a5a4807454ea404 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 5 Sep 2018 18:34:58 -0400 Subject: [PATCH 070/174] +Added get_simple_array_i_ind and ..._array_j_ind Added get_simple_array_i_ind and get_simple_array_j_ind to determine the computational array extents for simple arrays based on their size. All answers are bitwise identical, but there are new public types. --- src/framework/MOM_domains.F90 | 122 +++++++++++++++++++++++++++------- 1 file changed, 97 insertions(+), 25 deletions(-) diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index a38facf79a..5d3faaae35 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -43,6 +43,7 @@ module MOM_domains public :: create_group_pass, do_group_pass, group_pass_type public :: start_group_pass, complete_group_pass public :: compute_block_extent, get_global_shape +public :: get_simple_array_i_ind, get_simple_array_j_ind !> Do a halo update on an array interface pass_var @@ -1682,31 +1683,29 @@ subroutine get_domain_extent(Domain, isc, iec, jsc, jec, isd, ied, jsd, jed, & isg, ieg, jsg, jeg, idg_offset, jdg_offset, & symmetric, local_indexing, index_offset) type(MOM_domain_type), & - intent(in) :: Domain !< The MOM domain from which to extract information - integer, intent(out) :: isc !< The start i-index of the computational domain - integer, intent(out) :: iec !< The end i-index of the computational domain - integer, intent(out) :: jsc !< The start j-index of the computational domain - integer, intent(out) :: jec !< The end j-index of the computational domain - integer, intent(out) :: isd !< The start i-index of the data domain - integer, intent(out) :: ied !< The end i-index of the data domain - integer, intent(out) :: jsd !< The start j-index of the data domain - integer, intent(out) :: jed !< The end j-index of the data domain - integer, intent(out) :: isg !< The start i-index of the global domain - integer, intent(out) :: ieg !< The end i-index of the global domain - integer, intent(out) :: jsg !< The start j-index of the global domain - integer, intent(out) :: jeg !< The end j-index of the global domain - integer, intent(out) :: idg_offset !< The offset between the corresponding global and - !! data i-index spaces. - integer, intent(out) :: jdg_offset !< The offset between the corresponding global and - !! data j-index spaces. - logical, intent(out) :: symmetric !< True if symmetric memory is used. - logical, optional, & - intent(in) :: local_indexing !< If true, local tracer array indices start at 1, - !! as in most MOM6 code. - integer, optional, & - intent(in) :: index_offset !< A fixed additional offset to all indices. This - !! can be useful for some types of debugging with - !! dynamic memory allocation. + intent(in) :: Domain !< The MOM domain from which to extract information + integer, intent(out) :: isc !< The start i-index of the computational domain + integer, intent(out) :: iec !< The end i-index of the computational domain + integer, intent(out) :: jsc !< The start j-index of the computational domain + integer, intent(out) :: jec !< The end j-index of the computational domain + integer, intent(out) :: isd !< The start i-index of the data domain + integer, intent(out) :: ied !< The end i-index of the data domain + integer, intent(out) :: jsd !< The start j-index of the data domain + integer, intent(out) :: jed !< The end j-index of the data domain + integer, intent(out) :: isg !< The start i-index of the global domain + integer, intent(out) :: ieg !< The end i-index of the global domain + integer, intent(out) :: jsg !< The start j-index of the global domain + integer, intent(out) :: jeg !< The end j-index of the global domain + integer, intent(out) :: idg_offset !< The offset between the corresponding global and + !! data i-index spaces. + integer, intent(out) :: jdg_offset !< The offset between the corresponding global and + !! data j-index spaces. + logical, intent(out) :: symmetric !< True if symmetric memory is used. + logical, optional, intent(in) :: local_indexing !< If true, local tracer array indices start at 1, + !! as in most MOM6 code. + integer, optional, intent(in) :: index_offset !< A fixed additional offset to all indices. This + !! can be useful for some types of debugging with + !! dynamic memory allocation. ! Local variables integer :: ind_off logical :: local @@ -1738,6 +1737,79 @@ subroutine get_domain_extent(Domain, isc, iec, jsc, jec, isd, ied, jsd, jed, & end subroutine get_domain_extent +!> Return the (potentially symmetric) computational domain i-bounds for an array +!! passed without index specifications (i.e. indices start at 1) based on an array size. +subroutine get_simple_array_i_ind(domain, size, is, ie, symmetric) + type(MOM_domain_type), intent(in) :: domain !< MOM domain from which to extract information + integer, intent(in) :: size !< The i-array size + integer, intent(out) :: is !< The computational domain starting i-index. + integer, intent(out) :: ie !< The computational domain ending i-index. + logical, optional, intent(in) :: symmetric !< If present, indicates whether symmetric sizes + !! can be considered. + ! Local variables + logical :: sym + character(len=120) :: mesg, mesg2 + integer :: isc, iec, jsc, jec, isd, ied, jsd, jed + + call mpp_get_compute_domain(Domain%mpp_domain, isc, iec, jsc, jec) + call mpp_get_data_domain(Domain%mpp_domain, isd, ied, jsd, jed) + + isc = isc-isd+1 ; iec = iec-isd+1 ; ied = ied-isd+1 ; isd = 1 + sym = Domain%symmetric ; if (present(symmetric)) sym = symmetric + + if (size == ied) then ; is = isc ; ie = iec + elseif (size == 1+iec-isc) then ; is = 1 ; ie = size + elseif (sym .and. (size == 1+ied)) then ; is = isc ; ie = iec+1 + elseif (sym .and. (size == 2+iec-isc)) then ; is = 1 ; ie = size+1 + else + write(mesg,'("Unrecognized size ", i6, "in call to get_simple_array_i_ind. \")') size + if (sym) then + write(mesg2,'("Valid sizes are : ", 2i7)') ied, 1+iec-isc + else + write(mesg2,'("Valid sizes are : ", 4i7)') ied, 1+iec-isc, 1+ied, 2+iec-isc + endif + call MOM_error(FATAL, trim(mesg)//trim(mesg2)) + endif + +end subroutine get_simple_array_i_ind + + +!> Return the (potentially symmetric) computational domain j-bounds for an array +!! passed without index specifications (i.e. indices start at 1) based on an array size. +subroutine get_simple_array_j_ind(domain, size, js, je, symmetric) + type(MOM_domain_type), intent(in) :: domain !< MOM domain from which to extract information + integer, intent(in) :: size !< The j-array size + integer, intent(out) :: js !< The computational domain starting j-index. + integer, intent(out) :: je !< The computational domain ending j-index. + logical, optional, intent(in) :: symmetric !< If present, indicates whether symmetric sizes + !! can be considered. + ! Local variables + logical :: sym + character(len=120) :: mesg, mesg2 + integer :: isc, iec, jsc, jec, isd, ied, jsd, jed + + call mpp_get_compute_domain(Domain%mpp_domain, isc, iec, jsc, jec) + call mpp_get_data_domain(Domain%mpp_domain, isd, ied, jsd, jed) + + jsc = jsc-jsd+1 ; jec = jec-jsd+1 ; jed = jed-jsd+1 ; jsd = 1 + sym = Domain%symmetric ; if (present(symmetric)) sym = symmetric + + if (size == jed) then ; js = jsc ; je = jec + elseif (size == 1+jec-jsc) then ; js = 1 ; je = size + elseif (sym .and. (size == 1+jed)) then ; js = jsc ; je = jec+1 + elseif (sym .and. (size == 2+jec-jsc)) then ; js = 1 ; je = size+1 + else + write(mesg,'("Unrecognized size ", i6, "in call to get_simple_array_j_ind. \")') size + if (sym) then + write(mesg2,'("Valid sizes are : ", 2i7)') jed, 1+jec-jsc + else + write(mesg2,'("Valid sizes are : ", 4i7)') jed, 1+jec-jsc, 1+jed, 2+jec-jsc + endif + call MOM_error(FATAL, trim(mesg)//trim(mesg2)) + endif + +end subroutine get_simple_array_j_ind + !> Returns the global shape of h-point arrays subroutine get_global_shape(domain, niglobal, njglobal) type(MOM_domain_type), intent(in) :: domain !< MOM domain From 243bc339ae9c1addaa4b0607cbfe3f493a96ba38 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 5 Sep 2018 18:35:29 -0400 Subject: [PATCH 071/174] +Added scale argument to MOM_read_data Added a scale argument to the various versions of MOM_read_data, so that input arrays can be rescaled before being returned. All answers are bitwise identical but there is a new optional argument in a public interface. --- src/framework/MOM_io.F90 | 78 +++++++++++++++++++++++++++++++++++----- 1 file changed, 69 insertions(+), 9 deletions(-) diff --git a/src/framework/MOM_io.F90 b/src/framework/MOM_io.F90 index e523270802..db0afa3d8a 100644 --- a/src/framework/MOM_io.F90 +++ b/src/framework/MOM_io.F90 @@ -6,6 +6,7 @@ module MOM_io use MOM_error_handler, only : MOM_error, NOTE, FATAL, WARNING use MOM_domains, only : MOM_domain_type, AGRID, BGRID_NE, CGRID_NE +use MOM_domains, only : get_simple_array_i_ind, get_simple_array_j_ind use MOM_file_parser, only : log_version, param_file_type use MOM_grid, only : ocean_grid_type use MOM_dyn_horgrid, only : dyn_horgrid_type @@ -845,21 +846,27 @@ end function FMS_file_exists !> This function uses the fms_io function read_data to read 1-D !! data field named "fieldname" from file "filename". -subroutine MOM_read_data_1d(filename, fieldname, data, timelevel) +subroutine MOM_read_data_1d(filename, fieldname, data, timelevel, scale) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file real, dimension(:), intent(inout) :: data !< The 1-dimensional array into which the data integer, optional, intent(in) :: timelevel !< The time level in the file to read + real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied + !! by before they are returned. call read_data(filename, fieldname, data, timelevel=timelevel, no_domain=.true.) + if (present(scale)) then ; if (scale /= 1.0) then + data(:) = scale*data(:) + endif ; endif + end subroutine MOM_read_data_1d !> This function uses the fms_io function read_data to read a distributed !! 2-D data field named "fieldname" from file "filename". Valid values for !! "position" include CORNER, CENTER, EAST_FACE and NORTH_FACE. subroutine MOM_read_data_2d(filename, fieldname, data, MOM_Domain, & - timelevel, position) + timelevel, position, scale) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file real, dimension(:,:), intent(inout) :: data !< The 2-dimensional array into which the data @@ -867,17 +874,27 @@ subroutine MOM_read_data_2d(filename, fieldname, data, MOM_Domain, & type(MOM_domain_type), intent(in) :: MOM_Domain !< The MOM_Domain that describes the decomposition integer, optional, intent(in) :: timelevel !< The time level in the file to read integer, optional, intent(in) :: position !< A flag indicating where this data is located + real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied + !! by before they are returned. + + integer :: is, ie, js, je call read_data(filename, fieldname, data, MOM_Domain%mpp_domain, & timelevel=timelevel, position=position) + if (present(scale)) then ; if (scale /= 1.0) then + call get_simple_array_i_ind(MOM_Domain, size(data,1), is, ie) + call get_simple_array_j_ind(MOM_Domain, size(data,2), js, je) + data(is:ie,js:je) = scale*data(is:ie,js:je) + endif ; endif + end subroutine MOM_read_data_2d !> This function uses the fms_io function read_data to read a distributed !! 3-D data field named "fieldname" from file "filename". Valid values for !! "position" include CORNER, CENTER, EAST_FACE and NORTH_FACE. subroutine MOM_read_data_3d(filename, fieldname, data, MOM_Domain, & - timelevel, position) + timelevel, position, scale) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file real, dimension(:,:,:), intent(inout) :: data !< The 3-dimensional array into which the data @@ -885,17 +902,27 @@ subroutine MOM_read_data_3d(filename, fieldname, data, MOM_Domain, & type(MOM_domain_type), intent(in) :: MOM_Domain !< The MOM_Domain that describes the decomposition integer, optional, intent(in) :: timelevel !< The time level in the file to read integer, optional, intent(in) :: position !< A flag indicating where this data is located + real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied + !! by before they are returned. + + integer :: is, ie, js, je call read_data(filename, fieldname, data, MOM_Domain%mpp_domain, & timelevel=timelevel, position=position) + if (present(scale)) then ; if (scale /= 1.0) then + call get_simple_array_i_ind(MOM_Domain, size(data,1), is, ie) + call get_simple_array_j_ind(MOM_Domain, size(data,2), js, je) + data(is:ie,js:je,:) = scale*data(is:ie,js:je,:) + endif ; endif + end subroutine MOM_read_data_3d !> This function uses the fms_io function read_data to read a distributed !! 4-D data field named "fieldname" from file "filename". Valid values for !! "position" include CORNER, CENTER, EAST_FACE and NORTH_FACE. subroutine MOM_read_data_4d(filename, fieldname, data, MOM_Domain, & - timelevel, position) + timelevel, position, scale) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file real, dimension(:,:,:,:), intent(inout) :: data !< The 4-dimensional array into which the data @@ -903,10 +930,20 @@ subroutine MOM_read_data_4d(filename, fieldname, data, MOM_Domain, & type(MOM_domain_type), intent(in) :: MOM_Domain !< The MOM_Domain that describes the decomposition integer, optional, intent(in) :: timelevel !< The time level in the file to read integer, optional, intent(in) :: position !< A flag indicating where this data is located + real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied + !! by before they are returned. + + integer :: is, ie, js, je call read_data(filename, fieldname, data, MOM_Domain%mpp_domain, & timelevel=timelevel, position=position) + if (present(scale)) then ; if (scale /= 1.0) then + call get_simple_array_i_ind(MOM_Domain, size(data,1), is, ie) + call get_simple_array_j_ind(MOM_Domain, size(data,2), js, je) + data(is:ie,js:je,:,:) = scale*data(is:ie,js:je,:,:) + endif ; endif + end subroutine MOM_read_data_4d @@ -914,7 +951,7 @@ end subroutine MOM_read_data_4d !! 2-D data fields with names given by "[uv]_fieldname" from file "filename". Valid values for !! "stagger" include CGRID_NE, BGRID_NE, and AGRID. subroutine MOM_read_vector_2d(filename, u_fieldname, v_fieldname, u_data, v_data, MOM_Domain, & - timelevel, stagger, scalar_pair) + timelevel, stagger, scalar_pair, scale) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: u_fieldname !< The variable name of the u data in the file character(len=*), intent(in) :: v_fieldname !< The variable name of the v data in the file @@ -925,8 +962,10 @@ subroutine MOM_read_vector_2d(filename, u_fieldname, v_fieldname, u_data, v_data type(MOM_domain_type), intent(in) :: MOM_Domain !< The MOM_Domain that describes the decomposition integer, optional, intent(in) :: timelevel !< The time level in the file to read integer, optional, intent(in) :: stagger !< A flag indicating where this vector is discretized - logical, optional, intent(in) :: scalar_pair !< If true, a pair of scalars are to be read.cretized - + logical, optional, intent(in) :: scalar_pair !< If true, a pair of scalars are to be read.cretized + real, optional, intent(in) :: scale !< A scaling factor that the fields are multiplied + !! by before they are returned. + integer :: is, ie, js, je integer :: u_pos, v_pos u_pos = EAST_FACE ; v_pos = NORTH_FACE @@ -941,6 +980,15 @@ subroutine MOM_read_vector_2d(filename, u_fieldname, v_fieldname, u_data, v_data call read_data(filename, v_fieldname, v_data, MOM_Domain%mpp_domain, & timelevel=timelevel, position=v_pos) + if (present(scale)) then ; if (scale /= 1.0) then + call get_simple_array_i_ind(MOM_Domain, size(u_data,1), is, ie) + call get_simple_array_j_ind(MOM_Domain, size(u_data,2), js, je) + u_data(is:ie,js:je) = scale*u_data(is:ie,js:je) + call get_simple_array_i_ind(MOM_Domain, size(v_data,1), is, ie) + call get_simple_array_j_ind(MOM_Domain, size(v_data,2), js, je) + v_data(is:ie,js:je) = scale*v_data(is:ie,js:je) + endif ; endif + end subroutine MOM_read_vector_2d @@ -948,7 +996,7 @@ end subroutine MOM_read_vector_2d !! 3-D data fields with names given by "[uv]_fieldname" from file "filename". Valid values for !! "stagger" include CGRID_NE, BGRID_NE, and AGRID. subroutine MOM_read_vector_3d(filename, u_fieldname, v_fieldname, u_data, v_data, MOM_Domain, & - timelevel, stagger, scalar_pair) + timelevel, stagger, scalar_pair, scale) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: u_fieldname !< The variable name of the u data in the file character(len=*), intent(in) :: v_fieldname !< The variable name of the v data in the file @@ -959,8 +1007,11 @@ subroutine MOM_read_vector_3d(filename, u_fieldname, v_fieldname, u_data, v_data type(MOM_domain_type), intent(in) :: MOM_Domain !< The MOM_Domain that describes the decomposition integer, optional, intent(in) :: timelevel !< The time level in the file to read integer, optional, intent(in) :: stagger !< A flag indicating where this vector is discretized - logical, optional, intent(in) :: scalar_pair !< If true, a pair of scalars are to be read.cretized + logical, optional, intent(in) :: scalar_pair !< If true, a pair of scalars are to be read.cretized + real, optional, intent(in) :: scale !< A scaling factor that the fields are multiplied + !! by before they are returned. + integer :: is, ie, js, je integer :: u_pos, v_pos u_pos = EAST_FACE ; v_pos = NORTH_FACE @@ -975,6 +1026,15 @@ subroutine MOM_read_vector_3d(filename, u_fieldname, v_fieldname, u_data, v_data call read_data(filename, v_fieldname, v_data, MOM_Domain%mpp_domain, & timelevel=timelevel, position=v_pos) + if (present(scale)) then ; if (scale /= 1.0) then + call get_simple_array_i_ind(MOM_Domain, size(u_data,1), is, ie) + call get_simple_array_j_ind(MOM_Domain, size(u_data,2), js, je) + u_data(is:ie,js:je,:) = scale*u_data(is:ie,js:je,:) + call get_simple_array_i_ind(MOM_Domain, size(v_data,1), is, ie) + call get_simple_array_j_ind(MOM_Domain, size(v_data,2), js, je) + v_data(is:ie,js:je,:) = scale*v_data(is:ie,js:je,:) + endif ; endif + end subroutine MOM_read_vector_3d From 8c0acdeefb3ce4a7aa91f2c67703f1c24980a682 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 5 Sep 2018 18:37:28 -0400 Subject: [PATCH 072/174] Rescale input fields in MOM_read_data calls Rescaled a number of initialization fields that are read from files to the right internal representation inside of the MOM_read_data calls. All answers are bitwise identical. --- .../MOM_state_initialization.F90 | 32 ++++++------------- src/user/ISOMIP_initialization.F90 | 5 +-- 2 files changed, 11 insertions(+), 26 deletions(-) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 756e192196..4aa8e55e93 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -641,10 +641,7 @@ subroutine initialize_thickness_from_file(h, G, GV, param_file, file_has_thickne if (file_has_thickness) then !### Consider adding a parameter to use to rescale h. if (just_read) return ! All run-time parameters have been read, so return. - call MOM_read_data(filename, "h", h(:,:,:), G%Domain) - do k=1,nz ; do j=js,je ; do i=is,ie - h(i,j,k) = GV%m_to_H * h(i,j,k) - enddo ; enddo ; enddo + call MOM_read_data(filename, "h", h(:,:,:), G%Domain, scale=GV%m_to_H) else call get_param(param_file, mdl, "ADJUST_THICKNESS", correct_thickness, & "If true, all mass below the bottom removed if the \n"//& @@ -860,8 +857,7 @@ subroutine initialize_thickness_list(h, G, GV, param_file, just_read_params) call log_param(param_file, mdl, "INPUTDIR/INTERFACE_IC_FILE", filename) e0(:) = 0.0 - call MOM_read_data(filename, eta_var, e0(:)) - do k=1,nz+1 ; e0(k) = GV%m_to_Z*e0(k) ; enddo + call MOM_read_data(filename, eta_var, e0(:), scale=GV%m_to_Z) if ((abs(e0(1)) - 0.0) > 0.001) then ! This list probably starts with the interior interface, so shift it up. @@ -1024,11 +1020,7 @@ subroutine depress_surface(h, G, GV, param_file, tv, just_read_params) if (just_read) return ! All run-time parameters have been read, so return. - call MOM_read_data(filename, eta_srf_var, eta_sfc, G%Domain) - - if (scale_factor /= 1.0) then ; do j=js,je ; do i=is,ie - eta_sfc(i,j) = eta_sfc(i,j) * scale_factor - enddo ; enddo ; endif + call MOM_read_data(filename, eta_srf_var, eta_sfc, G%Domain, scale=scale_factor) ! Convert thicknesses to interface heights. call find_eta(h, tv, GV%g_Earth, G, GV, eta) @@ -1111,8 +1103,7 @@ subroutine trim_for_ice(PF, G, GV, ALE_CSp, tv, h, just_read_params) if (just_read) return ! All run-time parameters have been read, so return. - call MOM_read_data(filename, p_surf_var, p_surf, G%Domain) - if (scale_factor /= 1.) p_surf(:,:) = scale_factor * p_surf(:,:) + call MOM_read_data(filename, p_surf_var, p_surf, G%Domain, scale=scale_factor) if (use_remapping) then allocate(remap_CS) @@ -1748,10 +1739,7 @@ subroutine initialize_sponges_file(G, GV, use_temperature, tv, param_file, CSp, if (.not. use_ALE) then allocate(eta(isd:ied,jsd:jed,nz+1)) - call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain) - if (GV%m_to_Z /= 1.0) then ; do k=1,nz+1 ; do j=js,je ; do i=is,ie - eta(i,j,k) = GV%m_to_Z*eta(i,j,k) - enddo ; enddo ; enddo ; endif + call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain, scale=GV%m_to_Z) do j=js,je ; do i=is,ie eta(i,j,nz+1) = -G%bathyT(i,j) @@ -1776,18 +1764,18 @@ subroutine initialize_sponges_file(G, GV, use_temperature, tv, param_file, CSp, allocate(eta(isd:ied,jsd:jed,nz_data+1)) allocate(h(isd:ied,jsd:jed,nz_data)) - call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain) + call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain, scale=GV%m_to_Z) do j=js,je ; do i=is,ie - eta(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) + eta(i,j,nz+1) = -G%bathyT(i,j) enddo ; enddo do k=nz,1,-1 ; do j=js,je ; do i=is,ie - if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_m)) & - eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_m + if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_Z)) & + eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_Z enddo ; enddo ; enddo do k=1,nz; do j=js,je ; do i=is,ie - h(i,j,k) = eta(i,j,k)-eta(i,j,k+1) + h(i,j,k) = GV%m_to_H*(eta(i,j,k)-eta(i,j,k+1)) enddo ; enddo ; enddo call initialize_ALE_sponge(Idamp, G, param_file, ALE_CSp, h, nz_data) deallocate(eta) diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index 267e4c0558..969bb0664e 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -623,10 +623,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) filename = trim(inputdir)//trim(state_file) if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & "ISOMIP_initialize_sponges: Unable to open "//trim(filename)) - call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain) - if (GV%m_to_Z /= 1.0) then ; do k=1,nz+1 ; do j=js,je ; do i=is,ie - eta(i,j,k) = GV%m_to_Z*eta(i,j,k) - enddo ; enddo ; enddo ; endif + call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain, scale=GV%m_to_Z) call MOM_read_data(filename, temp_var, T(:,:,:), G%Domain) call MOM_read_data(filename, salt_var, S(:,:,:), G%Domain) From 48a28d20824a75121bfeb873445cb6852c6b8c62 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 6 Sep 2018 09:20:43 -0400 Subject: [PATCH 073/174] Rescale diagnostics in post_data_1d_k If the conversion argument in a register_diag_field call has been set to something other than 1, other post_data calls will rescale diagnostics, but post_data_1d_k previously did not. Now it does. All answers are bitwise identical. --- src/framework/MOM_diag_mediator.F90 | 29 ++++++++++++++++++++++++----- 1 file changed, 24 insertions(+), 5 deletions(-) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index fb84d4d48d..e1103f2a20 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -752,14 +752,15 @@ end subroutine post_data_0d subroutine post_data_1d_k(diag_field_id, field, diag_cs, is_static) integer, intent(in) :: diag_field_id !< The id for an output variable returned by a !! previous call to register_diag_field. - real, intent(in) :: field(:) !< 1-d array being offered for output or averaging + real, target, intent(in) :: field(:) !< 1-d array being offered for output or averaging type(diag_ctrl), target, intent(in) :: diag_CS !< Structure used to regulate diagnostic output logical, optional, intent(in) :: is_static !< If true, this is a static field that is always offered. ! Local variables logical :: used ! The return value of send_data is not used for anything. + real, dimension(:), pointer :: locfield => NULL() logical :: is_stat - integer :: isv, iev, jsv, jev + integer :: k, ks, ke type(diag_type), pointer :: diag => null() if (id_clock_diag_mediator>0) call cpu_clock_begin(id_clock_diag_mediator) @@ -770,11 +771,29 @@ subroutine post_data_1d_k(diag_field_id, field, diag_cs, is_static) 'post_data_1d_k: Unregistered diagnostic id') diag => diag_cs%diags(diag_field_id) do while (associated(diag)) + + if ((diag%conversion_factor /= 0.) .and. (diag%conversion_factor /= 1.)) then + ks = lbound(field,1) ; ke = ubound(field,1) + allocate( locfield( ks:ke ) ) + + do k=ks,ke + if (field(k) == diag_cs%missing_value) then + locfield(k) = diag_cs%missing_value + else + locfield(k) = field(k) * diag%conversion_factor + endif + enddo + else + locfield => field + endif + if (is_stat) then - used = send_data(diag%fms_diag_id, field) + used = send_data(diag%fms_diag_id, locfield) elseif (diag_cs%ave_enabled) then - used = send_data(diag%fms_diag_id, field, diag_cs%time_end, weight=diag_cs%time_int) + used = send_data(diag%fms_diag_id, locfield, diag_cs%time_end, weight=diag_cs%time_int) endif + if ((diag%conversion_factor /= 0.) .and. (diag%conversion_factor /= 1.)) deallocate( locfield ) + diag => diag%next enddo @@ -800,7 +819,7 @@ subroutine post_data_2d(diag_field_id, field, diag_cs, is_static, mask) 'post_data_2d: Unregistered diagnostic id') diag => diag_cs%diags(diag_field_id) do while (associated(diag)) - call post_data_2d_low(diag, field, diag_cs, is_static, mask) + call post_data_2d_low(diag, field, diag_cs, is_static, mask) diag => diag%next enddo From 2f66582d1f1e4dd278926f45af1f51d072be84a2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 6 Sep 2018 09:25:44 -0400 Subject: [PATCH 074/174] Explicitly calculate thkcello Added code to avoid an array syntax multiply of a diagnostic. All answers are bitwise identical in test cases, but this could avoid encountering NaNs in halo regions, and it avoids unnecessary calculations when H_to_m=1. --- src/diagnostics/MOM_diagnostics.F90 | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index e5ffdbff02..99d19c657a 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -324,7 +324,14 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & ! diagnose thickness/volumes of grid cells (meter) if (CS%id_thkcello>0 .or. CS%id_volcello>0) then if (GV%Boussinesq) then ! thkcello = h for Boussinesq - if (CS%id_thkcello > 0) call post_data(CS%id_thkcello, GV%H_to_m*h, CS%diag) + if (CS%id_thkcello > 0) then ; if (GV%H_to_m == 1.0) then + call post_data(CS%id_thkcello, h, CS%diag) + else + 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) + enddo ; enddo ; enddo + call post_data(CS%id_thkcello, work_3d, CS%diag) + 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) From ea65055688d81d3698c331fd6f619e510633e487 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 6 Sep 2018 10:51:45 -0400 Subject: [PATCH 075/174] Calculate non-Boussinesq e_tidal in depth units Change e_tidal from m to depth units in the non-Boussinesq pressure gradient force calculations. Also simplified MOM_PressureForce_Montgomery openMP directives. All answers are bitwise identical for no Z-rescaling or for rescaling by 2^93 or 2^-93. --- src/core/MOM_PressureForce_Montgomery.F90 | 69 ++++++++++------------ src/core/MOM_PressureForce_analytic_FV.F90 | 21 +++---- src/core/MOM_PressureForce_blocked_AFV.F90 | 21 +++---- 3 files changed, 52 insertions(+), 59 deletions(-) diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 079bab6b19..09ce4721d9 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -96,11 +96,11 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, ! enable the use of a reduced gravity form of the equations, ! in m2 s-2. dp_star, & ! Layer thickness after compensation for compressibility, in Pa. + SSH, & ! The sea surface height anomaly, in depth units (Z). e_tidal, & ! Bottom geopotential anomaly due to tidal forces from - ! astronomical sources and self-attraction and loading, in m. - geopot_bot, & ! Bottom geopotential relative to time-mean sea level, + ! astronomical sources and self-attraction and loading, in Z. + geopot_bot ! Bottom geopotential relative to time-mean sea level, ! including any tidal contributions, in units of m2 s-2. - SSH ! Sea surface height anomalies, in m. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density, in Pa (usually 2e7 Pa = 2000 dbar). real :: rho_in_situ(SZI_(G)) !In-situ density of a layer, in kg m-3. @@ -116,7 +116,8 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, ! barotropic and baroclinic pieces. type(thermo_var_ptrs) :: tv_tmp! A structure of temporary T & S. - real :: I_gEarth + real :: g_Earth_z ! A scaled version of g_Earth, in m2 Z-1 s-2. + real :: I_gEarth ! The inverse of g_Earth_z, in s2 Z m-2 real :: dalpha real :: Pa_to_H ! A factor to convert from Pa to the thicknesss units (H). real :: alpha_Lay(SZK_(G)) ! The specific volume of each layer, in kg m-3. @@ -141,7 +142,8 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, "can no longer be used with a compressible EOS. Use #define ANALYTIC_FV_PGF.") endif - I_gEarth = 1.0 / GV%g_Earth + g_Earth_z = GV%g_Earth*GV%Z_to_m + I_gEarth = 1.0 / g_Earth_z dp_neglect = GV%H_to_Pa * GV%H_subroundoff do k=1,nz ; alpha_Lay(k) = 1.0 / GV%Rlay(k) ; enddo do k=2,nz ; dalpha_int(K) = alpha_Lay(k-1) - alpha_Lay(k) ; enddo @@ -178,7 +180,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, ! of self-attraction and loading. !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - SSH(i,j) = -GV%Z_to_m*G%bathyT(i,j) + SSH(i,j) = -G%bathyT(i,j) enddo ; enddo if (use_EOS) then !$OMP parallel do default(shared) @@ -193,19 +195,19 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do k=1,nz ; do i=Isq,Ieq+1 - SSH(i,j) = SSH(i,j) + GV%H_to_kg_m2*h(i,j,k)*alpha_Lay(k) + SSH(i,j) = SSH(i,j) + (GV%m_to_Z*GV%H_to_kg_m2)*h(i,j,k)*alpha_Lay(k) enddo ; enddo ; enddo endif - call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=1.0) + call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=GV%m_to_Z) !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - geopot_bot(i,j) = -GV%g_Earth*(e_tidal(i,j) + GV%Z_to_m*G%bathyT(i,j)) + geopot_bot(i,j) = -g_Earth_z*(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) = -GV%g_Earth*GV%Z_to_m*G%bathyT(i,j) + geopot_bot(i,j) = -g_Earth_z*G%bathyT(i,j) enddo ; enddo endif @@ -394,8 +396,8 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta ! attraction and loading, in depth units (Z). real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density, in Pa (usually 2e7 Pa = 2000 dbar). - real :: I_Rho0 ! 1/Rho0. - real :: G_Rho0 ! G_Earth / Rho0 in m4 s-2 kg-1. + real :: I_Rho0 ! 1/Rho0, in m3 kg-1. + real :: G_Rho0 ! G_Earth / Rho0 in m5 Z-1 s-2 kg-1. real :: PFu_bc, PFv_bc ! The pressure gradient force due to along-layer ! compensated density gradients, in m s-2. real :: dr ! Temporary variables. @@ -430,7 +432,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta h_neglect = GV%H_subroundoff * GV%H_to_Z I_Rho0 = 1.0/CS%Rho0 - G_Rho0 = GV%g_Earth/GV%Rho0 + G_Rho0 = GV%Z_to_m*GV%g_Earth/GV%Rho0 if (CS%tides) then ! Determine the surface height anomaly for calculating self attraction @@ -592,7 +594,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta if (CS%id_PFu_bc>0) call post_data(CS%id_PFu_bc, CS%PFu_bc, CS%diag) if (CS%id_PFv_bc>0) call post_data(CS%id_PFv_bc, CS%PFv_bc, CS%diag) - if (CS%id_e_tidal>0) call post_data(CS%id_e_tidal, GV%Z_to_m*e_tidal(:,:), CS%diag) + if (CS%id_e_tidal>0) call post_data(CS%id_e_tidal, e_tidal, CS%diag) end subroutine PressureForce_Mont_Bouss @@ -616,15 +618,14 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star !! compensated), times g/rho_0, in m2 Z-1 s-2. ! Local variables - real :: Ihtot(SZI_(G)) ! The inverse of the sum of the layer - ! thicknesses, in m-1. + real :: Ihtot(SZI_(G)) ! The inverse of the sum of the layer thicknesses, in H-1. real :: press(SZI_(G)) ! Interface pressure, in Pa. real :: T_int(SZI_(G)) ! Interface temperature in C. real :: S_int(SZI_(G)) ! Interface salinity in PSU. real :: dR_dT(SZI_(G)) ! Partial derivatives of density with temperature real :: dR_dS(SZI_(G)) ! and salinity in kg m-3 K-1 and kg m-3 PSU-1. real :: rho_in_situ(SZI_(G)) !In-situ density at the top of a layer. - real :: G_Rho0 ! g_Earth / Rho0 in m4 s-2 kg-1. + real :: G_Rho0 ! G_Earth / Rho0 in m5 Z-1 s-2 kg-1. real :: Rho0xG ! g_Earth * Rho0 in kg s-2 m-1 Z-1. logical :: use_EOS ! If true, density is calculated from T & S using ! an equation of state. @@ -635,15 +636,13 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = G%ke Rho0xG = Rho0*g_Earth*GV%Z_to_m - G_Rho0 = g_Earth/Rho0 + G_Rho0 = GV%Z_to_m*GV%g_Earth / GV%Rho0 use_EOS = associated(tv%eqn_of_state) z_neglect = GV%H_subroundoff*GV%H_to_Z if (use_EOS) then if (present(rho_star)) then -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,e,z_neglect,pbce,rho_star,& -!$OMP GFS_scale,GV) & -!$OMP private(Ihtot) + !$OMP parallel do default(shared) private(Ihtot) 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) @@ -655,18 +654,16 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star enddo ; enddo enddo ! end of j loop else -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,e,tv,z_neglect,G_Rho0,Rho0xG,& -!$OMP pbce,GFS_scale,GV) & -!$OMP private(Ihtot,press,rho_in_situ,T_int,S_int,dR_dT,dR_dS) + !$OMP parallel do default(shared) private(Ihtot,press,rho_in_situ,T_int,S_int,dR_dT,dR_dS) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - Ihtot(i) = GV%H_to_m / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect) + Ihtot(i) = GV%H_to_Z / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect) press(i) = -Rho0xG*e(i,j,1) enddo call calculate_density(tv%T(:,j,1), tv%S(:,j,1), press, rho_in_situ, & Isq, Ieq-Isq+2, tv%eqn_of_state) do i=Isq,Ieq+1 - pbce(i,j,1) = G_Rho0*(GFS_scale * rho_in_situ(i)) * GV%H_to_m + pbce(i,j,1) = G_Rho0*(GFS_scale * rho_in_situ(i)) * GV%H_to_Z enddo do k=2,nz do i=Isq,Ieq+1 @@ -686,7 +683,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star enddo ! end of j loop endif else ! not use_EOS -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,e,GV,z_neglect,pbce) private(Ihtot) + !$OMP parallel do default(share) private(Ihtot) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 Ihtot(i) = GV%H_to_m / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect) @@ -749,8 +746,7 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, g_Earth, GFS_scale, pbce, alpha_star) if (use_EOS) then if (present(alpha_star)) then -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,C_htot,dP_dH,p,dp_neglect, & -!$OMP pbce,alpha_star) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 C_htot(i,j) = dP_dH / ((p(i,j,nz+1)-p(i,j,1)) + dp_neglect) @@ -762,9 +758,7 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, g_Earth, GFS_scale, pbce, alpha_star) enddo ; enddo enddo else -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,tv,p,C_htot, & -!$OMP dP_dH,dp_neglect,pbce) & -!$OMP private(T_int,S_int,dR_dT,dR_dS,rho_in_situ) + !$OMP parallel do default(shared) private(T_int,S_int,dR_dT,dR_dS,rho_in_situ) do j=Jsq,Jeq+1 call calculate_density(tv%T(:,j,nz), tv%S(:,j,nz), p(:,j,nz+1), & rho_in_situ, Isq, Ieq-Isq+2, tv%eqn_of_state) @@ -790,8 +784,7 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, g_Earth, GFS_scale, pbce, alpha_star) enddo endif else ! not use_EOS -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,C_htot,dP_dH,p,dp_neglect, & -!$OMP pbce,alpha_Lay,dalpha_int) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 C_htot(i,j) = dP_dH / ((p(i,j,nz+1)-p(i,j,1)) + dp_neglect) @@ -806,16 +799,14 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, g_Earth, GFS_scale, pbce, alpha_star) if (GFS_scale < 1.0) then ! Adjust the Montgomery potential to make this a reduced gravity model. -!$OMP parallel default(none) shared(Isq,Ieq,Jsq,Jeq,dpbce,GFS_scale,pbce,nz) -!$OMP do + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 dpbce(i,j) = (GFS_scale - 1.0) * pbce(i,j,1) enddo ; enddo -!$OMP do + !$OMP parallel do default(shared) do k=1,nz ; do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 pbce(i,j,k) = pbce(i,j,k) + dpbce(i,j) enddo ; enddo ; enddo -!$OMP end parallel endif end subroutine Set_pbce_nonBouss @@ -876,7 +867,7 @@ subroutine PressureForce_Mont_init(Time, G, GV, param_file, diag, CS, tides_CSp) if (CS%tides) then CS%id_e_tidal = register_diag_field('ocean_model', 'e_tidal', diag%axesT1, & - Time, 'Tidal Forcing Astronomical and SAL Height Anomaly', 'meter') + Time, 'Tidal Forcing Astronomical and SAL Height Anomaly', 'meter', conversion=GV%Z_to_m) endif CS%GFS_scale = 1.0 diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index 99ffda6a88..470636126c 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -127,9 +127,9 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm ! the pressure anomaly at the top of the layer, in Pa m2 s-2. real, dimension(SZI_(G),SZJ_(G)) :: & dp, & ! The (positive) change in pressure across a layer, in Pa. - SSH, & ! The sea surface height anomaly, in m. + SSH, & ! The sea surface height anomaly, in depth units (Z). e_tidal, & ! The bottom geopotential anomaly due to tidal forces from - ! astronomical sources and self-attraction and loading, in m. + ! astronomical sources and self-attraction and loading, in Z. dM, & ! The barotropic adjustment to the Montgomery potential to ! account for a reduced gravity model, in m2 s-2. za ! The geopotential anomaly (i.e. g*e + alpha_0*pressure) at the @@ -152,6 +152,8 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm real :: dp_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in Pa. + real :: g_Earth_z ! A scaled version of g_Earth, in m2 Z-1 s-2. + real :: I_gEarth ! The inverse of g_Earth_z, in s2 Z m-2 real :: alpha_anom ! The in-situ specific volume, averaged over a ! layer, less alpha_ref, in m3 kg-1. logical :: use_p_atm ! If true, use the atmospheric pressure. @@ -165,7 +167,6 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm real :: rho_in_situ(SZI_(G)) ! The in situ density, in kg m-3. real :: Pa_to_H ! A factor to convert from Pa to the thicknesss units (H). ! real :: oneatm = 101325.0 ! 1 atm in Pa (kg/ms2) - real :: I_gEarth real, parameter :: C1_6 = 1.0/6.0 integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb integer :: i, j, k @@ -185,6 +186,8 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm dp_neglect = GV%H_to_Pa * GV%H_subroundoff alpha_ref = 1.0/CS%Rho0 + g_Earth_z = GV%g_Earth*GV%Z_to_m + I_gEarth = 1.0 / g_Earth_z if (use_p_atm) then !$OMP parallel do default(shared) @@ -202,8 +205,6 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm p(i,j,K) = p(i,j,K-1) + GV%H_to_Pa * h(i,j,k-1) enddo ; enddo ; enddo - I_gEarth = 1.0 / GV%g_Earth - if (use_EOS) then ! With a bulk mixed layer, replace the T & S of any layers that are ! lighter than the the buffer layer with the properties of the buffer @@ -302,7 +303,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - za(i,j) = alpha_ref*p(i,j,nz+1) - GV%g_Earth*GV%Z_to_m*G%bathyT(i,j) + za(i,j) = alpha_ref*p(i,j,nz+1) - g_Earth_z*G%bathyT(i,j) enddo do k=nz,1,-1 ; do i=Isq,Ieq+1 za(i,j) = za(i,j) + dza(i,j,k) @@ -315,10 +316,10 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 SSH(i,j) = (za(i,j) - alpha_ref*p(i,j,1)) * I_gEarth enddo ; enddo - call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=1.0) + call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=GV%m_to_Z) !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - za(i,j) = za(i,j) - GV%g_Earth*e_tidal(i,j) + za(i,j) = za(i,j) - g_Earth_z * e_tidal(i,j) enddo ; enddo endif @@ -767,7 +768,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p endif endif - if (CS%id_e_tidal>0) call post_data(CS%id_e_tidal, GV%Z_to_m*e_tidal(:,:), CS%diag) + if (CS%id_e_tidal>0) call post_data(CS%id_e_tidal, e_tidal, CS%diag) end subroutine PressureForce_AFV_Bouss @@ -833,7 +834,7 @@ subroutine PressureForce_AFV_init(Time, G, GV, param_file, diag, CS, tides_CSp) if (CS%tides) then CS%id_e_tidal = register_diag_field('ocean_model', 'e_tidal', diag%axesT1, & - Time, 'Tidal Forcing Astronomical and SAL Height Anomaly', 'meter') + Time, 'Tidal Forcing Astronomical and SAL Height Anomaly', 'meter', conversion=GV%Z_to_m) endif CS%GFS_scale = 1.0 diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index 7119426871..f8f2abd35b 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -123,9 +123,9 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc ! the pressure anomaly at the top of the layer, in Pa m2 s-2. real, dimension(SZI_(G),SZJ_(G)) :: & dp, & ! The (positive) change in pressure across a layer, in Pa. - SSH, & ! The sea surface height anomaly, in m. + SSH, & ! The sea surface height anomaly, in depth units (Z). e_tidal, & ! The bottom geopotential anomaly due to tidal forces from - ! astronomical sources and self-attraction and loading, in m. + ! astronomical sources and self-attraction and loading, in Z. dM, & ! The barotropic adjustment to the Montgomery potential to ! account for a reduced gravity model, in m2 s-2. za ! The geopotential anomaly (i.e. g*e + alpha_0*pressure) at the @@ -152,6 +152,8 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc real :: dp_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in Pa. + real :: g_Earth_z ! A scaled version of g_Earth, in m2 Z-1 s-2. + real :: I_gEarth ! The inverse of g_Earth_z, in s2 Z m-2 real :: alpha_anom ! The in-situ specific volume, averaged over a ! layer, less alpha_ref, in m3 kg-1. logical :: use_p_atm ! If true, use the atmospheric pressure. @@ -164,7 +166,6 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc real :: rho_in_situ(SZI_(G)) ! The in situ density, in kg m-3. real :: Pa_to_H ! A factor to convert from Pa to the thicknesss units (H). ! real :: oneatm = 101325.0 ! 1 atm in Pa (kg/ms2) - real :: I_gEarth real, parameter :: C1_6 = 1.0/6.0 integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb integer :: is_bk, ie_bk, js_bk, je_bk, Isq_bk, Ieq_bk, Jsq_bk, Jeq_bk @@ -183,6 +184,8 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc dp_neglect = GV%H_to_Pa * GV%H_subroundoff alpha_ref = 1.0/CS%Rho0 + g_Earth_z = GV%g_Earth*GV%Z_to_m + I_gEarth = 1.0 / g_Earth_z if (use_p_atm) then !$OMP parallel do default(shared) @@ -200,8 +203,6 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc p(i,j,K) = p(i,j,K-1) + GV%H_to_Pa * h(i,j,k-1) enddo ; enddo ; enddo - I_gEarth = 1.0 / GV%g_Earth - if (use_EOS) then ! With a bulk mixed layer, replace the T & S of any layers that are ! lighter than the the buffer layer with the properties of the buffer @@ -269,7 +270,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - za(i,j) = alpha_ref*p(i,j,nz+1) - GV%g_Earth*GV%Z_to_m*G%bathyT(i,j) + za(i,j) = alpha_ref*p(i,j,nz+1) - g_Earth_z*G%bathyT(i,j) enddo do k=nz,1,-1 ; do i=Isq,Ieq+1 za(i,j) = za(i,j) + dza(i,j,k) @@ -282,10 +283,10 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 SSH(i,j) = (za(i,j) - alpha_ref*p(i,j,1)) * I_gEarth enddo ; enddo - call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=1.0) + call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=GV%m_to_Z) !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - za(i,j) = za(i,j) - GV%g_Earth*e_tidal(i,j) + za(i,j) = za(i,j) - g_Earth_z * e_tidal(i,j) enddo ; enddo endif @@ -761,7 +762,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at endif endif - if (CS%id_e_tidal>0) call post_data(CS%id_e_tidal, GV%Z_to_m*e_tidal(:,:), CS%diag) + if (CS%id_e_tidal>0) call post_data(CS%id_e_tidal, e_tidal, CS%diag) end subroutine PressureForce_blk_AFV_Bouss @@ -827,7 +828,7 @@ subroutine PressureForce_blk_AFV_init(Time, G, GV, param_file, diag, CS, tides_C if (CS%tides) then CS%id_e_tidal = register_diag_field('ocean_model', 'e_tidal', diag%axesT1, & - Time, 'Tidal Forcing Astronomical and SAL Height Anomaly', 'meter') + Time, 'Tidal Forcing Astronomical and SAL Height Anomaly', 'meter', conversion=GV%Z_to_m) endif CS%GFS_scale = 1.0 From 32b5fe06160dbbc66e9d9828350872ea4a410d8b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 6 Sep 2018 12:00:02 -0400 Subject: [PATCH 076/174] +Put post_data_1d_k into the post_data overload Made post_data_1d_k into the routines that the interface post_data might call. All answers are bitwise identical, but there is effectively a new public interface. --- src/framework/MOM_diag_mediator.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index e1103f2a20..6fb42e9df0 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -64,7 +64,7 @@ module MOM_diag_mediator !> Make a diagnostic available for averaging or output. interface post_data - module procedure post_data_3d, post_data_2d, post_data_0d + module procedure post_data_3d, post_data_2d, post_data_1d_k, post_data_0d end interface post_data !> A group of 1D axes that comprise a 1D/2D/3D mesh From 49053c79bacaa811832052ff16f46aa92bba9f20 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 6 Sep 2018 12:00:51 -0400 Subject: [PATCH 077/174] Replace calls to post_data_1d_k with post_data Calls to post_data can now resolve to post_data_1d_k, so there is no reason to use the specific interface. All answers are bitwise identical. --- src/diagnostics/MOM_diag_to_Z.F90 | 4 +- src/diagnostics/MOM_diagnostics.F90 | 6 +-- .../vertical/MOM_diapyc_energy_req.F90 | 38 +++++++++---------- 3 files changed, 24 insertions(+), 24 deletions(-) diff --git a/src/diagnostics/MOM_diag_to_Z.F90 b/src/diagnostics/MOM_diag_to_Z.F90 index 2a4b1b1ec3..a4471e1318 100644 --- a/src/diagnostics/MOM_diag_to_Z.F90 +++ b/src/diagnostics/MOM_diag_to_Z.F90 @@ -8,7 +8,7 @@ module MOM_diag_to_Z use MOM_domains, only : pass_var use MOM_coms, only : reproducing_sum -use MOM_diag_mediator, only : post_data, post_data_1d_k, register_diag_field, safe_alloc_ptr +use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : diag_ctrl, time_type, diag_axis_init use MOM_diag_mediator, only : axes_grp, define_axes_group use MOM_diag_mediator, only : ocean_register_diag @@ -479,7 +479,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS) if (CS%id_tr(m) > 0) call post_data(CS%id_tr(m), CS%tr_z(m)%p, CS%diag) if (CS%id_tr_xyave(m) > 0) then layer_ave = global_z_mean(CS%tr_z(m)%p,G,CS,m) - call post_data_1d_k(CS%id_tr_xyave(m), layer_ave, CS%diag) + call post_data(CS%id_tr_xyave(m), layer_ave, CS%diag) endif enddo endif diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 99d19c657a..eb6f02daae 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -6,7 +6,7 @@ module MOM_diagnostics ! This file is part of MOM6. See LICENSE.md for the license. use MOM_coms, only : reproducing_sum -use MOM_diag_mediator, only : post_data, post_data_1d_k, get_diag_time_end +use MOM_diag_mediator, only : post_data, get_diag_time_end use MOM_diag_mediator, only : register_diag_field, register_scalar_field use MOM_diag_mediator, only : register_static_field, diag_register_area_ids use MOM_diag_mediator, only : diag_ctrl, time_type, safe_alloc_ptr @@ -441,13 +441,13 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & ! layer mean potential temperature if (CS%id_temp_layer_ave>0) then temp_layer_ave = global_layer_mean(tv%T, h, G, GV) - call post_data_1d_k(CS%id_temp_layer_ave, temp_layer_ave, CS%diag) + call post_data(CS%id_temp_layer_ave, temp_layer_ave, CS%diag) endif ! layer mean salinity if (CS%id_salt_layer_ave>0) then salt_layer_ave = global_layer_mean(tv%S, h, G, GV) - call post_data_1d_k(CS%id_salt_layer_ave, salt_layer_ave, CS%diag) + call post_data(CS%id_salt_layer_ave, salt_layer_ave, CS%diag) endif call calculate_vertical_integrals(h, tv, p_surf, G, GV, CS) diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index b3ddad75fd..acd0c9336c 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -5,7 +5,7 @@ module MOM_diapyc_energy_req !! \author By Robert Hallberg, May 2015 -use MOM_diag_mediator, only : diag_ctrl, Time_type, post_data_1d_k, register_diag_field +use MOM_diag_mediator, only : diag_ctrl, Time_type, post_data, register_diag_field use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg, is_root_pe use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type @@ -910,22 +910,22 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & K=nz if (do_print) then - if (CS%id_ERt>0) call post_data_1d_k(CS%id_ERt, PE_chg_k(:,1), CS%diag) - if (CS%id_ERb>0) call post_data_1d_k(CS%id_ERb, PE_chg_k(:,2), CS%diag) - if (CS%id_ERc>0) call post_data_1d_k(CS%id_ERc, PE_chg_k(:,3), CS%diag) - if (CS%id_ERh>0) call post_data_1d_k(CS%id_ERh, PE_chg_k(:,4), CS%diag) - if (CS%id_Kddt>0) call post_data_1d_k(CS%id_Kddt, GV%H_to_m*Kddt_h, CS%diag) - if (CS%id_Kd>0) call post_data_1d_k(CS%id_Kd, Kd, CS%diag) - if (CS%id_h>0) call post_data_1d_k(CS%id_h, GV%H_to_m*h_tr, CS%diag) - if (CS%id_zInt>0) call post_data_1d_k(CS%id_zInt, Z_int, CS%diag) - if (CS%id_CHCt>0) call post_data_1d_k(CS%id_CHCt, ColHt_cor_k(:,1), CS%diag) - if (CS%id_CHCb>0) call post_data_1d_k(CS%id_CHCb, ColHt_cor_k(:,2), CS%diag) - if (CS%id_CHCc>0) call post_data_1d_k(CS%id_CHCc, ColHt_cor_k(:,3), CS%diag) - if (CS%id_CHCh>0) call post_data_1d_k(CS%id_CHCh, ColHt_cor_k(:,4), CS%diag) - if (CS%id_T0>0) call post_data_1d_k(CS%id_T0, T0, CS%diag) - if (CS%id_Tf>0) call post_data_1d_k(CS%id_Tf, Tf, CS%diag) - if (CS%id_S0>0) call post_data_1d_k(CS%id_S0, S0, CS%diag) - if (CS%id_Sf>0) call post_data_1d_k(CS%id_Sf, Sf, CS%diag) + if (CS%id_ERt>0) call post_data(CS%id_ERt, PE_chg_k(:,1), CS%diag) + if (CS%id_ERb>0) call post_data(CS%id_ERb, PE_chg_k(:,2), CS%diag) + if (CS%id_ERc>0) call post_data(CS%id_ERc, PE_chg_k(:,3), CS%diag) + if (CS%id_ERh>0) call post_data(CS%id_ERh, PE_chg_k(:,4), CS%diag) + if (CS%id_Kddt>0) call post_data(CS%id_Kddt, GV%H_to_m*Kddt_h, CS%diag) + if (CS%id_Kd>0) call post_data(CS%id_Kd, Kd, CS%diag) + if (CS%id_h>0) call post_data(CS%id_h, GV%H_to_m*h_tr, CS%diag) + if (CS%id_zInt>0) call post_data(CS%id_zInt, Z_int, CS%diag) + if (CS%id_CHCt>0) call post_data(CS%id_CHCt, ColHt_cor_k(:,1), CS%diag) + if (CS%id_CHCb>0) call post_data(CS%id_CHCb, ColHt_cor_k(:,2), CS%diag) + if (CS%id_CHCc>0) call post_data(CS%id_CHCc, ColHt_cor_k(:,3), CS%diag) + if (CS%id_CHCh>0) call post_data(CS%id_CHCh, ColHt_cor_k(:,4), CS%diag) + if (CS%id_T0>0) call post_data(CS%id_T0, T0, CS%diag) + if (CS%id_Tf>0) call post_data(CS%id_Tf, Tf, CS%diag) + if (CS%id_S0>0) call post_data(CS%id_S0, S0, CS%diag) + if (CS%id_Sf>0) call post_data(CS%id_Sf, Sf, CS%diag) if (CS%id_N2_0>0) then N2(1) = 0.0 ; N2(nz+1) = 0.0 do K=2,nz @@ -935,7 +935,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & ( 0.5*(dSV_dT(k-1) + dSV_dT(k)) * (T0(k-1) - T0(k)) + & 0.5*(dSV_dS(k-1) + dSV_dS(k)) * (S0(k-1) - S0(k)) ) enddo - call post_data_1d_k(CS%id_N2_0, N2, CS%diag) + call post_data(CS%id_N2_0, N2, CS%diag) endif if (CS%id_N2_f>0) then N2(1) = 0.0 ; N2(nz+1) = 0.0 @@ -946,7 +946,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & ( 0.5*(dSV_dT(k-1) + dSV_dT(k)) * (Tf(k-1) - Tf(k)) + & 0.5*(dSV_dS(k-1) + dSV_dS(k)) * (Sf(k-1) - Sf(k)) ) enddo - call post_data_1d_k(CS%id_N2_f, N2, CS%diag) + call post_data(CS%id_N2_f, N2, CS%diag) endif endif From c689b2a59747c02b810e1da5a0cf416d49f7a51f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 8 Sep 2018 06:37:16 -0400 Subject: [PATCH 078/174] +Added optional inner_halo argument to pass_var_2d Added a new optional argument to pass_var_2d of an inner halo region to exclude from halo updates. The use of this argument can correct a bug that sets G%geolonBu incorrectly on the tripolar fold. All answers are bitwise identical, although there is a new optional argument in a public interface. --- src/framework/MOM_domains.F90 | 73 ++++++++++++++++++++++++++++++----- 1 file changed, 64 insertions(+), 9 deletions(-) diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index a38facf79a..e24b411fd0 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -27,18 +27,18 @@ module MOM_domains use mpp_domains_mod, only : compute_block_extent => mpp_compute_block_extent use mpp_parameter_mod, only : AGRID, BGRID_NE, CGRID_NE, SCALAR_PAIR, BITWISE_EXACT_SUM, CORNER use mpp_parameter_mod, only : To_East => WUPDATE, To_West => EUPDATE, Omit_Corners => EDGEUPDATE -use mpp_parameter_mod, only : To_North => SUPDATE, To_South => NUPDATE +use mpp_parameter_mod, only : To_North => SUPDATE, To_South => NUPDATE, CENTER use fms_io_mod, only : file_exist, parse_mask_table implicit none ; private public :: MOM_domains_init, MOM_infra_init, MOM_infra_end, get_domain_extent public :: MOM_define_domain, MOM_define_io_domain, clone_MOM_domain -public :: pass_var, pass_vector, broadcast, PE_here, root_PE, num_PEs -public :: pass_var_start, pass_var_complete, fill_symmetric_edges +public :: pass_var, pass_vector, PE_here, root_PE, num_PEs +public :: pass_var_start, pass_var_complete, fill_symmetric_edges, broadcast public :: pass_vector_start, pass_vector_complete public :: global_field_sum, sum_across_PEs, min_across_PEs, max_across_PEs -public :: AGRID, BGRID_NE, CGRID_NE, SCALAR_PAIR, BITWISE_EXACT_SUM, CORNER +public :: AGRID, BGRID_NE, CGRID_NE, SCALAR_PAIR, BITWISE_EXACT_SUM, CORNER, CENTER public :: To_East, To_West, To_North, To_South, To_All, Omit_Corners public :: create_group_pass, do_group_pass, group_pass_type public :: start_group_pass, complete_group_pass @@ -178,8 +178,7 @@ subroutine pass_var_3d(array, MOM_dom, sideflag, complete, position, halo, & end subroutine pass_var_3d !> pass_var_2d does a halo update for a two-dimensional array. -subroutine pass_var_2d(array, MOM_dom, sideflag, complete, position, halo, & - clock) +subroutine pass_var_2d(array, MOM_dom, sideflag, complete, position, halo, inner_halo, clock) real, dimension(:,:), intent(inout) :: array !< The array which is having its halos points !! exchanged. type(MOM_domain_type), intent(inout) :: MOM_dom !< The MOM_domain_type containing the mpp_domain @@ -197,9 +196,18 @@ subroutine pass_var_2d(array, MOM_dom, sideflag, complete, position, halo, & !! by default. integer, optional, intent(in) :: halo !< The size of the halo to update - the full halo !! by default. - integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be + integer, optional, intent(in) :: inner_halo !< The size of an inner halo to avoid updating, + !! or 0 to avoid updating symmetric memory + !! computational domain points. Setting this >=0 + !! also enforces that complete=.true. + integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be !! started then stopped to time this routine. + ! Local variables + real, allocatable, dimension(:,:) :: tmp + integer :: pos, i_halo, j_halo + integer :: isc, iec, jsc, jec, isd, ied, jsd, jed, IscB, IecB, JscB, JecB + integer :: inner, i, j, isfw, iefw, isfe, iefe, jsfs, jefs, jsfn, jefn integer :: dirflag logical :: block_til_complete @@ -207,8 +215,15 @@ subroutine pass_var_2d(array, MOM_dom, sideflag, complete, position, halo, & dirflag = To_All ! 60 if (present(sideflag)) then ; if (sideflag > 0) dirflag = sideflag ; endif - block_til_complete = .true. - if (present(complete)) block_til_complete = complete + block_til_complete = .true. ; if (present(complete)) block_til_complete = complete + pos = CENTER ; if (present(position)) pos = position + + if (present(inner_halo)) then ; if (inner_halo >= 0) then + ! Store the original values. + allocate(tmp(size(array,1), size(array,2))) + tmp(:,:) = array(:,:) + block_til_complete = .true. + endif ; endif if (present(halo) .and. MOM_dom%thin_halo_updates) then call mpp_update_domains(array, MOM_dom%mpp_domain, flags=dirflag, & @@ -219,6 +234,46 @@ subroutine pass_var_2d(array, MOM_dom, sideflag, complete, position, halo, & complete=block_til_complete, position=position) endif + if (present(inner_halo)) then ; if (inner_halo >= 0) then + call mpp_get_compute_domain(MOM_dom%mpp_domain, isc, iec, jsc, jec) + call mpp_get_data_domain(MOM_dom%mpp_domain, isd, ied, jsd, jed) + ! Convert to local indices for arrays starting at 1. + isc = isc - (isd-1) ; iec = iec - (isd-1) ; ied = ied - (isd-1) ; isd = 1 + jsc = jsc - (jsd-1) ; jec = jec - (jsd-1) ; jed = jed - (jsd-1) ; jsd = 1 + i_halo = min(inner_halo, isc-1) ; j_halo = min(inner_halo, jsc-1) ; + + ! Figure out the array index extents of the eastern, western, northern and southern regions to copy. + if (pos == CENTER) then + if (size(array,1) == ied) then + isfw = isc - i_halo ; iefw = isc ; isfe = iec ; iefe = iec + i_halo + else ; call MOM_error(FATAL, "pass_var_2d: wrong i-size for CENTER array.") ; endif + if (size(array,2) == jed) then + isfw = isc - i_halo ; iefw = isc ; isfe = iec ; iefe = iec + i_halo + else ; call MOM_error(FATAL, "pass_var_2d: wrong j-size for CENTER array.") ; endif + elseif (pos == CORNER) then + if (size(array,1) == ied) then + isfw = max(isc - (i_halo+1), 1) ; iefw = isc ; isfe = iec ; iefe = iec + i_halo + elseif (size(array,1) == ied+1) then + isfw = isc - i_halo ; iefw = isc+1 ; isfe = iec+1 ; iefe = min(iec + 1 + i_halo, ied+1) + else ; call MOM_error(FATAL, "pass_var_2d: wrong i-size for CORNER array.") ; endif + if (size(array,2) == jed) then + jsfs = max(jsc - (j_halo+1), 1) ; jefs = jsc ; jsfn = jec ; jefn = jec + j_halo + elseif (size(array,2) == jed+1) then + jsfs = jsc - j_halo ; jefs = jsc+1 ; jsfn = jec+1 ; jefn = min(jec + 1 + j_halo, jed+1) + else ; call MOM_error(FATAL, "pass_var_2d: wrong j-size for CORNER array.") ; endif + else + call MOM_error(FATAL, "pass_var_2d: Unrecognized position") + endif + + ! Copy back the stored inner halo points + do j=jsfs,jefn ; do i=isfw,iefw ; array(i,j) = tmp(i,j) ; enddo ; enddo + do j=jsfs,jefn ; do i=isfe,iefe ; array(i,j) = tmp(i,j) ; enddo ; enddo + do j=jsfs,jefs ; do i=isfw,iefe ; array(i,j) = tmp(i,j) ; enddo ; enddo + do j=jsfn,jefn ; do i=isfw,iefe ; array(i,j) = tmp(i,j) ; enddo ; enddo + + deallocate(tmp) + endif ; endif + if (present(clock)) then ; if (clock>0) call cpu_clock_end(clock) ; endif end subroutine pass_var_2d From 107dd90bcfaf7c3be6012b510ef9800a9e560b14 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 8 Sep 2018 06:42:25 -0400 Subject: [PATCH 079/174] (*)Use inner_halo to correct grid transcription Use the new inner_halo argument to pass_var for geolonBu in the grid transcription code, to avoid incorrectly setting the longitudes in points that were set properly without a halo update. This avoids creating new problems but does not by itself correct the problems with G%geolonBu along the tripolar fold when setting the grid from a mosaic file. All answers in the current MOM6 test cases are bitwise identical. --- src/core/MOM_transcribe_grid.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/MOM_transcribe_grid.F90 b/src/core/MOM_transcribe_grid.F90 index eea4874f4e..62ac6e1ea4 100644 --- a/src/core/MOM_transcribe_grid.F90 +++ b/src/core/MOM_transcribe_grid.F90 @@ -143,7 +143,7 @@ subroutine copy_dyngrid_to_MOM_grid(dG, oG) call pass_vector(oG%geoLatCu, oG%geoLatCv, oG%Domain, To_All+Scalar_Pair, CGRID_NE) call pass_var(oG%areaBu, oG%Domain, position=CORNER) - call pass_var(oG%geoLonBu, oG%Domain, position=CORNER) + call pass_var(oG%geoLonBu, oG%Domain, position=CORNER, inner_halo=oG%isc-isd) call pass_var(oG%geoLatBu, oG%Domain, position=CORNER) call pass_vector(oG%dxBu, oG%dyBu, oG%Domain, To_All+Scalar_Pair, BGRID_NE) call pass_var(oG%CoriolisBu, oG%Domain, position=CORNER) @@ -287,7 +287,7 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG) call pass_vector(dG%geoLatCu, dG%geoLatCv, dG%Domain, To_All+Scalar_Pair, CGRID_NE) call pass_var(dG%areaBu, dG%Domain, position=CORNER) - call pass_var(dG%geoLonBu, dG%Domain, position=CORNER) + call pass_var(dG%geoLonBu, dG%Domain, position=CORNER, inner_halo=dG%isc-isd) call pass_var(dG%geoLatBu, dG%Domain, position=CORNER) call pass_vector(dG%dxBu, dG%dyBu, dG%Domain, To_All+Scalar_Pair, BGRID_NE) call pass_var(dG%CoriolisBu, dG%Domain, position=CORNER) From 0e96fbaede18bd97f4252dd40c6eeacf54d177c5 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 8 Sep 2018 06:44:05 -0400 Subject: [PATCH 080/174] +(*)Added runtime parameter USE_TRIPOLAR_GEOLONB_BUG Added the new runtime parameter USE_TRIPOLAR_GEOLONB_BUG that will recreate a longstanding bug in setting the G%geoLonBu for points along the tripolar fold, or if false corrects this bug by use of the new inner_halo argument to pass_var. The default is truebut this should be the depricated branch; setting this to false can change answers in any cases using SIS2 with a tripolar grid. By default all answers are bitwise identical, but the MOM_parameter_doc.all and SIS_parameter_doc.all files change. --- src/initialization/MOM_grid_initialize.F90 | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 9f7c5dcc28..70039bcb98 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -183,6 +183,7 @@ subroutine set_grid_metrics_from_mosaic(G, param_file) character(len=64) :: mdl = "MOM_grid_init set_grid_metrics_from_mosaic" integer :: err=0, ni, nj, global_indices(4) type(MOM_domain_type) :: SGdom ! Supergrid domain + logical :: lon_bug ! If true use an older buggy answer in the tripolar longitude. integer :: i, j, i2, j2 integer :: npei,npej integer, dimension(:), allocatable :: exni,exnj @@ -193,6 +194,10 @@ subroutine set_grid_metrics_from_mosaic(G, param_file) 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.) + call get_param(param_file, mdl, "USE_TRIPOLAR_GEOLONB_BUG", lon_bug, & + "If true, use older code that incorrectly sets the longitude \n"//& + "in some points along the tripolar fold to be off by 360 degrees.", & + default=.true.) call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) filename = trim(adjustl(inputdir)) // trim(adjustl(grid_file)) @@ -248,7 +253,11 @@ subroutine set_grid_metrics_from_mosaic(G, param_file) tmpZ(:,:) = 999. call MOM_read_data(filename, 'x', tmpZ, SGdom, position=CORNER) - call pass_var(tmpZ, SGdom, position=CORNER) + if (lon_bug) then + call pass_var(tmpZ, SGdom, position=CORNER) + else + call pass_var(tmpZ, SGdom, position=CORNER, inner_halo=0) + endif call extrapolate_metric(tmpZ, 2*(G%jsc-G%jsd)+2, missing=999.) do j=G%jsd,G%jed ; do i=G%isd,G%ied ; i2 = 2*i ; j2 = 2*j G%geoLonT(i,j) = tmpZ(i2-1,j2-1) From b5ee33f4bc719bb3d5c4ca4d007f649fa6140c12 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 8 Sep 2018 06:44:36 -0400 Subject: [PATCH 081/174] +(*)Added runtime parameter GRID_ROTATION_ANGLE_BUGS Added a new runtime argument, GRID_ROTATION_ANGLE_BUGS, that triggers the use of older code to set the grid rotation angle if it is true, or if it is false triggers the use of code that does not give wrong answers when some of the longitudes of points differ by a large factor. The default is true, but this should be the depricated branch; setting this to false changes answers in any cases using SIS2 with a tripolar grid, and may change answers at the level of roundoff even without a tripolar fold. By default all answers are bitwise identical, but the {MOM,SIS}_parameter_doc.all files change. --- .../MOM_shared_initialization.F90 | 72 +++++++++++++++---- 1 file changed, 58 insertions(+), 14 deletions(-) diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index e818c33acd..46a3344a96 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -525,25 +525,69 @@ subroutine initialize_grid_rotation_angle(G, PF) !! to parse for model parameter values. real :: angle, lon_scale - integer :: i, j + real :: pi_720deg ! One quarter the conversion factor from degrees to radians. + real :: lonB(2,2) ! The longitude of a point, shifted to have about the same value. + character(len=40) :: mdl = "initialize_grid_rotation_angle" ! This subroutine's name. + logical :: use_bugs + integer :: i, j, m, n + + call get_param(PF, mdl, "GRID_ROTATION_ANGLE_BUGS", use_bugs, & + "If true, use an older algorithm to calculate the sine and \n"//& + "cosines needed rotate between grid-oriented directions and \n"//& + "true north and east. Differences arise at the tripolar fold.", & + default=.True.) + + if (use_bugs) then + do j=G%jsc,G%jec ; do i=G%isc,G%iec + lon_scale = cos((G%geoLatBu(I-1,J-1) + G%geoLatBu(I,J-1 ) + & + G%geoLatBu(I-1,J) + G%geoLatBu(I,J)) * atan(1.0)/180) + angle = atan2((G%geoLonBu(I-1,J) + G%geoLonBu(I,J) - & + G%geoLonBu(I-1,J-1) - G%geoLonBu(I,J-1))*lon_scale, & + G%geoLatBu(I-1,J) + G%geoLatBu(I,J) - & + G%geoLatBu(I-1,J-1) - G%geoLatBu(I,J-1) ) + G%sin_rot(i,j) = sin(angle) ! angle is the clockwise angle from lat/lon to ocean + G%cos_rot(i,j) = cos(angle) ! grid (e.g. angle of ocean "north" from true north) + enddo ; enddo - do j=G%jsc,G%jec ; do i=G%isc,G%iec - lon_scale = cos((G%geoLatBu(I-1,J-1) + G%geoLatBu(I,J-1 ) + & - G%geoLatBu(I-1,J) + G%geoLatBu(I,J)) * atan(1.0)/180) - angle = atan2((G%geoLonBu(I-1,J) + G%geoLonBu(I,J) - & - G%geoLonBu(I-1,J-1) - G%geoLonBu(I,J-1))*lon_scale, & - G%geoLatBu(I-1,J) + G%geoLatBu(I,J) - & - G%geoLatBu(I-1,J-1) - G%geoLatBu(I,J-1) ) - G%sin_rot(i,j) = sin(angle) ! angle is the clockwise angle from lat/lon to ocean - G%cos_rot(i,j) = cos(angle) ! grid (e.g. angle of ocean "north" from true north) - enddo ; enddo + ! This is not right at a tripolar or cubed-sphere fold. + call pass_var(G%cos_rot, G%Domain) + call pass_var(G%sin_rot, G%Domain) + else + pi_720deg = atan(1.0) / 180.0 + do j=G%jsc,G%jec ; do i=G%isc,G%iec + do n=1,2 ; do m=1,2 + lonB(m,n) = modulo_around_point(G%geoLonBu(I+m-2,J+n-2), G%geoLonT(i,j), 360.0) + enddo ; enddo + lon_scale = cos(pi_720deg*((G%geoLatBu(I-1,J-1) + G%geoLatBu(I,J)) + & + (G%geoLatBu(I,J-1) + G%geoLatBu(I-1,J)) ) ) + angle = atan2(lon_scale*((lonB(1,2) - lonB(2,1)) + (lonB(2,2) - lonB(1,1))), & + (G%geoLatBu(I-1,J) - G%geoLatBu(I,J-1)) + & + (G%geoLatBu(I,J) - G%geoLatBu(I-1,J-1)) ) + G%sin_rot(i,j) = sin(angle) ! angle is the clockwise angle from lat/lon to ocean + G%cos_rot(i,j) = cos(angle) ! grid (e.g. angle of ocean "north" from true north) + enddo ; enddo - ! ### THIS DOESN'T SEEM RIGHT AT A CUBED-SPHERE FOLD -RWH - call pass_var(G%cos_rot, G%Domain) - call pass_var(G%sin_rot, G%Domain) + call pass_vector(G%cos_rot, G%sin_rot, G%Domain, stagger=AGRID) + endif end subroutine initialize_grid_rotation_angle +! ----------------------------------------------------------------------------- +!> Return the modulo value of x in an interval [xc-(Lx/2) xc+(Lx/2)] +!! If Lx<=0, then it returns x without applying modulo arithmetic. +function modulo_around_point(x, xc, Lx) result(x_mod) + real, intent(in) :: x !< Value to which to apply modulo arithmetic + real, intent(in) :: xc !< Center of modulo range + real, intent(in) :: Lx !< Modulo range width + real :: x_mod !< x shifted by an integer multiple of Lx to be close to xc. + + if (Lx > 0.0) then + x_mod = modulo(x - (xc - 0.5*Lx), Lx) + (xc - 0.5*Lx) + else + x_mod = x + endif +end function modulo_around_point + ! ----------------------------------------------------------------------------- !> This subroutine sets the open face lengths at selected points to restrict !! passages to their observed widths based on a named set of sizes. From 813a92386bb64a1ece1192da6c558fcb04aa56a2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 8 Sep 2018 07:33:01 -0400 Subject: [PATCH 082/174] Removed trailing white space --- src/framework/MOM_domains.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index e24b411fd0..a43a392963 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -240,7 +240,7 @@ subroutine pass_var_2d(array, MOM_dom, sideflag, complete, position, halo, inner ! Convert to local indices for arrays starting at 1. isc = isc - (isd-1) ; iec = iec - (isd-1) ; ied = ied - (isd-1) ; isd = 1 jsc = jsc - (jsd-1) ; jec = jec - (jsd-1) ; jed = jed - (jsd-1) ; jsd = 1 - i_halo = min(inner_halo, isc-1) ; j_halo = min(inner_halo, jsc-1) ; + i_halo = min(inner_halo, isc-1) ; j_halo = min(inner_halo, jsc-1) ! Figure out the array index extents of the eastern, western, northern and southern regions to copy. if (pos == CENTER) then From 68d859f0ccac29c787ae9cb430f968c64fe89f2b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 8 Sep 2018 07:33:39 -0400 Subject: [PATCH 083/174] Use G%len_lon to set longitude periodicity If the domain lengths in latitude and longitude stored in the grid type have been set to positive values, use these instead of 180.0 and 360.0 for the periodicity values when initializing the grid rotation angles and setting the open face lengths. All answers are bitwise identical in all existing test cases, but answers could conceivably change for tilted grids with axis location units other than degrees. --- .../MOM_shared_initialization.F90 | 20 ++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 46a3344a96..1a40cdadc8 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -525,6 +525,7 @@ subroutine initialize_grid_rotation_angle(G, PF) !! to parse for model parameter values. real :: angle, lon_scale + real :: len_lon ! The periodic range of longitudes, usually 360 degrees. real :: pi_720deg ! One quarter the conversion factor from degrees to radians. real :: lonB(2,2) ! The longitude of a point, shifted to have about the same value. character(len=40) :: mdl = "initialize_grid_rotation_angle" ! This subroutine's name. @@ -554,9 +555,10 @@ subroutine initialize_grid_rotation_angle(G, PF) call pass_var(G%sin_rot, G%Domain) else pi_720deg = atan(1.0) / 180.0 + len_lon = 360.0 ; if (G%len_lon > 0.0) len_lon = G%len_lon do j=G%jsc,G%jec ; do i=G%isc,G%iec do n=1,2 ; do m=1,2 - lonB(m,n) = modulo_around_point(G%geoLonBu(I+m-2,J+n-2), G%geoLonT(i,j), 360.0) + lonB(m,n) = modulo_around_point(G%geoLonBu(I+m-2,J+n-2), G%geoLonT(i,j), len_lon) enddo ; enddo lon_scale = cos(pi_720deg*((G%geoLatBu(I-1,J-1) + G%geoLatBu(I,J)) + & (G%geoLatBu(I,J-1) + G%geoLatBu(I-1,J)) ) ) @@ -806,6 +808,8 @@ subroutine reset_face_lengths_list(G, param_file) real, pointer, dimension(:) :: & u_width => NULL(), v_width => NULL() 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. real :: lon_p, lon_m ! The longitude of a point shifted by 360 degrees. logical :: check_360 ! If true, check for longitudes that are shifted by ! +/- 360 degrees from the specified range of values. @@ -852,6 +856,8 @@ subroutine reset_face_lengths_list(G, param_file) call read_face_length_list(iounit, filename, num_lines, lines) endif + len_lon = 360.0 ; if (G%len_lon > 0.0) len_lon = G%len_lon + len_lat = 180.0 ; if (G%len_lat > 0.0) len_lat = G%len_lat ! Broadcast the number of lines and allocate the required space. call broadcast(num_lines, root_PE()) u_pt = 0 ; v_pt = 0 @@ -893,11 +899,11 @@ subroutine reset_face_lengths_list(G, param_file) read(line(isu+8:),*) u_lon(1:2,u_pt), u_lat(1:2,u_pt), u_width(u_pt) if (is_root_PE()) then if (check_360) then - if ((abs(u_lon(1,u_pt)) > 360.0) .or. (abs(u_lon(2,u_pt)) > 360.0)) & + if ((abs(u_lon(1,u_pt)) > len_lon) .or. (abs(u_lon(2,u_pt)) > len_lon)) & call MOM_error(WARNING, "reset_face_lengths_list : Out-of-bounds "//& "u-longitude found when reading line "//trim(line)//" from file "//& trim(filename)) - if ((abs(u_lat(1,u_pt)) > 180.0) .or. (abs(u_lat(2,u_pt)) > 180.0)) & + if ((abs(u_lat(1,u_pt)) > len_lat) .or. (abs(u_lat(2,u_pt)) > len_lat)) & call MOM_error(WARNING, "reset_face_lengths_list : Out-of-bounds "//& "u-latitude found when reading line "//trim(line)//" from file "//& trim(filename)) @@ -920,11 +926,11 @@ subroutine reset_face_lengths_list(G, param_file) read(line(isv+8:),*) v_lon(1:2,v_pt), v_lat(1:2,v_pt), v_width(v_pt) if (is_root_PE()) then if (check_360) then - if ((abs(v_lon(1,v_pt)) > 360.0) .or. (abs(v_lon(2,v_pt)) > 360.0)) & + if ((abs(v_lon(1,v_pt)) > len_lon) .or. (abs(v_lon(2,v_pt)) > len_lon)) & call MOM_error(WARNING, "reset_face_lengths_list : Out-of-bounds "//& "v-longitude found when reading line "//trim(line)//" from file "//& trim(filename)) - if ((abs(v_lat(1,v_pt)) > 180.0) .or. (abs(v_lat(2,v_pt)) > 180.0)) & + if ((abs(v_lat(1,v_pt)) > len_lat) .or. (abs(v_lat(2,v_pt)) > len_lat)) & call MOM_error(WARNING, "reset_face_lengths_list : Out-of-bounds "//& "v-latitude found when reading line "//trim(line)//" from file "//& trim(filename)) @@ -950,7 +956,7 @@ subroutine reset_face_lengths_list(G, param_file) do j=jsd,jed ; do I=IsdB,IedB lat = G%geoLatCu(I,j) ; lon = G%geoLonCu(I,j) - if (check_360) then ; lon_p = lon+360.0 ; lon_m = lon-360.0 + if (check_360) then ; lon_p = lon+len_lon ; lon_m = lon-len_lon else ; lon_p = lon ; lon_m = lon ; endif do npt=1,u_pt @@ -980,7 +986,7 @@ subroutine reset_face_lengths_list(G, param_file) do J=JsdB,JedB ; do i=isd,ied lat = G%geoLatCv(i,J) ; lon = G%geoLonCv(i,J) - if (check_360) then ; lon_p = lon+360.0 ; lon_m = lon-360.0 + if (check_360) then ; lon_p = lon+len_lon ; lon_m = lon-len_lon else ; lon_p = lon ; lon_m = lon ; endif do npt=1,v_pt From cc306eb606c216c7a5561726e8dcdbb14b26c276 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 8 Sep 2018 10:50:38 -0400 Subject: [PATCH 084/174] Cast initial_thickness_from_file into depth units Changed the calculations using interface heights from m to depth units in initial_thickness_from_file and adjustEtaToFitBathymetry. Also temporarily introduced two separate interface height variables in m and Z inside of MOM_temp_salt_initialize_from_Z. All answers are bitwise identical for no Z-rescaling or for rescaling by 2^93 or 2^-93. --- .../MOM_state_initialization.F90 | 56 ++++++++++--------- 1 file changed, 30 insertions(+), 26 deletions(-) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 4aa8e55e93..0fca4301d3 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -649,23 +649,22 @@ subroutine initialize_thickness_from_file(h, G, GV, param_file, file_has_thickne "would indicate.", default=.false., do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. - call MOM_read_data(filename, "eta", eta(:,:,:), G%Domain) - ! if (GV%m_to_Z /= 1.0) eta(:,:,:) = GV%m_to_Z*eta(:,:,:) + call MOM_read_data(filename, "eta", eta(:,:,:), G%Domain, scale=GV%m_to_Z) if (correct_thickness) then call adjustEtaToFitBathymetry(G, GV, eta, h) else do k=nz,1,-1 ; do j=js,je ; do i=is,ie - if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_m)) then - eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_m + if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_Z)) then + eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_Z h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = GV%m_to_H * (eta(i,j,K) - eta(i,j,K+1)) + h(i,j,k) = GV%Z_to_H * (eta(i,j,K) - eta(i,j,K+1)) endif enddo ; enddo ; enddo do j=js,je ; do i=is,ie - if (abs(eta(i,j,nz+1) + G%Zd_to_m*G%bathyT(i,j)) > 1.0) & + if (abs(eta(i,j,nz+1) + G%bathyT(i,j)) > 1.0*GV%m_to_Z) & inconsistent = inconsistent + 1 enddo ; enddo call sum_across_PEs(inconsistent) @@ -692,20 +691,21 @@ end subroutine initialize_thickness_from_file subroutine adjustEtaToFitBathymetry(G, GV, eta, h) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: eta !< Interface heights, in m + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: eta !< Interface heights, in Z real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses, in H ! Local variables integer :: i, j, k, is, ie, js, je, nz, contractions, dilations - real, parameter :: hTolerance = 0.1 !< Tolerance to exceed adjustment criteria (m) + real :: hTolerance = 0.1 !< Tolerance to exceed adjustment criteria (m) real :: hTmp, eTmp, dilate character(len=100) :: mesg is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + hTolerance = 0.1*GV%m_to_Z contractions = 0 do j=js,je ; do i=is,ie - if (-eta(i,j,nz+1) > G%Zd_to_m*G%bathyT(i,j) + hTolerance) then - eta(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) + if (-eta(i,j,nz+1) > G%bathyT(i,j) + hTolerance) then + eta(i,j,nz+1) = -G%bathyT(i,j) contractions = contractions + 1 endif enddo ; enddo @@ -716,14 +716,14 @@ subroutine adjustEtaToFitBathymetry(G, GV, eta, h) call MOM_error(WARNING, 'adjustEtaToFitBathymetry: '//mesg) endif - ! To preserve previous answers, delay converting thicknesses to units of H - ! until the end of this routine. + ! To preserve previous answers in non-Boussinesq cases, delay converting + ! thicknesses to units of H until the end of this routine. do k=nz,1,-1 ; do j=js,je ; do i=is,ie ! Collapse layers to thinnest possible if the thickness less than ! the thinnest possible (or negative). - if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_m)) then - eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_m - h(i,j,k) = GV%Angstrom_m + if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_Z)) then + eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_Z + h(i,j,k) = GV%Angstrom_Z else h(i,j,k) = (eta(i,j,K) - eta(i,j,K+1)) endif @@ -734,12 +734,12 @@ subroutine adjustEtaToFitBathymetry(G, GV, eta, h) ! The whole column is dilated to accommodate deeper topography than ! the bathymetry would indicate. ! This should be... if ((G%mask2dt(i,j)*(eta(i,j,1)-eta(i,j,nz+1)) > 0.0) .and. & - if (-eta(i,j,nz+1) < G%Zd_to_m*G%bathyT(i,j) - hTolerance) then + if (-eta(i,j,nz+1) < G%bathyT(i,j) - hTolerance) then dilations = dilations + 1 if (eta(i,j,1) <= eta(i,j,nz+1)) then - do k=1,nz ; h(i,j,k) = (eta(i,j,1) + G%Zd_to_m*G%bathyT(i,j)) / real(nz) ; enddo + do k=1,nz ; h(i,j,k) = (eta(i,j,1) + G%bathyT(i,j)) / real(nz) ; enddo else - dilate = (eta(i,j,1) + G%Zd_to_m*G%bathyT(i,j)) / (eta(i,j,1) - eta(i,j,nz+1)) + dilate = (eta(i,j,1) + G%bathyT(i,j)) / (eta(i,j,1) - eta(i,j,nz+1)) do k=1,nz ; h(i,j,k) = h(i,j,k) * dilate ; enddo endif do k=nz,2,-1 ; eta(i,j,K) = eta(i,j,K+1) + h(i,j,k) ; enddo @@ -748,7 +748,7 @@ subroutine adjustEtaToFitBathymetry(G, GV, eta, h) ! Now convert thicknesses to units of H. do k=1,nz ; do j=js,je ; do i=is,ie - h(i,j,k) = h(i,j,k)*GV%m_to_H + h(i,j,k) = h(i,j,k)*GV%Z_to_H enddo ; enddo ; enddo call sum_across_PEs(dilations) @@ -1936,7 +1936,8 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) real, dimension(:), allocatable :: z_edges_in, z_in, Rb real, dimension(:,:,:), allocatable, target :: temp_z, salt_z, mask_z real, dimension(:,:,:), allocatable :: rho_z - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: zi ! Interface heights in m. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: zi ! Interface heights in Z. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: zi_m ! Interface heights in m. real, dimension(SZI_(G),SZJ_(G)) :: nlevs real, dimension(SZI_(G)) :: press @@ -2228,21 +2229,24 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) zi(is:ie,js:je,:) = find_interfaces(rho_z(is:ie,js:je,:), z_in, Rb, G%Zd_to_m*G%bathyT(is:ie,js:je), & nlevs(is:ie,js:je), nkml, nkbl, min_depth) + do K=1,nz+1 ; do j=js,je ; do i=is,ie + zi_m(i,j,K) = zi(i,j,K) ; zi(i,j,K) = GV%m_to_Z*zi(i,j,K) + enddo ; enddo ; enddo if (correct_thickness) then call adjustEtaToFitBathymetry(G, GV, zi, h) else do k=nz,1,-1 ; do j=js,je ; do i=is,ie - if (zi(i,j,K) < (zi(i,j,K+1) + GV%Angstrom_m)) then - zi(i,j,K) = zi(i,j,K+1) + GV%Angstrom_m + if (zi(i,j,K) < (zi(i,j,K+1) + GV%Angstrom_Z)) then + zi(i,j,K) = zi(i,j,K+1) + GV%Angstrom_Z h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = GV%m_to_H * (zi(i,j,K) - zi(i,j,K+1)) + h(i,j,k) = GV%Z_to_H * (zi(i,j,K) - zi(i,j,K+1)) endif enddo ; enddo ; enddo inconsistent=0 do j=js,je ; do i=is,ie - if (abs(zi(i,j,nz+1) + G%Zd_to_m*G%bathyT(i,j)) > 1.0) & + if (abs(zi(i,j,nz+1) + G%bathyT(i,j)) > 1.0*GV%m_to_Z) & inconsistent = inconsistent + 1 enddo ; enddo call sum_across_PEs(inconsistent) @@ -2254,10 +2258,10 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) endif endif - tv%T(is:ie,js:je,:) = tracer_z_init(temp_z(is:ie,js:je,:),-1.0*z_edges_in,zi(is:ie,js:je,:), & + tv%T(is:ie,js:je,:) = tracer_z_init(temp_z(is:ie,js:je,:),-1.0*z_edges_in,zi_m(is:ie,js:je,:), & nkml,nkbl,missing_value,G%mask2dT(is:ie,js:je),nz, & nlevs(is:ie,js:je),dbg,idbg,jdbg) - tv%S(is:ie,js:je,:) = tracer_z_init(salt_z(is:ie,js:je,:),-1.0*z_edges_in,zi(is:ie,js:je,:), & + tv%S(is:ie,js:je,:) = tracer_z_init(salt_z(is:ie,js:je,:),-1.0*z_edges_in,zi_m(is:ie,js:je,:), & nkml,nkbl,missing_value,G%mask2dT(is:ie,js:je),nz, & nlevs(is:ie,js:je)) From ff9e1b865e62abaca8ffc7746dbbe643130e5b3c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 8 Sep 2018 12:34:17 -0400 Subject: [PATCH 085/174] +Added optional argument eps_z to tracer_z_init Added a new optional argument, eps_z, to tracer_z_init and find_interfaces, to permit the interface heights used to initialize the tracers to be in depth units instead of requiring that they always be in m. Also cleaned up the formatting in midas_vertmap to clarify comments and standardize the indents. All answers are bitwise identical. --- src/initialization/midas_vertmap.F90 | 427 +++++++++++++-------------- 1 file changed, 203 insertions(+), 224 deletions(-) diff --git a/src/initialization/midas_vertmap.F90 b/src/initialization/midas_vertmap.F90 index 0124c767b5..23bda0fce0 100644 --- a/src/initialization/midas_vertmap.F90 +++ b/src/initialization/midas_vertmap.F90 @@ -19,8 +19,8 @@ module MIDAS_vertmap module procedure fill_boundaries_int end interface -real, parameter :: epsln=1.e-10 !< A hard-wired constant! - !! \todo Get rid of this constant +! real, parameter :: epsln=1.e-10 !< A hard-wired constant! + !! \todo Get rid of this constant contains @@ -143,59 +143,58 @@ end function beta_wright_eos_2d #endif !> Layer model routine for remapping tracers -function tracer_z_init(tr_in,z_edges,e,nkml,nkbl,land_fill,wet,nlay,nlevs,debug,i_debug,j_debug) result(tr) - real, dimension(:,:,:), intent(in) :: tr_in !< The z-space array of tracer concentrations that is read in. - real, dimension(size(tr_in,3)+1), intent(in) :: z_edges !< The depths of the cell edges in the input z* data (m) - integer, intent(in) :: nlay !< The number of vertical layers in the target grid - real, dimension(size(tr_in,1),size(tr_in,2),nlay+1), intent(in) :: e !< The depths of the target layer interfaces (m) - integer, intent(in) :: nkml !< The number of mixed layers - integer, intent(in) :: nkbl !< The number of buffer layers - real, intent(in) :: land_fill !< fill in data over land (1) - real, dimension(size(tr_in,1),size(tr_in,2)), intent(in) :: wet !< The wet mask for the source data (valid points) +function tracer_z_init(tr_in, z_edges, e, nkml, nkbl, land_fill, wet, nlay, nlevs, & + debug, i_debug, j_debug, eps_z) result(tr) + real, dimension(:,:,:), intent(in) :: tr_in !< The z-space array of tracer concentrations that is read in. + real, dimension(size(tr_in,3)+1), intent(in) :: z_edges !< The depths of the cell edges in the input z* data (Z or m) + integer, intent(in) :: nlay !< The number of vertical layers in the target grid + real, dimension(size(tr_in,1),size(tr_in,2),nlay+1), & + intent(in) :: e !< The depths of the target layer interfaces (Z or m) + integer, intent(in) :: nkml !< The number of mixed layers + integer, intent(in) :: nkbl !< The number of buffer layers + real, intent(in) :: land_fill !< fill in data over land (1) + real, dimension(size(tr_in,1),size(tr_in,2)), & + intent(in) :: wet !< The wet mask for the source data (valid points) real, dimension(size(tr_in,1),size(tr_in,2)), & optional, intent(in) :: nlevs !< The number of input levels with valid data - logical, optional, intent(in) :: debug !< optional debug flag - integer, optional, intent(in) :: i_debug !< i-index of point for debugging - integer, optional, intent(in) :: j_debug !< j-index of point for debugging + logical, optional, intent(in) :: debug !< optional debug flag + integer, optional, intent(in) :: i_debug !< i-index of point for debugging + integer, optional, intent(in) :: j_debug !< j-index of point for debugging + real, optional, intent(in) :: eps_z !< A negligibly small layer thickness in the units of Z. real, dimension(size(tr_in,1),size(tr_in,2),nlay) :: tr !< tracers in layer space + ! Local variables real, dimension(size(tr_in,3)) :: tr_1d !< a copy of the input tracer concentrations in a column. - real, dimension(nlay+1) :: e_1d - real, dimension(nlay) :: tr_ + real, dimension(nlay+1) :: e_1d ! A 1-d column of intreface heights, in the same units as e. + real, dimension(nlay) :: tr_ ! A 1-d column of tracer concentrations integer, dimension(size(tr_in,1),size(tr_in,2)) :: nlevs_data !< number of valid levels in the input dataset integer :: n,i,j,k,l,nx,ny,nz,nt,kz integer :: k_top,k_bot,k_bot_prev,kk,kstart - real :: sl_tr + real :: sl_tr ! The tracer concentration slope times the layer thickess, in tracer units. + real :: epsln_Z ! A negligibly thin layer thickness, in Z. real, dimension(size(tr_in,3)) :: wt !< The fractional weight for each layer in the range between z1 and z2 - real, dimension(size(tr_in,3)) :: z1,z2 !< z1 and z2 are the depths of the top and bottom limits of the part - ! of a z-cell that contributes to a layer, relative to the cell - ! center and normalized by the cell thickness, nondim. - ! Note that -1/2 <= z1 <= z2 <= 1/2. + real, dimension(size(tr_in,3)) :: z1, z2 ! z1 and z2 are the fractional depths of the top and bottom + ! limits of the part of a z-cell that contributes to a layer, relative + ! to the cell center and normalized by the cell thickness, nondim. + ! Note that -1/2 <= z1 <= z2 <= 1/2. - logical :: debug_msg, debug_ + logical :: debug_msg, debug_, debug_pt nx = size(tr_in,1); ny=size(tr_in,2); nz = size(tr_in,3) nlevs_data = size(tr_in,3) - if (PRESENT(nlevs)) then - nlevs_data = anint(nlevs) - endif + if (PRESENT(nlevs)) nlevs_data = anint(nlevs) + epsln_Z = 1.0e-10 ; if (PRESENT(eps_z)) epsln_Z = eps_z - debug_=.false. - if (PRESENT(debug)) then - debug_=debug - endif - - debug_msg = .false. - if (debug_) then - debug_msg=.true. - endif + debug_=.false. ; if (PRESENT(debug)) debug_ = debug + debug_msg = debug_ + debug_pt = debug_ ; if (PRESENT(i_debug) .and. PRESENT(j_debug)) debug_pt = debug_ do j=1,ny i_loop: do i=1,nx if (nlevs_data(i,j) == 0 .or. wet(i,j) == 0.) then - tr(i,j,:) = land_fill - cycle i_loop + tr(i,j,:) = land_fill + cycle i_loop endif do k=1,nz @@ -208,106 +207,83 @@ function tracer_z_init(tr_in,z_edges,e,nkml,nkbl,land_fill,wet,nlay,nlevs,debug, k_bot = 1 ; k_bot_prev = -1 do k=1,nlay if (e_1d(k+1) > z_edges(1)) then - tr(i,j,k) = tr_1d(1) + tr(i,j,k) = tr_1d(1) elseif (e_1d(k) < z_edges(nlevs_data(i,j)+1)) then - if (debug_msg) then - print *,'*** WARNING : Found interface below valid range of z data ' - print *,'(i,j,z_bottom,interface)= ',& - i,j,z_edges(nlevs_data(i,j)+1),e_1d(k) - print *,'z_edges= ',z_edges - print *,'e=',e_1d - print *,'*** I will extrapolate below using the bottom-most valid values' - debug_msg = .false. - endif - tr(i,j,k) = tr_1d(nlevs_data(i,j)) + if (debug_msg) then + print *,'*** WARNING : Found interface below valid range of z data ' + print *,'(i,j,z_bottom,interface)= ',& + i,j,z_edges(nlevs_data(i,j)+1),e_1d(k) + print *,'z_edges= ',z_edges + print *,'e=',e_1d + print *,'*** I will extrapolate below using the bottom-most valid values' + debug_msg = .false. + endif + tr(i,j,k) = tr_1d(nlevs_data(i,j)) else - kstart=k_bot - call find_overlap(z_edges, e_1d(k), e_1d(k+1), nlevs_data(i,j), & - kstart, k_top, k_bot, wt, z1, z2) - - if (debug_) then - if (PRESENT(i_debug)) then - if (i == i_debug.and.j == j_debug) then - print *,'0001 k,k_top,k_bot,sum(wt),sum(z2-z1) = ',k,k_top,k_bot,sum(wt),sum(z2-z1) - endif - endif - endif - kz = k_top - sl_tr=0.0; ! cur_tr=0.0 - if (kz /= k_bot_prev) then - ! Calculate the intra-cell profile. - if ((kz < nlevs_data(i,j)) .and. (kz > 1)) then - sl_tr = find_limited_slope(tr_1d, z_edges, kz) - endif - endif - if (kz > nlevs_data(i,j)) kz = nlevs_data(i,j) - ! This is the piecewise linear form. - tr(i,j,k) = wt(kz) * & - (tr_1d(kz) + 0.5*sl_tr*(z2(kz) + z1(kz))) - ! For the piecewise parabolic form add the following... - ! + C1_3*cur_tr*(z2(kz)**2 + z2(kz)*z1(kz) + z1(kz)**2)) - ! if (debug_) then - ! print *,'k,k_top,k_bot= ',k,k_top,k_bot - ! endif - if (debug_) then - if (PRESENT(i_debug)) then - if (i == i_debug.and.j == j_debug) then - print *,'0002 k,k_top,k_bot,k_bot_prev,sl_tr = ',k,k_top,k_bot,k_bot_prev,sl_tr - endif - endif - endif - - do kz=k_top+1,k_bot-1 - tr(i,j,k) = tr(i,j,k) + wt(kz)*tr_1d(kz) - enddo + kstart=k_bot + call find_overlap(z_edges, e_1d(k), e_1d(k+1), nlevs_data(i,j), & + kstart, k_top, k_bot, wt, z1, z2) + + if (debug_pt) then ; if ((i == i_debug) .and. (j == j_debug)) then + print *,'0001 k,k_top,k_bot,sum(wt),sum(z2-z1) = ',k,k_top,k_bot,sum(wt),sum(z2-z1) + endif ; endif + kz = k_top + sl_tr=0.0; ! cur_tr=0.0 + if (kz /= k_bot_prev) then + ! Calculate the intra-cell profile. + if ((kz < nlevs_data(i,j)) .and. (kz > 1)) then + sl_tr = find_limited_slope(tr_1d, z_edges, kz) + endif + endif + if (kz > nlevs_data(i,j)) kz = nlevs_data(i,j) + ! This is the piecewise linear form. + tr(i,j,k) = wt(kz) * (tr_1d(kz) + 0.5*sl_tr*(z2(kz) + z1(kz))) + ! For the piecewise parabolic form add the following... + ! + C1_3*wt(kz) * cur_tr*(z2(kz)**2 + z2(kz)*z1(kz) + z1(kz)**2)) + if (debug_pt) then ; if ((i == i_debug) .and. (j == j_debug)) then + print *,'0002 k,k_top,k_bot,k_bot_prev,sl_tr = ',k,k_top,k_bot,k_bot_prev,sl_tr + endif ; endif + + do kz=k_top+1,k_bot-1 + tr(i,j,k) = tr(i,j,k) + wt(kz)*tr_1d(kz) + enddo + + if (debug_pt) then ; if ((i == i_debug) .and. (j == j_debug)) then + print *,'0003 k,tr = ',k,tr(i,j,k) + endif ; endif + + if (k_bot > k_top) then + kz = k_bot + ! Calculate the intra-cell profile. + sl_tr = 0.0 ! ; cur_tr = 0.0 + if ((kz < nlevs_data(i,j)) .and. (kz > 1)) then + sl_tr = find_limited_slope(tr_1d, z_edges, kz) + endif + ! This is the piecewise linear form. + tr(i,j,k) = tr(i,j,k) + wt(kz) * & + (tr_1d(kz) + 0.5*sl_tr*(z2(kz) + z1(kz))) + ! For the piecewise parabolic form add the following... + ! + C1_3*cur_tr*(z2(kz)**2 + z2(kz)*z1(kz) + z1(kz)**2)) + + if (debug_pt) then ; if ((i == i_debug) .and. (j == j_debug)) then + print *,'0004 k,kz,nlevs,sl_tr,tr = ',k,kz,nlevs_data(i,j),sl_tr,tr(i,j,k) + print *,'0005 k,kz,tr(kz),tr(kz-1),tr(kz+1) = ',k,kz,tr_1d(kz),tr_1d(kz-1),tr_1d(kz+1),z_edges(kz+2) + endif ; endif - if (debug_) then - if (PRESENT(i_debug)) then - if (i == i_debug.and.j == j_debug) then - print *,'0003 k,tr = ',k,tr(i,j,k) - endif - endif - endif - - if (k_bot > k_top) then - kz = k_bot - ! Calculate the intra-cell profile. - sl_tr = 0.0 ! ; cur_tr = 0.0 - if ((kz < nlevs_data(i,j)) .and. (kz > 1)) then - sl_tr = find_limited_slope(tr_1d, z_edges, kz) - ! if (debug_) then - ! print *,'002 sl_tr,k,kz,nlevs= ',sl_tr,k,kz,nlevs_data(i,j),nlevs(i,j) - ! endif - endif - ! This is the piecewise linear form. - tr(i,j,k) = tr(i,j,k) + wt(kz) * & - (tr_1d(kz) + 0.5*sl_tr*(z2(kz) + z1(kz))) - ! For the piecewise parabolic form add the following... - ! + C1_3*cur_tr*(z2(kz)**2 + z2(kz)*z1(kz) + z1(kz)**2)) - - if (debug_) then ; if (PRESENT(i_debug)) then - if (i == i_debug.and.j == j_debug) then - print *,'0004 k,kz,nlevs,sl_tr,tr = ',k,kz,nlevs_data(i,j),sl_tr,tr(i,j,k) - print *,'0005 k,kz,tr(kz),tr(kz-1),tr(kz+1) = ',k,kz,tr_1d(kz),tr_1d(kz-1),tr_1d(kz+1),z_edges(kz+2) - endif - endif ; endif - - endif - k_bot_prev = k_bot + endif + k_bot_prev = k_bot endif enddo ! k-loop do k=2,nlay ! simply fill vanished layers with adjacent value - if (e_1d(k)-e_1d(k+1) <= epsln) tr(i,j,k)=tr(i,j,k-1) + if (e_1d(k)-e_1d(k+1) <= epsln_Z) tr(i,j,k)=tr(i,j,k-1) enddo enddo i_loop enddo - return - end function tracer_z_init !> Return the index where to insert item x in list a, assuming a is sorted. @@ -483,16 +459,17 @@ end subroutine determine_temperature !! of each layer that overlaps that depth range. !! Note that by convention, e decreases with increasing k and Z_top > Z_bot. subroutine find_overlap(e, Z_top, Z_bot, k_max, k_start, k_top, k_bot, wt, z1, z2) - real, dimension(:), intent(in) :: e !< the interface positions, in m. - real, intent(in) :: Z_top !< The top of the range being mapped to, in m. - real, intent(in) :: Z_bot !< The bottom of the range being mapped to, in m. - integer, intent(in) :: k_max !< The number of valid layers. - integer, intent(in) :: k_start !< The layer at which to start searching. - integer, intent(out) :: k_top !< The index of the top layer that overlap with the depth range. - integer, intent(out) :: k_bot !< The index of the bottom layer that overlap with the depth range. - real, dimension(:), intent(out) :: wt !< The relative weights of each layer from k_top to k_bot. - real, dimension(:), intent(out) :: z1 !< Depth of the top limit of layer that contributes to a level - real, dimension(:), intent(out) :: z2 !< Depth of the bottom limit of layer that contributes to a level + real, dimension(:), intent(in) :: e !< The interface positions, in m or Z. + real, intent(in) :: Z_top !< The top of the range being mapped to, in m or Z. + real, intent(in) :: Z_bot !< The bottom of the range being mapped to, in m or Z. + integer, intent(in) :: k_max !< The number of valid layers. + integer, intent(in) :: k_start !< The layer at which to start searching. + integer, intent(out) :: k_top !< The index of the top layer that overlap with the depth range. + integer, intent(out) :: k_bot !< The index of the bottom layer that overlap with the depth range. + real, dimension(:), intent(out) :: wt !< The relative weights of each layer from k_top to k_bot, nondim. + real, dimension(:), intent(out) :: z1 !< Depth of the top limit of layer that contributes to a level, nondim. + real, dimension(:), intent(out) :: z2 !< Depth of the bottom limit of layer that contributes to a level, nondim. + ! Local variables real :: Ih, e_c, tot_wt, I_totwt integer :: k @@ -500,31 +477,36 @@ subroutine find_overlap(e, Z_top, Z_bot, k_max, k_start, k_top, k_bot, wt, z1, z wt(:)=0.0 ; z1(:)=0.0 ; z2(:)=0.0 k_top = k_start ; k_bot = k_start ; wt(1) = 1.0 ; z1(1) = -0.5 ; z2(1) = 0.5 - do k=k_start,k_max ; if (e(k+1) < Z_top) exit ; enddo + do k=k_start,k_max ; if (e(K+1) < Z_top) exit ; enddo k_top = k if (k>k_max) return ! Determine the fractional weights of each layer. ! Note that by convention, e and Z_int decrease with increasing k. - if (e(k+1) <= Z_bot) then + if (e(K+1) <= Z_bot) then wt(k) = 1.0 ; k_bot = k - Ih = 1.0 / (e(k)-e(k+1)) - e_c = 0.5*(e(k)+e(k+1)) - z1(k) = (e_c - MIN(e(k),Z_top)) * Ih + Ih = 0.0 ; if (e(K) /= e(K+1)) Ih = 1.0 / (e(K)-e(K+1)) + e_c = 0.5*(e(K)+e(K+1)) + z1(k) = (e_c - MIN(e(K), Z_top)) * Ih z2(k) = (e_c - Z_bot) * Ih else - wt(k) = MIN(e(k),Z_top) - e(k+1) ; tot_wt = wt(k) ! These are always > 0. - z1(k) = (0.5*(e(k)+e(k+1)) - MIN(e(k),Z_top)) / (e(k)-e(k+1)) + wt(k) = MIN(e(K),Z_top) - e(K+1) ; tot_wt = wt(k) ! These are always > 0. + ! Ih = 0.0 ; if (e(K) /= e(K+1)) Ih = 1.0 / (e(K)-e(K+1)) + if (e(K) /= e(K+1)) then + z1(k) = (0.5*(e(K)+e(K+1)) - MIN(e(K), Z_top)) / (e(K)-e(K+1)) + else ; z1(k) = -0.5 ; endif z2(k) = 0.5 k_bot = k_max do k=k_top+1,k_max - if (e(k+1) <= Z_bot) then + if (e(K+1) <= Z_bot) then k_bot = k - wt(k) = e(k) - Z_bot ; z1(k) = -0.5 - z2(k) = (0.5*(e(k)+e(k+1)) - Z_bot) / (e(k)-e(k+1)) + wt(k) = e(K) - Z_bot ; z1(k) = -0.5 + if (e(K) /= e(K+1)) then + z2(k) = (0.5*(e(K)+e(K+1)) - Z_bot) / (e(K)-e(K+1)) + else ; z2(k) = 0.5 ; endif else - wt(k) = e(k) - e(k+1) ; z1(k) = -0.5 ; z2(k) = 0.5 + wt(k) = e(K) - e(K+1) ; z1(k) = -0.5 ; z2(k) = 0.5 endif tot_wt = tot_wt + wt(k) ! wt(k) is always > 0. if (k>=k_bot) exit @@ -540,7 +522,7 @@ end subroutine find_overlap !! a piecewise limited scheme. function find_limited_slope(val, e, k) result(slope) real, dimension(:), intent(in) :: val !< An column the values that are being interpolated. - real, dimension(:), intent(in) :: e !< A column's interface heights, in m. + real, dimension(:), intent(in) :: e !< A column's interface heights, in Z or m. integer, intent(in) :: k !< The layer whose slope is being determined. real :: slope !< The normalized slope in the intracell distribution of val. ! Local variables @@ -550,41 +532,45 @@ function find_limited_slope(val, e, k) result(slope) if ((val(k)-val(k-1)) * (val(k)-val(k+1)) >= 0.0) then slope = 0.0 ! ; curvature = 0.0 else - d1 = 0.5*(e(k-1)-e(k+1)) ; d2 = 0.5*(e(k)-e(k+2)) - slope = ((d1**2)*(val(k+1) - val(k)) + (d2**2)*(val(k) - val(k-1))) * & - (e(k) - e(k+1)) / (d1*d2*(d1+d2)) - ! slope = 0.5*(val(k+1) - val(k-1)) - ! This is S.J. Lin's form of the PLM limiter. - amn = min(abs(slope), 2.0*(max(val(k-1), val(k), val(k+1)) - val(k))) - cmn = 2.0*(val(k) - min(val(k-1), val(k), val(k+1))) - slope = sign(1.0, slope) * min(amn, cmn) - - ! min(abs(slope), 2.0*(max(val(k-1),val(k),val(k+1)) - val(k)), & - ! 2.0*(val(k) - min(val(k-1),val(k),val(k+1)))) - ! curvature = 0.0 + d1 = 0.5*(e(K-1)-e(K+1)) ; d2 = 0.5*(e(K)-e(K+2)) + if (d1*d2 > 0.0) then + slope = ((d1**2)*(val(k+1) - val(k)) + (d2**2)*(val(k) - val(k-1))) * & + (e(K) - e(K+1)) / (d1*d2*(d1+d2)) + ! slope = 0.5*(val(k+1) - val(k-1)) + ! This is S.J. Lin's form of the PLM limiter. + amn = min(abs(slope), 2.0*(max(val(k-1), val(k), val(k+1)) - val(k))) + cmn = 2.0*(val(k) - min(val(k-1), val(k), val(k+1))) + slope = sign(1.0, slope) * min(amn, cmn) + + ! min(abs(slope), 2.0*(max(val(k-1),val(k),val(k+1)) - val(k)), & + ! 2.0*(val(k) - min(val(k-1),val(k),val(k+1)))) + ! curvature = 0.0 + else + slope = 0.0 ! ; curvature = 0.0 + endif endif - return - end function find_limited_slope !> Find interface positions corresponding to density profile -function find_interfaces(rho,zin,Rb,depth,nlevs,nkml,nkbl,hml,debug) result(zi) +function find_interfaces(rho, zin, Rb, depth, nlevs, nkml, nkbl, hml, debug, eps_z) result(zi) real, dimension(:,:,:), & - intent(in) :: rho !< potential density in z-space (kg m-3) + intent(in) :: rho !< potential density in z-space (kg m-3) real, dimension(size(rho,3)), & - intent(in) :: zin !< levels (m) - real, dimension(:), intent(in) :: Rb !< target interface densities (kg m-3) + intent(in) :: zin !< Input data levels, in Z (often m). + real, dimension(:), intent(in) :: Rb !< target interface densities (kg m-3) real, dimension(size(rho,1),size(rho,2)), & - intent(in) :: depth !< ocean depth (m) + intent(in) :: depth !< ocean depth in Z real, dimension(size(rho,1),size(rho,2)), & - optional, intent(in) ::nlevs !< number of valid points in each column + optional, intent(in) :: nlevs !< number of valid points in each column logical, optional, intent(in) :: debug !< optional debug flag - integer, optional, intent(in) :: nkml !< number of mixed layer pieces - integer, optional, intent(in) :: nkbl !< number of buffer layer pieces - real, optional, intent(in) :: hml !< mixed layer depth + integer, optional, intent(in) :: nkml !< number of mixed layer pieces + integer, optional, intent(in) :: nkbl !< number of buffer layer pieces + real, optional, intent(in) :: hml !< mixed layer depth, in Z + real, optional, intent(in) :: eps_z !< A negligibly small layer thickness in the units of Z. + real, dimension(size(rho,1),size(rho,2),size(Rb,1)) :: zi !< The returned interface, in the same units az zin. + ! Local variables - real, dimension(size(rho,1),size(rho,2),size(Rb,1)) :: zi real, dimension(size(rho,1),size(rho,3)) :: rho_ real, dimension(size(rho,1)) :: depth_ logical :: unstable @@ -592,11 +578,13 @@ function find_interfaces(rho,zin,Rb,depth,nlevs,nkml,nkbl,hml,debug) result(zi) integer, dimension(size(rho,1),size(Rb,1)) :: ki_ real, dimension(size(rho,1),size(Rb,1)) :: zi_ integer, dimension(size(rho,1),size(rho,2)) :: nlevs_data - integer, dimension(size(rho,1)) :: lo,hi + integer, dimension(size(rho,1)) :: lo, hi real :: slope,rsm,drhodz,hml_ integer :: n,i,j,k,l,nx,ny,nz,nt integer :: nlay,kk,nkml_,nkbl_ logical :: debug_ = .false. + real :: epsln_Z ! A negligibly thin layer thickness, in Z. + real :: epsln_rho ! A negligibly small density change, in kg m-3. real, parameter :: zoff=0.999 nlay=size(Rb)-1 @@ -608,95 +596,86 @@ function find_interfaces(rho,zin,Rb,depth,nlevs,nkml,nkbl,hml,debug) result(zi) nx = size(rho,1); ny=size(rho,2); nz = size(rho,3) nlevs_data(:,:) = size(rho,3) - nkml_=0;nkbl_=0;hml_=0.0 - if (PRESENT(nkml)) nkml_=max(0,nkml) - if (PRESENT(nkbl)) nkbl_=max(0,nkbl) - if (PRESENT(hml)) hml_=hml + nkml_ = 0 ; if (PRESENT(nkml)) nkml_ = max(0, nkml) + nkbl_ = 0 ; if (PRESENT(nkbl)) nkbl_ = max(0, nkbl) + hml_ = 0.0 ; if (PRESENT(hml)) hml_ = hml + epsln_Z = 1.0e-10 ; if (PRESENT(eps_z)) epsln_Z = eps_z + epsln_rho = 1.0e-10 if (PRESENT(nlevs)) then - nlevs_data(:,:) = nlevs(:,:) + nlevs_data(:,:) = nlevs(:,:) endif do j=1,ny rho_(:,:) = rho(:,j,:) i_loop: do i=1,nx if (debug_) then - print *,'looking for interfaces, i,j,nlevs= ',i,j,nlevs_data(i,j) - print *,'initial density profile= ', rho_(i,:) + print *,'looking for interfaces, i,j,nlevs= ',i,j,nlevs_data(i,j) + print *,'initial density profile= ', rho_(i,:) endif unstable=.true. dir=1 do while (unstable) unstable=.false. if (dir == 1) then - do k=2,nlevs_data(i,j)-1 - if (rho_(i,k) - rho_(i,k-1) < 0.0 ) then - if (k == 2) then - rho_(i,k-1)=rho_(i,k)-epsln - else - drhodz = (rho_(i,k+1)-rho_(i,k-1))/(zin(k+1)-zin(k-1)) - if (drhodz < 0.0) then - unstable=.true. - endif - rho_(i,k) = rho_(i,k-1)+drhodz*zoff*(zin(k)-zin(k-1)) - endif - endif - enddo - dir=-1*dir + do k=2,nlevs_data(i,j)-1 + if (rho_(i,k) - rho_(i,k-1) < 0.0 ) then + if (k == 2) then + rho_(i,k-1) = rho_(i,k)-epsln_rho + else + drhodz = (rho_(i,k+1)-rho_(i,k-1)) / (zin(k+1)-zin(k-1)) + if (drhodz < 0.0) unstable=.true. + rho_(i,k) = rho_(i,k-1) + drhodz*zoff*(zin(k)-zin(k-1)) + endif + endif + enddo + dir = -1*dir else - do k=nlevs_data(i,j)-1,2,-1 - if (rho_(i,k+1) - rho_(i,k) < 0.0) then - if (k == nlevs_data(i,j)-1) then - rho_(i,k+1)=rho_(i,k-1)+epsln - else - drhodz = (rho_(i,k+1)-rho_(i,k-1))/(zin(k+1)-zin(k-1)) - if (drhodz < 0.0) then - unstable=.true. - endif - rho_(i,k) = rho_(i,k+1)-drhodz*(zin(k+1)-zin(k)) - endif - endif - enddo - dir=-1*dir + do k=nlevs_data(i,j)-1,2,-1 + if (rho_(i,k+1) - rho_(i,k) < 0.0) then + if (k == nlevs_data(i,j)-1) then + rho_(i,k+1) = rho_(i,k-1)+epsln_rho + else + drhodz = (rho_(i,k+1)-rho_(i,k-1))/(zin(k+1)-zin(k-1)) + if (drhodz < 0.0) unstable=.true. + rho_(i,k) = rho_(i,k+1)-drhodz*(zin(k+1)-zin(k)) + endif + endif + enddo + dir = -1*dir endif enddo if (debug_) then - print *,'final density profile= ', rho_(i,:) + print *,'final density profile= ', rho_(i,:) endif enddo i_loop ki_(:,:) = 0 zi_(:,:) = 0.0 - depth_(:)=-1.0*depth(:,j) - lo(:)=1 - hi(:)=nlevs_data(:,j) - ki_ = bisect_fast(rho_,Rb,lo,hi) - ki_(:,:) = max(1,ki_(:,:)-1) + depth_(:) = -1.0*depth(:,j) + lo(:) = 1 + hi(:) = nlevs_data(:,j) + ki_ = bisect_fast(rho_, Rb, lo, hi) + ki_(:,:) = max(1, ki_(:,:)-1) do i=1,nx do l=2,nlay - slope = (zin(ki_(i,l)+1) - zin(ki_(i,l)))/max(rho_(i,ki_(i,l)+1) - rho_(i,ki_(i,l)),epsln) + slope = (zin(ki_(i,l)+1) - zin(ki_(i,l))) / max(rho_(i,ki_(i,l)+1) - rho_(i,ki_(i,l)),epsln_rho) zi_(i,l) = -1.0*(zin(ki_(i,l)) + slope*(Rb(l)-rho_(i,ki_(i,l)))) - zi_(i,l) = max(zi_(i,l),depth_(i)) - zi_(i,l) = min(zi_(i,l),-1.0*hml_) + zi_(i,l) = max(zi_(i,l), depth_(i)) + zi_(i,l) = min(zi_(i,l), -1.0*hml_) enddo - zi_(i,nlay+1)=depth_(i) + zi_(i,nlay+1) = depth_(i) do l=2,nkml_+1 - zi_(i,l)=max(((1.0-real(l))/real(nkml_))*hml_,depth_(i)) + zi_(i,l) = max(hml_*((1.0-real(l))/real(nkml_)), depth_(i)) enddo do l=nlay,nkml_+2,-1 - if (zi_(i,l) < zi_(i,l+1)+epsln) then - zi_(i,l)=zi_(i,l+1)+epsln - endif - if (zi_(i,l)>-1.0*hml_) then - zi_(i,l)=max(-1.0*hml_,depth_(i)) - endif + if (zi_(i,l) < zi_(i,l+1) + epsln_Z) zi_(i,l) = zi_(i,l+1) + epsln_Z + if (zi_(i,l) > -1.0*hml_) zi_(i,l) = max(-1.0*hml_, depth_(i)) enddo enddo - zi(:,j,:)=zi_(:,:) + zi(:,j,:) = zi_(:,:) enddo - return - end function find_interfaces !> Create a 2d-mesh of grid coordinates from 1-d arrays From 1625ffc04179c1d6d4eeeb18611c46e35328f39e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 9 Sep 2018 12:03:40 -0400 Subject: [PATCH 086/174] +MOM_temp_salt_initialize_from_Z now uses Z units Modified MOM_temp_salt_initialize_from_Z to work in depth (Z) units instead of m for heights. Also modified trim_for_ice and cut_off_column_top to work in Z units, including adding a verticalGrid_type argument to cut_off_column_top. All answers in the MOM6 test cases are bitwise identical. --- .../MOM_state_initialization.F90 | 105 +++++++++--------- 1 file changed, 55 insertions(+), 50 deletions(-) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 0fca4301d3..fa719aca4c 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -1096,7 +1096,7 @@ subroutine trim_for_ice(PF, G, GV, ALE_CSp, tv, h, just_read_params) "file SURFACE_PRESSURE_FILE into a surface pressure.", & units="file dependent", default=1., do_not_log=just_read) call get_param(PF, mdl, "MIN_THICKNESS", min_thickness, 'Minimum layer thickness', & - units='m', default=1.e-3, do_not_log=just_read) + units='m', default=1.e-3, do_not_log=just_read, scale=GV%m_to_Z) call get_param(PF, mdl, "TRIMMING_USES_REMAPPING", use_remapping, & 'When trimming the column, also remap T and S.', & default=.false., do_not_log=just_read) @@ -1122,7 +1122,7 @@ subroutine trim_for_ice(PF, G, GV, ALE_CSp, tv, h, just_read_params) endif do j=G%jsc,G%jec ; do i=G%isc,G%iec - call cut_off_column_top(GV%ke, tv, GV%Rho0, GV%g_Earth, G%Zd_to_m*G%bathyT(i,j), & + call cut_off_column_top(GV%ke, tv, GV, GV%g_Earth*GV%Z_to_m, G%bathyT(i,j), & min_thickness, tv%T(i,j,:), T_t(i,j,:), T_b(i,j,:), & tv%S(i,j,:), S_t(i,j,:), S_b(i,j,:), p_surf(i,j), h(i,j,:), remap_CS) enddo ; enddo @@ -1131,14 +1131,14 @@ end subroutine trim_for_ice !> Adjust the layer thicknesses by cutting away the top at the depth where the hydrostatic !! pressure matches p_surf -subroutine cut_off_column_top(nk, tv, Rho0, G_earth, depth, min_thickness, & +subroutine cut_off_column_top(nk, tv, GV, G_earth, depth, min_thickness, & T, T_t, T_b, S, S_t, S_b, p_surf, h, remap_CS) integer, intent(in) :: nk !< Number of layers type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure - real, intent(in) :: Rho0 !< Reference density (kg/m3) - real, intent(in) :: G_earth !< Gravitational acceleration (m/s2) - real, intent(in) :: depth !< Depth of ocean column (m) - real, intent(in) :: min_thickness !< Smallest thickness allowed (m) + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + real, intent(in) :: G_earth !< Gravitational acceleration (m2 Z-1 s-2) + real, intent(in) :: depth !< Depth of ocean column (Z) + real, intent(in) :: min_thickness !< Smallest thickness allowed (Z) real, dimension(nk), intent(inout) :: T !< Layer mean temperature real, dimension(nk), intent(in) :: T_t !< Temperature at top of layer real, dimension(nk), intent(in) :: T_b !< Temperature at bottom of layer @@ -1149,6 +1149,7 @@ subroutine cut_off_column_top(nk, tv, Rho0, G_earth, depth, min_thickness, & real, dimension(nk), intent(inout) :: h !< Layer thickness (H units, m or Pa) type(remapping_CS), pointer :: remap_CS !< Remapping structure for remapping T and S, !! if associated + ! Local variables real, dimension(nk+1) :: e ! Top and bottom edge values for reconstructions real, dimension(nk) :: h0, S0, T0, h1, S1, T1 @@ -1158,7 +1159,7 @@ subroutine cut_off_column_top(nk, tv, Rho0, G_earth, depth, min_thickness, & ! Calculate original interface positions e(nk+1) = -depth do k=nk,1,-1 - e(K) = e(K+1) + h(k) + e(K) = e(K+1) + GV%H_to_Z*h(k) h0(k) = h(nk+1-k) ! Keep a copy to use in remapping enddo @@ -1166,7 +1167,7 @@ subroutine cut_off_column_top(nk, tv, Rho0, G_earth, depth, min_thickness, & e_top = e(1) do k=1,nk call find_depth_of_pressure_in_cell(T_t(k), T_b(k), S_t(k), S_b(k), e(K), e(K+1), & - P_t, p_surf, Rho0, G_earth, tv%eqn_of_state, P_b, z_out) + P_t, p_surf, GV%Rho0, G_earth, tv%eqn_of_state, P_b, z_out) if (z_out>=e(K)) then ! Imposed pressure was less that pressure at top of cell exit @@ -1183,14 +1184,14 @@ subroutine cut_off_column_top(nk, tv, Rho0, G_earth, depth, min_thickness, & if (e_tope_top) then + if (e(K) > e_top) then ! Original e(K) is too high e(K) = e_top e_top = e_top - min_thickness ! Next interface must be at least this deep endif ! This layer needs trimming - h(k) = max( min_thickness, e(K) - e(K+1) ) - if (e(K) NULL() - real :: min_depth + real :: min_depth ! The minimum depth in Z. real :: dilate real :: missing_value_temp, missing_value_salt logical :: correct_thickness @@ -1937,19 +1939,18 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) real, dimension(:,:,:), allocatable, target :: temp_z, salt_z, mask_z real, dimension(:,:,:), allocatable :: rho_z real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: zi ! Interface heights in Z. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: zi_m ! Interface heights in m. real, dimension(SZI_(G),SZJ_(G)) :: nlevs - real, dimension(SZI_(G)) :: press + real, dimension(SZI_(G)) :: press ! Pressures in Pa. ! Local variables for ALE remapping - real, dimension(:), allocatable :: hTarget + real, dimension(:), allocatable :: hTarget ! Target thicknesses in Z. real, dimension(:,:), allocatable :: area_shelf_h real, dimension(:,:), allocatable, target :: frac_shelf_h real, dimension(:,:,:), allocatable, target :: tmpT1dIn, tmpS1dIn real, dimension(:,:,:), allocatable :: tmp_mask_in real, dimension(:,:,:), allocatable :: h1 ! Thicknesses in H. real, dimension(:,:,:), allocatable :: dz_interface ! Change in position of interface due to regridding - real :: zTopOfCell, zBottomOfCell + real :: zTopOfCell, zBottomOfCell ! Heights in Z units type(regridding_CS) :: regridCS ! Regridding parameters and work arrays type(remapping_CS) :: remapCS ! Remapping parameters and work arrays @@ -1985,7 +1986,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) reentrant_x = .false. ; call get_param(PF, mdl, "REENTRANT_X", reentrant_x,default=.true.) tripolar_n = .false. ; call get_param(PF, mdl, "TRIPOLAR_N", tripolar_n, default=.false.) - call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, default=0.0) + call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, default=0.0, scale=GV%m_to_Z) call get_param(PF, mdl, "NKML",nkml,default=0) call get_param(PF, mdl, "NKBL",nkbl,default=0) @@ -2059,6 +2060,9 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) return ! All run-time parameters have been read, so return. endif + !### Change this to GV%Angstrom_Z + eps_z = 1.0e-10*GV%m_to_Z + ! Read input grid coordinates for temperature and salinity field ! in z-coordinate dataset. The file is REQUIRED to contain the ! following: @@ -2082,6 +2086,10 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) kd = size(z_in,1) + ! Convert the units and sign convention of z_in and Z_edges_in. + do k=1,kd ; z_in(k) = GV%m_to_Z*z_in(k) ; enddo + do k=1,size(Z_edges_in,1) ; Z_edges_in(k) = -GV%m_to_Z*Z_edges_in(k) ; enddo + allocate(rho_z(isd:ied,jsd:jed,kd)) allocate(area_shelf_h(isd:ied,jsd:jed)) allocate(frac_shelf_h(isd:ied,jsd:jed)) @@ -2140,21 +2148,21 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) tmp_mask_in(i,j,1:kd) = mask_z(i,j,:) do k = 1, nkd if (tmp_mask_in(i,j,k)>0. .and. k<=kd) then - zBottomOfCell = max( -z_edges_in(k+1), -G%Zd_to_m*G%bathyT(i,j) ) + zBottomOfCell = max( z_edges_in(k+1), -G%bathyT(i,j) ) tmpT1dIn(i,j,k) = temp_z(i,j,k) tmpS1dIn(i,j,k) = salt_z(i,j,k) elseif (k>1) then - zBottomOfCell = -G%Zd_to_m*G%bathyT(i,j) + zBottomOfCell = -G%bathyT(i,j) tmpT1dIn(i,j,k) = tmpT1dIn(i,j,k-1) tmpS1dIn(i,j,k) = tmpS1dIn(i,j,k-1) else ! This next block should only ever be reached over land tmpT1dIn(i,j,k) = -99.9 tmpS1dIn(i,j,k) = -99.9 endif - h1(i,j,k) = GV%m_to_H * (zTopOfCell - zBottomOfCell) + h1(i,j,k) = GV%Z_to_H * (zTopOfCell - zBottomOfCell) zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k enddo - h1(i,j,kd) = h1(i,j,kd) + GV%m_to_H * max(0., zTopOfCell + G%Zd_to_m*G%bathyT(i,j) ) + h1(i,j,kd) = h1(i,j,kd) + GV%Z_to_H * max(0., zTopOfCell + G%bathyT(i,j) ) ! The max here is in case the data data is shallower than model endif ! mask2dT enddo ; enddo @@ -2170,15 +2178,15 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) if (.not. remap_general) then ! This is the old way of initializing to z* coordinates only allocate( hTarget(nz) ) - hTarget = getCoordinateResolution( regridCS ) + hTarget = GV%m_to_Z * getCoordinateResolution( regridCS ) do j = js, je ; do i = is, ie h(i,j,:) = 0. if (G%mask2dT(i,j)>0.) then ! Build the target grid combining hTarget and topography zTopOfCell = 0. ; zBottomOfCell = 0. do k = 1, nz - zBottomOfCell = max( zTopOfCell - hTarget(k), -G%Zd_to_m*G%bathyT(i,j) ) - h(i,j,k) = GV%m_to_H * (zTopOfCell - zBottomOfCell) + zBottomOfCell = max( zTopOfCell - hTarget(k), -G%bathyT(i,j) ) + h(i,j,k) = GV%Z_to_H * (zTopOfCell - zBottomOfCell) zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k enddo else @@ -2227,11 +2235,8 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) do k=2,nz ; Rb(k)=0.5*(GV%Rlay(k-1)+GV%Rlay(k)) ; enddo Rb(1) = 0.0 ; Rb(nz+1) = 2.0*GV%Rlay(nz) - GV%Rlay(nz-1) - zi(is:ie,js:je,:) = find_interfaces(rho_z(is:ie,js:je,:), z_in, Rb, G%Zd_to_m*G%bathyT(is:ie,js:je), & - nlevs(is:ie,js:je), nkml, nkbl, min_depth) - do K=1,nz+1 ; do j=js,je ; do i=is,ie - zi_m(i,j,K) = zi(i,j,K) ; zi(i,j,K) = GV%m_to_Z*zi(i,j,K) - enddo ; enddo ; enddo + zi(is:ie,js:je,:) = find_interfaces(rho_z(is:ie,js:je,:), z_in, Rb, G%bathyT(is:ie,js:je), & + nlevs(is:ie,js:je), nkml, nkbl, min_depth, eps_z=eps_z) if (correct_thickness) then call adjustEtaToFitBathymetry(G, GV, zi, h) @@ -2252,25 +2257,25 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) call sum_across_PEs(inconsistent) if ((inconsistent > 0) .and. (is_root_pe())) then - write(mesg,'("Thickness initial conditions are inconsistent ",'// & - '"with topography in ",I5," places.")') inconsistent + write(mesg, '("Thickness initial conditions are inconsistent ",'// & + '"with topography in ",I5," places.")') inconsistent call MOM_error(WARNING, mesg) endif endif - tv%T(is:ie,js:je,:) = tracer_z_init(temp_z(is:ie,js:je,:),-1.0*z_edges_in,zi_m(is:ie,js:je,:), & - nkml,nkbl,missing_value,G%mask2dT(is:ie,js:je),nz, & - nlevs(is:ie,js:je),dbg,idbg,jdbg) - tv%S(is:ie,js:je,:) = tracer_z_init(salt_z(is:ie,js:je,:),-1.0*z_edges_in,zi_m(is:ie,js:je,:), & - nkml,nkbl,missing_value,G%mask2dT(is:ie,js:je),nz, & - nlevs(is:ie,js:je)) + tv%T(is:ie,js:je,:) = tracer_z_init(temp_z(is:ie,js:je,:), z_edges_in, zi(is:ie,js:je,:), & + nkml, nkbl, missing_value, G%mask2dT(is:ie,js:je), nz, & + nlevs(is:ie,js:je),dbg,idbg,jdbg, eps_z=eps_z) + tv%S(is:ie,js:je,:) = tracer_z_init(salt_z(is:ie,js:je,:), z_edges_in, zi(is:ie,js:je,:), & + nkml, nkbl, missing_value, G%mask2dT(is:ie,js:je), nz, & + nlevs(is:ie,js:je), eps_z=eps_z) do k=1,nz nPoints = 0 ; tempAvg = 0. ; saltAvg = 0. do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) >= 1.0) then nPoints = nPoints + 1 tempAvg = tempAvg + tv%T(i,j,k) - saltAvg =saltAvg + tv%S(i,j,k) + saltAvg = saltAvg + tv%S(i,j,k) endif ; enddo ; enddo ! Horizontally homogenize data to produce perfectly "flat" initial conditions @@ -2279,8 +2284,8 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) call sum_across_PEs(tempAvg) call sum_across_PEs(saltAvg) if (nPoints>0) then - tempAvg = tempAvg/real(nPoints) - saltAvg = saltAvg/real(nPoints) + tempAvg = tempAvg / real(nPoints) + saltAvg = saltAvg / real(nPoints) endif tv%T(:,:,k) = tempAvg tv%S(:,:,k) = saltAvg @@ -2292,13 +2297,13 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) ! Fill land values do k=1,nz ; do j=js,je ; do i=is,ie if (tv%T(i,j,k) == missing_value) then - tv%T(i,j,k)=temp_land_fill - tv%S(i,j,k)=salt_land_fill + tv%T(i,j,k) = temp_land_fill + tv%S(i,j,k) = salt_land_fill endif enddo ; enddo ; enddo ! Finally adjust to target density - ks=max(0,nkml)+max(0,nkbl)+1 + ks = max(0,nkml)+max(0,nkbl)+1 if (adjust_temperature .and. .not. useALEremapping) then call determine_temperature(tv%T(is:ie,js:je,:), tv%S(is:ie,js:je,:), & @@ -2307,7 +2312,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) endif deallocate(z_in, z_edges_in, temp_z, salt_z, mask_z) - deallocate(rho_z) ; deallocate(area_shelf_h, frac_shelf_h) + deallocate(rho_z, area_shelf_h, frac_shelf_h) call pass_var(h, G%Domain) call pass_var(tv%T, G%Domain) @@ -2365,7 +2370,7 @@ subroutine MOM_state_init_tests(G, GV, tv) write(0,*) ' ==================================================================== ' write(0,*) '' write(0,*) h - call cut_off_column_top(nk, tv, GV%Rho0, GV%g_Earth, -e(nk+1), GV%Angstrom_H, & + call cut_off_column_top(nk, tv, GV, GV%g_Earth, -e(nk+1), GV%Angstrom_H, & T, T_t, T_b, S, S_t, S_b, 0.5*P_tot, h, remap_CS) write(0,*) h From d556d75d6ac03d9babb01837a5df3f9f8c32e0b8 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 9 Sep 2018 21:48:59 -0400 Subject: [PATCH 087/174] dense_water_initialize_sponges now uses Z units Modified dense_water_initialize_sponges to work in depth (Z) units instead of m for heights. All answers in the MOM6 test cases are bitwise identical. --- src/user/dense_water_initialization.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/user/dense_water_initialization.F90 b/src/user/dense_water_initialization.F90 index 260caf2f53..f1a7bd6492 100644 --- a/src/user/dense_water_initialization.F90 +++ b/src/user/dense_water_initialization.F90 @@ -232,9 +232,9 @@ subroutine dense_water_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, A if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then ! is this layer vanished? eta1D(k) = eta1D(k+1) + GV%Angstrom_Z - h(i,j,k) = GV%Angstrom_m + h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = GV%Z_to_m * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif enddo enddo @@ -253,7 +253,7 @@ subroutine dense_water_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, A x = (G%geoLonT(i,j) - G%west_lon) / G%len_lon do k = 1,nz ! nondimensional middle of layer - zmid = zi + 0.5 * h(i,j,k) / (GV%Z_to_m * G%max_depth) + zmid = zi + 0.5 * h(i,j,k) / (GV%Z_to_H * G%max_depth) if (x > (1. - east_sponge_width)) then !if (zmid >= 0.9 * sill_height) & @@ -264,7 +264,7 @@ subroutine dense_water_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, A S(i,j,k) = S_ref + S_range * (zmid - mld) / (1.0 - mld) endif - zi = zi + h(i,j,k) / (GV%Z_to_m * G%max_depth) + zi = zi + h(i,j,k) / (GV%Z_to_H * G%max_depth) enddo enddo enddo From d00ba7dbb55caafe96acd03b86f2317f8f2edbc6 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 9 Sep 2018 21:49:37 -0400 Subject: [PATCH 088/174] +Modified bcz_param to read using depth units Modified bcz_param to read two parameters using depth units, including an additional verticalGrid_type parameter. All answers are bitwise identical. --- src/user/baroclinic_zone_initialization.F90 | 41 +++++++++++---------- 1 file changed, 21 insertions(+), 20 deletions(-) diff --git a/src/user/baroclinic_zone_initialization.F90 b/src/user/baroclinic_zone_initialization.F90 index 1a9f99b840..bdcd84aeee 100644 --- a/src/user/baroclinic_zone_initialization.F90 +++ b/src/user/baroclinic_zone_initialization.F90 @@ -21,21 +21,23 @@ module baroclinic_zone_initialization contains !> Reads the parameters unique to this module -subroutine bcz_params(G, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, dTdz, & +subroutine bcz_params(G, GV, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, dTdz, & delta_T, dTdx, L_zone, just_read_params) - type(ocean_grid_type), intent(in) :: G !< Grid structure - type(param_file_type), intent(in) :: param_file !< Parameter file handle - real, intent(out) :: S_ref !< Reference salinity (ppt) - real, intent(out) :: dSdz !< Salinity stratification (ppt/m) - real, intent(out) :: delta_S !< Salinity difference across baroclinic zone (ppt) - real, intent(out) :: dSdx !< Linear salinity gradient (ppt/m) - real, intent(out) :: T_ref !< Reference temperature (ppt) - real, intent(out) :: dTdz !< Temperature stratification (ppt/m) - real, intent(out) :: delta_T !< Temperature difference across baroclinic zone (ppt) - real, intent(out) :: dTdx !< Linear temperature gradient (ppt/m) - real, intent(out) :: L_zone !< Width of baroclinic zone (m) - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + type(ocean_grid_type), intent(in) :: G !< Grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(param_file_type), intent(in) :: param_file !< Parameter file handle + real, intent(out) :: S_ref !< Reference salinity (ppt) + real, intent(out) :: dSdz !< Salinity stratification (ppt/Z) + real, intent(out) :: delta_S !< Salinity difference across baroclinic zone (ppt) + real, intent(out) :: dSdx !< Linear salinity gradient (ppt/m) + real, intent(out) :: T_ref !< Reference temperature (ppt) + real, intent(out) :: dTdz !< Temperature stratification (ppt/Z) + real, intent(out) :: delta_T !< Temperature difference across baroclinic zone (ppt) + real, intent(out) :: dTdx !< Linear temperature gradient (ppt/m) + real, intent(out) :: L_zone !< Width of baroclinic zone (m) + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. + logical :: just_read ! If true, just read parameters but set nothing. just_read = .false. ; if (present(just_read_params)) just_read = just_read_params @@ -45,16 +47,16 @@ subroutine bcz_params(G, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, dTdz, & call openParameterBlock(param_file,'BCZIC') call get_param(param_file, mdl, "S_REF", S_ref, 'Reference salinity', units='ppt', & default=35., do_not_log=just_read) - call get_param(param_file, mdl,"DSDZ",dSdz,'Salinity stratification',units='ppt/m', & - default=0.0, do_not_log=just_read) + call get_param(param_file, mdl, "DSDZ", dSdz, 'Salinity stratification', & + units='ppt/m', default=0.0, scale=GV%Z_to_m, do_not_log=just_read) call get_param(param_file, mdl,"DELTA_S",delta_S,'Salinity difference across baroclinic zone', & units='ppt', default=0.0, do_not_log=just_read) call get_param(param_file, mdl,"DSDX",dSdx,'Meridional salinity difference', & units='ppt/'//trim(G%x_axis_units), default=0.0, do_not_log=just_read) call get_param(param_file, mdl,"T_REF",T_ref,'Reference temperature',units='C', & default=10., do_not_log=just_read) - call get_param(param_file, mdl,"DTDZ",dTdz,'Temperature stratification',units='C/m', & - default=0.0, do_not_log=just_read) + call get_param(param_file, mdl, "DTDZ", dTdz, 'Temperature stratification', & + units='C/m', default=0.0, scale=GV%Z_to_m, do_not_log=just_read) call get_param(param_file, mdl,"DELTA_T",delta_T,'Temperature difference across baroclinic zone', & units='C', default=0.0, do_not_log=just_read) call get_param(param_file, mdl,"DTDX",dTdx,'Meridional temperature difference', & @@ -89,8 +91,7 @@ subroutine baroclinic_zone_init_temperature_salinity(T, S, h, G, GV, param_file, is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - call bcz_params(G, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, dTdz, delta_T, dTdx, L_zone, just_read_params) - dTdz = GV%Z_to_m*dTdz ; dSdz = GV%Z_to_m*dSdz + call bcz_params(G, GV, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, dTdz, delta_T, dTdx, L_zone, just_read_params) if (just_read) return ! All run-time parameters have been read, so return. From 091ef9522d99323463c3f37e2906c462f4ea6c09 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 9 Sep 2018 21:50:14 -0400 Subject: [PATCH 089/174] Rossby_front_initialize_velocity now uses Z units Modified Rossby_front_initialize_velocity to work in depth (Z) units instead of m for heights. All answers in the MOM6 test cases are bitwise identical. --- src/user/Rossby_front_2d_initialization.F90 | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/user/Rossby_front_2d_initialization.F90 b/src/user/Rossby_front_2d_initialization.F90 index 6c1410da3f..c619f3db64 100644 --- a/src/user/Rossby_front_2d_initialization.F90 +++ b/src/user/Rossby_front_2d_initialization.F90 @@ -177,9 +177,9 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, param_file, just_rea real :: T_range ! Range of salinities and temperatures over the vertical real :: dUdT ! Factor to convert dT/dy into dU/dz, g*alpha/f real :: dRho_dT - real :: Dml, zi, zc, zm ! Depths in units of m. + real :: Dml, zi, zc, zm ! Depths in units of Z. real :: f, Ty - real :: hAtU ! Interpolated layer thickness in units of m. + real :: hAtU ! Interpolated layer thickness in units of Z. integer :: i, j, k, is, ie, js, je, nz logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: verticalCoordinate @@ -202,12 +202,12 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, param_file, just_rea do j = G%jsc,G%jec ; do I = G%isc-1,G%iec+1 f = 0.5*( G%CoriolisBu(I,j) + G%CoriolisBu(I,j-1) ) dUdT = 0.0 ; if (abs(f) > 0.0) & - dUdT = ( GV%g_Earth * dRho_dT ) / ( f * GV%Rho0 ) - Dml = GV%Z_to_m*Hml( G, G%geoLatT(i,j) ) + dUdT = ( GV%Z_to_m*GV%g_Earth * dRho_dT ) / ( f * GV%Rho0 ) + Dml = Hml( G, G%geoLatT(i,j) ) Ty = dTdy( G, T_range, G%geoLatT(i,j) ) zi = 0. do k = 1, nz - hAtU = 0.5*(h(i,j,k)+h(i+1,j,k)) * GV%H_to_m + hAtU = 0.5*(h(i,j,k)+h(i+1,j,k)) * GV%H_to_Z 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 @@ -232,7 +232,8 @@ real function yPseudo( G, lat ) end function yPseudo -!> Analytic prescription of mixed layer depth in 2d Rossby front test +!> Analytic prescription of mixed layer depth in 2d Rossby front test, +!! in the same units as G%max_depth real function Hml( G, lat ) type(ocean_grid_type), intent(in) :: G !< Grid structure real, intent(in) :: lat !< Latitude From 17446618ce490ec3ca62b72d48062d21da8978d6 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 9 Sep 2018 21:50:42 -0400 Subject: [PATCH 090/174] ISOMIP_intialize_sponges now uses Z units Modified ISOMIP_intialize_sponges to work in depth (Z) units instead of m for heights, correcting oversights in previous commits. All answers in the MOM6 test cases are bitwise identical. --- src/user/ISOMIP_initialization.F90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index 969bb0664e..8940a9fcc3 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -294,7 +294,7 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, dS_dz = (s_sur - s_bot) / G%max_depth dT_dz = (t_sur - t_bot) / G%max_depth do j=js,je ; do i=is,ie - xi0 = -G%Zd_to_m * G%bathyT(i,j) + xi0 = -G%bathyT(i,j) do k = nz,1,-1 xi0 = xi0 + 0.5 * h(i,j,k) * GV%H_to_Z ! Depth in middle of layer S(i,j,k) = S_sur + dS_dz * xi0 @@ -497,14 +497,14 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) enddo ; enddo ! Compute min/max density using T_SUR/S_SUR and T_BOT/S_BOT - call calculate_density(t_sur,s_sur,0.0,rho_sur,tv%eqn_of_state) - !write (*,*)'Surface density in sponge:', rho_sur + call calculate_density(t_sur, s_sur, 0.0, rho_sur, tv%eqn_of_state) + !write (mesg,*) 'Surface density in sponge:', rho_sur ! call MOM_mesg(mesg,5) - call calculate_density(t_bot,s_bot,0.0,rho_bot,tv%eqn_of_state) - !write (*,*)'Bottom density in sponge:', rho_bot + call calculate_density(t_bot, s_bot, 0.0, rho_bot, tv%eqn_of_state) + !write (mesg,*) 'Bottom density in sponge:', rho_bot ! call MOM_mesg(mesg,5) rho_range = rho_bot - rho_sur - !write (*,*)'Density range in sponge:', rho_range + !write (mesg,*) 'Density range in sponge:', rho_range ! call MOM_mesg(mesg,5) if (use_ALE) then @@ -530,9 +530,9 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) eta1D(k) = e0(k) if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then eta1D(k) = eta1D(k+1) + GV%Angstrom_Z - h(i,j,k) = GV%Angstrom_m + h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = GV%Z_to_m*(eta1D(k) - eta1D(k+1)) + h(i,j,k) = GV%Z_to_H*(eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo From 245f66590df85c4452cf2d619872557dab738bc6 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 9 Sep 2018 21:53:14 -0400 Subject: [PATCH 091/174] Corrected a recent bug in PressureForce_Mont_Bouss Corrected a double correction for Z in PressureForce_Mont_Bouss that was recently added with commit NOAA-GFDL/MOM6@5907c9e. All answers are bitwise identical when Z units are m. --- src/core/MOM_PressureForce_Montgomery.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 09ce4721d9..6d094349ae 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -507,7 +507,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta do k=1,nz+1 ; do j=Jsq,Jeq+1 call calculate_density(tv_tmp%T(:,j,k), tv_tmp%S(:,j,k), p_ref, rho_star(:,j,k), & Isq,Ieq-Isq+2,tv%eqn_of_state) - do i=Isq,Ieq+1 ; rho_star(i,j,k) = GV%Z_to_m*G_Rho0*rho_star(i,j,k) ; enddo + do i=Isq,Ieq+1 ; rho_star(i,j,k) = G_Rho0*rho_star(i,j,k) ; enddo enddo ; enddo endif ! use_EOS From 1554e0fea2ea86dada86b9dee85f94ec4e485761 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 9 Sep 2018 22:00:29 -0400 Subject: [PATCH 092/174] Improved robustness of find_overlap Modified find_overlap and find_limited_slope to avoid NaNs with vanishing layers. All answers are biwise identical in all existing test cases. --- src/diagnostics/MOM_diag_to_Z.F90 | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/src/diagnostics/MOM_diag_to_Z.F90 b/src/diagnostics/MOM_diag_to_Z.F90 index a4471e1318..0e966e7ff6 100644 --- a/src/diagnostics/MOM_diag_to_Z.F90 +++ b/src/diagnostics/MOM_diag_to_Z.F90 @@ -678,20 +678,24 @@ subroutine find_overlap(e, Z_top, Z_bot, k_max, k_start, k_top, k_bot, wt, z1, z ! Note that by convention, e and Z_int decrease with increasing k. if (e(K+1)<=Z_bot) then wt(k) = 1.0 ; k_bot = k - Ih = 1.0 / (e(K)-e(K+1)) + Ih = 0.0 ; if (e(K) /= e(K+1)) Ih = 1.0 / (e(K)-e(K+1)) e_c = 0.5*(e(K)+e(K+1)) z1(k) = (e_c - MIN(e(K),Z_top)) * Ih z2(k) = (e_c - Z_bot) * Ih else wt(k) = MIN(e(K),Z_top) - e(K+1) ; tot_wt = wt(k) ! These are always > 0. - z1(k) = (0.5*(e(K)+e(K+1)) - MIN(e(K),Z_top)) / (e(K)-e(K+1)) + if (e(K) /= e(K+1)) then + z1(k) = (0.5*(e(K)+e(K+1)) - MIN(e(K), Z_top)) / (e(K)-e(K+1)) + else ; z1(k) = -0.5 ; endif z2(k) = 0.5 k_bot = k_max do k=k_top+1,k_max if (e(K+1)<=Z_bot) then k_bot = k wt(k) = e(K) - Z_bot ; z1(k) = -0.5 - z2(k) = (0.5*(e(K)+e(K+1)) - Z_bot) / (e(K)-e(K+1)) + if (e(K) /= e(K+1)) then + z2(k) = (0.5*(e(K)+e(K+1)) - Z_bot) / (e(K)-e(K+1)) + else ; z2(k) = 0.5 ; endif else wt(k) = e(K) - e(K+1) ; z1(k) = -0.5 ; z2(k) = 0.5 endif @@ -705,7 +709,7 @@ subroutine find_overlap(e, Z_top, Z_bot, k_max, k_start, k_top, k_bot, wt, z1, z end subroutine find_overlap -!> This subroutine determines a limited slope for val to be advected with +!> This subroutine determines a limited slope for val to be advected with !! a piecewise limited scheme. subroutine find_limited_slope(val, e, slope, k) real, dimension(:), intent(in) :: val !< A column of values that are being interpolated. @@ -715,10 +719,10 @@ subroutine find_limited_slope(val, e, slope, k) ! Local variables real :: d1, d2 - if ((val(k)-val(k-1)) * (val(k)-val(k+1)) >= 0.0) then + d1 = 0.5*(e(K-1)-e(K+1)) ; d2 = 0.5*(e(K)-e(K+2)) + if (((val(k)-val(k-1)) * (val(k)-val(k+1)) >= 0.0) .or. (d1*d2 <= 0.0)) then slope = 0.0 ! ; curvature = 0.0 else - d1 = 0.5*(e(K-1)-e(K+1)) ; d2 = 0.5*(e(K)-e(K+2)) slope = (d1**2*(val(k+1) - val(k)) + d2**2*(val(k) - val(k-1))) * & ((e(K) - e(K+1)) / (d1*d2*(d1+d2))) ! slope = 0.5*(val(k+1) - val(k-1)) From e54668abcf731832bce855765f8826d5f1652e42 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 9 Sep 2018 22:08:50 -0400 Subject: [PATCH 093/174] Changed tracer_Z_init to use depths in Z units Modified tracer_Z_init to be able to work with depths in units of Z, and added a scale argument to read_Z_edges to change input depths to units of Z. All answers are bitwise identical. --- src/tracer/MOM_tracer_Z_init.F90 | 22 +++++++++++++--------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index 88b1ba37ce..7450571500 100644 --- a/src/tracer/MOM_tracer_Z_init.F90 +++ b/src/tracer/MOM_tracer_Z_init.F90 @@ -47,7 +47,7 @@ function tracer_Z_init(tr, h, filename, tr_name, G, missing_val, land_val) tr_in ! The z-space array of tracer concentrations that is read in. real, allocatable, dimension(:) :: & z_edges, & ! The depths of the cell edges or cell centers (depending on - ! the value of has_edges) in the input z* data. + ! the value of has_edges) in the input z* data, in depth units (Z). tr_1d, & ! A copy of the input tracer concentrations in a column. wt, & ! The fractional weight for each layer in the range between ! k_top and k_bot, nondim. @@ -55,14 +55,14 @@ function tracer_Z_init(tr, h, filename, tr_name, G, missing_val, land_val) z2 ! of a z-cell that contributes to a layer, relative to the cell ! center and normalized by the cell thickness, nondim. ! Note that -1/2 <= z1 <= z2 <= 1/2. - real :: e(SZK_(G)+1) ! The z-star interface heights in m. + real :: e(SZK_(G)+1) ! The z-star interface heights in Z. real :: landval ! The tracer value to use in land points. real :: sl_tr ! The normalized slope of the tracer ! within the cell, in tracer units. real :: htot(SZI_(G)) ! The vertical sum of h, in m or kg m-2. real :: dilate ! The amount by which the thicknesses are dilated to ! create a z-star coordinate, nondim or in m3 kg-1. - real :: missing ! The missing value for the tracer. + real :: missing ! The missing value for the tracer. logical :: has_edges, use_missing, zero_surface character(len=80) :: loc_msg @@ -81,7 +81,8 @@ function tracer_Z_init(tr, h, filename, tr_name, G, missing_val, land_val) ! Find out the number of input levels and read the depth of the edges, ! also modifying their sign convention to be monotonically decreasing. - call read_Z_edges(filename, tr_name, z_edges, nz_in, has_edges, use_missing, missing) + call read_Z_edges(filename, tr_name, z_edges, nz_in, has_edges, use_missing, & + missing, scale=1.0/G%Zd_to_m) if (nz_in < 1) then tracer_Z_init = .false. return @@ -128,8 +129,8 @@ function tracer_Z_init(tr, h, filename, tr_name, G, missing_val, land_val) do i=is,ie ; if (G%mask2dT(i,j)*htot(i) > 0.0) then ! Determine the z* heights of the model interfaces. - dilate = (G%Zd_to_m*G%bathyT(i,j) - 0.0) / htot(i) - e(nz+1) = -G%Zd_to_m*G%bathyT(i,j) + dilate = (G%bathyT(i,j) - 0.0) / htot(i) + e(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 ; e(K) = e(K+1) + dilate * h(i,j,k) ; enddo ! Create a single-column copy of tr_in. ### CHANGE THIS LATER? @@ -203,8 +204,8 @@ function tracer_Z_init(tr, h, filename, tr_name, G, missing_val, land_val) do i=is,ie ; if (G%mask2dT(i,j)*htot(i) > 0.0) then ! Determine the z* heights of the model interfaces. - dilate = (G%Zd_to_m*G%bathyT(i,j) - 0.0) / htot(i) - e(nz+1) = -G%Zd_to_m*G%bathyT(i,j) + dilate = (G%bathyT(i,j) - 0.0) / htot(i) + e(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 ; e(K) = e(K+1) + dilate * h(i,j,k) ; enddo ! Create a single-column copy of tr_in. ### CHANGE THIS LATER? @@ -269,7 +270,7 @@ end function tracer_Z_init !> This subroutine reads the vertical coordinate data for a field from a NetCDF file. !! It also might read the missing value attribute for that same field. subroutine read_Z_edges(filename, tr_name, z_edges, nz_out, has_edges, & - use_missing, missing) + use_missing, missing, scale) character(len=*), intent(in) :: filename !< The name of the file to read from. character(len=*), intent(in) :: tr_name !< The name of the tracer in the file. real, dimension(:), allocatable, & @@ -280,6 +281,7 @@ subroutine read_Z_edges(filename, tr_name, z_edges, nz_out, has_edges, & logical, intent(inout) :: use_missing !< If false on input, see whether the tracer has a !! missing value, and if so return true real, intent(inout) :: missing !< The missing value, if one has been found + real, intent(in) :: scale !< A scaling factor for z_edges into new units. ! This subroutine reads the vertical coordinate data for a field from a ! NetCDF file. It also might read the missing value attribute for that same field. @@ -388,6 +390,8 @@ subroutine read_Z_edges(filename, tr_name, z_edges, nz_out, has_edges, & if (.not.monotonic) & call MOM_error(WARNING,mdl//" "//trim(dim_msg)//" is not monotonic.") + if (scale /= 1.0) then ; do k=1,nz_edge ; z_edges(k) = scale*z_edges(k) ; enddo ; endif + end subroutine read_Z_edges From 8e85151780a503496cd82e87627f9e2fae6e3940 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 9 Sep 2018 22:10:58 -0400 Subject: [PATCH 094/174] Modified dye_example to use Z units for depths Modified dye_example to work in depth (Z) units instead of m for depths and related parameters. All answers in the MOM6 test cases are bitwise identical. --- src/tracer/dye_example.F90 | 25 ++++++++++++------------- 1 file changed, 12 insertions(+), 13 deletions(-) diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index 489fba76fa..c9a8706e3c 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -41,8 +41,8 @@ module regional_dyes real, allocatable, dimension(:) :: dye_source_maxlon !< Maximum longitude of region dye will be injected. real, allocatable, dimension(:) :: dye_source_minlat !< Minimum latitude of region dye will be injected. real, allocatable, dimension(:) :: dye_source_maxlat !< Maximum latitude of region dye will be injected. - real, allocatable, dimension(:) :: dye_source_mindepth !< Minimum depth of region dye will be injected (m). - real, allocatable, dimension(:) :: dye_source_maxdepth !< Maximum depth of region dye will be injected (m). + real, allocatable, dimension(:) :: dye_source_mindepth !< Minimum depth of region dye will be injected, in Z. + real, allocatable, dimension(:) :: dye_source_maxdepth !< Maximum depth of region dye will be injected, in Z. type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the tracer registry real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this subroutine, in g m-3? @@ -135,18 +135,17 @@ function register_dye_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) CS%dye_source_mindepth(:) = -1.e30 call get_param(param_file, mdl, "DYE_SOURCE_MINDEPTH", CS%dye_source_mindepth, & "This is the minumum depth at which we inject dyes.", & - fail_if_missing=.true.) - if (minval(CS%dye_source_mindepth(:)) < -1.e29) & + units="m", scale=GV%m_to_Z, fail_if_missing=.true.) + if (minval(CS%dye_source_mindepth(:)) < -1.e29*GV%m_to_Z) & call MOM_error(FATAL, "register_dye_tracer: Not enough values provided for DYE_SOURCE_MINDEPTH") CS%dye_source_maxdepth(:) = -1.e30 call get_param(param_file, mdl, "DYE_SOURCE_MAXDEPTH", CS%dye_source_maxdepth, & "This is the maximum depth at which we inject dyes.", & - fail_if_missing=.true.) - if (minval(CS%dye_source_maxdepth(:)) < -1.e29) & + units="m", scale=GV%m_to_Z, fail_if_missing=.true.) + if (minval(CS%dye_source_maxdepth(:)) < -1.e29*GV%m_to_Z) & call MOM_error(FATAL, "register_dye_tracer: Not enough values provided for DYE_SOURCE_MAXDEPTH ") - allocate(CS%tr(isd:ied,jsd:jed,nz,CS%ntr)) ; CS%tr(:,:,:,:) = 0.0 do m = 1, CS%ntr @@ -222,14 +221,14 @@ subroutine initialize_dye_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_C CS%dye_source_minlat(m)=G%geoLatT(i,j) .and. & G%mask2dT(i,j) > 0.0 ) then - z_bot = -G%Zd_to_m*G%bathyT(i,j) + z_bot = -G%bathyT(i,j) do k = GV%ke, 1, -1 - z_center = z_bot + 0.5*h(i,j,k)*GV%H_to_m + z_center = z_bot + 0.5*h(i,j,k)*GV%H_to_Z if ( z_center > -CS%dye_source_maxdepth(m) .and. & z_center < -CS%dye_source_mindepth(m) ) then CS%tr(i,j,k,m) = 1.0 endif - z_bot = z_bot + h(i,j,k)*GV%H_to_m + z_bot = z_bot + h(i,j,k)*GV%H_to_Z enddo endif enddo ; enddo @@ -305,14 +304,14 @@ subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS CS%dye_source_minlat(m)=G%geoLatT(i,j) .and. & G%mask2dT(i,j) > 0.0 ) then - z_bot = -G%Zd_to_m*G%bathyT(i,j) + z_bot = -G%bathyT(i,j) do k=nz,1,-1 - z_center = z_bot + 0.5*h_new(i,j,k)*GV%H_to_m + z_center = z_bot + 0.5*h_new(i,j,k)*GV%H_to_Z if ( z_center > -CS%dye_source_maxdepth(m) .and. & z_center < -CS%dye_source_mindepth(m) ) then CS%tr(i,j,k,m) = 1.0 endif - z_bot = z_bot + h_new(i,j,k)*GV%H_to_m + z_bot = z_bot + h_new(i,j,k)*GV%H_to_Z enddo endif enddo ; enddo From b43827ce6c23beaec070d430134241fca89df1b9 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 9 Sep 2018 22:12:28 -0400 Subject: [PATCH 095/174] Modified DOME_tracer to use Z units for depths Modified DOME_tracer to work in depth (Z) units instead of m for depths and related parameters. All answers in the MOM6 test cases are bitwise identical. --- src/tracer/DOME_tracer.F90 | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index 0a59eb1c92..89393c2c8c 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -169,8 +169,9 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, h, diag, OBC, CS, & real :: tr_y ! Initial zonally uniform tracer concentrations. real :: dist2 ! The distance squared from a line, in m2. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in m. - real :: e(SZK_(G)+1), e_top, e_bot, d_tr + ! in roundoff and can be neglected, in H. + real :: e(SZK_(G)+1), e_top, e_bot ! Heights in Z. + real :: d_tr ! A change in tracer concentraions, in tracer units. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m integer :: IsdB, IedB, JsdB, JedB @@ -213,21 +214,21 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, h, diag, OBC, CS, & if (NTR > 7) then do j=js,je ; do i=is,ie - e(nz+1) = -G%Zd_to_m*G%bathyT(i,j) + e(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 - e(K) = e(K+1) + h(i,j,k)*GV%H_to_m + e(K) = e(K+1) + h(i,j,k)*GV%H_to_Z do m=7,NTR - e_top = -600.0*real(m-1) + 3000.0 - e_bot = -600.0*real(m-1) + 2700.0 + e_top = (-600.0*real(m-1) + 3000.0) * GV%m_to_Z + e_bot = (-600.0*real(m-1) + 2700.0) * GV%m_to_Z if (e_top < e(K)) then if (e_top < e(K+1)) then ; d_tr = 0.0 elseif (e_bot < e(K+1)) then - d_tr = (e_top-e(K+1)) / ((h(i,j,k)+h_neglect)*GV%H_to_m) - else ; d_tr = (e_top-e_bot) / ((h(i,j,k)+h_neglect)*GV%H_to_m) + d_tr = 1.0 * (e_top-e(K+1)) / ((h(i,j,k)+h_neglect)*GV%H_to_Z) + else ; d_tr = 1.0 * (e_top-e_bot) / ((h(i,j,k)+h_neglect)*GV%H_to_Z) endif elseif (e_bot < e(K)) then if (e_bot < e(K+1)) then ; d_tr = 1.0 - else ; d_tr = (e(K)-e_bot) / ((h(i,j,k)+h_neglect)*GV%H_to_m) + else ; d_tr = 1.0 * (e(K)-e_bot) / ((h(i,j,k)+h_neglect)*GV%H_to_Z) endif else d_tr = 0.0 From 76a87b41d3626b27aef80e6c8082abd016862463 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 10 Sep 2018 19:32:27 -0400 Subject: [PATCH 096/174] +Added an optional halo argument to make_frazil Added an optional argument to make_frazil and adjust_salt that will cause them to work on an extended region beyond the computational domain. All answers are bitwise identical, but there are new optional arguments to publicly visible subroutines. --- src/parameterizations/vertical/MOM_diabatic_aux.F90 | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index f662eda365..5fa4125fcb 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -77,7 +77,7 @@ module MOM_diabatic_aux !! This subroutine warms any water that is colder than the (currently !! surface) freezing point up to the freezing point and accumulates !! the required heat (in J m-2) in tv%frazil. -subroutine make_frazil(h, tv, G, GV, CS, p_surf) +subroutine make_frazil(h, tv, G, GV, CS, p_surf, halo) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -88,6 +88,7 @@ subroutine make_frazil(h, tv, G, GV, CS, p_surf) !! call to diabatic_aux_init. real, dimension(SZI_(G),SZJ_(G)), & optional, intent(in) :: p_surf !< The pressure at the ocean surface, in Pa. + integer, optional, intent(in) :: halo !< Halo width over which to calculate frazil ! Frazil formation keeps the temperature above the freezing point. ! This subroutine warms any water that is colder than the (currently @@ -113,7 +114,11 @@ subroutine make_frazil(h, tv, G, GV, CS, p_surf) logical :: T_fr_set ! True if the freezing point has been calculated for a ! row of points. integer :: i, j, k, is, ie, js, je, nz + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + if (present(halo)) then + is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo + endif call cpu_clock_begin(id_clock_frazil) @@ -309,7 +314,7 @@ end subroutine differential_diffuse_T_S !> This subroutine keeps salinity from falling below a small but positive threshold. !! This usually occurs when the ice model attempts to extract more salt then !! is actually available to it from the ocean. -subroutine adjust_salt(h, tv, G, GV, CS) +subroutine adjust_salt(h, tv, G, GV, CS, halo) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -318,6 +323,7 @@ subroutine adjust_salt(h, tv, G, GV, CS) !! available thermodynamic fields. type(diabatic_aux_CS), intent(in) :: CS !< The control structure returned by a previous !! call to diabatic_aux_init. + integer, optional, intent(in) :: halo !< Halo width over which to work ! local variables real :: salt_add_col(SZI_(G),SZJ_(G)) !< The accumulated salt requirement @@ -325,6 +331,9 @@ subroutine adjust_salt(h, tv, G, GV, CS) real :: mc !< A layer's mass kg m-2 . integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + if (present(halo)) then + is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo + endif ! call cpu_clock_begin(id_clock_adjust_salt) From fd6fb2e8bd8bf9409aef126f515372075c167524 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 10 Sep 2018 19:34:06 -0400 Subject: [PATCH 097/174] +Added an optional halo argument to geothermal Added an optional argument to geothermal that will cause it to work on an extended region beyond the computational domain, along with a pass_var call on the static geothermal heat flux to enable this to work properly. All answers are bitwise identical, but there is a new optional argument to a publicly visible subroutines. --- src/parameterizations/vertical/MOM_geothermal.F90 | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 360c3a791d..b1fc1fd177 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -5,6 +5,7 @@ module MOM_geothermal use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : register_static_field, time_type, diag_ctrl +use MOM_domains, only : pass_var use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_io, only : MOM_read_data, slasher @@ -44,7 +45,7 @@ module MOM_geothermal !! the partial derivative of the coordinate density with temperature is positive !! or very small, the layers are simply heated in place. Any heat that can not !! be applied to the ocean is returned (WHERE)? -subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS) +subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid !! structure. @@ -69,6 +70,7 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS) type(geothermal_CS), pointer :: CS !< The control structure returned by !! a previous call to !! geothermal_init. + integer, optional, intent(in) :: halo !< Halo width over which to work ! Local variables real, dimension(SZI_(G)) :: & heat_rem, & ! remaining heat (H * degC) @@ -105,6 +107,9 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + if (present(halo)) then + is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo + endif if (.not. associated(CS)) call MOM_error(FATAL, "MOM_geothermal: "//& "Module must be initialized before it is used.") @@ -377,6 +382,7 @@ subroutine geothermal_init(Time, G, param_file, diag, CS) CS%geo_heat(i,j) = G%mask2dT(i,j) * scale enddo ; enddo endif + call pass_var(CS%geo_heat, G%domain) ! post the static geothermal heating field id = register_static_field('ocean_model', 'geo_heat', diag%axesT1, & From 1cc8d7202223876e80ceb264a907d80faad299ad Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 10 Sep 2018 19:34:28 -0400 Subject: [PATCH 098/174] +Added optional halo_TS arg to set_diffusivity_init Added an optional argument to set_diffusivity_init to return the size of the temperature and salinity halos that are expected to be valid to work with the options in set_diffusivity. Also corrected the checksum call for Kv_shear_Bu. All answers are bitwise identical, but there is a new optional argument to a publicly visible subroutine. --- .../vertical/MOM_set_diffusivity.F90 | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 8d3206303c..7ef7f972ec 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -354,7 +354,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (associated(visc%Kv_shear)) visc%Kv_shear(:,:,:) = 0.0 ! needed for other parameterizations if (CS%debug) then call hchksum(visc%Kd_shear, "after calc_KS_vert visc%Kd_shear",G%HI) - call Bchksum(visc%Kv_shear, "after calc_KS_vert visc%Kv_shear_Bu",G%HI) + call Bchksum(visc%Kv_shear_Bu, "after calc_KS_vert visc%Kv_shear_Bu",G%HI) call Bchksum(visc%TKE_turb, "after calc_KS_vert visc%TKE_turb",G%HI) endif else @@ -1892,7 +1892,7 @@ subroutine set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0) end subroutine set_density_ratios subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp, int_tide_CSp, & - tm_CSp) + tm_CSp, halo_TS) type(time_type), intent(in) :: Time !< The current model time type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -1907,6 +1907,8 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp !! structure (BDM) type(tidal_mixing_cs), pointer :: tm_csp !< pointer to tidal mixing control !! structure + integer, optional, intent(out) :: halo_TS !< The halo size of tracer points that must be + !! valid for the calculations in set_diffusivity. ! local variables real :: decay_length @@ -2228,6 +2230,11 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp if (CS%use_CVMix_ddiff) & id_clock_CVMix_ddiff = cpu_clock_id('(Double diffusion via CVMix)', grain=CLOCK_MODULE) + if (present(halo_TS)) then + halo_TS = 0 + if (CS%Vertex_Shear) halo_TS = 1 + endif + end subroutine set_diffusivity_init !> Clear pointers and dealocate memory From 9ede9b61a32119251bc2920388af117a881b222c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 10 Sep 2018 19:35:05 -0400 Subject: [PATCH 099/174] +(*)Corrected halo data when VERTEX_SHEAR=True Added code to work on extra points or do appropriate halo updates for those calls that modify temperatures, salinities and thicknesses before the call to set_diffusivity in both diabatic and legacy_diabatic. All answers are bitwise identical in the existing MOM6 test cases, but this corrects a problem with answers that do not reproduce across PE layouts when VERTEX_SHEAR=True. --- .../vertical/MOM_diabatic_driver.F90 | 36 +++++++++++-------- 1 file changed, 22 insertions(+), 14 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index e3806fd684..5985c6f054 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -154,7 +154,8 @@ module MOM_diabatic_driver !! fluxes are applied, in m. real :: evap_CFL_limit = 0.8 !< The largest fraction of a layer that can be !! evaporated in one time-step (non-dim). - + integer :: halo_TS_diff = 0 !< The temperature, salinity and thickness halo size that + !! must be valid for the diffusivity calculations. logical :: useKPP = .false. !< use CVMix/KPP diffusivities and non-local transport logical :: salt_reject_below_ML !< If true, add salt below mixed layer (layer mode only) logical :: KPPisPassive !< If true, KPP is in passive mode, not changing answers. @@ -379,7 +380,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & integer :: z_ids(7) ! id numbers of diagnostics to be interpolated to depth integer :: dir_flag ! An integer encoding the directions in which to do halo updates. logical :: showCallTree ! If true, show the call tree - integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, m + integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, m, halo integer :: ig, jg ! global indices for testing testing itide point source (BDM) logical :: avg_enabled ! for testing internal tides (BDM) @@ -447,9 +448,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif if (associated(fluxes%p_surf_full)) then - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full) + call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full, halo=CS%halo_TS_diff) else - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp) + call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, halo=CS%halo_TS_diff) endif if (showCallTree) call callTree_waypoint("done with 1st make_frazil (diabatic)") @@ -465,15 +466,16 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%debugConservation) call MOM_state_stats('1st make_frazil', u, v, h, tv%T, tv%S, G) if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then -!$OMP parallel do default(none) shared(is,ie,js,je,nz,h_orig,h,eaml,ebml) - do k=1,nz ; do j=js,je ; do i=is,ie + halo = CS%halo_TS_diff + !$OMP parallel do default(shared) + do k=1,nz ; do j=js-halo,je+halo ; do i=is-halo,ie+halo h_orig(i,j,k) = h(i,j,k) ; eaml(i,j,k) = 0.0 ; ebml(i,j,k) = 0.0 enddo ; enddo ; enddo endif if (CS%use_geothermal) then call cpu_clock_begin(id_clock_geothermal) - call geothermal(h, tv, dt, eaml, ebml, G, GV, CS%geothermal_CSp) + 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) @@ -1258,7 +1260,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en integer :: z_ids(7) ! id numbers of diagnostics to be interpolated to depth integer :: dir_flag ! An integer encoding the directions in which to do halo updates. logical :: showCallTree ! If true, show the call tree - integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, m + integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, m, halo integer :: ig, jg ! global indices for testing testing itide point source (BDM) logical :: avg_enabled ! for testing internal tides (BDM) @@ -1323,9 +1325,9 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en endif if (associated(fluxes%p_surf_full)) then - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full) + call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full, halo=CS%halo_TS_diff) else - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp) + call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, halo=CS%halo_TS_diff) endif if (showCallTree) call callTree_waypoint("done with 1st make_frazil (diabatic)") @@ -1340,15 +1342,16 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%debugConservation) call MOM_state_stats('1st make_frazil', u, v, h, tv%T, tv%S, G) if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then -!$OMP parallel do default(none) shared(is,ie,js,je,nz,h_orig,h,eaml,ebml) - do k=1,nz ; do j=js,je ; do i=is,ie + halo = CS%halo_TS_diff + !$OMP parallel do default(shared) + do k=1,nz ; do j=js-halo,je+halo ; do i=is-halo,ie+halo h_orig(i,j,k) = h(i,j,k) ; eaml(i,j,k) = 0.0 ; ebml(i,j,k) = 0.0 enddo ; enddo ; enddo endif if (CS%use_geothermal) then call cpu_clock_begin(id_clock_geothermal) - call geothermal(h, tv, dt, eaml, ebml, G, GV, CS%geothermal_CSp) + 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) @@ -1478,6 +1481,11 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! Sets: Kd, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S ! Also changes: visc%Kd_shear, visc%TKE_turb (not clear that TKE_turb is used as input ???? ! And sets visc%Kv_shear + if ((CS%halo_TS_diff > 0) .and. (CS%ML_mix_first > 0.0)) then + if (associated(tv%T)) call pass_var(tv%T, G%Domain, halo=CS%halo_TS_diff, complete=.false.) + 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, G, GV, CS%set_diff_CSp, Kd, Kd_int) call cpu_clock_end(id_clock_set_diffusivity) if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") @@ -3277,7 +3285,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, ! initialize module for setting diffusivities call set_diffusivity_init(Time, G, GV, param_file, diag, CS%set_diff_CSp, diag_to_Z_CSp, & - CS%int_tide_CSp, CS%tidal_mixing_CSp) + CS%int_tide_CSp, CS%tidal_mixing_CSp, CS%halo_TS_diff) ! set up the clocks for this module From 7dd4753ee5c1214c564522bfb0273c92f4968453 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 21 Sep 2018 11:28:19 -0400 Subject: [PATCH 100/174] Scale MINIMUM_DEPTH and MASKING_DEPTH when read Changed the code to rescale MINIMUM_DEPTH and MASKING_DEPTH from units of m to Z in their get_param calls in MOM_grid_initialize, rather than doing it later. All answers are bitwise identical. --- src/initialization/MOM_grid_initialize.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index f0626cbd02..2845523654 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -1209,8 +1209,8 @@ subroutine initialize_masks(G, PF) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type type(param_file_type), intent(in) :: PF !< Parameter file structure ! Local variables - real :: Dmin ! The depth for masking in the same units as G%bathyT. - real :: min_depth, mask_depth ! Depths in m. + real :: Dmin ! The depth for masking in the same units as G%bathyT (Z). + real :: min_depth, mask_depth ! Depths in the same units as G%bathyT (Z). character(len=40) :: mdl = "MOM_grid_init initialize_masks" integer :: i, j @@ -1220,14 +1220,14 @@ subroutine initialize_masks(G, PF) "MINIMUM_DEPTH is assumed to be land and all fluxes are masked out.\n"//& "If MASKING_DEPTH is specified, then all depths shallower than\n"//& "MINIMUM_DEPTH but deeper than MASKING_DEPTH are rounded to MINIMUM_DEPTH.", & - units="m", default=0.0) + units="m", default=0.0, scale=1.0/G%Zd_to_m) call get_param(PF, mdl, "MASKING_DEPTH", mask_depth, & "The depth below which to mask points as land points, for which all\n"//& "fluxes are zeroed out. MASKING_DEPTH is ignored if negative.", & - units="m", default=-9999.0) + units="m", default=-9999.0, scale=1.0/G%Zd_to_m) - Dmin = min_depth / G%Zd_to_m - if (mask_depth>=0.) Dmin = mask_depth / G%Zd_to_m + Dmin = min_depth + if (mask_depth>=0.) Dmin = mask_depth G%mask2dCu(:,:) = 0.0 ; G%mask2dCv(:,:) = 0.0 ; G%mask2dBu(:,:) = 0.0 From a034c72dbbf9bae10049063111dcf639e04a8934 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 21 Sep 2018 11:29:22 -0400 Subject: [PATCH 101/174] Do MOM_tracer_initialize_from_Z in units of Z Rescaled the veriables in MOM_tracer_initialization_from_Z to work in units of Z and H instead of m. Also eliminated several unused variables and added or updated the comments describing others. All answers are bitwise identical. --- .../MOM_tracer_initialization_from_Z.F90 | 48 +++++-------------- 1 file changed, 13 insertions(+), 35 deletions(-) diff --git a/src/initialization/MOM_tracer_initialization_from_Z.F90 b/src/initialization/MOM_tracer_initialization_from_Z.F90 index 95041d814d..fb5487780f 100644 --- a/src/initialization/MOM_tracer_initialization_from_Z.F90 +++ b/src/initialization/MOM_tracer_initialization_from_Z.F90 @@ -26,6 +26,7 @@ module MOM_tracer_initialization_from_Z use MOM_remapping, only : remapping_core_h use MOM_verticalGrid, only : verticalGrid_type use MOM_horizontal_regridding, only : myStats, horiz_interp_and_extrap_tracer + implicit none ; private #include @@ -43,7 +44,7 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam, 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 !< Layer thickness, in m. + intent(in) :: h !< Layer thickness, in H (often m or kg m-2). real, dimension(:,:,:), pointer :: tr !< Pointer to array to be initialized type(param_file_type), intent(in) :: PF !< parameter file character(len=*), intent(in) :: src_file !< source filename @@ -64,31 +65,24 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam, character(len=10) :: remapScheme logical :: homog,useALE -! 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_initialize_tracers_from_Z" ! This module's name. integer :: is, ie, js, je, nz ! compute domain indices - integer :: isg, ieg, jsg, jeg ! global extent integer :: isd, ied, jsd, jed ! data domain indices - integer :: i, j, k, kd - - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: zi real, allocatable, dimension(:,:,:), target :: tr_z, mask_z real, allocatable, dimension(:), target :: z_edges_in, z_in ! Local variables for ALE remapping - real, dimension(:), allocatable :: h1, h2, hTarget, deltaE, tmpT1d - real, dimension(:), allocatable :: tmpT1dIn - real :: zTopOfCell, zBottomOfCell, z_bathy ! Heights in m. + real, dimension(:,:,:), allocatable :: hSrc ! Source thicknesses in H units. + real, dimension(:), allocatable :: h1 ! A 1-d column of source thicknesses in Z. + real :: zTopOfCell, zBottomOfCell, z_bathy ! Heights in Z. type(remapping_CS) :: remapCS ! Remapping parameters and work arrays - real, dimension(:,:,:), allocatable :: hSrc - - real :: tempAvg, missing_value - integer :: nPoints, ans + real :: missing_value + integer :: nPoints integer :: id_clock_routine, id_clock_ALE logical :: reentrant_x, tripolar_n @@ -99,7 +93,6 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam, is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - isg = G%isg ; ieg = G%ieg ; jsg = G%jsg ; jeg = G%jeg call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") @@ -118,7 +111,6 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam, reentrant_x = .false. ; call get_param(PF, mdl, "REENTRANT_X", reentrant_x,default=.true.) tripolar_n = .false. ; call get_param(PF, mdl, "TRIPOLAR_N", tripolar_n, default=.false.) - if (PRESENT(homogenize)) homog=homogenize if (PRESENT(useALEremapping)) useALE=useALEremapping if (PRESENT(remappingScheme)) remapScheme=remappingScheme @@ -127,11 +119,11 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam, convert=1.0 if (PRESENT(src_var_unit_conversion)) convert = src_var_unit_conversion - call horiz_interp_and_extrap_tracer(src_file, src_var_nam, convert, recnum, & G, tr_z, mask_z, z_in, z_edges_in, missing_value, reentrant_x, tripolar_n, homog) kd = size(z_edges_in,1)-1 + do k=1,kd+1 ; z_edges_in(k) = GV%m_to_Z*z_edges_in(k) ; enddo call pass_var(tr_z,G%Domain) call pass_var(mask_z,G%Domain) @@ -142,28 +134,19 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam, ! First we reserve a work space for reconstructions of the source data allocate( h1(kd) ) allocate( hSrc(isd:ied,jsd:jed,kd) ) - allocate( tmpT1dIn(kd) ) call initialize_remapping( remapCS, remapScheme, boundary_extrapolation=.false. ) ! Data for reconstructions ! Next we initialize the regridding package so that it knows about the target grid - allocate( hTarget(nz) ) - allocate( h2(nz) ) - allocate( tmpT1d(nz) ) - allocate( deltaE(nz+1) ) do j = js, je ; do i = is, ie if (G%mask2dT(i,j)>0.) then ! Build the source grid zTopOfCell = 0. ; zBottomOfCell = 0. ; nPoints = 0 - z_bathy = G%Zd_to_m*G%bathyT(i,j) + z_bathy = G%bathyT(i,j) do k = 1, kd if (mask_z(i,j,k) > 0.) then zBottomOfCell = -min( z_edges_in(k+1), z_bathy ) - tmpT1dIn(k) = tr_z(i,j,k) elseif (k>1) then zBottomOfCell = -z_bathy - tmpT1dIn(k) = tmpT1dIn(k-1) - else ! This next block should only ever be reached over land - tmpT1dIn(k) = -99.9 endif h1(k) = zTopOfCell - zBottomOfCell if (h1(k)>0.) nPoints = nPoints + 1 @@ -173,21 +156,16 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam, else tr(i,j,:) = 0. endif ! mask2dT - hSrc(i,j,:) = h1(:) + hSrc(i,j,:) = GV%Z_to_H * h1(:) enddo ; enddo call ALE_remap_scalar(remapCS, G, GV, kd, hSrc, tr_z, h, tr, all_cells=.false. ) deallocate( hSrc ) deallocate( h1 ) - deallocate( h2 ) - deallocate( hTarget ) - deallocate( tmpT1d ) - deallocate( tmpT1dIn ) - deallocate( deltaE ) do k=1,nz - call myStats(tr(:,:,k),missing_value,is,ie,js,je,k,'Tracer from ALE()') + call myStats(tr(:,:,k), missing_value, is, ie, js, je, k, 'Tracer from ALE()') enddo call cpu_clock_end(id_clock_ALE) endif ! useALEremapping From 78dc30b337fcc3401b1a044b1d823e9593df28b4 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 21 Sep 2018 18:26:46 -0400 Subject: [PATCH 102/174] Use units of Z in extract_surface_state Changed the code to work in depth (Z) units in extract_surface_state, including storing two H_mix control structure variables in Z units. All answers are bitwise identical. --- src/core/MOM.F90 | 64 +++++++++++++++++++++++++++--------------------- 1 file changed, 36 insertions(+), 28 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index f004bfcbd3..04b3cdc600 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -274,11 +274,11 @@ module MOM ! These elements are used to control the calculation and error checking of the surface state real :: Hmix !< Diagnostic mixed layer thickness over which to - !! average surface tracer properties (in meter) when + !! average surface tracer properties (in depth units, Z) when !! bulk mixed layer is not used, or a negative value !! if a bulk mixed layer is being used. real :: Hmix_UV !< Depth scale over which to average surface flow to - !! feedback to the coupler/driver (m) when + !! feedback to the coupler/driver (in depth units, Z) when !! bulk mixed layer is not used, or a negative value !! if a bulk mixed layer is being used. logical :: check_bad_sfc_vals !< If true, scan surface state for ridiculous values. @@ -1572,7 +1572,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & integer :: nkml, nkbl, verbosity, write_geom integer :: dynamics_stencil ! The computational stencil for the calculations ! in the dynamic core. - real :: conv2watt, conv2salt, H_convert + real :: conv2watt, conv2salt character(len=48) :: flux_units, S_flux_units type(vardesc) :: vd_T, vd_S ! Structures describing temperature and salinity variables. @@ -1751,12 +1751,12 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & "If BULKMIXEDLAYER is false, HMIX_SFC_PROP is the depth \n"//& "over which to average to find surface properties like \n"//& "SST and SSS or density (but not surface velocities).", & - units="m", default=1.0) + units="m", default=1.0) !, scale=GV%m_to_Z) call get_param(param_file, "MOM", "HMIX_UV_SFC_PROP", CS%Hmix_UV, & "If BULKMIXEDLAYER is false, HMIX_UV_SFC_PROP is the depth\n"//& "over which to average to find surface flow properties,\n"//& "SSU, SSV. A non-positive value indicates no averaging.", & - units="m", default=0.) + units="m", default=0.) !, scale=GV%m_to_Z) endif call get_param(param_file, "MOM", "MIN_Z_DIAG_INTERVAL", Z_diag_int, & "The minimum amount of time in seconds between \n"//& @@ -1944,6 +1944,11 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call verticalGridInit( param_file, CS%GV ) GV => CS%GV ! dG%g_Earth = GV%g_Earth + !### These should be merged with the get_param calls, but must follow verticalGridInit. + if (.not.bulkmixedlayer) then + CS%Hmix = CS%Hmix * GV%m_to_Z + CS%Hmix_UV = CS%Hmix_UV * GV%m_to_Z + endif ! Allocate the auxiliary non-symmetric domain for debugging or I/O purposes. if (CS%debug .or. dG%symmetric) & @@ -2001,10 +2006,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & conv2watt = GV%H_to_kg_m2 * CS%tv%C_p if (GV%Boussinesq) then conv2salt = GV%H_to_m ! Could change to GV%H_to_kg_m2 * 0.001? - H_convert = GV%H_to_m else conv2salt = GV%H_to_kg_m2 - H_convert = GV%H_to_kg_m2 endif call register_tracer(CS%tv%T, CS%tracer_Reg, param_file, dG%HI, GV, & tr_desc=vd_T, registry_diags=.true., flux_nameroot='T', & @@ -2675,11 +2678,12 @@ subroutine extract_surface_state(CS, sfc_state) u => NULL(), & ! u : zonal velocity component (m/s) v => NULL(), & ! v : meridional velocity component (m/s) h => NULL() ! h : layer thickness (meter (Bouss) or kg/m2 (non-Bouss)) - real :: depth(SZI_(CS%G)) ! distance from the surface (meter) - real :: depth_ml ! depth over which to average to - ! determine mixed layer properties (meter) - real :: dh ! thickness of a layer within mixed layer (meter) - real :: mass ! mass per unit area of a layer (kg/m2) + real :: depth(SZI_(CS%G)) ! Distance from the surface in depth units (Z) + real :: depth_ml ! Depth over which to average to determine mixed + ! layer properties (Z) + real :: dh ! Thickness of a layer within the mixed layer (Z) + real :: mass ! Mass per unit area of a layer (kg/m2) + real :: bathy_m ! The depth of bathymetry in m (not Z), used for error checking. logical :: use_temperature ! If true, temp and saln used as state variables. integer :: i, j, k, is, ie, js, je, nz, numberOfErrors @@ -2731,7 +2735,8 @@ subroutine extract_surface_state(CS, sfc_state) sfc_state%Hml(i,j) = CS%Hml(i,j) enddo ; enddo ; endif else ! (CS%Hmix >= 0.0) - + !### This calculation should work in thickness (H) units instead of Z, but that + !### would change answers at roundoff in non-Boussinesq cases. depth_ml = CS%Hmix ! Determine the mean tracer properties of the uppermost depth_ml fluid. !$OMP parallel do default(shared) private(depth,dh) @@ -2746,8 +2751,8 @@ subroutine extract_surface_state(CS, sfc_state) enddo do k=1,nz ; do i=is,ie - if (depth(i) + h(i,j,k)*GV%H_to_m < depth_ml) then - dh = h(i,j,k)*GV%H_to_m + if (depth(i) + h(i,j,k)*GV%H_to_Z < depth_ml) then + dh = h(i,j,k)*GV%H_to_Z elseif (depth(i) < depth_ml) then dh = depth_ml - depth(i) else @@ -2763,20 +2768,22 @@ subroutine extract_surface_state(CS, sfc_state) enddo ; enddo ! Calculate the average properties of the mixed layer depth. do i=is,ie - if (depth(i) < GV%H_subroundoff*GV%H_to_m) & - depth(i) = GV%H_subroundoff*GV%H_to_m + if (depth(i) < GV%H_subroundoff*GV%H_to_Z) & + depth(i) = GV%H_subroundoff*GV%H_to_Z if (use_temperature) then sfc_state%SST(i,j) = sfc_state%SST(i,j) / depth(i) sfc_state%SSS(i,j) = sfc_state%SSS(i,j) / depth(i) else sfc_state%sfc_density(i,j) = sfc_state%sfc_density(i,j) / depth(i) endif - sfc_state%Hml(i,j) = depth(i) + sfc_state%Hml(i,j) = GV%Z_to_m * depth(i) enddo enddo ! end of j loop ! Determine the mean velocities in the uppermost depth_ml fluid. if (CS%Hmix_UV>0.) then + !### This calculation should work in thickness (H) units instead of Z, but that + !### would change answers at roundoff in non-Boussinesq cases. depth_ml = CS%Hmix_UV !$OMP parallel do default(shared) private(depth,dh,hv) do J=jscB,jecB @@ -2785,7 +2792,7 @@ subroutine extract_surface_state(CS, sfc_state) sfc_state%v(i,J) = 0.0 enddo do k=1,nz ; do i=is,ie - hv = 0.5 * (h(i,j,k) + h(i,j+1,k)) * GV%H_to_m + hv = 0.5 * (h(i,j,k) + h(i,j+1,k)) * GV%H_to_Z if (depth(i) + hv < depth_ml) then dh = hv elseif (depth(i) < depth_ml) then @@ -2798,8 +2805,8 @@ subroutine extract_surface_state(CS, sfc_state) enddo ; enddo ! Calculate the average properties of the mixed layer depth. do i=is,ie - if (depth(i) < GV%H_subroundoff*GV%H_to_m) & - depth(i) = GV%H_subroundoff*GV%H_to_m + if (depth(i) < GV%H_subroundoff*GV%H_to_Z) & + depth(i) = GV%H_subroundoff*GV%H_to_Z sfc_state%v(i,J) = sfc_state%v(i,J) / depth(i) enddo enddo ! end of j loop @@ -2811,7 +2818,7 @@ subroutine extract_surface_state(CS, sfc_state) sfc_state%u(I,j) = 0.0 enddo do k=1,nz ; do I=iscB,iecB - hu = 0.5 * (h(i,j,k) + h(i+1,j,k)) * GV%H_to_m + hu = 0.5 * (h(i,j,k) + h(i+1,j,k)) * GV%H_to_Z if (depth(i) + hu < depth_ml) then dh = hu elseif (depth(I) < depth_ml) then @@ -2824,8 +2831,8 @@ subroutine extract_surface_state(CS, sfc_state) enddo ; enddo ! Calculate the average properties of the mixed layer depth. do I=iscB,iecB - if (depth(I) < GV%H_subroundoff*GV%H_to_m) & - depth(I) = GV%H_subroundoff*GV%H_to_m + if (depth(I) < GV%H_subroundoff*GV%H_to_Z) & + depth(I) = GV%H_subroundoff*GV%H_to_Z sfc_state%u(I,j) = sfc_state%u(I,j) / depth(I) enddo enddo ! end of j loop @@ -2900,10 +2907,11 @@ subroutine extract_surface_state(CS, sfc_state) numberOfErrors=0 ! count number of errors do j=js,je; do i=is,ie if (G%mask2dT(i,j)>0.) then - localError = sfc_state%sea_lev(i,j)<=-G%Zd_to_m*G%bathyT(i,j) & + bathy_m = G%Zd_to_m*G%bathyT(i,j) + localError = sfc_state%sea_lev(i,j)<=-bathy_m & .or. sfc_state%sea_lev(i,j)>= CS%bad_val_ssh_max & .or. sfc_state%sea_lev(i,j)<=-CS%bad_val_ssh_max & - .or. sfc_state%sea_lev(i,j) + G%Zd_to_m*G%bathyT(i,j) < CS%bad_vol_col_thick + .or. sfc_state%sea_lev(i,j) + bathy_m < CS%bad_vol_col_thick if (use_temperature) localError = localError & .or. sfc_state%SSS(i,j)<0. & .or. sfc_state%SSS(i,j)>=CS%bad_val_sss_max & @@ -2916,7 +2924,7 @@ subroutine extract_surface_state(CS, sfc_state) write(msg(1:240),'(2(a,i4,x),2(a,f8.3,x),8(a,es11.4,x))') & 'Extreme surface sfc_state detected: i=',i,'j=',j, & 'x=',G%geoLonT(i,j), 'y=',G%geoLatT(i,j), & - 'D=',G%Zd_to_m*G%bathyT(i,j), 'SSH=',sfc_state%sea_lev(i,j), & + 'D=',bathy_m, 'SSH=',sfc_state%sea_lev(i,j), & 'SST=',sfc_state%SST(i,j), 'SSS=',sfc_state%SSS(i,j), & 'U-=',sfc_state%u(I-1,j), 'U+=',sfc_state%u(I,j), & 'V-=',sfc_state%v(i,J-1), 'V+=',sfc_state%v(i,J) @@ -2924,7 +2932,7 @@ subroutine extract_surface_state(CS, sfc_state) write(msg(1:240),'(2(a,i4,x),2(a,f8.3,x),6(a,es11.4))') & 'Extreme surface sfc_state detected: i=',i,'j=',j, & 'x=',G%geoLonT(i,j), 'y=',G%geoLatT(i,j), & - 'D=',G%Zd_to_m*G%bathyT(i,j), 'SSH=',sfc_state%sea_lev(i,j), & + 'D=',bathy_m, 'SSH=',sfc_state%sea_lev(i,j), & 'U-=',sfc_state%u(I-1,j), 'U+=',sfc_state%u(I,j), & 'V-=',sfc_state%v(i,J-1), 'V+=',sfc_state%v(i,J) endif From ea8a7704f76dbe2f05691acf8f38c3b089167f2e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 21 Sep 2018 18:27:46 -0400 Subject: [PATCH 103/174] Refactored code inside Set_pbce_Bous for clarity Relocated an internal factor in the expression for pbce for greater clarity of where the unit conversion factors come in. All answers are bitwise identical. --- src/core/MOM_PressureForce_Montgomery.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 6d094349ae..4ed4438d58 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -686,12 +686,12 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star !$OMP parallel do default(share) private(Ihtot) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - Ihtot(i) = GV%H_to_m / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect) + Ihtot(i) = 1.0 / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect) pbce(i,j,1) = GV%g_prime(1) * GV%H_to_m enddo do k=2,nz ; do i=Isq,Ieq+1 pbce(i,j,k) = pbce(i,j,k-1) + & - GV%g_prime(K) * ((e(i,j,K) - e(i,j,nz+1)) * Ihtot(i)) + (GV%g_prime(K)*GV%H_to_m) * ((e(i,j,K) - e(i,j,nz+1)) * Ihtot(i)) enddo ; enddo enddo ! end of j loop endif ! use_EOS From 4fcdeacaa995f4722cf5c435d8378fe76ea096f2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 22 Sep 2018 04:11:01 -0400 Subject: [PATCH 104/174] Replaced the variable mod with mdl in 7 modules Replaced variables mod with mdl in 7 modules to avoid a potential namespace conflict with the intrinsic mod function, and for greater standardization across the MOM6 code. All answers are bitwise identical. --- .../solo_driver/Neverland_surface_forcing.F90 | 16 +-- src/ALE/MOM_regridding.F90 | 118 +++++++++--------- src/framework/MOM_diag_mediator.F90 | 18 +-- .../vertical/MOM_diabatic_aux.F90 | 18 +-- .../vertical/MOM_diabatic_driver.F90 | 70 +++++------ .../vertical/MOM_entrain_diffusive.F90 | 14 +-- src/user/Neverland_initialization.F90 | 10 +- 7 files changed, 132 insertions(+), 132 deletions(-) diff --git a/config_src/solo_driver/Neverland_surface_forcing.F90 b/config_src/solo_driver/Neverland_surface_forcing.F90 index e6111b2a19..326b807293 100644 --- a/config_src/solo_driver/Neverland_surface_forcing.F90 +++ b/config_src/solo_driver/Neverland_surface_forcing.F90 @@ -218,7 +218,7 @@ subroutine Neverland_surface_forcing_init(Time, G, param_file, diag, CS) ! This include declares and sets the variable "version". #include "version_variable.h" ! Local variables - character(len=40) :: mod = "Neverland_surface_forcing" ! This module's name. + character(len=40) :: mdl = "Neverland_surface_forcing" ! This module's name. if (associated(CS)) then call MOM_error(WARNING, "Neverland_surface_forcing_init called with an associated "// & @@ -229,31 +229,31 @@ subroutine Neverland_surface_forcing_init(Time, G, param_file, diag, CS) CS%diag => diag ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "ENABLE_THERMODYNAMICS", CS%use_temperature, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", CS%use_temperature, & "If true, Temperature and salinity are used as state \n"//& "variables.", default=.true.) - call get_param(param_file, mod, "G_EARTH", CS%G_Earth, & + call get_param(param_file, mdl, "G_EARTH", CS%G_Earth, & "The gravitational acceleration of the Earth.", & units="m s-2", default = 9.80) - call get_param(param_file, mod, "RHO_0", CS%Rho0, & + call get_param(param_file, mdl, "RHO_0", CS%Rho0, & "The mean ocean density used with BOUSSINESQ true to \n"//& "calculate accelerations and the mass for conservation \n"//& "properties, or with BOUSSINSEQ false to convert some \n"//& "parameters from vertical units of m to kg m-2.", & units="kg m-3", default=1035.0) -! call get_param(param_file, mod, "GUST_CONST", CS%gust_const, & +! call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & ! "The background gustiness in the winds.", units="Pa", & ! default=0.02) - call get_param(param_file, mod, "RESTOREBUOY", CS%restorebuoy, & + call get_param(param_file, mdl, "RESTOREBUOY", CS%restorebuoy, & "If true, the buoyancy fluxes drive the model back \n"//& "toward some specified surface state with a rate \n"//& "given by FLUXCONST.", default= .false.) if (CS%restorebuoy) then - call get_param(param_file, mod, "FLUXCONST", CS%flux_const, & + call get_param(param_file, mdl, "FLUXCONST", CS%flux_const, & "The constant that relates the restoring surface fluxes \n"//& "to the relative surface anomalies (akin to a piston \n"//& "velocity). Note the non-MKS units.", units="m day-1", & diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index 9cf69a2485..1e7da482a3 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -164,12 +164,12 @@ module MOM_regridding contains !> Initialization and configures a regridding control structure based on customizable run-time parameters -subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, param_prefix, param_suffix) +subroutine initialize_regridding(CS, GV, max_depth, param_file, mdl, coord_mode, param_prefix, param_suffix) type(regridding_CS), intent(inout) :: CS !< Regridding control structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure real, intent(in) :: max_depth !< The maximum depth of the ocean, in m. type(param_file_type), intent(in) :: param_file !< Parameter file - character(len=*), intent(in) :: mod !< Name of calling module. + character(len=*), intent(in) :: mdl !< Name of calling module. character(len=*), intent(in) :: coord_mode !< Coordinate mode character(len=*), intent(in) :: param_prefix !< String to prefix to parameter names. !! If empty, causes main model parameters to be used. @@ -199,12 +199,12 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, 250., 375., 500., 500., 500., 500., 500., 500., & 500., 500., 500., 500., 500., 500., 500., 500. /) - call get_param(param_file, mod, "INPUTDIR", inputdir, default=".") + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) main_parameters=.false. if (len_trim(param_prefix)==0) main_parameters=.true. - if (main_parameters .and. len_trim(param_suffix)>0) call MOM_error(FATAL,trim(mod)//', initialize_regridding: '// & + if (main_parameters .and. len_trim(param_suffix)>0) call MOM_error(FATAL,trim(mdl)//', initialize_regridding: '// & 'Suffix provided without prefix for parameter names!') CS%nk = 0 @@ -213,7 +213,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, if (main_parameters) then ! Read coordinate units parameter (main model = REGRIDDING_COORDINATE_UNITS) - call get_param(param_file, mod, "REGRIDDING_COORDINATE_UNITS", coord_units, & + call get_param(param_file, mdl, "REGRIDDING_COORDINATE_UNITS", coord_units, & "Units of the regridding coordinuate.",& default=coordinateUnits(coord_mode)) else @@ -228,7 +228,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, param_name = trim(param_prefix)//"_INTERP_SCHEME_"//trim(param_suffix) string2 = 'PPM_H4' ! Default for diagnostics endif - call get_param(param_file, mod, "INTERPOLATION_SCHEME", string, & + call get_param(param_file, mdl, "INTERPOLATION_SCHEME", string, & "This sets the interpolation scheme to use to\n"//& "determine the new grid. These parameters are\n"//& "only relevant when REGRIDDING_COORDINATE_MODE is\n"//& @@ -239,7 +239,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, endif if (main_parameters .and. coord_is_state_dependent) then - call get_param(param_file, mod, "BOUNDARY_EXTRAPOLATION", tmpLogical, & + call get_param(param_file, mdl, "BOUNDARY_EXTRAPOLATION", tmpLogical, & "When defined, a proper high-order reconstruction\n"//& "scheme is used within boundary cells rather\n"//& "than PCM. E.g., if PPM is used for remapping, a\n"//& @@ -261,7 +261,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, string2 = 'UNIFORM' if (max_depth>3000.) string2='WOA09' ! For convenience endif - call get_param(param_file, mod, param_name, string, & + call get_param(param_file, mdl, param_name, string, & "Determines how to specify the coordinate\n"//& "resolution. Valid options are:\n"//& " PARAM - use the vector-parameter "//trim(coord_res_param)//"\n"//& @@ -291,7 +291,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, ke = extract_integer(string(9:len_trim(string)),'',1) tmpReal = extract_real(string(9:len_trim(string)),',',2,missing_value=max_depth) else - call MOM_error(FATAL,trim(mod)//', initialize_regridding: '// & + call MOM_error(FATAL,trim(mdl)//', initialize_regridding: '// & 'Unable to interpret "'//trim(string)//'".') endif allocate(dz(ke)) @@ -302,13 +302,13 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, GV%Rlay(1)+0.5*(GV%Rlay(1)-GV%Rlay(2)), & GV%Rlay(ke)+0.5*(GV%Rlay(ke)-GV%Rlay(ke-1)) ) endif - if (main_parameters) call log_param(param_file, mod, "!"//coord_res_param, dz, & + if (main_parameters) call log_param(param_file, mdl, "!"//coord_res_param, dz, & trim(message), units=trim(coord_units)) elseif (trim(string)=='PARAM') then ! Read coordinate resolution (main model = ALE_RESOLUTION) ke = GV%ke ! Use model nk by default allocate(dz(ke)) - call get_param(param_file, mod, coord_res_param, dz, & + call get_param(param_file, mdl, coord_res_param, dz, & trim(message), units=trim(coord_units), fail_if_missing=.true.) elseif (index(trim(string),'FILE:')==1) then ! FILE:filename,var_name is assumed to be reading level thickness variables @@ -320,7 +320,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, ! Otherwise assume we should look for the file in INPUTDIR fileName = trim(inputdir) // trim( extractWord(trim(string(6:80)), 1) ) endif - if (.not. file_exists(fileName)) call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// & + if (.not. file_exists(fileName)) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & "Specified file not found: Looking for '"//trim(fileName)//"' ("//trim(string)//")") varName = trim( extractWord(trim(string(6:)), 2) ) @@ -328,12 +328,12 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, if (field_exists(fileName,'dz')) then; varName = 'dz' elseif (field_exists(fileName,'dsigma')) then; varName = 'dsigma' elseif (field_exists(fileName,'ztest')) then; varName = 'ztest' - else ; call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// & + else ; call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & "Coordinate variable not specified and none could be guessed.") endif endif ! This check fails when the variable is a dimension variable! -AJA - !if (.not. field_exists(fileName,trim(varName))) call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// & + !if (.not. field_exists(fileName,trim(varName))) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & ! "Specified field not found: Looking for '"//trim(varName)//"' ("//trim(string)//")") if (CS%regridding_scheme == REGRIDDING_SIGMA) then expected_units = 'nondim' @@ -345,7 +345,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, if (index(trim(varName),'interfaces=')==1) then varName=trim(varName(12:)) call check_grid_def(filename, varName, expected_units, message, ierr) - if (ierr) call MOM_error(FATAL,trim(mod)//", initialize_regridding: "//& + if (ierr) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "//& "Unsupported format in grid definition '"//trim(filename)//"'. Error message "//trim(message)) call field_size(trim(fileName), trim(varName), nzf) ke = nzf(1)-1 @@ -367,15 +367,15 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, call MOM_read_data(trim(fileName), trim(varName), dz) endif if (main_parameters .and. ke/=GV%ke) then - call MOM_error(FATAL,trim(mod)//', initialize_regridding: '// & + call MOM_error(FATAL,trim(mdl)//', initialize_regridding: '// & 'Mismatch in number of model levels and "'//trim(string)//'".') endif - if (main_parameters) call log_param(param_file, mod, "!"//coord_res_param, dz, & + if (main_parameters) call log_param(param_file, mdl, "!"//coord_res_param, dz, & trim(message), units=coordinateUnits(coord_mode)) elseif (index(trim(string),'FNC1:')==1) then ke = GV%ke; allocate(dz(ke)) call dz_function1( trim(string(6:)), dz ) - if (main_parameters) call log_param(param_file, mod, "!"//coord_res_param, dz, & + if (main_parameters) call log_param(param_file, mdl, "!"//coord_res_param, dz, & trim(message), units=coordinateUnits(coord_mode)) elseif (index(trim(string),'RFNC1:')==1) then ! Function used for set target interface densities @@ -386,24 +386,24 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, allocate(rho_target(ke+1)) fileName = trim( extractWord(trim(string(8:)), 1) ) if (fileName(1:1)/='.' .and. filename(1:1)/='/') fileName = trim(inputdir) // trim( fileName ) - if (.not. file_exists(fileName)) call MOM_error(FATAL,trim(mod)//", initialize_regridding: HYBRID "// & + if (.not. file_exists(fileName)) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: HYBRID "// & "Specified file not found: Looking for '"//trim(fileName)//"' ("//trim(string)//")") varName = trim( extractWord(trim(string(8:)), 2) ) - if (.not. field_exists(fileName,varName)) call MOM_error(FATAL,trim(mod)//", initialize_regridding: HYBRID "// & + if (.not. field_exists(fileName,varName)) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: HYBRID "// & "Specified field not found: Looking for '"//trim(varName)//"' ("//trim(string)//")") call MOM_read_data(trim(fileName), trim(varName), rho_target) varName = trim( extractWord(trim(string(8:)), 3) ) if (varName(1:5) == 'FNC1:') then ! Use FNC1 to calculate dz call dz_function1( trim(string((index(trim(string),'FNC1:')+5):)), dz ) else ! Read dz from file - if (.not. field_exists(fileName,varName)) call MOM_error(FATAL,trim(mod)//", initialize_regridding: HYBRID "// & + if (.not. field_exists(fileName,varName)) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: HYBRID "// & "Specified field not found: Looking for '"//trim(varName)//"' ("//trim(string)//")") call MOM_read_data(trim(fileName), trim(varName), dz) endif if (main_parameters) then - call log_param(param_file, mod, "!"//coord_res_param, dz, & + call log_param(param_file, mdl, "!"//coord_res_param, dz, & trim(message), units=coordinateUnits(coord_mode)) - call log_param(param_file, mod, "!TARGET_DENSITIES", rho_target, & + call log_param(param_file, mdl, "!TARGET_DENSITIES", rho_target, & 'HYBRID target densities for itnerfaces', units=coordinateUnits(coord_mode)) endif elseif (index(trim(string),'WOA09')==1) then @@ -414,16 +414,16 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, tmpReal = tmpReal + woa09_dz(ke) enddo elseif (index(trim(string),'WOA09:')==1) then - if (len_trim(string)==6) call MOM_error(FATAL,trim(mod)//', initialize_regridding: '// & + if (len_trim(string)==6) call MOM_error(FATAL,trim(mdl)//', initialize_regridding: '// & 'Expected string of form "WOA09:N" but got "'//trim(string)//'".') ke = extract_integer(string(7:len_trim(string)),'',1) endif - if (ke>40 .or. ke<1) call MOM_error(FATAL,trim(mod)//', initialize_regridding: '// & + if (ke>40 .or. ke<1) call MOM_error(FATAL,trim(mdl)//', initialize_regridding: '// & 'For "WOA05:N" N must 0 0. ) then dz(ke) = dz(ke) + ( max_depth - tmpReal ) else - call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// & + call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & "MAXIMUM_DEPTH was too shallow to adjust bottom layer of DZ!"//trim(string)) endif endif @@ -466,7 +466,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, ! \todo This line looks like it would overwrite the target densities set just above? elseif (coordinateMode(coord_mode) == REGRIDDING_RHO) then call set_target_densities_from_GV(GV, CS) - call log_param(param_file, mod, "!TARGET_DENSITIES", CS%target_density, & + call log_param(param_file, mdl, "!TARGET_DENSITIES", CS%target_density, & 'RHO target densities for interfaces', units=coordinateUnits(coord_mode)) endif @@ -474,7 +474,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, call initCoord(CS, coord_mode) if (main_parameters .and. coord_is_state_dependent) then - call get_param(param_file, mod, "REGRID_COMPRESSIBILITY_FRACTION", tmpReal, & + call get_param(param_file, mdl, "REGRID_COMPRESSIBILITY_FRACTION", tmpReal, & "When interpolating potential density profiles we can add\n"//& "some artificial compressibility solely to make homogenous\n"//& "regions appear stratified.", default=0.) @@ -482,7 +482,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, endif if (main_parameters) then - call get_param(param_file, mod, "MIN_THICKNESS", tmpReal, & + call get_param(param_file, mdl, "MIN_THICKNESS", tmpReal, & "When regridding, this is the minimum layer\n"//& "thickness allowed.", units="m",& default=regriddingDefaultMinThickness ) @@ -493,21 +493,21 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, if (coordinateMode(coord_mode) == REGRIDDING_SLIGHT) then ! Set SLight-specific regridding parameters. - call get_param(param_file, mod, "SLIGHT_DZ_SURFACE", dz_fixed_sfc, & + call get_param(param_file, mdl, "SLIGHT_DZ_SURFACE", dz_fixed_sfc, & "The nominal thickness of fixed thickness near-surface\n"//& "layers with the SLight coordinate.", units="m", default=1.0) - call get_param(param_file, mod, "SLIGHT_NZ_SURFACE_FIXED", nz_fixed_sfc, & + call get_param(param_file, mdl, "SLIGHT_NZ_SURFACE_FIXED", nz_fixed_sfc, & "The number of fixed-depth surface layers with the SLight\n"//& "coordinate.", units="nondimensional", default=2) - call get_param(param_file, mod, "SLIGHT_SURFACE_AVG_DEPTH", Rho_avg_depth, & + call get_param(param_file, mdl, "SLIGHT_SURFACE_AVG_DEPTH", Rho_avg_depth, & "The thickness of the surface region over which to average\n"//& "when calculating the density to use to define the interior\n"//& "with the SLight coordinate.", units="m", default=1.0) - call get_param(param_file, mod, "SLIGHT_NLAY_TO_INTERIOR", nlay_sfc_int, & + call get_param(param_file, mdl, "SLIGHT_NLAY_TO_INTERIOR", nlay_sfc_int, & "The number of layers to offset the surface density when\n"//& "defining where the interior ocean starts with SLight.", & units="nondimensional", default=2.0) - call get_param(param_file, mod, "SLIGHT_FIX_HALOCLINES", fix_haloclines, & + call get_param(param_file, mdl, "SLIGHT_FIX_HALOCLINES", fix_haloclines, & "If true, identify regions above the reference pressure\n"//& "where the reference pressure systematically underestimates\n"//& "the stratification and use this in the definition of the\n"//& @@ -518,11 +518,11 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, nlay_ML_to_interior=nlay_sfc_int, fix_haloclines=fix_haloclines) if (fix_haloclines) then ! Set additional parameters related to SLIGHT_FIX_HALOCLINES. - call get_param(param_file, mod, "HALOCLINE_FILTER_LENGTH", filt_len, & + call get_param(param_file, mdl, "HALOCLINE_FILTER_LENGTH", filt_len, & "A length scale over which to smooth the temperature and\n"//& "salinity before identifying erroneously unstable haloclines.", & units="m", default=2.0) - call get_param(param_file, mod, "HALOCLINE_STRAT_TOL", strat_tol, & + call get_param(param_file, mdl, "HALOCLINE_STRAT_TOL", strat_tol, & "A tolerance for the ratio of the stratification of the\n"//& "apparent coordinate stratification to the actual value\n"//& "that is used to identify erroneously unstable haloclines.\n"//& @@ -535,20 +535,20 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, endif if (coordinateMode(coord_mode) == REGRIDDING_ADAPTIVE) then - call get_param(param_file, mod, "ADAPT_TIME_RATIO", adaptTimeRatio, & + call get_param(param_file, mdl, "ADAPT_TIME_RATIO", adaptTimeRatio, & "Ratio of ALE timestep to grid timescale.", units="s", default=1e-1) !### Should the units be "nondim"? - call get_param(param_file, mod, "ADAPT_ZOOM_DEPTH", adaptZoom, & + call get_param(param_file, mdl, "ADAPT_ZOOM_DEPTH", adaptZoom, & "Depth of near-surface zooming region.", units="m", default=200.0) - call get_param(param_file, mod, "ADAPT_ZOOM_COEFF", adaptZoomCoeff, & + call get_param(param_file, mdl, "ADAPT_ZOOM_COEFF", adaptZoomCoeff, & "Coefficient of near-surface zooming diffusivity.", & units="nondim", default=0.2) - call get_param(param_file, mod, "ADAPT_BUOY_COEFF", adaptBuoyCoeff, & + call get_param(param_file, mdl, "ADAPT_BUOY_COEFF", adaptBuoyCoeff, & "Coefficient of buoyancy diffusivity.", & units="nondim", default=0.8) - call get_param(param_file, mod, "ADAPT_ALPHA", adaptAlpha, & + call get_param(param_file, mdl, "ADAPT_ALPHA", adaptAlpha, & "Scaling on optimization tendency.", & units="nondim", default=1.0) - call get_param(param_file, mod, "ADAPT_DO_MIN_DEPTH", tmpLogical, & + call get_param(param_file, mdl, "ADAPT_DO_MIN_DEPTH", tmpLogical, & "If true, make a HyCOM-like mixed layer by preventing interfaces\n"//& "from being shallower than the depths specified by the regridding coordinate.", & default=.false.) @@ -559,7 +559,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, endif if (main_parameters .and. coord_is_state_dependent) then - call get_param(param_file, mod, "MAXIMUM_INT_DEPTH_CONFIG", string, & + call get_param(param_file, mdl, "MAXIMUM_INT_DEPTH_CONFIG", string, & "Determines how to specify the maximum interface depths.\n"//& "Valid options are:\n"//& " NONE - there are no maximum interface depths\n"//& @@ -575,7 +575,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, if ( trim(string) == "NONE") then ! Do nothing. elseif ( trim(string) == "PARAM") then - call get_param(param_file, mod, "MAXIMUM_INTERFACE_DEPTHS", z_max, & + call get_param(param_file, mdl, "MAXIMUM_INTERFACE_DEPTHS", z_max, & trim(message), units="m", fail_if_missing=.true.) call set_regrid_max_depths(CS, z_max, GV%m_to_H) elseif (index(trim(string),'FILE:')==1) then @@ -586,18 +586,18 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, ! Otherwise assume we should look for the file in INPUTDIR fileName = trim(inputdir) // trim( extractWord(trim(string(6:80)), 1) ) endif - if (.not. file_exists(fileName)) call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// & + if (.not. file_exists(fileName)) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & "Specified file not found: Looking for '"//trim(fileName)//"' ("//trim(string)//")") do_sum = .false. varName = trim( extractWord(trim(string(6:)), 2) ) - if (.not. field_exists(fileName,varName)) call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// & + if (.not. field_exists(fileName,varName)) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & "Specified field not found: Looking for '"//trim(varName)//"' ("//trim(string)//")") if (len_trim(varName)==0) then if (field_exists(fileName,'z_max')) then; varName = 'z_max' elseif (field_exists(fileName,'dz')) then; varName = 'dz' ; do_sum = .true. elseif (field_exists(fileName,'dz_max')) then; varName = 'dz_max' ; do_sum = .true. - else ; call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// & + else ; call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & "MAXIMUM_INT_DEPTHS variable not specified and none could be guessed.") endif endif @@ -607,7 +607,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, else call MOM_read_data(trim(fileName), trim(varName), z_max) endif - call log_param(param_file, mod, "!MAXIMUM_INT_DEPTHS", z_max, & + call log_param(param_file, mdl, "!MAXIMUM_INT_DEPTHS", z_max, & trim(message), units=coordinateUnits(coord_mode)) call set_regrid_max_depths(CS, z_max, GV%m_to_H) elseif (index(trim(string),'FNC1:')==1) then @@ -617,11 +617,11 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, do k=1,nz_fixed_sfc ; dz_max(k) = dz_fixed_sfc ; enddo endif z_max(1) = 0.0 ; do K=1,ke ; z_max(K+1) = z_max(K) + dz_max(K) ; enddo - call log_param(param_file, mod, "!MAXIMUM_INT_DEPTHS", z_max, & + call log_param(param_file, mdl, "!MAXIMUM_INT_DEPTHS", z_max, & trim(message), units=coordinateUnits(coord_mode)) call set_regrid_max_depths(CS, z_max, GV%m_to_H) else - call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// & + call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & "Unrecognized MAXIMUM_INT_DEPTH_CONFIG "//trim(string)) endif deallocate(z_max) @@ -629,7 +629,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, ! Optionally specify maximum thicknesses for each layer, enforced by moving ! the interface below a layer downward. - call get_param(param_file, mod, "MAX_LAYER_THICKNESS_CONFIG", string, & + call get_param(param_file, mdl, "MAX_LAYER_THICKNESS_CONFIG", string, & "Determines how to specify the maximum layer thicknesses.\n"//& "Valid options are:\n"//& " NONE - there are no maximum layer thicknesses\n"//& @@ -644,7 +644,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, if ( trim(string) == "NONE") then ! Do nothing. elseif ( trim(string) == "PARAM") then - call get_param(param_file, mod, "MAX_LAYER_THICKNESS", h_max, & + call get_param(param_file, mdl, "MAX_LAYER_THICKNESS", h_max, & trim(message), units="m", fail_if_missing=.true.) call set_regrid_max_thickness(CS, h_max, GV%m_to_H) elseif (index(trim(string),'FILE:')==1) then @@ -655,30 +655,30 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, ! Otherwise assume we should look for the file in INPUTDIR fileName = trim(inputdir) // trim( extractWord(trim(string(6:80)), 1) ) endif - if (.not. file_exists(fileName)) call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// & + if (.not. file_exists(fileName)) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & "Specified file not found: Looking for '"//trim(fileName)//"' ("//trim(string)//")") varName = trim( extractWord(trim(string(6:)), 2) ) - if (.not. field_exists(fileName,varName)) call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// & + if (.not. field_exists(fileName,varName)) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & "Specified field not found: Looking for '"//trim(varName)//"' ("//trim(string)//")") if (len_trim(varName)==0) then if (field_exists(fileName,'h_max')) then; varName = 'h_max' elseif (field_exists(fileName,'dz_max')) then; varName = 'dz_max' - else ; call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// & + else ; call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & "MAXIMUM_INT_DEPTHS variable not specified and none could be guessed.") endif endif call MOM_read_data(trim(fileName), trim(varName), h_max) - call log_param(param_file, mod, "!MAX_LAYER_THICKNESS", h_max, & + call log_param(param_file, mdl, "!MAX_LAYER_THICKNESS", h_max, & trim(message), units=coordinateUnits(coord_mode)) call set_regrid_max_thickness(CS, h_max, GV%m_to_H) elseif (index(trim(string),'FNC1:')==1) then call dz_function1( trim(string(6:)), h_max ) - call log_param(param_file, mod, "!MAX_LAYER_THICKNESS", h_max, & + call log_param(param_file, mdl, "!MAX_LAYER_THICKNESS", h_max, & trim(message), units=coordinateUnits(coord_mode)) call set_regrid_max_thickness(CS, h_max, GV%m_to_H) else - call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// & + call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & "Unrecognized MAX_LAYER_THICKNESS_CONFIG "//trim(string)) endif deallocate(h_max) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 6fb42e9df0..a4c1787855 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -2190,7 +2190,7 @@ subroutine diag_mediator_init(G, GV, nz, param_file, diag_cs, doc_file_dir) character(len=240), allocatable :: diag_coords(:) ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_diag_mediator" ! This module's name. + character(len=40) :: mdl = "MOM_diag_mediator" ! This module's name. id_clock_diag_mediator = cpu_clock_id('(Ocean diagnostics framework)', grain=CLOCK_MODULE) id_clock_diag_remap = cpu_clock_id('(Ocean diagnostics remapping)', grain=CLOCK_ROUTINE) @@ -2204,22 +2204,22 @@ subroutine diag_mediator_init(G, GV, nz, param_file, diag_cs, doc_file_dir) enddo ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") + call log_version(param_file, mdl, version, "") - call get_param(param_file, mod, 'NUM_DIAG_COORDS', diag_cs%num_diag_coords, & + call get_param(param_file, mdl, 'NUM_DIAG_COORDS', diag_cs%num_diag_coords, & 'The number of diagnostic vertical coordinates to use.\n'//& 'For each coordinate, an entry in DIAG_COORDS must be provided.', & default=1) if (diag_cs%num_diag_coords>0) then allocate(diag_coords(diag_cs%num_diag_coords)) if (diag_cs%num_diag_coords==1) then ! The default is to provide just one instance of Z* - call get_param(param_file, mod, 'DIAG_COORDS', diag_coords, & + call get_param(param_file, mdl, 'DIAG_COORDS', diag_coords, & 'A list of string tuples associating diag_table modules to\n'//& 'a coordinate definition used for diagnostics. Each string\n'//& 'is of the form "MODULE_SUFFIX PARAMETER_SUFFIX COORDINATE_NAME".', & default='z Z ZSTAR') else ! If using more than 1 diagnostic coordinate, all must be explicitly defined - call get_param(param_file, mod, 'DIAG_COORDS', diag_coords, & + call get_param(param_file, mdl, 'DIAG_COORDS', diag_coords, & 'A list of string tuples associating diag_table modules to\n'//& 'a coordinate definition used for diagnostics. Each string\n'//& 'is of the form "MODULE_SUFFIX,PARAMETER_SUFFIX,COORDINATE_NAME".', & @@ -2233,10 +2233,10 @@ subroutine diag_mediator_init(G, GV, nz, param_file, diag_cs, doc_file_dir) deallocate(diag_coords) endif - call get_param(param_file, mod, 'DIAG_MISVAL', diag_cs%missing_value, & + call get_param(param_file, mdl, 'DIAG_MISVAL', diag_cs%missing_value, & 'Set the default missing value to use for diagnostics.', & default=1.e20) - call get_param(param_file, mod, 'DIAG_AS_CHKSUM', diag_cs%diag_as_chksum, & + call get_param(param_file, mdl, 'DIAG_AS_CHKSUM', diag_cs%diag_as_chksum, & 'Instead of writing diagnostics to the diag manager, write\n' //& 'a textfile containing the checksum (bitcount) of the array.', & default=.false.) @@ -2263,7 +2263,7 @@ subroutine diag_mediator_init(G, GV, nz, param_file, diag_cs, doc_file_dir) if (is_root_pe() .and. (diag_CS%available_diag_doc_unit < 0)) then write(this_pe,'(i6.6)') PE_here() doc_file_dflt = "available_diags."//this_pe - call get_param(param_file, mod, "AVAILABLE_DIAGS_FILE", doc_file, & + call get_param(param_file, mdl, "AVAILABLE_DIAGS_FILE", doc_file, & "A file into which to write a list of all available \n"//& "ocean diagnostics that can be included in a diag_table.", & default=doc_file_dflt, do_not_log=(diag_CS%available_diag_doc_unit/=-1)) @@ -2301,7 +2301,7 @@ subroutine diag_mediator_init(G, GV, nz, param_file, diag_cs, doc_file_dir) if (is_root_pe() .and. (diag_CS%chksum_diag_doc_unit < 0) .and. diag_CS%diag_as_chksum) then write(this_pe,'(i6.6)') PE_here() doc_file_dflt = "chksum_diag."//this_pe - call get_param(param_file, mod, "CHKSUM_DIAG_FILE", doc_file, & + call get_param(param_file, mdl, "CHKSUM_DIAG_FILE", doc_file, & "A file into which to write all checksums of the \n"//& "diagnostics listed in the diag_table.", & default=doc_file_dflt, do_not_log=(diag_CS%chksum_diag_doc_unit/=-1)) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index b6a77e1fe6..657c243b2c 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -1299,7 +1299,7 @@ subroutine diabatic_aux_init(Time, G, GV, param_file, diag, CS, useALEalgorithm, ! This "include" declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_diabatic_aux" ! This module's name. + character(len=40) :: mdl = "MOM_diabatic_aux" ! This module's name. character(len=48) :: thickness_units integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz, nbands isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke @@ -1316,15 +1316,15 @@ subroutine diabatic_aux_init(Time, G, GV, param_file, diag, CS, useALEalgorithm, CS%diag => diag ! Set default, read and log parameters - call log_version(param_file, mod, version, & + call log_version(param_file, mdl, version, & "The following parameters are used for auxiliary diabatic processes.") - call get_param(param_file, mod, "RECLAIM_FRAZIL", CS%reclaim_frazil, & + call get_param(param_file, mdl, "RECLAIM_FRAZIL", CS%reclaim_frazil, & "If true, try to use any frazil heat deficit to cool any\n"//& "overlying layers down to the freezing point, thereby \n"//& "avoiding the creation of thin ice when the SST is above \n"//& "the freezing point.", default=.true.) - call get_param(param_file, mod, "PRESSURE_DEPENDENT_FRAZIL", & + call get_param(param_file, mdl, "PRESSURE_DEPENDENT_FRAZIL", & CS%pressure_dependent_frazil, & "If true, use a pressure dependent freezing temperature \n"//& "when making frazil. The default is false, which will be \n"//& @@ -1332,27 +1332,27 @@ subroutine diabatic_aux_init(Time, G, GV, param_file, diag, CS, useALEalgorithm, default=.false.) if (use_ePBL) then - call get_param(param_file, mod, "IGNORE_FLUXES_OVER_LAND", CS%ignore_fluxes_over_land,& + call get_param(param_file, mdl, "IGNORE_FLUXES_OVER_LAND", CS%ignore_fluxes_over_land,& "If true, the model does not check if fluxes are being applied\n"//& "over land points. This is needed when the ocean is coupled \n"//& "with ice shelves and sea ice, since the sea ice mask needs to \n"//& "be different than the ocean mask to avoid sea ice formation \n"//& "under ice shelves. This flag only works when use_ePBL = True.", default=.false.) - call get_param(param_file, mod, "DO_RIVERMIX", CS%do_rivermix, & + call get_param(param_file, mdl, "DO_RIVERMIX", CS%do_rivermix, & "If true, apply additional mixing whereever there is \n"//& "runoff, so that it is mixed down to RIVERMIX_DEPTH \n"//& "if the ocean is that deep.", default=.false.) if (CS%do_rivermix) & - call get_param(param_file, mod, "RIVERMIX_DEPTH", CS%rivermix_depth, & + call get_param(param_file, mdl, "RIVERMIX_DEPTH", CS%rivermix_depth, & "The depth to which rivers are mixed if DO_RIVERMIX is \n"//& "defined.", units="m", default=0.0) else ; CS%do_rivermix = .false. ; CS%rivermix_depth = 0.0 ; endif if (GV%nkml == 0) then - call get_param(param_file, mod, "USE_RIVER_HEAT_CONTENT", CS%use_river_heat_content, & + call get_param(param_file, mdl, "USE_RIVER_HEAT_CONTENT", CS%use_river_heat_content, & "If true, use the fluxes%runoff_Hflx field to set the \n"//& "heat carried by runoff, instead of using SST*CP*liq_runoff.", & default=.false.) - call get_param(param_file, mod, "USE_CALVING_HEAT_CONTENT", CS%use_calving_heat_content, & + call get_param(param_file, mdl, "USE_CALVING_HEAT_CONTENT", CS%use_calving_heat_content, & "If true, use the fluxes%calving_Hflx field to set the \n"//& "heat carried by runoff, instead of using SST*CP*froz_runoff.", & default=.false.) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 90e9c5a504..b294bbc64b 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -2724,7 +2724,7 @@ subroutine adiabatic_driver_init(Time, G, param_file, diag, CS, & ! This "include" declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_diabatic_driver" ! This module's name. + character(len=40) :: mdl = "MOM_diabatic_driver" ! This module's name. if (associated(CS)) then call MOM_error(WARNING, "adiabatic_driver_init called with an "// & @@ -2737,7 +2737,7 @@ subroutine adiabatic_driver_init(Time, G, param_file, diag, CS, & if (associated(diag_to_Z_CSp)) CS%diag_to_Z_CSp => diag_to_Z_CSp ! Set default, read and log parameters - call log_version(param_file, mod, version, & + call log_version(param_file, mdl, version, & "The following parameters are used for diabatic processes.") end subroutine adiabatic_driver_init @@ -2770,7 +2770,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, ! This "include" declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_diabatic_driver" ! This module's name. + character(len=40) :: mdl = "MOM_diabatic_driver" ! This module's name. character(len=48) :: thickness_units character(len=40) :: var_name character(len=160) :: var_descript @@ -2798,25 +2798,25 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, CS%bulkmixedlayer = (GV%nkml > 0) ! Set default, read and log parameters - call log_version(param_file, mod, version, & + call log_version(param_file, mdl, version, & "The following parameters are used for diabatic processes.") - call get_param(param_file, mod, "SPONGE", CS%use_sponge, & + call get_param(param_file, mdl, "SPONGE", CS%use_sponge, & "If true, sponges may be applied anywhere in the domain. \n"//& "The exact location and properties of those sponges are \n"//& "specified via calls to initialize_sponge and possibly \n"//& "set_up_sponge_field.", default=.false.) - call get_param(param_file, mod, "ENABLE_THERMODYNAMICS", use_temperature, & + call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", use_temperature, & "If true, temperature and salinity are used as state \n"//& "variables.", default=.true.) - call get_param(param_file, mod, "ENERGETICS_SFC_PBL", CS%use_energetic_PBL, & + call get_param(param_file, mdl, "ENERGETICS_SFC_PBL", CS%use_energetic_PBL, & "If true, use an implied energetics planetary boundary \n"//& "layer scheme to determine the diffusivity and viscosity \n"//& "in the surface boundary layer.", default=.false.) - call get_param(param_file, mod, "EPBL_IS_ADDITIVE", CS%ePBL_is_additive, & + call get_param(param_file, mdl, "EPBL_IS_ADDITIVE", CS%ePBL_is_additive, & "If true, the diffusivity from ePBL is added to all\n"//& "other diffusivities. Otherwise, the larger of kappa-\n"//& "shear and ePBL diffusivities are used.", default=.true.) - call get_param(param_file, mod, "DOUBLE_DIFFUSION", differentialDiffusion, & + call get_param(param_file, mdl, "DOUBLE_DIFFUSION", differentialDiffusion, & "If true, apply parameterization of double-diffusion.", & default=.false. ) @@ -2832,55 +2832,55 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, CS%use_CVMix_shear = CVMix_shear_is_used(param_file) if (CS%bulkmixedlayer) then - call get_param(param_file, mod, "ML_MIX_FIRST", CS%ML_mix_first, & + call get_param(param_file, mdl, "ML_MIX_FIRST", CS%ML_mix_first, & "The fraction of the mixed layer mixing that is applied \n"//& "before interior diapycnal mixing. 0 by default.", & units="nondim", default=0.0) - call get_param(param_file, mod, "NKBL", CS%nkbl, default=2, do_not_log=.true.) + call get_param(param_file, mdl, "NKBL", CS%nkbl, default=2, do_not_log=.true.) else CS%ML_mix_first = 0.0 endif if (use_temperature) then - call get_param(param_file, mod, "DO_GEOTHERMAL", CS%use_geothermal, & + call get_param(param_file, mdl, "DO_GEOTHERMAL", CS%use_geothermal, & "If true, apply geothermal heating.", default=.false.) else CS%use_geothermal = .false. endif - call get_param(param_file, mod, "INTERNAL_TIDES", CS%use_int_tides, & + call get_param(param_file, mdl, "INTERNAL_TIDES", CS%use_int_tides, & "If true, use the code that advances a separate set of \n"//& "equations for the internal tide energy density.", default=.false.) CS%nMode = 1 if (CS%use_int_tides) then ! SET NUMBER OF MODES TO CONSIDER - call get_param(param_file, mod, "INTERNAL_TIDE_MODES", CS%nMode, & + call get_param(param_file, mdl, "INTERNAL_TIDE_MODES", CS%nMode, & "The number of distinct internal tide modes \n"//& "that will be calculated.", default=1, do_not_log=.true.) ! The following parameters are used in testing the internal tide code. ! GET LOCATION AND DURATION OF ENERGY POINT SOURCE FOR TESTING (BDM) - call get_param(param_file, mod, "INTERNAL_TIDE_SOURCE_TEST", CS%int_tide_source_test, & + call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_TEST", CS%int_tide_source_test, & "If true, apply an arbitrary generation site for internal tide testing", & default=.false.) if (CS%int_tide_source_test)then - call get_param(param_file, mod, "INTERNAL_TIDE_SOURCE_X", CS%int_tide_source_x, & + call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_X", CS%int_tide_source_x, & "X Location of generation site for internal tide", default=1.) - call get_param(param_file, mod, "INTERNAL_TIDE_SOURCE_Y", CS%int_tide_source_y, & + call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_Y", CS%int_tide_source_y, & "Y Location of generation site for internal tide", default=1.) - call get_param(param_file, mod, "INTERNAL_TIDE_SOURCE_TLEN_DAYS", CS%tlen_days, & + call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_TLEN_DAYS", CS%tlen_days, & "Time interval from start of experiment for adding wave source", & units="days", default=0) CS%time_max_source = increment_time(Time,0,days=CS%tlen_days) endif ! GET UNIFORM MODE VELOCITY FOR TESTING (BDM) - call get_param(param_file, mod, "UNIFORM_CG", CS%uniform_cg, & + call get_param(param_file, mdl, "UNIFORM_CG", CS%uniform_cg, & "If true, set cg = cg_test everywhere for test case", default=.false.) if (CS%uniform_cg)then - call get_param(param_file, mod, "CG_TEST", CS%cg_test, & + call get_param(param_file, mdl, "CG_TEST", CS%cg_test, & "Uniform group velocity of internal tide for test case", default=1.) endif endif - call get_param(param_file, mod, "MASSLESS_MATCH_TARGETS", & + call get_param(param_file, mdl, "MASSLESS_MATCH_TARGETS", & CS%massless_match_targets, & "If true, the temperature and salinity of massless layers \n"//& "are kept consistent with their target densities. \n"//& @@ -2888,7 +2888,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, "diffusively to match massive neighboring layers.", & default=.true.) - call get_param(param_file, mod, "AGGREGATE_FW_FORCING", CS%aggregate_FW_forcing, & + call get_param(param_file, mdl, "AGGREGATE_FW_FORCING", CS%aggregate_FW_forcing, & "If true, the net incoming and outgoing fresh water fluxes are combined\n"//& "and applied as either incoming or outgoing depending on the sign of the net.\n"//& "If false, the net incoming fresh water flux is added to the model and\n"//& @@ -2896,44 +2896,44 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, "into the first non-vanished layer for which the column remains stable", & default=.true.) - call get_param(param_file, mod, "DEBUG", CS%debug, & + call get_param(param_file, mdl, "DEBUG", CS%debug, & "If true, write out verbose debugging data.", & default=.false., debuggingParam=.true.) - call get_param(param_file, mod, "DEBUG_CONSERVATION", CS%debugConservation, & + call get_param(param_file, mdl, "DEBUG_CONSERVATION", CS%debugConservation, & "If true, monitor conservation and extrema.", & default=.false., debuggingParam=.true.) - call get_param(param_file, mod, "DEBUG_ENERGY_REQ", CS%debug_energy_req, & + call get_param(param_file, mdl, "DEBUG_ENERGY_REQ", CS%debug_energy_req, & "If true, debug the energy requirements.", default=.false., do_not_log=.true.) - call get_param(param_file, mod, "MIX_BOUNDARY_TRACERS", CS%mix_boundary_tracers, & + call get_param(param_file, mdl, "MIX_BOUNDARY_TRACERS", CS%mix_boundary_tracers, & "If true, mix the passive tracers in massless layers at \n"//& "the bottom into the interior as though a diffusivity of \n"//& "KD_MIN_TR were operating.", default=.true.) if (CS%mix_boundary_tracers) then - call get_param(param_file, mod, "KD", Kd, fail_if_missing=.true.) - call get_param(param_file, mod, "KD_MIN_TR", CS%Kd_min_tr, & + call get_param(param_file, mdl, "KD", Kd, fail_if_missing=.true.) + call get_param(param_file, mdl, "KD_MIN_TR", CS%Kd_min_tr, & "A minimal diffusivity that should always be applied to \n"//& "tracers, especially in massless layers near the bottom. \n"//& "The default is 0.1*KD.", units="m2 s-1", default=0.1*Kd) - call get_param(param_file, mod, "KD_BBL_TR", CS%Kd_BBL_tr, & + call get_param(param_file, mdl, "KD_BBL_TR", CS%Kd_BBL_tr, & "A bottom boundary layer tracer diffusivity that will \n"//& "allow for explicitly specified bottom fluxes. The \n"//& "entrainment at the bottom is at least sqrt(Kd_BBL_tr*dt) \n"//& "over the same distance.", units="m2 s-1", default=0.) endif - call get_param(param_file, mod, "TRACER_TRIDIAG", CS%tracer_tridiag, & + call get_param(param_file, mdl, "TRACER_TRIDIAG", CS%tracer_tridiag, & "If true, use the passive tracer tridiagonal solver for T and S\n", & default=.false.) - call get_param(param_file, mod, "MINIMUM_FORCING_DEPTH", CS%minimum_forcing_depth, & + call get_param(param_file, mdl, "MINIMUM_FORCING_DEPTH", CS%minimum_forcing_depth, & "The smallest depth over which forcing can be applied. This\n"//& "only takes effect when near-surface layers become thin\n"//& "relative to this scale, in which case the forcing tendencies\n"//& "scaled down by distributing the forcing over this depth scale.", & units="m", default=0.001) - call get_param(param_file, mod, "EVAP_CFL_LIMIT", CS%evap_CFL_limit, & + call get_param(param_file, mdl, "EVAP_CFL_LIMIT", CS%evap_CFL_limit, & "The largest fraction of a layer than can be lost to forcing\n"//& "(e.g. evaporation, sea-ice formation) in one time-step. The unused\n"//& "mass loss is passed down through the column.", & @@ -3000,7 +3000,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, 'Squared buoyancy frequency below mixed layer', 's-2') CS%id_MLD_user = register_diag_field('ocean_model','MLD_user',diag%axesT1,Time, & 'Mixed layer depth (used defined)', 'm') - call get_param(param_file, mod, "DIAG_MLD_DENSITY_DIFF", CS%MLDdensityDifference, & + call get_param(param_file, mdl, "DIAG_MLD_DENSITY_DIFF", CS%MLDdensityDifference, & "The density difference used to determine a diagnostic mixed\n"//& "layer depth, MLD_user, following the definition of Levitus 1982. \n"//& "The MLD is the depth at which the density is larger than the\n"//& @@ -3087,7 +3087,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, 'set DOUBLE_DIFFUSION=False and USE_CVMIX_DDIFF=True.') endif - call get_param(param_file, mod, "SALT_REJECT_BELOW_ML", CS%salt_reject_below_ML, & + call get_param(param_file, mdl, "SALT_REJECT_BELOW_ML", CS%salt_reject_below_ML, & "If true, place salt from brine rejection below the mixed layer,\n"// & "into the first non-vanished layer for which the column remains stable", & default=.false.) @@ -3322,7 +3322,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, ! obtain information about the number of bands for penetrative shortwave if (use_temperature) then - call get_param(param_file, mod, "PEN_SW_NBANDS", nbands, default=1) + call get_param(param_file, mdl, "PEN_SW_NBANDS", nbands, default=1) if (nbands > 0) then allocate(CS%optics) call opacity_init(Time, G, param_file, diag, CS%tracer_flow_CSp, CS%opacity_CSp, CS%optics) diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index df3783fa32..95a43c8a3c 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -2157,7 +2157,7 @@ subroutine entrain_diffusive_init(Time, G, GV, param_file, diag, CS) real :: decay_length, dt, Kd ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_entrain_diffusive" ! This module's name. + character(len=40) :: mdl = "MOM_entrain_diffusive" ! This module's name. if (associated(CS)) then call MOM_error(WARNING, "entrain_diffusive_init called with an associated "// & @@ -2171,22 +2171,22 @@ subroutine entrain_diffusive_init(Time, G, GV, param_file, diag, CS) CS%bulkmixedlayer = (GV%nkml > 0) ! Set default, read and log parameters - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "CORRECT_DENSITY", CS%correct_density, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "CORRECT_DENSITY", CS%correct_density, & "If true, and USE_EOS is true, the layer densities are \n"//& "restored toward their target values by the diapycnal \n"//& "mixing, as described in Hallberg (MWR, 2000).", & default=.true.) - call get_param(param_file, mod, "MAX_ENT_IT", CS%max_ent_it, & + call get_param(param_file, mdl, "MAX_ENT_IT", CS%max_ent_it, & "The maximum number of iterations that may be used to \n"//& "calculate the interior diapycnal entrainment.", default=5) ! In this module, KD is only used to set the default for TOLERANCE_ENT. (m2 s-1) - call get_param(param_file, mod, "KD", Kd, fail_if_missing=.true.) - call get_param(param_file, mod, "DT", dt, & + call get_param(param_file, mdl, "KD", Kd, fail_if_missing=.true.) + call get_param(param_file, mdl, "DT", dt, & "The (baroclinic) dynamics time step.", units = "s", & fail_if_missing=.true.) ! CS%Tolerance_Ent = MAX(100.0*GV%Angstrom_H,1.0e-4*sqrt(dt*Kd)) ! - call get_param(param_file, mod, "TOLERANCE_ENT", CS%Tolerance_Ent, & + call get_param(param_file, mdl, "TOLERANCE_ENT", CS%Tolerance_Ent, & "The tolerance with which to solve for entrainment values.", & units="m", default=MAX(100.0*GV%Angstrom_m,1.0e-4*sqrt(dt*Kd))) diff --git a/src/user/Neverland_initialization.F90 b/src/user/Neverland_initialization.F90 index 5e0e7f0af0..76d028c6f4 100644 --- a/src/user/Neverland_initialization.F90 +++ b/src/user/Neverland_initialization.F90 @@ -37,7 +37,7 @@ subroutine Neverland_initialize_topography(D, G, param_file, max_depth) real :: x, y ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "Neverland_initialize_topography" ! This subroutine's name. + character(len=40) :: mdl = "Neverland_initialize_topography" ! This subroutine's name. integer :: i, j, is, ie, js, je, isd, ied, jsd, jed real :: nl_roughness_amp is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -45,8 +45,8 @@ subroutine Neverland_initialize_topography(D, G, param_file, max_depth) call MOM_mesg(" Neverland_initialization.F90, Neverland_initialize_topography: setting topography", 5) - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "NL_ROUGHNESS_AMP", nl_roughness_amp, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "NL_ROUGHNESS_AMP", nl_roughness_amp, & "Amplitude of wavy signal in bathymetry.", default=0.05) PI = 4.0*atan(1.0) @@ -119,13 +119,13 @@ subroutine Neverland_initialize_thickness(h, G, GV, param_file, eqn_of_state, P_ ! usually negative because it is positive upward. real, dimension(SZK_(G)) :: h_profile ! Vector of initial thickness profile (Z) real :: e_interface ! Current interface position (m) - character(len=40) :: mod = "Neverland_initialize_thickness" ! This subroutine's name. + character(len=40) :: mdl = "Neverland_initialize_thickness" ! This subroutine's name. integer :: i, j, k, k1, is, ie, js, je, nz, itt is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke call MOM_mesg(" Neverland_initialization.F90, Neverland_initialize_thickness: setting thickness", 5) - call get_param(param_file, mod, "INIT_THICKNESS_PROFILE", h_profile, & + call get_param(param_file, mdl, "INIT_THICKNESS_PROFILE", h_profile, & "Profile of initial layer thicknesses.", units="m", scale=GV%m_to_Z, & fail_if_missing=.true.) From 0c9b40959de364dc7e01ec0774992c8485a8c6d3 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 22 Sep 2018 21:07:52 -0400 Subject: [PATCH 105/174] Changed the units of a_u to Z Changed the units for the viscous coupling coefficients between layers from m to Z, to expand the automated testing of dimensional consistency.` Also changed variables names to reflect their new use and to avoid the use of a single character name to help in searches. All answers are bitwise identical. --- .../vertical/MOM_vert_friction.F90 | 224 +++++++++--------- 1 file changed, 110 insertions(+), 114 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index a19ec5c215..92d1d79b4e 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -60,11 +60,11 @@ module MOM_vert_friction type(time_type) :: rampStartTime !< The time at which the ramping of CFL_trunc starts real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NK_INTERFACE_) :: & - a_u !< The u-drag coefficient across an interface, in m s-1. + a_u !< The u-drag coefficient across an interface, in Z s-1. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & h_u !< The effective layer thickness at u-points, m or kg m-2. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NK_INTERFACE_) :: & - a_v !< The v-drag coefficient across an interface, in m s-1. + a_v !< The v-drag coefficient across an interface, in Z s-1. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & h_v !< The effective layer thickness at v-points, m or kg m-2. real, pointer, dimension(:,:) :: a1_shelf_u => NULL() !< The u-momentum coupling coefficient under @@ -172,7 +172,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & real :: c1(SZIB_(G),SZK_(G)) ! tridiagonal solver. c1 is nondimensional, ! while b1 has units of inverse thickness. real :: d1(SZIB_(G)) ! d1=1-c1 is used by the tridiagonal solver, ND. - real :: Ray(SZIB_(G),SZK_(G)) ! Ray is the Rayleigh-drag velocity in m s-1 + real :: Ray(SZIB_(G),SZK_(G)) ! Ray is the Rayleigh-drag velocity in Z s-1 real :: b_denom_1 ! The first term in the denominator of b1, in H. real :: Hmix ! The mixed layer thickness over which stress @@ -184,7 +184,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & ! density, in s m3 kg-1. real :: Rho0 ! A density used to convert drag laws into stress in ! Pa, in kg m-3. - real :: dt_m_to_H ! The time step times the conversion from m to the + real :: dt_Z_to_H ! The time step times the conversion from Z to the ! units of thickness - either s or s m3 kg-1. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in m or kg m-2. @@ -211,7 +211,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & I_Hmix = 1.0 / Hmix endif dt_Rho0 = dt/GV%H_to_kg_m2 - dt_m_to_H = dt*GV%m_to_H + dt_Z_to_H = dt*GV%Z_to_H Rho0 = GV%Rho0 h_neglect = GV%H_subroundoff Idt = 1.0 / dt @@ -265,7 +265,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & enddo ; endif ! direct_stress if (CS%Channel_drag) then ; do k=1,nz ; do I=Isq,Ieq - Ray(I,k) = visc%Ray_u(I,j,k) + Ray(I,k) = GV%m_to_Z*visc%Ray_u(I,j,k) enddo ; enddo ; endif ! perform forward elimination on the tridiagonal system @@ -274,9 +274,9 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & ! and the superdiagonal as c_k. The right-hand side terms are d_k. ! ! ignoring the rayleigh drag contribution, - ! we have a_k = -dt_m_to_H * a_u(k) - ! b_k = h_u(k) + dt_m_to_H * (a_u(k) + a_u(k+1)) - ! c_k = -dt_m_to_H * a_u(k+1) + ! we have a_k = -dt_Z_to_H * a_u(k) + ! b_k = h_u(k) + dt_Z_to_H * (a_u(k) + a_u(k+1)) + ! c_k = -dt_Z_to_H * a_u(k+1) ! ! for forward elimination, we want to: ! calculate c'_k = - c_k / (b_k + a_k c'_(k-1)) @@ -292,18 +292,18 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & ! and the right-hand-side is destructively updated to be d'_k ! do I=Isq,Ieq ; if (do_i(I)) then - b_denom_1 = CS%h_u(I,j,1) + dt_m_to_H * (Ray(I,1) + CS%a_u(I,j,1)) - b1(I) = 1.0 / (b_denom_1 + dt_m_to_H*CS%a_u(I,j,2)) + b_denom_1 = CS%h_u(I,j,1) + dt_Z_to_H * (Ray(I,1) + CS%a_u(I,j,1)) + b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_u(I,j,2)) d1(I) = b_denom_1 * b1(I) u(I,j,1) = b1(I) * (CS%h_u(I,j,1) * u(I,j,1) + surface_stress(I)) endif ; enddo do k=2,nz ; do I=Isq,Ieq ; if (do_i(I)) then - c1(I,k) = dt_m_to_H * CS%a_u(I,j,K) * b1(I) - b_denom_1 = CS%h_u(I,j,k) + dt_m_to_H * (Ray(I,k) + CS%a_u(I,j,K)*d1(I)) - b1(I) = 1.0 / (b_denom_1 + dt_m_to_H * CS%a_u(I,j,K+1)) + c1(I,k) = dt_Z_to_H * CS%a_u(I,j,K) * b1(I) + b_denom_1 = CS%h_u(I,j,k) + dt_Z_to_H * (Ray(I,k) + CS%a_u(I,j,K)*d1(I)) + b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_u(I,j,K+1)) d1(I) = b_denom_1 * b1(I) u(I,j,k) = (CS%h_u(I,j,k) * u(I,j,k) + & - dt_m_to_H * CS%a_u(I,j,K) * u(I,j,k-1)) * b1(I) + dt_Z_to_H * CS%a_u(I,j,K) * u(I,j,k-1)) * b1(I) endif ; enddo ; enddo ! back substitute to solve for the new velocities @@ -373,22 +373,21 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & enddo ; endif ! direct_stress if (CS%Channel_drag) then ; do k=1,nz ; do i=is,ie - Ray(i,k) = visc%Ray_v(i,J,k) + Ray(i,k) = GV%m_to_Z*visc%Ray_v(i,J,k) enddo ; enddo ; endif do i=is,ie ; if (do_i(i)) then - b_denom_1 = CS%h_v(i,J,1) + dt_m_to_H * (Ray(i,1) + CS%a_v(i,J,1)) - b1(i) = 1.0 / (b_denom_1 + dt_m_to_H*CS%a_v(i,J,2)) + b_denom_1 = CS%h_v(i,J,1) + dt_Z_to_H * (Ray(i,1) + CS%a_v(i,J,1)) + b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_v(i,J,2)) d1(i) = b_denom_1 * b1(i) v(i,J,1) = b1(i) * (CS%h_v(i,J,1) * v(i,J,1) + surface_stress(i)) endif ; enddo do k=2,nz ; do i=is,ie ; if (do_i(i)) then - c1(i,k) = dt_m_to_H * CS%a_v(i,J,K) * b1(i) - b_denom_1 = CS%h_v(i,J,k) + dt_m_to_H * (Ray(i,k) + CS%a_v(i,J,K)*d1(i)) - b1(i) = 1.0 / (b_denom_1 + dt_m_to_H * CS%a_v(i,J,K+1)) + c1(i,k) = dt_Z_to_H * CS%a_v(i,J,K) * b1(i) + b_denom_1 = CS%h_v(i,J,k) + dt_Z_to_H * (Ray(i,k) + CS%a_v(i,J,K)*d1(i)) + b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_v(i,J,K+1)) d1(i) = b_denom_1 * b1(i) - v(i,J,k) = (CS%h_v(i,J,k) * v(i,J,k) + dt_m_to_H * & - CS%a_v(i,J,K) * v(i,J,k-1)) * b1(i) + v(i,J,k) = (CS%h_v(i,J,k) * v(i,J,k) + dt_Z_to_H * CS%a_v(i,J,K) * v(i,J,k-1)) * b1(i) endif ; enddo ; enddo do k=nz-1,1,-1 ; do i=is,ie ; if (do_i(i)) then v(i,J,k) = v(i,J,k) + c1(i,k+1) * v(i,J,k+1) @@ -479,7 +478,7 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS) real :: Ray(SZIB_(G),SZK_(G)) ! Ray is the Rayleigh-drag velocity times the ! time step, in m. real :: b_denom_1 ! The first term in the denominator of b1, in m or kg m-2. - real :: dt_m_to_H ! The time step times the conversion from m to the + real :: dt_Z_to_H ! The time step times the conversion from Z to the ! units of thickness - either s or s m3 kg-1. logical :: do_i(SZIB_(G)) @@ -490,33 +489,33 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS) if (.not.associated(CS)) call MOM_error(FATAL,"MOM_vert_friction(visc): "// & "Module must be initialized before it is used.") - dt_m_to_H = dt*GV%m_to_H + dt_Z_to_H = dt*GV%Z_to_H do k=1,nz ; do i=Isq,Ieq ; Ray(i,k) = 0.0 ; enddo ; enddo ! Find the zonal viscous using a modification of a standard tridagonal solver. -!$OMP parallel do default(none) shared(G,Isq,Ieq,CS,nz,visc,dt_m_to_H,visc_rem_u) & +!$OMP parallel do default(none) shared(G,Isq,Ieq,CS,nz,visc,dt_Z_to_H,visc_rem_u) & !$OMP firstprivate(Ray) & !$OMP private(do_i,b_denom_1,b1,d1,c1) do j=G%jsc,G%jec do I=Isq,Ieq ; do_i(I) = (G%mask2dCu(I,j) > 0) ; enddo if (CS%Channel_drag) then ; do k=1,nz ; do I=Isq,Ieq - Ray(I,k) = visc%Ray_u(I,j,k) + Ray(I,k) = GV%m_to_Z*visc%Ray_u(I,j,k) enddo ; enddo ; endif do I=Isq,Ieq ; if (do_i(I)) then - b_denom_1 = CS%h_u(I,j,1) + dt_m_to_H * (Ray(I,1) + CS%a_u(I,j,1)) - b1(I) = 1.0 / (b_denom_1 + dt_m_to_H*CS%a_u(I,j,2)) + b_denom_1 = CS%h_u(I,j,1) + dt_Z_to_H * (Ray(I,1) + CS%a_u(I,j,1)) + b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_u(I,j,2)) d1(I) = b_denom_1 * b1(I) visc_rem_u(I,j,1) = b1(I) * CS%h_u(I,j,1) endif ; enddo do k=2,nz ; do I=Isq,Ieq ; if (do_i(I)) then - c1(I,k) = dt_m_to_H * CS%a_u(I,j,K)*b1(I) - b_denom_1 = CS%h_u(I,j,k) + dt_m_to_H * (Ray(I,k) + CS%a_u(I,j,K)*d1(I)) - b1(I) = 1.0 / (b_denom_1 + dt_m_to_H * CS%a_u(I,j,K+1)) + c1(I,k) = dt_Z_to_H * CS%a_u(I,j,K)*b1(I) + b_denom_1 = CS%h_u(I,j,k) + dt_Z_to_H * (Ray(I,k) + CS%a_u(I,j,K)*d1(I)) + b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_u(I,j,K+1)) d1(I) = b_denom_1 * b1(I) - visc_rem_u(I,j,k) = (CS%h_u(I,j,k) + dt_m_to_H * CS%a_u(I,j,K) * visc_rem_u(I,j,k-1)) * b1(I) + visc_rem_u(I,j,k) = (CS%h_u(I,j,k) + dt_Z_to_H * CS%a_u(I,j,K) * visc_rem_u(I,j,k-1)) * b1(I) endif ; enddo ; enddo do k=nz-1,1,-1 ; do I=Isq,Ieq ; if (do_i(I)) then visc_rem_u(I,j,k) = visc_rem_u(I,j,k) + c1(I,k+1)*visc_rem_u(I,j,k+1) @@ -526,28 +525,28 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS) enddo ! end u-component j loop ! Now find the meridional viscous using a modification. -!$OMP parallel do default(none) shared(Jsq,Jeq,is,ie,G,CS,visc,dt_m_to_H,visc_rem_v,nz) & +!$OMP parallel do default(none) shared(Jsq,Jeq,is,ie,G,CS,visc,dt_Z_to_H,visc_rem_v,nz) & !$OMP firstprivate(Ray) & !$OMP private(do_i,b_denom_1,b1,d1,c1) do J=Jsq,Jeq do i=is,ie ; do_i(i) = (G%mask2dCv(i,J) > 0) ; enddo if (CS%Channel_drag) then ; do k=1,nz ; do i=is,ie - Ray(i,k) = visc%Ray_v(i,J,k) + Ray(i,k) = GV%m_to_Z*visc%Ray_v(i,J,k) enddo ; enddo ; endif do i=is,ie ; if (do_i(i)) then - b_denom_1 = CS%h_v(i,J,1) + dt_m_to_H * (Ray(i,1) + CS%a_v(i,J,1)) - b1(i) = 1.0 / (b_denom_1 + dt_m_to_H*CS%a_v(i,J,2)) + b_denom_1 = CS%h_v(i,J,1) + dt_Z_to_H * (Ray(i,1) + CS%a_v(i,J,1)) + b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_v(i,J,2)) d1(i) = b_denom_1 * b1(i) visc_rem_v(i,J,1) = b1(i) * CS%h_v(i,J,1) endif ; enddo do k=2,nz ; do i=is,ie ; if (do_i(i)) then - c1(i,k) = dt_m_to_H * CS%a_v(i,J,K)*b1(i) - b_denom_1 = CS%h_v(i,J,k) + dt_m_to_H * (Ray(i,k) + CS%a_v(i,J,K)*d1(i)) - b1(i) = 1.0 / (b_denom_1 + dt_m_to_H * CS%a_v(i,J,K+1)) + c1(i,k) = dt_Z_to_H * CS%a_v(i,J,K)*b1(i) + b_denom_1 = CS%h_v(i,J,k) + dt_Z_to_H * (Ray(i,k) + CS%a_v(i,J,K)*d1(i)) + b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_v(i,J,K+1)) d1(i) = b_denom_1 * b1(i) - visc_rem_v(i,J,k) = (CS%h_v(i,J,k) + dt_m_to_H * CS%a_v(i,J,K) * visc_rem_v(i,J,k-1)) * b1(i) + visc_rem_v(i,J,k) = (CS%h_v(i,J,k) + dt_Z_to_H * CS%a_v(i,J,K) * visc_rem_v(i,J,k-1)) * b1(i) endif ; enddo ; enddo do k=nz-1,1,-1 ; do i=is,ie ; if (do_i(i)) then visc_rem_v(i,J,k) = visc_rem_v(i,J,k) + c1(i,k+1)*visc_rem_v(i,J,k+1) @@ -593,10 +592,10 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) hvel, & ! hvel is the thickness used at a velocity grid point, in H. hvel_shelf ! The equivalent of hvel under shelves, in H. real, dimension(SZIB_(G),SZK_(G)+1) :: & - a, & ! The drag coefficients across interfaces, in m s-1. a times + a_cpl, & ! The drag coefficients across interfaces, in Z s-1. a_cpl times ! the velocity difference gives the stress across an interface. a_shelf, & ! The drag coefficients across interfaces in water columns under - ! ice shelves, in m s-1. + ! ice shelves, in Z s-1. z_i ! An estimate of each interface's height above the bottom, ! normalized by the bottom boundary layer thickness, nondim. real, dimension(SZIB_(G)) :: & @@ -628,7 +627,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) real :: z_clear ! The clearance of an interface above the surrounding topography, in H. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in H. - real :: H_to_m, m_to_H ! Unit conversion factors. + real :: m_to_H ! Unit conversion factors. real :: I_valBL ! The inverse of a scaling factor determining when water is ! still within the boundary layer, as determined by the sum @@ -646,7 +645,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) "Module must be initialized before it is used.") h_neglect = GV%H_subroundoff - H_to_m = GV%H_to_m ; m_to_H = GV%m_to_H + m_to_H = GV%m_to_H I_Hbbl(:) = 1.0 / (CS%Hbbl * GV%m_to_H + h_neglect) I_valBL = 0.0 ; if (CS%harm_BL_val > 0.0) I_valBL = 1.0 / CS%harm_BL_val @@ -674,9 +673,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) allocate(CS%a1_shelf_v(G%isd:G%ied,G%JsdB:G%JedB)) ; CS%a1_shelf_v(:,:)=0.0 endif - !$OMP parallel do default(private) shared(G,GV,CS,visc,Isq,ieq,nz,u,h,forces,hML_u, & - !$OMP OBC,h_neglect,dt,m_to_H,I_valBL,Kv_u) & - !$OMP firstprivate(i_hbbl) + !$OMP parallel do default(shared) firstprivate(i_hbbl) do j=G%Jsc,G%Jec do I=Isq,Ieq ; do_i(I) = (G%mask2dCu(I,j) > 0) ; enddo @@ -757,7 +754,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) enddo ! k loop endif - call find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & + call find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & dt, j, G, GV, CS, visc, forces, work_on_u=.true., OBC=OBC) if (allocated(hML_u)) then do i=isq,ieq ; if (do_i(i)) then ; hML_u(I,j) = h_ml(I) ; endif ; enddo @@ -811,12 +808,12 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) if (do_any_shelf) then do K=1,nz+1 ; do I=Isq,Ieq ; if (do_i_shelf(I)) then CS%a_u(I,j,K) = forces%frac_shelf_u(I,j) * a_shelf(I,K) + & - (1.0-forces%frac_shelf_u(I,j)) * a(I,K) + (1.0-forces%frac_shelf_u(I,j)) * a_cpl(I,K) ! This is Alistair's suggestion, but it destabilizes the model. I do not know why. RWH -! CS%a_u(I,j,K) = forces%frac_shelf_u(I,j) * max(a_shelf(I,K), a(I,K)) + & -! (1.0-forces%frac_shelf_u(I,j)) * a(I,K) +! CS%a_u(I,j,K) = forces%frac_shelf_u(I,j) * max(a_shelf(I,K), a_cpl(I,K)) + & +! (1.0-forces%frac_shelf_u(I,j)) * a_cpl(I,K) elseif (do_i(I)) then - CS%a_u(I,j,K) = a(I,K) + CS%a_u(I,j,K) = a_cpl(I,K) endif ; enddo ; enddo do k=1,nz ; do I=Isq,Ieq ; if (do_i_shelf(I)) then ! Should we instead take the inverse of the average of the inverses? @@ -826,14 +823,14 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) CS%h_u(I,j,k) = hvel(I,k) endif ; enddo ; enddo else - do K=1,nz+1 ; do I=Isq,Ieq ; if (do_i(I)) CS%a_u(I,j,K) = a(I,K) ; enddo ; enddo + do K=1,nz+1 ; do I=Isq,Ieq ; if (do_i(I)) CS%a_u(I,j,K) = a_cpl(I,K) ; enddo ; enddo do k=1,nz ; do I=Isq,Ieq ; if (do_i(I)) CS%h_u(I,j,k) = hvel(I,k) ; enddo ; enddo endif ! Diagnose total Kv at u-points if (CS%id_Kv_u > 0) then do k=1,nz ; do I=Isq,Ieq - if (do_i(I)) Kv_u(I,j,k) = 0.5 * (CS%a_u(I,j,K)+CS%a_u(I,j,K+1)) * CS%h_u(I,j,k) + if (do_i(I)) Kv_u(I,j,k) = 0.5 * GV%Z_to_m*(CS%a_u(I,j,K)+CS%a_u(I,j,K+1)) * CS%h_u(I,j,k) enddo ; enddo endif @@ -926,7 +923,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) endif ; enddo ; enddo ! i & k loops endif - call find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & + call find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & dt, j, G, GV, CS, visc, forces, work_on_u=.false., OBC=OBC) if ( allocated(hML_v)) then do i=is,ie ; if (do_i(i)) then ; hML_v(i,J) = h_ml(i) ; endif ; enddo @@ -979,12 +976,12 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) if (do_any_shelf) then do K=1,nz+1 ; do i=is,ie ; if (do_i_shelf(i)) then CS%a_v(i,J,K) = forces%frac_shelf_v(i,J) * a_shelf(i,k) + & - (1.0-forces%frac_shelf_v(i,J)) * a(i,K) + (1.0-forces%frac_shelf_v(i,J)) * a_cpl(i,K) ! This is Alistair's suggestion, but it destabilizes the model. I do not know why. RWH -! CS%a_v(i,J,K) = forces%frac_shelf_v(i,J) * max(a_shelf(i,K), a(i,K)) + & -! (1.0-forces%frac_shelf_v(i,J)) * a(i,K) +! CS%a_v(i,J,K) = forces%frac_shelf_v(i,J) * max(a_shelf(i,K), a_cpl(i,K)) + & +! (1.0-forces%frac_shelf_v(i,J)) * a_cpl(i,K) elseif (do_i(i)) then - CS%a_v(i,J,K) = a(i,K) + CS%a_v(i,J,K) = a_cpl(i,K) endif ; enddo ; enddo do k=1,nz ; do i=is,ie ; if (do_i_shelf(i)) then ! Should we instead take the inverse of the average of the inverses? @@ -994,14 +991,14 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) CS%h_v(i,J,k) = hvel(i,k) endif ; enddo ; enddo else - do K=1,nz+1 ; do i=is,ie ; if (do_i(i)) CS%a_v(i,J,K) = a(i,K) ; enddo ; enddo + do K=1,nz+1 ; do i=is,ie ; if (do_i(i)) CS%a_v(i,J,K) = a_cpl(i,K) ; enddo ; enddo do k=1,nz ; do i=is,ie ; if (do_i(i)) CS%h_v(i,J,k) = hvel(i,k) ; enddo ; enddo endif ! Diagnose total Kv at v-points if (CS%id_Kv_v > 0) then do k=1,nz ; do i=is,ie - if (do_i(I)) Kv_v(i,J,k) = 0.5 * (CS%a_v(i,J,K)+CS%a_v(i,J,K+1)) * CS%h_v(i,J,k) + if (do_i(I)) Kv_v(i,J,k) = 0.5 * GV%Z_to_m*(CS%a_v(i,J,K)+CS%a_v(i,J,K+1)) * CS%h_v(i,J,k) enddo ; enddo endif @@ -1011,7 +1008,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) 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) + CS%a_v, G%HI, haloshift=0, scale=GV%Z_to_m) 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) @@ -1036,12 +1033,12 @@ end subroutine vertvisc_coef !> Calculate the 'coupling coefficient' (a[k]) at the !! interfaces. If BOTTOMDRAGLAW is defined, the minimum of Hbbl and half the !! adjacent layer thicknesses are used to calculate a[k] near the bottom. -subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & +subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & dt, j, G, GV, CS, visc, forces, work_on_u, OBC, shelf) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure real, dimension(SZIB_(G),SZK_(GV)+1), & - intent(out) :: a !< Coupling coefficient across interfaces, in m s-1 + intent(out) :: a_cpl !< Coupling coefficient across interfaces, in Z s-1 real, dimension(SZIB_(G),SZK_(GV)), & intent(in) :: hvel !< Thickness at velocity points, in H logical, dimension(SZIB_(G)), & @@ -1069,7 +1066,7 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m ! Local variables real, dimension(SZIB_(G)) :: & - u_star, & ! ustar at a velocity point, in m s-1. + u_star, & ! ustar at a velocity point, in Z s-1. absf, & ! The average of the neighboring absolute values of f, in s-1. ! h_ml, & ! The mixed layer depth, in m or kg m-2. nk_visc, & ! The (real) interface index of the base of mixed layer. @@ -1085,13 +1082,12 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m real :: I_Hmix ! The inverse of the mixed layer thickness, in m-1 or m2 kg-1. real :: a_ml ! The layer coupling coefficient across an interface in ! the mixed layer, in m s-1. - real :: temp1 ! A temporary variable in m2 s-1. + real :: I_amax ! The inverse of the maximum coupling coefficient, in Z-1.??? + real :: temp1 ! A temporary variable in H Z real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in H. - real :: dz_neglect ! A thickness in m that is so small it is usually lost - ! in roundoff and can be neglected, in m. real :: z2 ! A copy of z_i, nondim. - real :: H_to_m, m_to_H ! Unit conversion factors. + real :: H_to_m, m_to_H, m2_to_Z2 ! Unit conversion factors. real :: topfn real :: a_top logical :: do_shelf, do_OBCs @@ -1099,14 +1095,19 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m integer :: nz real :: botfn - a(:,:) = 0.0 + a_cpl(:,:) = 0.0 if (work_on_u) then ; is = G%IscB ; ie = G%IecB else ; is = G%isc ; ie = G%iec ; endif nz = G%ke h_neglect = GV%H_subroundoff H_to_m = GV%H_to_m ; m_to_H = GV%m_to_H - dz_neglect = GV%H_subroundoff*GV%H_to_m + m2_to_Z2 = GV%m_to_Z*GV%m_to_Z + + ! The maximum coupling coefficent was originally introduced to avoid + ! truncation error problems in the tridiagonal solver. Effectively, the 1e-10 + ! sets the maximum coupling coefficient increment to 1e10 m per timestep. + I_amax = (1.0e-10*GV%Z_to_m) * dt do_shelf = .false. ; if (present(shelf)) do_shelf = shelf do_OBCs = .false. @@ -1115,15 +1116,15 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m ! The following loop calculates the vertical average velocity and ! surface mixed layer contributions to the vertical viscosity. - do i=is,ie ; a(i,1) = 0.0 ; enddo + do i=is,ie ; a_cpl(i,1) = 0.0 ; enddo if ((GV%nkml>0) .or. do_shelf) then ; do k=2,nz ; do i=is,ie - if (do_i(i)) a(i,K) = 2.0*CS%Kv + if (do_i(i)) a_cpl(i,K) = 2.0*CS%Kv enddo ; enddo ; else I_Hmix = 1.0 / (CS%Hmix * m_to_H + h_neglect) do i=is,ie ; z_t(i) = h_neglect*I_Hmix ; enddo do K=2,nz ; do i=is,ie ; if (do_i(i)) then z_t(i) = z_t(i) + h_harm(i,k-1)*I_Hmix - a(i,K) = 2.0*CS%Kv + 2.0*CS%Kvml / ((z_t(i)*z_t(i)) * & + a_cpl(i,K) = 2.0*CS%Kv + 2.0*CS%Kvml / ((z_t(i)*z_t(i)) * & (1.0 + 0.09*z_t(i)*z_t(i)*z_t(i)*z_t(i)*z_t(i)*z_t(i))) endif ; enddo ; enddo endif @@ -1132,12 +1133,12 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m if (CS%bottomdraglaw) then r = hvel(i,nz)*0.5 if (r < bbl_thick(i)) then - a(i,nz+1) = 1.0*kv_bbl(i) / (1e-10*dt*kv_bbl(i) + r*H_to_m) + a_cpl(i,nz+1) = 1.0*m2_to_Z2*kv_bbl(i) / (I_amax* m2_to_Z2*kv_bbl(i) + r*GV%H_to_Z) else - a(i,nz+1) = 1.0*kv_bbl(i) / (1e-10*dt*kv_bbl(i) + bbl_thick(i)*H_to_m) + a_cpl(i,nz+1) = 1.0*m2_to_Z2*kv_bbl(i) / (I_amax* m2_to_Z2*kv_bbl(i) + bbl_thick(i)*GV%H_to_Z) endif else - a(i,nz+1) = 2.0*CS%Kvbbl / (hvel(i,nz)*H_to_m + 2.0e-10*dt*CS%Kvbbl) + a_cpl(i,nz+1) = 2.0*m2_to_Z2*CS%Kvbbl / (hvel(i,nz)*GV%H_to_Z + 2.0*I_amax* m2_to_Z2*CS%Kvbbl) endif endif ; enddo @@ -1160,7 +1161,7 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m endif ; enddo endif do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a(i,K) = a(i,K) + Kv_add(i,K) + a_cpl(i,K) = a_cpl(i,K) + Kv_add(i,K) endif ; enddo ; enddo else do K=2,nz ; do i=is,ie ; if (do_i(i)) then @@ -1176,7 +1177,7 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m endif ; enddo endif do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a(i,K) = a(i,K) + Kv_add(i,K) + a_cpl(i,K) = a_cpl(i,K) + Kv_add(i,K) endif ; enddo ; enddo endif endif @@ -1184,11 +1185,11 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m if (associated(visc%Kv_shear_Bu)) then if (work_on_u) then do K=2,nz ; do I=Is,Ie ; If (do_i(I)) then - a(I,K) = a(I,K) + (2.*0.5)*(visc%Kv_shear_Bu(I,J-1,k) + visc%Kv_shear_Bu(I,J,k)) + a_cpl(I,K) = a_cpl(I,K) + (2.*0.5)*(visc%Kv_shear_Bu(I,J-1,k) + visc%Kv_shear_Bu(I,J,k)) endif ; enddo ; enddo else do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a(i,K) = a(i,K) + (2.*0.5)*(visc%Kv_shear_Bu(I-1,J,k) + visc%Kv_shear_Bu(I,J,k)) + a_cpl(i,K) = a_cpl(i,K) + (2.*0.5)*(visc%Kv_shear_Bu(I-1,J,k) + visc%Kv_shear_Bu(I,J,k)) endif ; enddo ; enddo endif endif @@ -1210,7 +1211,7 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m endif ; enddo endif do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a(i,K) = a(i,K) + Kv_add(i,K) + a_cpl(i,K) = a_cpl(i,K) + Kv_add(i,K) endif ; enddo ; enddo else do K=2,nz ; do i=is,ie ; if (do_i(i)) then @@ -1226,7 +1227,7 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m endif ; enddo endif do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a(i,K) = a(i,K) + Kv_add(i,K) + a_cpl(i,K) = a_cpl(i,K) + Kv_add(i,K) endif ; enddo ; enddo endif endif @@ -1238,7 +1239,7 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m botfn = 1.0 / (1.0 + 0.09*z2*z2*z2*z2*z2*z2) if (CS%bottomdraglaw) then - a(i,K) = a(i,K) + 2.0*(kv_bbl(i)-CS%Kv)*botfn + a_cpl(i,K) = a_cpl(i,K) + 2.0*(kv_bbl(i)-CS%Kv)*botfn r = (hvel(i,k)+hvel(i,k-1)) if (r > 2.0*bbl_thick(i)) then h_shear = ((1.0 - botfn) * r + botfn*2.0*bbl_thick(i)) @@ -1246,15 +1247,13 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m h_shear = r endif else - a(i,K) = a(i,K) + 2.0*(CS%Kvbbl-CS%Kv)*botfn + a_cpl(i,K) = a_cpl(i,K) + 2.0*(CS%Kvbbl-CS%Kv)*botfn h_shear = hvel(i,k) + hvel(i,k-1) + h_neglect endif - ! Up to this point a has units of m2 s-1, but now is converted to m s-1. - ! The term including 1e-10 in the denominators is here to avoid - ! truncation error problems in the tridiagonal solver. Effectively, this - ! sets the maximum coupling coefficient at 1e10 m. - a(i,K) = a(i,K) / (h_shear*H_to_m + 1.0e-10*dt*a(i,K)) + ! Up to this point a has units of m2 s-1, but now is converted to Z s-1. + a_cpl(i,K) = a_cpl(i,K) * m2_to_Z2 + a_cpl(i,K) = a_cpl(i,K) / (h_shear*GV%H_to_Z + I_amax*a_cpl(i,K)) endif ; enddo ; enddo ! i & k loops if (do_shelf) then @@ -1269,11 +1268,11 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m endif z_t(i) = 0.0 - ! If a(i,1) were not already 0, it would be added here. + ! If a_cpl(i,1) were not already 0, it would be added here. if (0.5*hvel(i,1) > tbl_thick(i)) then - a(i,1) = kv_tbl(i) / (tbl_thick(i) *H_to_m + (1.0e-10*dt)*kv_tbl(i)) + a_cpl(i,1) = m2_to_Z2 * kv_tbl(i) / (tbl_thick(i) *GV%H_to_Z + I_amax*(m2_to_Z2*kv_tbl(i))) else - a(i,1) = kv_tbl(i) / (0.5*hvel(i,1)*H_to_m + (1.0e-10*dt)*kv_tbl(i)) + a_cpl(i,1) = m2_to_Z2 * kv_tbl(i) / (0.5*hvel(i,1)*GV%H_to_Z + I_amax*(m2_to_Z2*kv_tbl(i))) endif endif ; enddo @@ -1287,22 +1286,20 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m else h_shear = r endif - ! The term including 1e-10 in the denominators is here to avoid - ! truncation error problems in the tridiagonal solver. Effectively, this - ! sets the maximum coupling coefficient increment to 1e10 m. - a_top = 2.0 * topfn * kv_tbl(i) - a(i,K) = a(i,K) + a_top / (h_shear*H_to_m + 1.0e-10*dt*a_top) + + a_top = 2.0 * topfn * (m2_to_Z2 * kv_tbl(i)) + a_cpl(i,K) = a_cpl(i,K) + a_top / (h_shear*GV%H_to_Z + I_amax*a_top) endif ; enddo ; enddo elseif (CS%dynamic_viscous_ML .or. (GV%nkml>0)) then max_nk = 0 do i=is,ie ; if (do_i(i)) then if (GV%nkml>0) nk_visc(i) = real(GV%nkml+1) if (work_on_u) then - u_star(I) = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) + u_star(I) = 0.5*GV%m_to_Z*(forces%ustar(i,j) + forces%ustar(i+1,j)) absf(I) = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) if (CS%dynamic_viscous_ML) nk_visc(I) = visc%nkml_visc_u(I,j) + 1 else - u_star(i) = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) + u_star(i) = 0.5*GV%m_to_Z*(forces%ustar(i,j) + forces%ustar(i,j+1)) absf(i) = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) if (CS%dynamic_viscous_ML) nk_visc(i) = visc%nkml_visc_v(i,J) + 1 endif @@ -1313,16 +1310,16 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m if (do_OBCS) then ; if (work_on_u) then do I=is,ie ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) & - u_star(I) = forces%ustar(i,j) + u_star(I) = GV%m_to_Z*forces%ustar(i,j) if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) & - u_star(I) = forces%ustar(i+1,j) + u_star(I) = GV%m_to_Z*forces%ustar(i+1,j) endif ; enddo else do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) & - u_star(i) = forces%ustar(i,j) + u_star(i) = GV%m_to_Z*forces%ustar(i,j) if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) & - u_star(i) = forces%ustar(i,j+1) + u_star(i) = GV%m_to_Z*forces%ustar(i,j+1) endif ; enddo endif ; endif @@ -1337,16 +1334,15 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m do K=2,max_nk ; do i=is,ie ; if (do_i(i)) then ; if (k < nk_visc(i)) then ! Set the viscosity at the interfaces. z_t(i) = z_t(i) + hvel(i,k-1) - temp1 = (z_t(i)*h_ml(i) - z_t(i)*z_t(i)) * H_to_m - ! This viscosity is set to go to 0 at the mixed layer top and bottom - ! (in a log-layer) and be further limited by rotation to give the - ! natural Ekman length. + temp1 = (z_t(i)*h_ml(i) - z_t(i)*z_t(i))*GV%H_to_Z + ! This viscosity is set to go to 0 at the mixed layer top and bottom (in a log-layer) + ! and be further limited by rotation to give the natural Ekman length. visc_ml = u_star(i) * 0.41 * (temp1*u_star(i)) / & (absf(i)*temp1 + h_ml(i)*u_star(i)) - a_ml = 4.0*visc_ml / ((hvel(i,k)+hvel(i,k-1) + h_neglect) * H_to_m + & - 2.0e-10*dt*visc_ml) + a_ml = 4.0*visc_ml / ((hvel(i,k)+hvel(i,k-1) + h_neglect) * GV%H_to_Z + & + 2.0*I_amax* visc_ml) ! Choose the largest estimate of a. - if (a_ml > a(i,K)) a(i,K) = a_ml + if (a_ml > a_cpl(i,K)) a_cpl(i,K) = a_ml endif ; endif ; enddo ; enddo endif @@ -1748,10 +1744,10 @@ subroutine vertvisc_init(MIS, Time, G, GV, param_file, diag, ADp, dirs, & 'Total vertical viscosity at v-points', 'm2 s-1') CS%id_au_vv = register_diag_field('ocean_model', 'au_visc', diag%axesCui, Time, & - 'Zonal Viscous Vertical Coupling Coefficient', 'm s-1') + 'Zonal Viscous Vertical Coupling Coefficient', 'm s-1', conversion=GV%Z_to_m) CS%id_av_vv = register_diag_field('ocean_model', 'av_visc', diag%axesCvi, Time, & - 'Meridional Viscous Vertical Coupling Coefficient', 'm s-1') + 'Meridional Viscous Vertical Coupling Coefficient', 'm s-1', conversion=GV%Z_to_m) CS%id_h_u = register_diag_field('ocean_model', 'Hu_visc', diag%axesCuL, Time, & 'Thickness at Zonal Velocity Points for Viscosity', thickness_units) From 5ae16fe46d42126e669ce9e758d894f20911f05a Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 22 Sep 2018 21:09:57 -0400 Subject: [PATCH 106/174] Rescale the output of a in write_u_accel Rescale the output of a in write_u_accel and write_v_accel. All answers are bitwise identical, but diagnsotic output changes when the model is truncating velocities. --- src/diagnostics/MOM_PointAccel.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index 29fb308dd3..fa31586659 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -85,7 +85,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a real, optional, intent(in) :: str !< The surface wind stress integrated over a time !! step, in m2 s-1. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - optional, intent(in) :: a !< The layer coupling coefficients from vertvisc, m. + optional, intent(in) :: a !< The layer coupling coefficients from vertvisc, Z s-1. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: hv !< The layer thicknesses at velocity grid points, !! from vertvisc, in m. @@ -215,7 +215,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a endif if (present(a)) then write(file,'(/,"a: ",$)') - do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ",$)') a(I,j,k); enddo + do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ",$)') a(I,j,k)*GV%Z_to_m*dt; enddo endif if (present(hv)) then write(file,'(/,"hvel: ",$)') @@ -413,7 +413,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a real, optional, intent(in) :: str !< The surface wind stress integrated over a time !! step, in m2 s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - optional, intent(in) :: a !< The layer coupling coefficients from vertvisc, m. + optional, intent(in) :: a !< The layer coupling coefficients from vertvisc, Z s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(in) :: hv !< The layer thicknesses at velocity grid points, !! from vertvisc, in m. @@ -547,7 +547,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a endif if (present(a)) then write(file,'(/,"a: ",$)') - do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ",$)') a(i,j,k); enddo + do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ",$)') a(i,j,k)*GV%Z_to_m*dt; enddo endif if (present(hv)) then write(file,'(/,"hvel: ",$)') From 086a5d72696f88cd9f21cc6628bf17bdf8b7cb87 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 23 Sep 2018 20:56:44 -0400 Subject: [PATCH 107/174] Removed unnueded variables in MOM_vert_friction Removed unnecssary variables in MOM_vert_friction by working directly with scaling factors from the vertical grid type. ALl answers are bitwise identical. --- .../vertical/MOM_vert_friction.F90 | 25 ++++++++----------- 1 file changed, 11 insertions(+), 14 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 92d1d79b4e..67be1e7ca8 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -625,9 +625,8 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) real :: z2 ! The distance from the bottom, normalized by Hbbl, nondim. real :: z2_wt ! A nondimensional (0-1) weight used when calculating z2. real :: z_clear ! The clearance of an interface above the surrounding topography, in H. - real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H. - real :: m_to_H ! Unit conversion factors. + real :: h_neglect ! A thickness that is so small it is usually lost + ! in roundoff and can be neglected, in H. real :: I_valBL ! The inverse of a scaling factor determining when water is ! still within the boundary layer, as determined by the sum @@ -645,7 +644,6 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) "Module must be initialized before it is used.") h_neglect = GV%H_subroundoff - m_to_H = GV%m_to_H I_Hbbl(:) = 1.0 / (CS%Hbbl * GV%m_to_H + h_neglect) I_valBL = 0.0 ; if (CS%harm_BL_val > 0.0) I_valBL = 1.0 / CS%harm_BL_val @@ -679,7 +677,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) if (CS%bottomdraglaw) then ; do I=Isq,Ieq kv_bbl(I) = visc%kv_bbl_u(I,j) - bbl_thick(I) = visc%bbl_thick_u(I,j) * m_to_H + bbl_thick(I) = visc%bbl_thick_u(I,j) * GV%m_to_H if (do_i(I)) I_Hbbl(I) = 1.0 / (bbl_thick(I) + h_neglect) enddo ; endif @@ -776,7 +774,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) ! Perhaps this needs to be done more carefully, via find_eta. do I=Isq,Ieq ; if (do_i_shelf(I)) then zh(I) = 0.0 ; Ztop_min(I) = min(zcol(i), zcol(i+1)) - I_HTbl(I) = 1.0 / (visc%tbl_thick_shelf_u(I,j)*m_to_H + h_neglect) + I_HTbl(I) = 1.0 / (visc%tbl_thick_shelf_u(I,j)*GV%m_to_H + h_neglect) endif ; enddo do k=1,nz do i=Isq,Ieq+1 ; zcol(i) = zcol(i) - h(i,j,k) ; enddo @@ -839,14 +837,14 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) ! Now work on v-points. !$OMP parallel do default(private) shared(G,GV,CS,visc,is,ie,Jsq,Jeq,nz,v,h,forces,hML_v, & - !$OMP OBC,h_neglect,dt,m_to_H,I_valBL,Kv_v) & + !$OMP OBC,h_neglect,dt,I_valBL,Kv_v) & !$OMP firstprivate(i_hbbl) do J=Jsq,Jeq do i=is,ie ; do_i(i) = (G%mask2dCv(i,J) > 0) ; enddo if (CS%bottomdraglaw) then ; do i=is,ie kv_bbl(i) = visc%kv_bbl_v(i,J) - bbl_thick(i) = visc%bbl_thick_v(i,J) * m_to_H + bbl_thick(i) = visc%bbl_thick_v(i,J) * GV%m_to_H if (do_i(i)) I_Hbbl(i) = 1.0 / bbl_thick(i) enddo ; endif @@ -944,7 +942,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) ! Perhaps this needs to be done more carefully, via find_eta. do i=is,ie ; if (do_i_shelf(i)) then zh(i) = 0.0 ; Ztop_min(I) = min(zcol1(i), zcol2(i)) - I_HTbl(i) = 1.0 / (visc%tbl_thick_shelf_v(i,J)*m_to_H + h_neglect) + I_HTbl(i) = 1.0 / (visc%tbl_thick_shelf_v(i,J)*GV%m_to_H + h_neglect) endif ; enddo do k=1,nz do i=is,ie ; if (do_i_shelf(i)) then @@ -1087,7 +1085,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in H. real :: z2 ! A copy of z_i, nondim. - real :: H_to_m, m_to_H, m2_to_Z2 ! Unit conversion factors. + real :: m2_to_Z2 ! Unit conversion factors. real :: topfn real :: a_top logical :: do_shelf, do_OBCs @@ -1101,7 +1099,6 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, else ; is = G%isc ; ie = G%iec ; endif nz = G%ke h_neglect = GV%H_subroundoff - H_to_m = GV%H_to_m ; m_to_H = GV%m_to_H m2_to_Z2 = GV%m_to_Z*GV%m_to_Z ! The maximum coupling coefficent was originally introduced to avoid @@ -1120,7 +1117,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, if ((GV%nkml>0) .or. do_shelf) then ; do k=2,nz ; do i=is,ie if (do_i(i)) a_cpl(i,K) = 2.0*CS%Kv enddo ; enddo ; else - I_Hmix = 1.0 / (CS%Hmix * m_to_H + h_neglect) + I_Hmix = 1.0 / (CS%Hmix * GV%m_to_H + h_neglect) do i=is,ie ; z_t(i) = h_neglect*I_Hmix ; enddo do K=2,nz ; do i=is,ie ; if (do_i(i)) then z_t(i) = z_t(i) + h_harm(i,k-1)*I_Hmix @@ -1261,10 +1258,10 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, do i=is,ie ; if (do_i(i)) then if (work_on_u) then kv_tbl(i) = visc%kv_tbl_shelf_u(I,j) - tbl_thick(i) = visc%tbl_thick_shelf_u(I,j) * m_to_H + tbl_thick(i) = visc%tbl_thick_shelf_u(I,j) * GV%m_to_H else kv_tbl(i) = visc%kv_tbl_shelf_v(i,J) - tbl_thick(i) = visc%tbl_thick_shelf_v(i,J) * m_to_H + tbl_thick(i) = visc%tbl_thick_shelf_v(i,J) * GV%m_to_H endif z_t(i) = 0.0 From 0c5a3ef8b9ed26cd8f5a10bd46f4402004c5a85d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 23 Sep 2018 20:57:17 -0400 Subject: [PATCH 108/174] Do MOM_set_viscosity in units of Z Rescaled several of the variables in MOM_set_viscosity to work in units of Z and H instead of m. Also eliminated several unused variables and updated the comments describing others. All answers are bitwise identical. --- .../vertical/MOM_set_viscosity.F90 | 168 +++++++++--------- 1 file changed, 86 insertions(+), 82 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 8f9e325ddc..ef92c5a8c5 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -44,15 +44,14 @@ module MOM_set_visc real :: drag_bg_vel !< An assumed unresolved background velocity for !! calculating the bottom drag, in m s-1. real :: BBL_thick_min !< The minimum bottom boundary layer thickness in - !! the same units as thickness (m or kg m-2). + !! the same units as thickness (H, often m or kg m-2). !! This might be Kv / (cdrag * drag_bg_vel) to give !! Kv as the minimum near-bottom viscosity. - real :: Htbl_shelf !< A nominal thickness of the surface boundary layer - !! for use in calculating the near-surface velocity, - !! in units of m. - real :: Htbl_shelf_min !< The minimum surface boundary layer thickness in m. - real :: KV_BBL_min !< The minimum viscosities in the bottom and top - real :: KV_TBL_min !< boundary layers, both in m2 s-1. + real :: Htbl_shelf !< A nominal thickness of the surface boundary layer for use + !! in calculating the near-surface velocity, in units of H. + real :: Htbl_shelf_min !< The minimum surface boundary layer thickness in H. + real :: KV_BBL_min !< The minimum viscosity in the bottom boundary layer, in Z2 s-1. + real :: KV_TBL_min !< The minimum viscosity in the top boundary layer, in Z2 s-1. logical :: bottomdraglaw !< If true, the bottom stress is calculated with a !! drag law c_drag*|u|*u. The velocity magnitude !! may be an assumed value or it may be based on the @@ -71,7 +70,7 @@ module MOM_set_visc !! thickness of the viscous mixed layer. Nondim. real :: omega !< The Earth's rotation rate, in s-1. real :: ustar_min !< A minimum value of ustar to avoid numerical - !! problems, in m s-1. If the value is small enough, + !! problems, in Z s-1. If the value is small enough, !! this should not affect the solution. real :: TKE_decay !< The ratio of the natural Ekman depth to the TKE !! decay scale, nondimensional. @@ -185,6 +184,8 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) real :: ustarsq ! 400 times the square of ustar, times ! Rho0 divided by G_Earth and the conversion ! from m to thickness units, in 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, in Z m-1. real :: cdrag_sqrt ! Square root of the drag coefficient, nd. real :: oldfn ! The integrated energy required to ! entrain up to the bottom of the layer, @@ -193,13 +194,14 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) ! the layer, in H kg m-3. real :: Dh ! The increment in layer thickness from ! the present layer, in H. - real :: bbl_thick ! The thickness of the bottom boundary layer in m. + real :: bbl_thick ! The thickness of the bottom boundary layer in H. + real :: bbl_thick_Z ! The thickness of the bottom boundary layer in Z. real :: C2f ! C2f = 2*f at velocity points. real :: U_bg_sq ! The square of an assumed background ! velocity, for calculating the mean ! magnitude near the bottom for use in the - ! quadratic bottom drag, in m2. + ! quadratic bottom drag, in m2 s-2. real :: hwtot ! Sum of the thicknesses used to calculate ! the near-bottom velocity magnitude, in H. real :: hutot ! Running sum of thicknesses times the @@ -209,8 +211,8 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) real :: hweight ! The thickness of a layer that is within Hbbl ! of the bottom, in H. real :: v_at_u, u_at_v ! v at a u point or vice versa, m s-1. - real :: Rho0x400_G ! 400*Rho0/G_Earth, in kg s2 m-4. The 400 is a - ! constant proposed by Killworth and Edwards, 1999. + real :: Rho0x400_G ! 400*Rho0/G_Earth, times unit conversion factors, in kg s2 H m-3 Z-2. + ! The 400 is a constant proposed by Killworth and Edwards, 1999. real, dimension(SZI_(G),SZJ_(G),max(GV%nk_rho_varies,1)) :: & Rml ! The mixed layer coordinate density, in kg m-3. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate @@ -256,7 +258,6 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) ! in roundoff and can be neglected, in H. real :: ustH ! ustar converted to units of H s-1. real :: root ! A temporary variable with units of H s-1. - real :: H_to_m, m_to_H ! Local copies of unit conversion factors. real :: Cell_width ! The transverse width of the velocity cell, in m. real :: Rayleigh ! A nondimensional value that is multiplied by the @@ -281,9 +282,8 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB nkmb = GV%nk_rho_varies ; nkml = GV%nkml h_neglect = GV%H_subroundoff - Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth)*GV%m_to_H + Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth) * GV%Z_to_m*GV%Z_to_H Vol_quit = 0.9*GV%Angstrom_H + h_neglect - H_to_m = GV%H_to_m ; m_to_H = GV%m_to_H C2pi_3 = 8.0*atan(1.0)/3.0 if (.not.associated(CS)) call MOM_error(FATAL,"MOM_vert_friction(BBL): "//& @@ -305,11 +305,12 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) OBC => CS%OBC U_bg_sq = CS%drag_bg_vel * CS%drag_bg_vel - cdrag_sqrt=sqrt(CS%cdrag) + cdrag_sqrt = sqrt(CS%cdrag) + cdrag_sqrt_Z = GV%m_to_Z * sqrt(CS%cdrag) K2 = max(nkmb+1, 2) ! With a linear drag law, the friction velocity is already known. -! if (CS%linear_drag) ustar(:) = cdrag_sqrt*CS%drag_bg_vel +! if (CS%linear_drag) ustar(:) = cdrag_sqrt_Z*CS%drag_bg_vel if ((nkml>0) .and. .not.use_BBL_EOS) then do i=Isq,Ieq+1 ; p_ref(i) = tv%P_ref ; enddo @@ -377,7 +378,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) !$OMP parallel do default(none) shared(u, v, h, tv, visc, G, GV, CS, Rml, is, ie, js, je, & !$OMP nz, Isq, Ieq, Jsq, Jeq, nkmb, h_neglect, Rho0x400_G,& !$OMP C2pi_3, U_bg_sq, cdrag_sqrt,K2,use_BBL_EOS,OBC, & -!$OMP maxitt,nkml,m_to_H,H_to_m,Vol_quit,D_u,D_v,mask_u,mask_v) & +!$OMP maxitt,nkml,Vol_quit,D_u,D_v,mask_u,mask_v) & !$OMP private(do_i,h_at_vel,htot_vel,hwtot,hutot,Thtot,Shtot, & !$OMP hweight,v_at_u,u_at_v,ustar,T_EOS,S_EOS,press, & !$OMP dR_dT, dR_dS,ustarsq,htot,T_vel,S_vel,Rml_vel, & @@ -543,9 +544,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) enddo ! end of k loop if (.not.CS%linear_drag .and. (hwtot > 0.0)) then - ustar(i) = cdrag_sqrt*hutot/hwtot + ustar(i) = cdrag_sqrt_Z*hutot/hwtot else - ustar(i) = cdrag_sqrt*CS%drag_bg_vel + ustar(i) = cdrag_sqrt_Z*CS%drag_bg_vel endif if (use_BBL_EOS) then ; if (hwtot > 0.0) then @@ -555,7 +556,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) endif ; endif endif ; enddo else - do i=is,ie ; ustar(i) = cdrag_sqrt*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 @@ -657,7 +658,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) if (CS%cdrag * U_bg_sq <= 0.0) then ! This avoids NaNs and overflows, and could be used in all cases, ! but is not bitwise identical to the current code. - ustH = ustar(i)*m_to_H ; root = sqrt(0.25*ustH**2 + (htot*C2f)**2) + ustH = ustar(i)*GV%Z_to_H ; root = sqrt(0.25*ustH**2 + (htot*C2f)**2) if (htot*ustH <= (CS%BBL_thick_min+h_neglect) * (0.5*ustH + root)) then bbl_thick = CS%BBL_thick_min else @@ -665,7 +666,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) endif else bbl_thick = htot / (0.5 + sqrt(0.25 + htot*htot*C2f*C2f/ & - ((ustar(i)*ustar(i)) * (m_to_H**2) ))) + ((ustar(i)*ustar(i)) * (GV%Z_to_H**2) ))) if (bbl_thick < CS%BBL_thick_min) bbl_thick = CS%BBL_thick_min endif @@ -856,8 +857,8 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) else ; Cell_width = G%dx_Cv(i,J) ; endif gam = 1.0 - L(K+1)/L(K) Rayleigh = 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 + m_to_H * & - CS%cdrag * gam*(1.0-gam)*(1.0-1.5*gam) * L(K)**2 * Cell_width) + (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) else ! This layer feels no drag. Rayleigh = 0.0 endif @@ -878,27 +879,27 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) enddo ! k loop to determine L(K). - bbl_thick = bbl_thick * H_to_m + bbl_thick_Z = bbl_thick * GV%H_to_Z if (m==1) then - visc%kv_bbl_u(I,j) = max(CS%KV_BBL_min, & - cdrag_sqrt*ustar(i)*bbl_thick*BBL_visc_frac) - visc%bbl_thick_u(I,j) = bbl_thick + visc%kv_bbl_u(I,j) = (GV%Z_to_m**2) * max(CS%KV_BBL_min, & + cdrag_sqrt*ustar(i)*bbl_thick_Z*BBL_visc_frac) + visc%bbl_thick_u(I,j) = GV%Z_to_m * bbl_thick_Z else - visc%kv_bbl_v(i,J) = max(CS%KV_BBL_min, & - cdrag_sqrt*ustar(i)*bbl_thick*BBL_visc_frac) - visc%bbl_thick_v(i,J) = bbl_thick + visc%kv_bbl_v(i,J) = (GV%Z_to_m**2) * max(CS%KV_BBL_min, & + cdrag_sqrt*ustar(i)*bbl_thick_Z*BBL_visc_frac) + visc%bbl_thick_v(i,J) = GV%Z_to_m * bbl_thick_Z endif else ! Not Channel_drag. ! Here the near-bottom viscosity is set to a value which will give ! the correct stress when the shear occurs over bbl_thick. - bbl_thick = bbl_thick * H_to_m + bbl_thick_Z = bbl_thick * GV%H_to_Z if (m==1) then - visc%kv_bbl_u(I,j) = max(CS%KV_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick) - visc%bbl_thick_u(I,j) = bbl_thick + visc%kv_bbl_u(I,j) = (GV%Z_to_m**2) * max(CS%KV_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick_Z) + visc%bbl_thick_u(I,j) = GV%Z_to_m * bbl_thick_Z else - visc%kv_bbl_v(i,J) = max(CS%KV_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick) - visc%bbl_thick_v(i,J) = bbl_thick + visc%kv_bbl_v(i,J) = (GV%Z_to_m**2) * max(CS%KV_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick_Z) + visc%bbl_thick_v(i,J) = GV%Z_to_m * bbl_thick_Z endif endif endif ; enddo ! end of i loop @@ -920,12 +921,12 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) if (CS%debug) then if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) & - call uvchksum("Ray [uv]", visc%Ray_u, visc%Ray_v, G%HI,haloshift=0) + call uvchksum("Ray [uv]", visc%Ray_u, visc%Ray_v, G%HI, haloshift=0) if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) & - call uvchksum("kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, G%HI,haloshift=0) + call uvchksum("kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, G%HI, haloshift=0) if (associated(visc%bbl_thick_u) .and. associated(visc%bbl_thick_v)) & call uvchksum("bbl_thick_[uv]", visc%bbl_thick_u, & - visc%bbl_thick_v, G%HI,haloshift=0) + visc%bbl_thick_v, G%HI, haloshift=0) endif end subroutine set_viscous_BBL @@ -1062,7 +1063,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) dR_dS, & ! Partial derivative of the density at the base of layer nkml ! (roughly the base of the mixed layer) with salinity, in units ! of kg m-3 psu-1. - ustar, & ! The surface friction velocity under ice shelves, in m s-1. + ustar, & ! The surface friction velocity under ice shelves, in Z s-1. press, & ! The pressure at which dR_dT and dR_dS are evaluated, in Pa. T_EOS, & ! T_EOS and S_EOS are the potential temperature and salnity at which dR_dT and dR_dS S_EOS ! which dR_dT and dR_dS are evaluated, in degC and PSU. @@ -1090,6 +1091,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) ! velocity magnitudes, in H m s-1. real :: hweight ! The thickness of a layer that is within Hbbl ! of the bottom, in H. + real :: tbl_thick_Z ! The thickness of the top boundary layer in Z. real :: hlay ! The layer thickness at velocity points, in H. real :: I_2hlay ! 1 / 2*hlay, in H-1. @@ -1112,7 +1114,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) real :: ustarsq ! 400 times the square of ustar, times ! Rho0 divided by G_Earth and the conversion ! from m to thickness units, in kg m-2 or kg2 m-5. - real :: cdrag_sqrt ! Square root of the drag coefficient, nd. + real :: cdrag_sqrt_Z ! Square root of the drag coefficient, times a unit conversion + ! factor from lateral lengths to vertical depths, in Z m-1. + real :: cdrag_sqrt ! Square root of the drag coefficient, ND. real :: oldfn ! The integrated energy required to ! entrain up to the bottom of the layer, ! divided by G_Earth, in H kg m-3. @@ -1126,12 +1130,11 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) real :: h_tiny ! A very small thickness, in H. 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, s-1. - real :: U_star ! The friction velocity at velocity points, in m s-1. + real :: U_star ! The friction velocity at velocity points, in Z s-1. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in H. - real :: Rho0x400_G ! 400*Rho0/G_Earth, in kg s2 m-4. The 400 is a - ! constant proposed by Killworth and Edwards, 1999. - real :: H_to_m, m_to_H ! Local copies of unit conversion factors. + real :: Rho0x400_G ! 400*Rho0/G_Earth, times unit conversion factors, in kg s2 H m-3 Z-2. + ! The 400 is a constant proposed by Killworth and Edwards, 1999. real :: ustar1 ! ustar in units of H/s real :: h2f2 ! (h*2*f)^2 logical :: use_EOS, do_any, do_any_shelf, do_i(SZIB_(G)) @@ -1151,9 +1154,10 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) Jsq = js-1 ; Isq = is-1 endif ; endif - Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth)*GV%m_to_H + Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth) * GV%Z_to_m*GV%Z_to_H U_bg_sq = CS%drag_bg_vel * CS%drag_bg_vel - cdrag_sqrt=sqrt(CS%cdrag) + cdrag_sqrt = sqrt(CS%cdrag) + cdrag_sqrt_Z = GV%m_to_Z * sqrt(CS%cdrag) OBC => CS%OBC use_EOS = associated(tv%eqn_of_state) @@ -1161,7 +1165,6 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) h_neglect = GV%H_subroundoff h_tiny = 2.0*GV%Angstrom_H + h_neglect g_H_Rho0 = (GV%g_Earth * GV%H_to_m) / GV%Rho0 - H_to_m = GV%H_to_m ; m_to_H = GV%m_to_H if (associated(forces%frac_shelf_u) .neqv. associated(forces%frac_shelf_v)) & call MOM_error(FATAL, "set_viscous_ML: one of forces%frac_shelf_u and "//& @@ -1177,7 +1180,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) call safe_alloc_ptr(visc%kv_tbl_shelf_v, G%isd, G%ied, G%JsdB, G%JedB) ! With a linear drag law, the friction velocity is already known. -! if (CS%linear_drag) ustar(:) = cdrag_sqrt*CS%drag_bg_vel +! if (CS%linear_drag) ustar(:) = cdrag_sqrt_Z*CS%drag_bg_vel endif !$OMP parallel do default(shared) @@ -1210,9 +1213,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) !$OMP parallel do default(none) shared(u, v, h, tv, forces, visc, dt, G, GV, CS, use_EOS, & !$OMP dt_Rho0, h_neglect, h_tiny, g_H_Rho0,js,je,OBC, & -!$OMP H_to_m, m_to_H, Isq, Ieq, nz, U_bg_sq,mask_v, & +!$OMP Isq, Ieq, nz, U_bg_sq,mask_v, & !$OMP cdrag_sqrt,Rho0x400_G,nkml) & -!$OMP private(do_any,htot,do_i,k_massive,Thtot,uhtot,vhtot,U_Star, & +!$OMP private(do_any,htot,do_i,k_massive,Thtot,uhtot,vhtot,U_star, & !$OMP Idecay_len_TKE,press,k2,I_2hlay,T_EOS,S_EOS,dR_dT, & !$OMP dR_dS,hlay,v_at_u,Uh2,T_lay,S_lay,gHprime, & !$OMP RiBulk,Shtot,Rhtot,absf,do_any_shelf, & @@ -1238,8 +1241,8 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) if (CS%omega_frac > 0.0) & absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2) endif - U_Star = max(CS%ustar_min, 0.5 * (forces%ustar(i,j) + forces%ustar(i+1,j))) - Idecay_len_TKE(I) = ((absf / U_Star) * CS%TKE_decay) * H_to_m + U_star = max(CS%ustar_min, 0.5 * (forces%ustar(i,j) + forces%ustar(i+1,j))*GV%m_to_Z) + Idecay_len_TKE(I) = ((absf / U_star) * CS%TKE_decay) * GV%H_to_Z endif enddo @@ -1363,9 +1366,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) enddo ; endif if ((.not.CS%linear_drag) .and. (hwtot > 0.0)) then - ustar(I) = cdrag_sqrt*hutot/hwtot + ustar(I) = cdrag_sqrt_Z*hutot/hwtot else - ustar(I) = cdrag_sqrt*CS%drag_bg_vel + ustar(I) = cdrag_sqrt_Z*CS%drag_bg_vel endif if (use_EOS) then ; if (hwtot > 0.0) then @@ -1438,13 +1441,13 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) !visc%tbl_thick_shelf_u(I,j) = max(CS%Htbl_shelf_min, & ! htot(I) / (0.5 + sqrt(0.25 + & ! (htot(i)*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)))**2 / & - ! (ustar(i)*m_to_H)**2 )) ) - ustar1 = ustar(i)*m_to_H + ! (ustar(i)*GV%Z_to_H)**2 )) ) + ustar1 = ustar(i)*GV%Z_to_H h2f2 = (htot(i)*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)) + h_neglect*CS%Omega)**2 - visc%tbl_thick_shelf_u(I,j) = max(CS%Htbl_shelf_min, & + tbl_thick_Z = GV%H_to_Z * max(CS%Htbl_shelf_min, & ( htot(I)*ustar1 ) / ( 0.5*ustar1 + sqrt((0.5*ustar1)**2 + h2f2 ) ) ) - visc%kv_tbl_shelf_u(I,j) = max(CS%KV_TBL_min, & - cdrag_sqrt*ustar(I)*visc%tbl_thick_shelf_u(I,j)) + visc%tbl_thick_shelf_u(I,j) = GV%Z_to_m * tbl_thick_Z + visc%kv_tbl_shelf_u(I,j) = (GV%Z_to_m**2) * max(CS%KV_TBL_min, cdrag_sqrt*ustar(i)*tbl_thick_Z) endif ; enddo ! I-loop endif ! do_any_shelf @@ -1453,9 +1456,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) !$OMP parallel do default(none) shared(u, v, h, tv, forces, visc, dt, G, GV, CS, use_EOS,& !$OMP dt_Rho0, h_neglect, h_tiny, g_H_Rho0,is,ie,OBC, & !$OMP Jsq,Jeq,nz,U_bg_sq,cdrag_sqrt,Rho0x400_G,nkml, & -!$OMP m_to_H,H_to_m,mask_u) & +!$OMP mask_u) & !$OMP private(do_any,htot,do_i,k_massive,Thtot,vhtot,uhtot,absf,& -!$OMP U_Star,Idecay_len_TKE,press,k2,I_2hlay,T_EOS, & +!$OMP U_star,Idecay_len_TKE,press,k2,I_2hlay,T_EOS, & !$OMP S_EOS,dR_dT, dR_dS,hlay,u_at_v,Uh2, & !$OMP T_lay,S_lay,gHprime,RiBulk,do_any_shelf, & !$OMP Shtot,Rhtot,ustar,h_at_vel,htot_vel,hwtot, & @@ -1482,8 +1485,8 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2) endif - U_Star = max(CS%ustar_min, 0.5 * (forces%ustar(i,j) + forces%ustar(i,j+1))) - Idecay_len_TKE(i) = ((absf / U_Star) * CS%TKE_decay) * H_to_m + U_star = max(CS%ustar_min, 0.5 * (forces%ustar(i,j) + forces%ustar(i,j+1))*GV%m_to_Z) + Idecay_len_TKE(i) = ((absf / U_star) * CS%TKE_decay) * GV%H_to_Z endif enddo @@ -1608,9 +1611,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) enddo ; endif if (.not.CS%linear_drag) then ; if (hwtot > 0.0) then - ustar(i) = cdrag_sqrt*hutot/hwtot + ustar(i) = cdrag_sqrt_Z*hutot/hwtot else - ustar(i) = cdrag_sqrt*CS%drag_bg_vel + ustar(i) = cdrag_sqrt_Z*CS%drag_bg_vel endif ; endif if (use_EOS) then ; if (hwtot > 0.0) then @@ -1683,13 +1686,14 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) !visc%tbl_thick_shelf_v(i,J) = max(CS%Htbl_shelf_min, & ! htot(i) / (0.5 + sqrt(0.25 + & ! (htot(i)*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)))**2 / & - ! (ustar(i)*m_to_H)**2 )) ) - ustar1 = ustar(i)*m_to_H + ! (ustar(i)*GV%Z_to_H)**2 )) ) + ustar1 = ustar(i)*GV%Z_to_H h2f2 = (htot(i)*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)) + h_neglect*CS%Omega)**2 - visc%tbl_thick_shelf_v(i,J) = max(CS%Htbl_shelf_min, & + tbl_thick_Z = GV%H_to_Z * max(CS%Htbl_shelf_min, & ( htot(i)*ustar1 ) / ( 0.5*ustar1 + sqrt((0.5*ustar1)**2 + h2f2 ) ) ) - visc%kv_tbl_shelf_v(i,J) = max(CS%KV_TBL_min, & - cdrag_sqrt*ustar(i)*visc%tbl_thick_shelf_v(i,J)) + visc%tbl_thick_shelf_v(i,J) = GV%Z_to_m * tbl_thick_Z + visc%kv_tbl_shelf_v(i,J) = (GV%Z_to_m**2) * max(CS%KV_TBL_min, cdrag_sqrt*ustar(i)*tbl_thick_Z) + endif ; enddo ! i-loop endif ! do_any_shelf @@ -1910,7 +1914,7 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) "The rotation rate of the earth.", units="s-1", & default=7.2921e-5) ! This give a minimum decay scale that is typically much less than Angstrom. - CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_m + GV%H_to_m*GV%H_subroundoff) + CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_Z + GV%H_to_Z*GV%H_subroundoff) else call get_param(param_file, mdl, "OMEGA", CS%omega, & "The rotation rate of the earth.", units="s-1", & @@ -1922,7 +1926,7 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) "viscosity of KVBBL if BOTTOMDRAGLAW is not defined, or \n"//& "the thickness over which near-bottom velocities are \n"//& "averaged for the drag law if BOTTOMDRAGLAW is defined \n"//& - "but LINEAR_DRAG is not.", units="m", fail_if_missing=.true.) + "but LINEAR_DRAG is not.", units="m", fail_if_missing=.true.) ! Rescaled later if (CS%bottomdraglaw) then call get_param(param_file, mdl, "CDRAG", CS%cdrag, & "CDRAG is the drag coefficient relating the magnitude of \n"//& @@ -1944,16 +1948,19 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) "The minimum bottom boundary layer thickness that can be \n"//& "used with BOTTOMDRAGLAW. This might be \n"//& "Kv / (cdrag * drag_bg_vel) to give Kv as the minimum \n"//& - "near-bottom viscosity.", units="m", default=0.0) + "near-bottom viscosity.", units="m", default=0.0) ! Rescaled later call get_param(param_file, mdl, "HTBL_SHELF_MIN", CS%Htbl_shelf_min, & "The minimum top boundary layer thickness that can be \n"//& "used with BOTTOMDRAGLAW. This might be \n"//& "Kv / (cdrag * drag_bg_vel) to give Kv as the minimum \n"//& - "near-top viscosity.", units="m", default=CS%BBL_thick_min) + "near-top viscosity.", units="m", default=CS%BBL_thick_min, scale=GV%m_to_H) call get_param(param_file, mdl, "HTBL_SHELF", CS%Htbl_shelf, & "The thickness over which near-surface velocities are \n"//& "averaged for the drag law under an ice shelf. By \n"//& - "default this is the same as HBBL", units="m", default=CS%Hbbl) + "default this is the same as HBBL", units="m", default=CS%Hbbl, scale=GV%m_to_H) + ! These unit conversions are out outside the get_param calls because the are also defaults. + CS%Hbbl = CS%Hbbl * GV%m_to_H ! Rescale + CS%BBL_thick_min = CS%BBL_thick_min * GV%m_to_H ! Rescale call get_param(param_file, mdl, "KV", Kv_background, & "The background kinematic viscosity in the interior. \n"//& @@ -1980,10 +1987,10 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) call get_param(param_file, mdl, "KV_BBL_MIN", CS%KV_BBL_min, & "The minimum viscosities in the bottom boundary layer.", & - units="m2 s-1", default=Kv_background) + units="m2 s-1", default=Kv_background, scale=GV%m_to_Z**2) call get_param(param_file, mdl, "KV_TBL_MIN", CS%KV_TBL_min, & "The minimum viscosities in the top boundary layer.", & - units="m2 s-1", default=Kv_background) + units="m2 s-1", default=Kv_background, scale=GV%m_to_Z**2) if (CS%Channel_drag) then call get_param(param_file, mdl, "SMAG_LAP_CONST", smag_const1, default=-1.0) @@ -2047,9 +2054,6 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) diag%axesCv1, Time, 'Number of layers in viscous mixed layer at v points', 'm') endif - CS%Hbbl = CS%Hbbl * GV%m_to_H - CS%BBL_thick_min = CS%BBL_thick_min * GV%m_to_H - end subroutine set_visc_init !> This subroutine dellocates any memory in the set_visc control structure. From 0090b2fd97f6144e155884883dfd3df180807bf4 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 26 Sep 2018 14:10:02 -0400 Subject: [PATCH 109/174] (*)Fixed a sign-error in ISOMIP_initialize_temp... Fixed a sign-error in ISOMIP_initialize_temperature_salinity, in which the temperature and salinity gradients were reversed in the layer mode branch. This bug was introduced with commit NOAA-GFDL/MOM6@59c7e221c, but was not detected by the MOM6-examples testing process. The ISOMIP test case now reproduces the answers that can be found with the MOM6 dev/master branch. --- src/user/ISOMIP_initialization.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index 8940a9fcc3..621c5046dd 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -333,8 +333,8 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, do k = 1,nz !T0(k) = T_Ref; S0(k) = S_Ref xi1 = xi0 + 0.5 * h(i,j,k) * GV%H_to_Z - S0(k) = S_sur + dS_dz * xi1 - T0(k) = T_sur + dT_dz * xi1 + S0(k) = S_sur - dS_dz * xi1 + T0(k) = T_sur - dT_dz * xi1 xi0 = xi0 + h(i,j,k) * GV%H_to_Z ! write(mesg,*) 'S,T,xi0,xi1,k',S0(k),T0(k),xi0,xi1,k ! call MOM_mesg(mesg,5) From a9ab1eb034bec59a7ea2625d51505fa2b8a72aef Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 26 Sep 2018 14:52:58 -0400 Subject: [PATCH 110/174] +Added z_tol arg to find_depth_of_pressure_in_cell Added optional z_tol argument to find_depth_of_pressure_in_cell, to permit the calling routine to specify the tolerance for the result of this routine, rather than using the current hard-coded value, and to enable dimensional consistency testing for depths. All answers are bitwise identical, but there is a new optional argument to a public routine. --- src/equation_of_state/MOM_EOS.F90 | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 7748a8b505..9a823d23eb 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -1355,20 +1355,21 @@ end subroutine int_density_dz_generic_plm !> Find the depth at which the reconstructed pressure matches P_tgt subroutine find_depth_of_pressure_in_cell(T_t, T_b, S_t, S_b, z_t, z_b, P_t, P_tgt, & - rho_ref, G_e, EOS, P_b, z_out) + rho_ref, G_e, EOS, P_b, z_out, z_tol) real, intent(in) :: T_t !< Potential temperatue at the cell top (degC) real, intent(in) :: T_b !< Potential temperatue at the cell bottom (degC) real, intent(in) :: S_t !< Salinity at the cell top (ppt) real, intent(in) :: S_b !< Salinity at the cell bottom (ppt) - real, intent(in) :: z_t !< Absolute height of top of cell (m) (Boussinesq ????) - real, intent(in) :: z_b !< Absolute height of bottom of cell (m) + real, intent(in) :: z_t !< Absolute height of top of cell (Z) (Boussinesq ????) + real, intent(in) :: z_b !< Absolute height of bottom of cell (Z) real, intent(in) :: P_t !< Anomalous pressure of top of cell, relative to g*rho_ref*z_t (Pa) real, intent(in) :: P_tgt !< Target pressure at height z_out, relative to g*rho_ref*z_out (Pa) real, intent(in) :: rho_ref !< Reference density with which calculation are anomalous to - real, intent(in) :: G_e !< Gravitational acceleration (m/s2) + real, intent(in) :: G_e !< Gravitational acceleration (m2 Z-1 s-2) type(EOS_type), pointer :: EOS !< Equation of state structure real, intent(out) :: P_b !< Pressure at the bottom of the cell (Pa) - real, intent(out) :: z_out !< Absolute depth at which anomalous pressure = p_tgt (m) + real, intent(out) :: z_out !< Absolute depth at which anomalous pressure = p_tgt (Z) + real, optional, intent(in) :: z_tol !< The tolerance in finding z_out, in Z. ! Local variables real :: top_weight, bottom_weight, rho_anom, w_left, w_right, GxRho, dz, dp, F_guess, F_l, F_r real :: Pa, Pa_left, Pa_right, Pa_tol ! Pressure anomalies, P = integral of g*(rho-rho_ref) dz @@ -1394,7 +1395,8 @@ subroutine find_depth_of_pressure_in_cell(T_t, T_b, S_t, S_b, z_t, z_b, P_t, P_t Pa_left = P_t - P_tgt ! Pa_left < 0 F_r = 1. Pa_right = P_b - P_tgt ! Pa_right > 0 - Pa_tol = GxRho * 1.e-5 + Pa_tol = GxRho * 1.e-5 ! 1e-5 has diimensions of m, but should be converted to the units of z. + if (present(z_tol)) Pa_tol = GxRho * z_tol F_guess = F_l - Pa_left / ( Pa_right -Pa_left ) * ( F_r - F_l ) Pa = Pa_right - Pa_left ! To get into iterative loop do while ( abs(Pa) > Pa_tol ) @@ -1435,7 +1437,7 @@ real function frac_dp_at_pos(T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, G_e, pos, EO real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted out to !! reduce the magnitude of each of the integrals. real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m s-2. - real, intent(in) :: pos !< The fractional vertical position, nondim. + real, intent(in) :: pos !< The fractional vertical position, nondim, 0 to 1. type(EOS_type), pointer :: EOS !< Equation of state structure ! Local variables real, parameter :: C1_90 = 1.0/90.0 ! Rational constants. From d60e85ffe9318949e4b6df41d6a68933badf90a7 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 26 Sep 2018 14:54:22 -0400 Subject: [PATCH 111/174] Correct Z-unit conversion in trim_for_ice Corrected conversions for dimensional consistency testing in a call to find_depth_of_pressure_in_cell in trim_for_ice, including adding a new optional argument, z_tol, to cut_off_column_top. Also added additional checksums in debug mode and corrected some comments. All answers are bitwise identical, and the layer-mode ISOMIP test case is now passing Z dimensional consistency checks. --- .../MOM_state_initialization.F90 | 37 ++++++++++++------- 1 file changed, 23 insertions(+), 14 deletions(-) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index fa719aca4c..6849acf27e 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -450,6 +450,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & do_not_log=just_read) if (depress_sfc .and. trim_ic_for_p_surf) call MOM_error(FATAL, "MOM_initialize_state: "//& "DEPRESS_INITIAL_SURFACE and TRIM_IC_FOR_P_SURF are exclusive and cannot both be True") + if (new_sim .and. debug .and. (depress_sfc .or. trim_ic_for_p_surf)) & + call hchksum(h, "Pre-depress: h ", G%HI, haloshift=1, scale=GV%H_to_m) if (depress_sfc) call depress_surface(h, G, GV, PF, tv, just_read_params=just_read) if (trim_ic_for_p_surf) call trim_for_ice(PF, G, GV, ALE_CSp, tv, h, just_read_params=just_read) @@ -469,6 +471,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & call get_param(PF, mdl, "DT", dt, "Timestep", fail_if_missing=.true.) + if (new_sim .and. debug) & + call hchksum(h, "Pre-ALE_regrid: h ", G%HI, haloshift=1, scale=GV%H_to_m) call ALE_regrid_accelerated(ALE_CSp, G, GV, h, tv, regrid_iterations, u, v, tracer_Reg, & dt=dt, initial=.true.) endif @@ -500,7 +504,6 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & write(mesg,'("MOM_IS: S[",I2,"]")') k call hchksum(tv%S(:,:,k), mesg, G%HI, haloshift=1) enddo ; endif - endif call get_param(PF, mdl, "SPONGE", use_sponge, & @@ -1073,10 +1076,11 @@ subroutine trim_for_ice(PF, G, GV, ALE_CSp, tv, h, just_read_params) real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: S_t, S_b ! Top and bottom edge values for reconstructions real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: T_t, T_b ! of salinity and temperature within each layer. character(len=200) :: inputdir, filename, p_surf_file, p_surf_var ! Strings for file/path - real :: scale_factor, min_thickness + real :: scale_factor ! A file-dependent scaling vactor for the input pressurs. + real :: min_thickness ! The minimum layer thickness, recast into Z units. integer :: i, j, k logical :: just_read ! If true, just read parameters but set nothing. - logical :: use_remapping + logical :: use_remapping ! If true, remap the initial conditions. type(remapping_CS), pointer :: remap_CS => NULL() just_read = .false. ; if (present(just_read_params)) just_read = just_read_params @@ -1124,31 +1128,35 @@ subroutine trim_for_ice(PF, G, GV, ALE_CSp, tv, h, just_read_params) do j=G%jsc,G%jec ; do i=G%isc,G%iec call cut_off_column_top(GV%ke, tv, GV, GV%g_Earth*GV%Z_to_m, G%bathyT(i,j), & min_thickness, tv%T(i,j,:), T_t(i,j,:), T_b(i,j,:), & - tv%S(i,j,:), S_t(i,j,:), S_b(i,j,:), p_surf(i,j), h(i,j,:), remap_CS) + tv%S(i,j,:), S_t(i,j,:), S_b(i,j,:), p_surf(i,j), h(i,j,:), remap_CS, & + z_tol=1.0e-5*GV%m_to_Z) enddo ; enddo end subroutine trim_for_ice -!> Adjust the layer thicknesses by cutting away the top at the depth where the hydrostatic -!! pressure matches p_surf + +!> Adjust the layer thicknesses by removing the top of the water column above the +!! depth where the hydrostatic pressure matches p_surf subroutine cut_off_column_top(nk, tv, GV, G_earth, depth, min_thickness, & - T, T_t, T_b, S, S_t, S_b, p_surf, h, remap_CS) - integer, intent(in) :: nk !< Number of layers - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + T, T_t, T_b, S, S_t, S_b, p_surf, h, remap_CS, z_tol) + integer, intent(in) :: nk !< Number of layers + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, intent(in) :: G_earth !< Gravitational acceleration (m2 Z-1 s-2) real, intent(in) :: depth !< Depth of ocean column (Z) real, intent(in) :: min_thickness !< Smallest thickness allowed (Z) - real, dimension(nk), intent(inout) :: T !< Layer mean temperature + real, dimension(nk), intent(inout) :: T !< Layer mean temperature real, dimension(nk), intent(in) :: T_t !< Temperature at top of layer real, dimension(nk), intent(in) :: T_b !< Temperature at bottom of layer - real, dimension(nk), intent(inout) :: S !< Layer mean salinity + real, dimension(nk), intent(inout) :: S !< Layer mean salinity real, dimension(nk), intent(in) :: S_t !< Salinity at top of layer real, dimension(nk), intent(in) :: S_b !< Salinity at bottom of layer real, intent(in) :: p_surf !< Imposed pressure on ocean at surface (Pa) - real, dimension(nk), intent(inout) :: h !< Layer thickness (H units, m or Pa) + real, dimension(nk), intent(inout) :: h !< Layer thickness (H units, m or Pa) type(remapping_CS), pointer :: remap_CS !< Remapping structure for remapping T and S, !! if associated + real, optional, intent(in) :: z_tol !< The tolerance with which to find the depth + !! matching the specified pressure, in Z. ! Local variables real, dimension(nk+1) :: e ! Top and bottom edge values for reconstructions @@ -1167,7 +1175,8 @@ subroutine cut_off_column_top(nk, tv, GV, G_earth, depth, min_thickness, & e_top = e(1) do k=1,nk call find_depth_of_pressure_in_cell(T_t(k), T_b(k), S_t(k), S_b(k), e(K), e(K+1), & - P_t, p_surf, GV%Rho0, G_earth, tv%eqn_of_state, P_b, z_out) + P_t, p_surf, GV%Rho0, G_earth, tv%eqn_of_state, & + P_b, z_out, z_tol=z_tol) if (z_out>=e(K)) then ! Imposed pressure was less that pressure at top of cell exit From 180e0ea12db99a6512aae70efd2a07b36178b4a1 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 26 Sep 2018 14:56:37 -0400 Subject: [PATCH 112/174] (*)Correct the grid used for allocate_forcing_type Use the correct grid type in allocate_forcing_type and allocate_mech_forcing calls inside initialize_ice_shelf, and added error checks to verify that compatible grids are being used by the ice shelf and ocean. All answers in the existing MOM6 test cases are bitwise identical, but this corrects a problem in which symmetric memory ocean models fail for the ISOMIP test case unless the ice shelf grid also uses symmetric memory. --- src/ice_shelf/MOM_ice_shelf.F90 | 25 +++++++++++++++++++------ 1 file changed, 19 insertions(+), 6 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index e6989caa54..24389af17f 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -754,6 +754,10 @@ subroutine add_shelf_forces(G, CS, forces, do_shelf_area) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; jsd = G%jsd ; ied = G%ied ; jed = G%jed + if ((CS%grid%isc /= G%isc) .or. (CS%grid%iec /= G%iec) .or. & + (CS%grid%jsc /= G%jsc) .or. (CS%grid%jec /= G%jec)) & + call MOM_error(FATAL,"add_shelf_forces: Incompatible ocean and ice shelf grids.") + ISS => CS%ISS find_area = .true. ; if (present(do_shelf_area)) find_area = do_shelf_area @@ -823,6 +827,10 @@ subroutine add_shelf_pressure(G, CS, fluxes) integer :: i, j, is, ie, js, je, isd, ied, jsd, jed is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + if ((CS%grid%isc /= G%isc) .or. (CS%grid%iec /= G%iec) .or. & + (CS%grid%jsc /= G%jsc) .or. (CS%grid%jec /= G%jec)) & + 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)) if (associated(fluxes%p_surf)) then @@ -877,6 +885,10 @@ subroutine add_shelf_flux(G, CS, state, fluxes) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; jsd = G%jsd ; ied = G%ied ; jed = G%jed + if ((CS%grid%isc /= G%isc) .or. (CS%grid%iec /= G%iec) .or. & + (CS%grid%jsc /= G%jsc) .or. (CS%grid%jec /= G%jec)) & + call MOM_error(FATAL,"add_shelf_flux: Incompatible ocean and ice shelf grids.") + ISS => CS%ISS call add_shelf_pressure(G, CS, fluxes) @@ -1098,16 +1110,17 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call set_grid_metrics(dG, param_file) ! call set_diag_mediator_grid(CS%grid, CS%diag) - ! The ocean grid is possibly different - if (associated(ocn_grid)) CS%ocn_grid => ocn_grid + ! The ocean grid possibly uses different symmetry. + if (associated(ocn_grid)) then ; CS%ocn_grid => ocn_grid + else ; CS%ocn_grid => CS%grid ; endif ! Convenience pointers G => CS%grid OG => CS%ocn_grid if (is_root_pe()) then - write(0,*) 'OG: ', OG%isd, OG%isc, OG%iec, OG%ied, OG%jsd, OG%jsc, OG%jsd, OG%jed - write(0,*) 'IG: ', G%isd, G%isc, G%iec, G%ied, G%jsd, G%jsc, G%jsd, G%jed + write(0,*) 'OG: ', OG%isd, OG%isc, OG%iec, OG%ied, OG%jsd, OG%jsc, OG%jsd, OG%jed + write(0,*) 'IG: ', G%isd, G%isc, G%iec, G%ied, G%jsd, G%jsc, G%jsd, G%jed endif CS%Time = Time ! ### This might not be in the right place? @@ -1344,10 +1357,10 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl ! when SHELF_THERMO = True. These fluxes are necessary if one wants to ! use either ENERGETICS_SFC_PBL (ALE mode) or BULKMIXEDLAYER (layer mode). if (present(fluxes)) & - call allocate_forcing_type(G, fluxes, ustar=.true., shelf=.true., & + call allocate_forcing_type(CS%ocn_grid, fluxes, ustar=.true., shelf=.true., & press=.true., water=CS%isthermo, heat=CS%isthermo) if (present(forces)) & - call allocate_mech_forcing(G, forces, ustar=.true., shelf=.true., press=.true.) + call allocate_mech_forcing(CS%ocn_grid, forces, ustar=.true., shelf=.true., press=.true.) else call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: allocating fluxes in solo mode.") if (present(fluxes)) & From f99e4bbb2a14240014fa7142fd7c5bd79501d0be Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 26 Sep 2018 15:34:51 -0400 Subject: [PATCH 113/174] Changed visc%Ray_u into units of Z s-1 Changed the dimensions of visc%Ray_u and visc%Ray_v to Z s-1, from m s-1, for expanded dimensional consistency testing. All answers are bitwise identical. --- src/core/MOM_variables.F90 | 6 +++--- .../vertical/MOM_set_diffusivity.F90 | 7 ++++--- .../vertical/MOM_set_viscosity.F90 | 14 +++++++------- .../vertical/MOM_vert_friction.F90 | 8 ++++---- 4 files changed, 18 insertions(+), 17 deletions(-) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 4a2dbbea54..3cfefd906c 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -219,10 +219,10 @@ module MOM_variables real, pointer, dimension(:,:) :: nkml_visc_v => NULL() !< The number of layers in the viscous surface mixed layer at v-points (nondimensional). real, pointer, dimension(:,:) :: & - MLD => NULL() !< Instantaneous active mixing layer depth (H units). + MLD => NULL() !< Instantaneous active mixing layer depth (H units). real, pointer, dimension(:,:,:) :: & - Ray_u => NULL(), & !< The Rayleigh drag velocity to be applied to each layer at u-points, in m s-1. - Ray_v => NULL() !< The Rayleigh drag velocity to be applied to each layer at v-points, in m s-1. + Ray_u => NULL(), & !< The Rayleigh drag velocity to be applied to each layer at u-points, in Z s-1. + Ray_v => NULL() !< The Rayleigh drag velocity to be applied to each layer at v-points, in Z s-1. real, pointer, dimension(:,:,:) :: Kd_extra_T => NULL() !< The extra diffusivity of temperature due to double diffusion relative to the !! diffusivity of density, in m2 s-1. diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 185bb6a14b..e3c591153f 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -549,7 +549,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & endif if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) then - call uvchksum("Ray_[uv]", visc%Ray_u, visc%Ray_v, G%HI, 0, symmetric=.true.) + call uvchksum("Ray_[uv]", visc%Ray_u, visc%Ray_v, G%HI, 0, symmetric=.true., scale=GV%Z_to_m) endif endif @@ -1279,7 +1279,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) * & + if (Rayleigh_drag) TKE_Ray = 0.5*CS%BBL_effic * GV%Z_to_m * 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 + & @@ -1459,7 +1459,8 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & dhm1 = GV%H_to_m * h(i,j,km1) ! Thickness of level above in m. ! Add in additional energy input from bottom-drag against slopes (sides) - if (Rayleigh_drag) TKE_remaining = TKE_remaining + 0.5*CS%BBL_effic * G%IareaT(i,j) * & + if (Rayleigh_drag) TKE_remaining = TKE_remaining + & + 0.5*CS%BBL_effic * GV%Z_to_m * 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 + & diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index ef92c5a8c5..9eb4b80be0 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -260,9 +260,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) real :: root ! A temporary variable with units of H s-1. real :: Cell_width ! The transverse width of the velocity cell, in m. - real :: Rayleigh ! A nondimensional value that is multiplied by the - ! layer's velocity magnitude to give the Rayleigh - ! drag velocity. + 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, in Z L-1. real :: gam ! The ratio of the change in the open interface width ! to the open interface width atop a cell, nondim. real :: BBL_frac ! The fraction of a layer's drag that goes into the @@ -856,7 +856,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, 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 = CS%cdrag * (L(K)-L(K+1)) * (1.0-BBL_frac) * & + Rayleigh = GV%m_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) else ! This layer feels no drag. @@ -921,7 +921,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) if (CS%debug) then if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) & - call uvchksum("Ray [uv]", visc%Ray_u, visc%Ray_v, G%HI, haloshift=0) + call uvchksum("Ray [uv]", visc%Ray_u, visc%Ray_v, G%HI, haloshift=0, scale=GV%Z_to_m) if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) & call uvchksum("kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, G%HI, haloshift=0) if (associated(visc%bbl_thick_u) .and. associated(visc%bbl_thick_v)) & @@ -2035,9 +2035,9 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) allocate(visc%Ray_u(IsdB:IedB,jsd:jed,nz)) ; visc%Ray_u = 0.0 allocate(visc%Ray_v(isd:ied,JsdB:JedB,nz)) ; visc%Ray_v = 0.0 CS%id_Ray_u = register_diag_field('ocean_model', 'Rayleigh_u', diag%axesCuL, & - Time, 'Rayleigh drag velocity at u points', 'm s-1') + Time, 'Rayleigh drag velocity at u points', 'm s-1', conversion=GV%Z_to_m) CS%id_Ray_v = register_diag_field('ocean_model', 'Rayleigh_v', diag%axesCvL, & - Time, 'Rayleigh drag velocity at v points', 'm s-1') + Time, 'Rayleigh drag velocity at v points', 'm s-1', conversion=GV%Z_to_m) endif if (use_CVMix_ddiff .or. differential_diffusion) then diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 67be1e7ca8..0666601701 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -265,7 +265,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & enddo ; endif ! direct_stress if (CS%Channel_drag) then ; do k=1,nz ; do I=Isq,Ieq - Ray(I,k) = GV%m_to_Z*visc%Ray_u(I,j,k) + Ray(I,k) = visc%Ray_u(I,j,k) enddo ; enddo ; endif ! perform forward elimination on the tridiagonal system @@ -373,7 +373,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & enddo ; endif ! direct_stress if (CS%Channel_drag) then ; do k=1,nz ; do i=is,ie - Ray(i,k) = GV%m_to_Z*visc%Ray_v(i,J,k) + Ray(i,k) = visc%Ray_v(i,J,k) enddo ; enddo ; endif do i=is,ie ; if (do_i(i)) then @@ -501,7 +501,7 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS) do I=Isq,Ieq ; do_i(I) = (G%mask2dCu(I,j) > 0) ; enddo if (CS%Channel_drag) then ; do k=1,nz ; do I=Isq,Ieq - Ray(I,k) = GV%m_to_Z*visc%Ray_u(I,j,k) + Ray(I,k) = visc%Ray_u(I,j,k) enddo ; enddo ; endif do I=Isq,Ieq ; if (do_i(I)) then @@ -532,7 +532,7 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS) do i=is,ie ; do_i(i) = (G%mask2dCv(i,J) > 0) ; enddo if (CS%Channel_drag) then ; do k=1,nz ; do i=is,ie - Ray(i,k) = GV%m_to_Z*visc%Ray_v(i,J,k) + Ray(i,k) = visc%Ray_v(i,J,k) enddo ; enddo ; endif do i=is,ie ; if (do_i(i)) then From 0eccfba3984bff24dd3ad90247a113f6991c8e36 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 26 Sep 2018 16:15:19 -0400 Subject: [PATCH 114/174] Changed visc%kv_bbl_u into units of Z2 s-1 Changed the dimensions of visc%kv_bbl_[uv] and visc%kv_tbl_[uv] to Z2 s-1, from m2 s-1, for expanded dimensional consistency testing. All answers are bitwise identical. --- src/core/MOM_variables.F90 | 10 +++++----- src/parameterizations/lateral/MOM_MEKE.F90 | 4 ++-- .../vertical/MOM_set_diffusivity.F90 | 6 +++--- .../vertical/MOM_set_viscosity.F90 | 18 +++++++++--------- .../vertical/MOM_vert_friction.F90 | 18 +++++++++--------- 5 files changed, 28 insertions(+), 28 deletions(-) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 3cfefd906c..b7f202aa5c 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -194,8 +194,8 @@ module MOM_variables real, pointer, dimension(:,:) :: & bbl_thick_u => NULL(), & !< The bottom boundary layer thickness at the u-points, in m. bbl_thick_v => NULL(), & !< The bottom boundary layer thickness at the v-points, in m. - kv_bbl_u => NULL(), & !< The bottom boundary layer viscosity at the u-points, in m2 s-1. - kv_bbl_v => NULL(), & !< The bottom boundary layer viscosity at the v-points, in m2 s-1. + kv_bbl_u => NULL(), & !< The bottom boundary layer viscosity at the u-points, in Z2 s-1. + kv_bbl_v => NULL(), & !< The bottom boundary layer viscosity at the v-points, in Z2 s-1. ustar_BBL => NULL() !< The turbulence velocity in the bottom boundary layer at h points, in m s-1. real, pointer, dimension(:,:) :: TKE_BBL => NULL() !< A term related to the bottom boundary layer source of turbulent kinetic @@ -208,9 +208,9 @@ module MOM_variables real, pointer, dimension(:,:) :: tbl_thick_shelf_v => NULL() !< Thickness of the viscous top boundary layer under ice shelves at v-points, in m. real, pointer, dimension(:,:) :: kv_tbl_shelf_u => NULL() - !< Viscosity in the viscous top boundary layer under ice shelves at u-points, in m2 s-1. + !< Viscosity in the viscous top boundary layer under ice shelves at u-points, in Z2 s-1. real, pointer, dimension(:,:) :: kv_tbl_shelf_v => NULL() - !< Viscosity in the viscous top boundary layer under ice shelves at v-points, in m2 s-1. + !< Viscosity in the viscous top boundary layer under ice shelves at v-points, in Z2 s-1. real, pointer, dimension(:,:) :: nkml_visc_u => NULL() !< The number of layers in the viscous surface mixed layer at u-points (nondimensional). !! This is not an integer because there may be fractional layers, and it is stored in @@ -243,7 +243,7 @@ module MOM_variables !! corner columns, in m2 s-1. real, pointer, dimension(:,:,:) :: Kv_slow => NULL() !< The turbulent vertical viscosity component due to "slow" processes (e.g., tidal, - !! background, convection etc). + !! background, convection etc), in m2 s-1. real, pointer, dimension(:,:,:) :: TKE_turb => NULL() !< The turbulent kinetic energy per unit mass at the interfaces, in m2 s-2. !! This may be at the tracer or corner points diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 21d6c21328..450eeb2b62 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -215,13 +215,13 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, CS, hu, hv) 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) = visc%kv_bbl_u(I,j) / visc%bbl_thick_u(I,j) + drag_vel_u(I,j) = (GV%Z_to_m**2)*visc%kv_bbl_u(I,j) / visc%bbl_thick_u(I,j) enddo ; enddo !$OMP do 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) = visc%kv_bbl_v(i,J) / visc%bbl_thick_v(i,J) + drag_vel_v(i,J) = (GV%Z_to_m**2)*visc%kv_bbl_v(i,J) / visc%bbl_thick_v(i,J) enddo ; enddo !$OMP do diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index e3c591153f..f24ad1944c 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -540,7 +540,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) then call uvchksum("BBL Kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, & - G%HI, 0, symmetric=.true.) + G%HI, 0, symmetric=.true., scale=GV%Z_to_m**2) endif if (associated(visc%bbl_thick_u) .and. associated(visc%bbl_thick_v)) then @@ -1703,7 +1703,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, CS) ! vertical decay scale. do i=is,ie ; if ((G%mask2dCv(i,J) > 0.5) .and. (cdrag_sqrt*visc%bbl_thick_v(i,J) > 0.0)) then do_i(i) = .true. ; vhtot(i) = 0.0 ; htot(i) = 0.0 - vstar(i,J) = visc%kv_bbl_v(i,J)/(cdrag_sqrt*visc%bbl_thick_v(i,J)) + vstar(i,J) = (GV%Z_to_m**2)*visc%kv_bbl_v(i,J)/(cdrag_sqrt*visc%bbl_thick_v(i,J)) else do_i(i) = .false. ; vstar(i,J) = 0.0 ; htot(i) = 0.0 endif ; enddo @@ -1733,7 +1733,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, CS) do j=js,je do I=is-1,ie ; if ((G%mask2dCu(I,j) > 0.5) .and. (cdrag_sqrt*visc%bbl_thick_u(I,j) > 0.0)) then do_i(I) = .true. ; uhtot(I) = 0.0 ; htot(I) = 0.0 - ustar(I) = visc%kv_bbl_u(I,j)/(cdrag_sqrt*visc%bbl_thick_u(I,j)) + ustar(I) = (GV%Z_to_m**2)*visc%kv_bbl_u(I,j)/(cdrag_sqrt*visc%bbl_thick_u(I,j)) else do_i(I) = .false. ; ustar(I) = 0.0 ; htot(I) = 0.0 endif ; enddo diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 9eb4b80be0..f533d73d78 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -881,11 +881,11 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) bbl_thick_Z = bbl_thick * GV%H_to_Z if (m==1) then - visc%kv_bbl_u(I,j) = (GV%Z_to_m**2) * max(CS%KV_BBL_min, & + visc%kv_bbl_u(I,j) = max(CS%KV_BBL_min, & cdrag_sqrt*ustar(i)*bbl_thick_Z*BBL_visc_frac) visc%bbl_thick_u(I,j) = GV%Z_to_m * bbl_thick_Z else - visc%kv_bbl_v(i,J) = (GV%Z_to_m**2) * max(CS%KV_BBL_min, & + visc%kv_bbl_v(i,J) = max(CS%KV_BBL_min, & cdrag_sqrt*ustar(i)*bbl_thick_Z*BBL_visc_frac) visc%bbl_thick_v(i,J) = GV%Z_to_m * bbl_thick_Z endif @@ -895,10 +895,10 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) ! the correct stress when the shear occurs over bbl_thick. bbl_thick_Z = bbl_thick * GV%H_to_Z if (m==1) then - visc%kv_bbl_u(I,j) = (GV%Z_to_m**2) * max(CS%KV_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick_Z) + visc%kv_bbl_u(I,j) = max(CS%KV_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick_Z) visc%bbl_thick_u(I,j) = GV%Z_to_m * bbl_thick_Z else - visc%kv_bbl_v(i,J) = (GV%Z_to_m**2) * max(CS%KV_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick_Z) + visc%kv_bbl_v(i,J) = max(CS%KV_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick_Z) visc%bbl_thick_v(i,J) = GV%Z_to_m * bbl_thick_Z endif endif @@ -923,7 +923,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) & call uvchksum("Ray [uv]", visc%Ray_u, visc%Ray_v, G%HI, haloshift=0, scale=GV%Z_to_m) if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) & - call uvchksum("kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, G%HI, haloshift=0) + call uvchksum("kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, G%HI, haloshift=0, scale=GV%Z_to_m**2) if (associated(visc%bbl_thick_u) .and. associated(visc%bbl_thick_v)) & call uvchksum("bbl_thick_[uv]", visc%bbl_thick_u, & visc%bbl_thick_v, G%HI, haloshift=0) @@ -1447,7 +1447,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) tbl_thick_Z = GV%H_to_Z * max(CS%Htbl_shelf_min, & ( htot(I)*ustar1 ) / ( 0.5*ustar1 + sqrt((0.5*ustar1)**2 + h2f2 ) ) ) visc%tbl_thick_shelf_u(I,j) = GV%Z_to_m * tbl_thick_Z - visc%kv_tbl_shelf_u(I,j) = (GV%Z_to_m**2) * max(CS%KV_TBL_min, cdrag_sqrt*ustar(i)*tbl_thick_Z) + visc%kv_tbl_shelf_u(I,j) = max(CS%KV_TBL_min, cdrag_sqrt*ustar(i)*tbl_thick_Z) endif ; enddo ! I-loop endif ! do_any_shelf @@ -1692,7 +1692,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) tbl_thick_Z = GV%H_to_Z * max(CS%Htbl_shelf_min, & ( htot(i)*ustar1 ) / ( 0.5*ustar1 + sqrt((0.5*ustar1)**2 + h2f2 ) ) ) visc%tbl_thick_shelf_v(i,J) = GV%Z_to_m * tbl_thick_Z - visc%kv_tbl_shelf_v(i,J) = (GV%Z_to_m**2) * max(CS%KV_TBL_min, cdrag_sqrt*ustar(i)*tbl_thick_Z) + visc%kv_tbl_shelf_v(i,J) = max(CS%KV_TBL_min, cdrag_sqrt*ustar(i)*tbl_thick_Z) endif ; enddo ! i-loop endif ! do_any_shelf @@ -2025,11 +2025,11 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) CS%id_bbl_thick_u = register_diag_field('ocean_model', 'bbl_thick_u', & diag%axesCu1, Time, 'BBL thickness at u points', 'm') CS%id_kv_bbl_u = register_diag_field('ocean_model', 'kv_bbl_u', diag%axesCu1, & - Time, 'BBL viscosity at u points', 'm2 s-1') + Time, 'BBL viscosity at u points', 'm2 s-1', conversion=GV%Z_to_m**2) CS%id_bbl_thick_v = register_diag_field('ocean_model', 'bbl_thick_v', & diag%axesCv1, Time, 'BBL thickness at v points', 'm') CS%id_kv_bbl_v = register_diag_field('ocean_model', 'kv_bbl_v', diag%axesCv1, & - Time, 'BBL viscosity at v points', 'm2 s-1') + Time, 'BBL viscosity at v points', 'm2 s-1', conversion=GV%Z_to_m**2) endif if (CS%Channel_drag) then allocate(visc%Ray_u(IsdB:IedB,jsd:jed,nz)) ; visc%Ray_u = 0.0 diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 0666601701..67c3ee5b29 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -599,7 +599,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) z_i ! An estimate of each interface's height above the bottom, ! normalized by the bottom boundary layer thickness, nondim. real, dimension(SZIB_(G)) :: & - kv_bbl, & ! The bottom boundary layer viscosity in m2 s-1. + kv_bbl, & ! The bottom boundary layer viscosity in Z2 s-1. bbl_thick, & ! The bottom boundary layer thickness in m or kg m-2. I_Hbbl, & ! The inverse of the bottom boundary layer thickness, in units ! of H-1 (i.e., m-1 or m2 kg-1). @@ -1045,7 +1045,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, intent(in) :: h_harm !< Harmonic mean of thicknesses around a velocity !! grid point, in H real, dimension(SZIB_(G)), intent(in) :: bbl_thick !< Bottom boundary layer thickness, in H - real, dimension(SZIB_(G)), intent(in) :: kv_bbl !< Bottom boundary layer viscosity, in m2 s-1 + real, dimension(SZIB_(G)), intent(in) :: kv_bbl !< Bottom boundary layer viscosity, in Z2 s-1 real, dimension(SZIB_(G),SZK_(GV)+1), & intent(in) :: z_i !< Estimate of interface heights above the bottom, !! normalized by the bottom boundary layer thickness @@ -1070,7 +1070,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, nk_visc, & ! The (real) interface index of the base of mixed layer. z_t, & ! The distance from the top, sometimes normalized ! by Hmix, in m or nondimensional. - kv_tbl, & + kv_tbl, & ! The viscosity in a top boundary layer under ice, in Z2 s-1. tbl_thick real, dimension(SZIB_(G),SZK_(GV)) :: & Kv_add ! A viscosity to add, in m2 s-1. @@ -1130,9 +1130,9 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, if (CS%bottomdraglaw) then r = hvel(i,nz)*0.5 if (r < bbl_thick(i)) then - a_cpl(i,nz+1) = 1.0*m2_to_Z2*kv_bbl(i) / (I_amax* m2_to_Z2*kv_bbl(i) + r*GV%H_to_Z) + a_cpl(i,nz+1) = 1.0*kv_bbl(i) / (I_amax*kv_bbl(i) + r*GV%H_to_Z) else - a_cpl(i,nz+1) = 1.0*m2_to_Z2*kv_bbl(i) / (I_amax* m2_to_Z2*kv_bbl(i) + bbl_thick(i)*GV%H_to_Z) + a_cpl(i,nz+1) = 1.0*kv_bbl(i) / (I_amax*kv_bbl(i) + bbl_thick(i)*GV%H_to_Z) endif else a_cpl(i,nz+1) = 2.0*m2_to_Z2*CS%Kvbbl / (hvel(i,nz)*GV%H_to_Z + 2.0*I_amax* m2_to_Z2*CS%Kvbbl) @@ -1236,7 +1236,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, botfn = 1.0 / (1.0 + 0.09*z2*z2*z2*z2*z2*z2) if (CS%bottomdraglaw) then - a_cpl(i,K) = a_cpl(i,K) + 2.0*(kv_bbl(i)-CS%Kv)*botfn + a_cpl(i,K) = a_cpl(i,K) + 2.0*((GV%Z_to_m**2)*kv_bbl(i) - CS%Kv)*botfn r = (hvel(i,k)+hvel(i,k-1)) if (r > 2.0*bbl_thick(i)) then h_shear = ((1.0 - botfn) * r + botfn*2.0*bbl_thick(i)) @@ -1267,9 +1267,9 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, ! If a_cpl(i,1) were not already 0, it would be added here. if (0.5*hvel(i,1) > tbl_thick(i)) then - a_cpl(i,1) = m2_to_Z2 * kv_tbl(i) / (tbl_thick(i) *GV%H_to_Z + I_amax*(m2_to_Z2*kv_tbl(i))) + a_cpl(i,1) = kv_tbl(i) / (tbl_thick(i) *GV%H_to_Z + I_amax*kv_tbl(i)) else - a_cpl(i,1) = m2_to_Z2 * kv_tbl(i) / (0.5*hvel(i,1)*GV%H_to_Z + I_amax*(m2_to_Z2*kv_tbl(i))) + a_cpl(i,1) = kv_tbl(i) / (0.5*hvel(i,1)*GV%H_to_Z + I_amax*kv_tbl(i)) endif endif ; enddo @@ -1284,7 +1284,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_shear = r endif - a_top = 2.0 * topfn * (m2_to_Z2 * kv_tbl(i)) + a_top = 2.0 * topfn * kv_tbl(i) a_cpl(i,K) = a_cpl(i,K) + a_top / (h_shear*GV%H_to_Z + I_amax*a_top) endif ; enddo ; enddo elseif (CS%dynamic_viscous_ML .or. (GV%nkml>0)) then From 20060fe27292449fde3af8fde1b0757980c21d46 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 26 Sep 2018 16:46:39 -0400 Subject: [PATCH 115/174] +Added the optional argument unscaled to get_param Added a new optional argument, unscaled, to the get_param_real and get_param_real_array routines, to return the value that is read without any rescaling, usually for later use as a default for another parameter. All answers are bitwise identical. --- src/framework/MOM_file_parser.F90 | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/framework/MOM_file_parser.F90 b/src/framework/MOM_file_parser.F90 index a4daaa7c40..5c80fb9d51 100644 --- a/src/framework/MOM_file_parser.F90 +++ b/src/framework/MOM_file_parser.F90 @@ -1688,7 +1688,7 @@ end subroutine get_param_int_array !! and logs it in documentation files. subroutine get_param_real(CS, modulename, varname, value, desc, units, & default, fail_if_missing, do_not_read, do_not_log, & - static_value, debuggingParam, scale) + static_value, debuggingParam, scale, unscaled) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters character(len=*), intent(in) :: modulename !< The name of the calling module @@ -1712,6 +1712,8 @@ subroutine get_param_real(CS, modulename, varname, value, desc, units, & !! logged in the debugging parameter file real, optional, intent(in) :: scale !< A scaling factor that the parameter is !! multiplied by before it is returned. + real, optional, intent(out) :: unscaled !< The value of the parameter that would be + !! returned without any multiplication by a scaling factor. logical :: do_read, do_log @@ -1729,6 +1731,7 @@ subroutine get_param_real(CS, modulename, varname, value, desc, units, & default, debuggingParam) endif + if (present(unscaled)) unscaled = value if (present(scale)) value = scale*value end subroutine get_param_real @@ -1736,7 +1739,7 @@ end subroutine get_param_real !> This subroutine reads the values of an array of real model parameters from a parameter file !! and logs them in documentation files. subroutine get_param_real_array(CS, modulename, varname, value, desc, units, & - default, fail_if_missing, do_not_read, do_not_log, static_value, scale) + default, fail_if_missing, do_not_read, do_not_log, static_value, scale, unscaled) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters character(len=*), intent(in) :: modulename !< The name of the calling module @@ -1758,6 +1761,8 @@ subroutine get_param_real_array(CS, modulename, varname, value, desc, units, & !! parameter to the documentation files real, optional, intent(in) :: scale !< A scaling factor that the parameter is !! multiplied by before it is returned. + real, dimension(:), optional, intent(out) :: unscaled !< The value of the parameter that would be + !! returned without any multiplication by a scaling factor. logical :: do_read, do_log @@ -1775,6 +1780,7 @@ subroutine get_param_real_array(CS, modulename, varname, value, desc, units, & units, default) endif + if (present(unscaled)) unscaled(:) = value(:) if (present(scale)) value(:) = scale*value(:) end subroutine get_param_real_array From 8164d0622d727a72482833de535298b226329b74 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 26 Sep 2018 16:50:24 -0400 Subject: [PATCH 116/174] Use viscosities in Z2 s-1 in MOM_vert_friction Do the calculations in MOM_vert_friction with viscosities in Z2 s-1, instead of m2 s-1, for dimensional consistency testing, including rescaling several parameters when they are read. All answers are bitwise identical. --- .../vertical/MOM_vert_friction.F90 | 62 ++++++++++--------- 1 file changed, 32 insertions(+), 30 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 67c3ee5b29..54d6daca1b 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -31,9 +31,9 @@ module MOM_vert_friction !> The control structure with parameters and memory for the MOM_vert_friction module type, public :: vertvisc_CS ; private - real :: Hmix !< The mixed layer thickness in m. + real :: Hmix !< The mixed layer thickness in thickness units (H). real :: Hmix_stress !< The mixed layer thickness over which the wind - !! stress is applied with direct_stress, in m. + !! stress is applied with direct_stress, in H. real :: Kvml !< The mixed layer vertical viscosity in m2 s-1. real :: Kv !< The interior vertical viscosity in m2 s-1. real :: Hbbl !< The static bottom boundary layer thickness, in m. @@ -207,7 +207,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & "Module must be initialized before it is used.") if (CS%direct_stress) then - Hmix = CS%Hmix_stress*GV%m_to_H + Hmix = CS%Hmix_stress I_Hmix = 1.0 / Hmix endif dt_Rho0 = dt/GV%H_to_kg_m2 @@ -1073,7 +1073,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, kv_tbl, & ! The viscosity in a top boundary layer under ice, in Z2 s-1. tbl_thick real, dimension(SZIB_(G),SZK_(GV)) :: & - Kv_add ! A viscosity to add, in m2 s-1. + Kv_add ! A viscosity to add, in Z2 s-1. real :: h_shear ! The distance over which shears occur, m or kg m-2. real :: r ! A thickness to compare with Hbbl, in m or kg m-2. real :: visc_ml ! The mixed layer viscosity, in m2 s-1. @@ -1117,7 +1117,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, if ((GV%nkml>0) .or. do_shelf) then ; do k=2,nz ; do i=is,ie if (do_i(i)) a_cpl(i,K) = 2.0*CS%Kv enddo ; enddo ; else - I_Hmix = 1.0 / (CS%Hmix * GV%m_to_H + h_neglect) + I_Hmix = 1.0 / (CS%Hmix + h_neglect) do i=is,ie ; z_t(i) = h_neglect*I_Hmix ; enddo do K=2,nz ; do i=is,ie ; if (do_i(i)) then z_t(i) = z_t(i) + h_harm(i,k-1)*I_Hmix @@ -1135,7 +1135,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, a_cpl(i,nz+1) = 1.0*kv_bbl(i) / (I_amax*kv_bbl(i) + bbl_thick(i)*GV%H_to_Z) endif else - a_cpl(i,nz+1) = 2.0*m2_to_Z2*CS%Kvbbl / (hvel(i,nz)*GV%H_to_Z + 2.0*I_amax* m2_to_Z2*CS%Kvbbl) + a_cpl(i,nz+1) = 2.0*CS%Kvbbl / (hvel(i,nz)*GV%H_to_Z + 2.0*I_amax*CS%Kvbbl) endif endif ; enddo @@ -1146,14 +1146,14 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, ! equal to 2 x \delta z if (work_on_u) then do K=2,nz ; do i=is,ie ; if (do_i(i)) then - Kv_add(i,K) = (2.*0.5)*(visc%Kv_shear(i,j,k) + visc%Kv_shear(i+1,j,k)) + Kv_add(i,K) = (2.*0.5)*m2_to_Z2*(visc%Kv_shear(i,j,k) + visc%Kv_shear(i+1,j,k)) endif ; enddo ; enddo if (do_OBCs) then do I=is,ie ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then - do K=2,nz ; Kv_add(i,K) = 2.*visc%Kv_shear(i,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = 2.*m2_to_Z2*visc%Kv_shear(i,j,k) ; enddo elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then - do K=2,nz ; Kv_add(i,K) = 2.*visc%Kv_shear(i+1,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = 2.*m2_to_Z2*visc%Kv_shear(i+1,j,k) ; enddo endif endif ; enddo endif @@ -1162,14 +1162,14 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, endif ; enddo ; enddo else do K=2,nz ; do i=is,ie ; if (do_i(i)) then - Kv_add(i,K) = (2.*0.5)*(visc%Kv_shear(i,j,k) + visc%Kv_shear(i,j+1,k)) + Kv_add(i,K) = (2.*0.5)*m2_to_Z2*(visc%Kv_shear(i,j,k) + visc%Kv_shear(i,j+1,k)) endif ; enddo ; enddo if (do_OBCs) then do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then - do K=2,nz ; Kv_add(i,K) = 2.*visc%Kv_shear(i,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = 2.*m2_to_Z2*visc%Kv_shear(i,j,k) ; enddo elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then - do K=2,nz ; Kv_add(i,K) = 2.*visc%Kv_shear(i,j+1,k) ; enddo + do K=2,nz ; Kv_add(i,K) = 2.*m2_to_Z2*visc%Kv_shear(i,j+1,k) ; enddo endif endif ; enddo endif @@ -1182,11 +1182,11 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, if (associated(visc%Kv_shear_Bu)) then if (work_on_u) then do K=2,nz ; do I=Is,Ie ; If (do_i(I)) then - a_cpl(I,K) = a_cpl(I,K) + (2.*0.5)*(visc%Kv_shear_Bu(I,J-1,k) + visc%Kv_shear_Bu(I,J,k)) + a_cpl(I,K) = a_cpl(I,K) + (2.*0.5)*m2_to_Z2*(visc%Kv_shear_Bu(I,J-1,k) + visc%Kv_shear_Bu(I,J,k)) endif ; enddo ; enddo else do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a_cpl(i,K) = a_cpl(i,K) + (2.*0.5)*(visc%Kv_shear_Bu(I-1,J,k) + visc%Kv_shear_Bu(I,J,k)) + a_cpl(i,K) = a_cpl(i,K) + (2.*0.5)*m2_to_Z2*(visc%Kv_shear_Bu(I-1,J,k) + visc%Kv_shear_Bu(I,J,k)) endif ; enddo ; enddo endif endif @@ -1196,14 +1196,14 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, ! GMM/ A factor of 2 is also needed here, see comment above from BGR. if (work_on_u) then do K=2,nz ; do i=is,ie ; if (do_i(i)) then - Kv_add(i,K) = Kv_add(i,K) + 1.0 * (visc%Kv_slow(i,j,k) + visc%Kv_slow(i+1,j,k)) + Kv_add(i,K) = Kv_add(i,K) + 1.0 * m2_to_Z2*(visc%Kv_slow(i,j,k) + visc%Kv_slow(i+1,j,k)) endif ; enddo ; enddo if (do_OBCs) then do I=is,ie ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then - do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * visc%Kv_slow(i,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * m2_to_Z2*visc%Kv_slow(i,j,k) ; enddo elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then - do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * visc%Kv_slow(i+1,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * m2_to_Z2*visc%Kv_slow(i+1,j,k) ; enddo endif endif ; enddo endif @@ -1212,14 +1212,15 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, endif ; enddo ; enddo else do K=2,nz ; do i=is,ie ; if (do_i(i)) then - Kv_add(i,K) = Kv_add(i,K) + 1.0*(visc%Kv_slow(i,j,k) + visc%Kv_slow(i,j+1,k)) + Kv_add(i,K) = Kv_add(i,K) + 1.0*m2_to_Z2*(visc%Kv_slow(i,j,k) + visc%Kv_slow(i,j+1,k)) endif ; enddo ; enddo + !### I am pretty sure that this is double counting here! - RWH if (do_OBCs) then do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then - do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * visc%Kv_slow(i,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * m2_to_Z2*visc%Kv_slow(i,j,k) ; enddo elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then - do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * visc%Kv_slow(i,j+1,k) ; enddo + do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * m2_to_Z2*visc%Kv_slow(i,j+1,k) ; enddo endif endif ; enddo endif @@ -1236,7 +1237,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, botfn = 1.0 / (1.0 + 0.09*z2*z2*z2*z2*z2*z2) if (CS%bottomdraglaw) then - a_cpl(i,K) = a_cpl(i,K) + 2.0*((GV%Z_to_m**2)*kv_bbl(i) - CS%Kv)*botfn + a_cpl(i,K) = a_cpl(i,K) + 2.0*(kv_bbl(i) - CS%Kv)*botfn r = (hvel(i,k)+hvel(i,k-1)) if (r > 2.0*bbl_thick(i)) then h_shear = ((1.0 - botfn) * r + botfn*2.0*bbl_thick(i)) @@ -1248,8 +1249,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_shear = hvel(i,k) + hvel(i,k-1) + h_neglect endif - ! Up to this point a has units of m2 s-1, but now is converted to Z s-1. - a_cpl(i,K) = a_cpl(i,K) * m2_to_Z2 + ! Up to this point a_cpl has had units of Z2 s-1, but now is converted to Z s-1. a_cpl(i,K) = a_cpl(i,K) / (h_shear*GV%H_to_Z + I_amax*a_cpl(i,K)) endif ; enddo ; enddo ! i & k loops @@ -1576,6 +1576,8 @@ subroutine vertvisc_init(MIS, Time, G, GV, param_file, diag, ADp, dirs, & ! Local variables real :: hmix_str_dflt + real :: Kv_dflt ! A default viscosity in m2 s-1. + real :: Hmix_m ! A boundary layer thickness, in m. integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz ! This include declares and sets the variable "version". #include "version_variable.h" @@ -1642,16 +1644,17 @@ subroutine vertvisc_init(MIS, Time, G, GV, param_file, diag, ADp, dirs, & call get_param(param_file, mdl, "HMIX_FIXED", CS%Hmix, & "The prescribed depth over which the near-surface \n"//& "viscosity and diffusivity are elevated when the bulk \n"//& - "mixed layer is not used.", units="m", fail_if_missing=.true.) + "mixed layer is not used.", units="m", scale=GV%m_to_H, & + unscaled=Hmix_m, fail_if_missing=.true.) if (CS%direct_stress) then if (GV%nkml < 1) then call get_param(param_file, mdl, "HMIX_STRESS", CS%Hmix_stress, & "The depth over which the wind stress is applied if \n"//& - "DIRECT_STRESS is true.", units="m", default=CS%Hmix) + "DIRECT_STRESS is true.", units="m", default=Hmix_m, scale=GV%m_to_H) else call get_param(param_file, mdl, "HMIX_STRESS", CS%Hmix_stress, & "The depth over which the wind stress is applied if \n"//& - "DIRECT_STRESS is true.", units="m", fail_if_missing=.true.) + "DIRECT_STRESS is true.", units="m", fail_if_missing=.true., scale=GV%m_to_H) endif if (CS%Hmix_stress <= 0.0) call MOM_error(FATAL, "vertvisc_init: " // & "HMIX_STRESS must be set to a positive value if DIRECT_STRESS is true.") @@ -1659,19 +1662,18 @@ subroutine vertvisc_init(MIS, Time, G, GV, param_file, diag, ADp, dirs, & call get_param(param_file, mdl, "KV", CS%Kv, & "The background kinematic viscosity in the interior. \n"//& "The molecular value, ~1e-6 m2 s-1, may be used.", & - units="m2 s-1", fail_if_missing=.true.) + units="m2 s-1", fail_if_missing=.true., scale=GV%m_to_Z**2, unscaled=Kv_dflt) -! CS%Kvml = CS%Kv ; CS%Kvbbl = CS%Kv ! Needed? -AJA if (GV%nkml < 1) call get_param(param_file, mdl, "KVML", CS%Kvml, & "The kinematic viscosity in the mixed layer. A typical \n"//& "value is ~1e-2 m2 s-1. KVML is not used if \n"//& "BULKMIXEDLAYER is true. The default is set by KV.", & - units="m2 s-1", default=CS%Kv) + units="m2 s-1", default=Kv_dflt, scale=GV%m_to_Z**2) if (.not.CS%bottomdraglaw) call get_param(param_file, mdl, "KVBBL", CS%Kvbbl, & "The kinematic viscosity in the benthic boundary layer. \n"//& "A typical value is ~1e-2 m2 s-1. KVBBL is not used if \n"//& "BOTTOMDRAGLAW is true. The default is set by KV.", & - units="m2 s-1", default=CS%Kv) + units="m2 s-1", default=Kv_dflt, scale=GV%m_to_Z**2) call get_param(param_file, mdl, "HBBL", CS%Hbbl, & "The thickness of a bottom boundary layer with a \n"//& "viscosity of KVBBL if BOTTOMDRAGLAW is not defined, or \n"//& From 3923bc51a54ebf60060bcb2f2858754c2a3720cf Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 26 Sep 2018 18:23:56 -0400 Subject: [PATCH 117/174] Changed visc%bbl_thick_u into units of Z Changed the dimensions of visc%bbl_thick_[uv] and visc%tbl_thick_shelf_[uv] to Z, from m, for expanded dimensional consistency testing. All answers are bitwise identical. --- src/core/MOM_variables.F90 | 8 +++---- src/parameterizations/lateral/MOM_MEKE.F90 | 4 ++-- .../vertical/MOM_set_diffusivity.F90 | 18 +++++++-------- .../vertical/MOM_set_viscosity.F90 | 22 +++++++++---------- .../vertical/MOM_vert_friction.F90 | 12 +++++----- 5 files changed, 32 insertions(+), 32 deletions(-) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index b7f202aa5c..a2b0db9fb6 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -192,8 +192,8 @@ module MOM_variables real :: Prandtl_turb !< The Prandtl number for the turbulent diffusion !! that is captured in Kd_shear. real, pointer, dimension(:,:) :: & - bbl_thick_u => NULL(), & !< The bottom boundary layer thickness at the u-points, in m. - bbl_thick_v => NULL(), & !< The bottom boundary layer thickness at the v-points, in m. + bbl_thick_u => NULL(), & !< The bottom boundary layer thickness at the u-points, in Z. + bbl_thick_v => NULL(), & !< The bottom boundary layer thickness at the v-points, in Z. kv_bbl_u => NULL(), & !< The bottom boundary layer viscosity at the u-points, in Z2 s-1. kv_bbl_v => NULL(), & !< The bottom boundary layer viscosity at the v-points, in Z2 s-1. ustar_BBL => NULL() !< The turbulence velocity in the bottom boundary layer at h points, in m s-1. @@ -204,9 +204,9 @@ module MOM_variables taux_shelf => NULL(), & !< The zonal stresses on the ocean under shelves, in Pa. tauy_shelf => NULL() !< The meridional stresses on the ocean under shelves, in Pa. real, pointer, dimension(:,:) :: tbl_thick_shelf_u => NULL() - !< Thickness of the viscous top boundary layer under ice shelves at u-points, in m. + !< Thickness of the viscous top boundary layer under ice shelves at u-points, in Z. real, pointer, dimension(:,:) :: tbl_thick_shelf_v => NULL() - !< Thickness of the viscous top boundary layer under ice shelves at v-points, in m. + !< Thickness of the viscous top boundary layer under ice shelves at v-points, in Z. real, pointer, dimension(:,:) :: kv_tbl_shelf_u => NULL() !< Viscosity in the viscous top boundary layer under ice shelves at u-points, in Z2 s-1. real, pointer, dimension(:,:) :: kv_tbl_shelf_v => NULL() diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 450eeb2b62..949268c7e9 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -215,13 +215,13 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, CS, hu, hv) 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) = (GV%Z_to_m**2)*visc%kv_bbl_u(I,j) / visc%bbl_thick_u(I,j) + drag_vel_u(I,j) = GV%Z_to_m*visc%kv_bbl_u(I,j) / visc%bbl_thick_u(I,j) enddo ; enddo !$OMP do 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) = (GV%Z_to_m**2)*visc%kv_bbl_v(i,J) / visc%bbl_thick_v(i,J) + drag_vel_v(i,J) = GV%Z_to_m*visc%kv_bbl_v(i,J) / visc%bbl_thick_v(i,J) enddo ; enddo !$OMP do diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index f24ad1944c..5db6034db3 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -545,7 +545,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (associated(visc%bbl_thick_u) .and. associated(visc%bbl_thick_v)) then call uvchksum("BBL bbl_thick_[uv]", visc%bbl_thick_u, & - visc%bbl_thick_v, G%HI, 0, symmetric=.true.) + visc%bbl_thick_v, G%HI, 0, symmetric=.true., scale=GV%Z_to_m) endif if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) then @@ -1658,21 +1658,21 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, CS) real, dimension(SZI_(G)) :: & htot ! total thickness above or below a layer, or the - ! integrated thickness in the BBL (meter) + ! integrated thickness in the BBL (Z) real, dimension(SZIB_(G)) :: & - uhtot, & ! running integral of u in the BBL (m2/s) + uhtot, & ! running integral of u in the BBL (Z m/s) ustar, & ! bottom boundary layer turbulence speed (m/s) u2_bbl ! square of the mean zonal velocity in the BBL (m2/s2) - real :: vhtot(SZI_(G)) ! running integral of v in the BBL (m2/sec) + real :: vhtot(SZI_(G)) ! running integral of v in the BBL (Z m/sec) real, dimension(SZI_(G),SZJB_(G)) :: & vstar, & ! ustar at at v-points in 2 j-rows (m/s) v2_bbl ! square of average meridional velocity in BBL (m2/s2) real :: cdrag_sqrt ! square root of the drag coefficient (nondim) - real :: hvel ! thickness at velocity points (meter) + real :: hvel ! thickness at velocity points (Z) logical :: domore, do_i(SZI_(G)) integer :: i, j, k, is, ie, js, je, nz @@ -1703,14 +1703,14 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, CS) ! vertical decay scale. do i=is,ie ; if ((G%mask2dCv(i,J) > 0.5) .and. (cdrag_sqrt*visc%bbl_thick_v(i,J) > 0.0)) then do_i(i) = .true. ; vhtot(i) = 0.0 ; htot(i) = 0.0 - vstar(i,J) = (GV%Z_to_m**2)*visc%kv_bbl_v(i,J)/(cdrag_sqrt*visc%bbl_thick_v(i,J)) + vstar(i,J) = GV%Z_to_m*visc%kv_bbl_v(i,J)/(cdrag_sqrt*visc%bbl_thick_v(i,J)) else do_i(i) = .false. ; vstar(i,J) = 0.0 ; htot(i) = 0.0 endif ; enddo do k=nz,1,-1 domore = .false. do i=is,ie ; if (do_i(i)) then - hvel = 0.5*GV%H_to_m*(h(i,j,k) + h(i,j+1,k)) + hvel = 0.5*GV%H_to_Z*(h(i,j,k) + h(i,j+1,k)) if ((htot(i) + hvel) >= visc%bbl_thick_v(i,J)) then vhtot(i) = vhtot(i) + (visc%bbl_thick_v(i,J) - htot(i))*v(i,J,k) htot(i) = visc%bbl_thick_v(i,J) @@ -1733,13 +1733,13 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, CS) do j=js,je do I=is-1,ie ; if ((G%mask2dCu(I,j) > 0.5) .and. (cdrag_sqrt*visc%bbl_thick_u(I,j) > 0.0)) then do_i(I) = .true. ; uhtot(I) = 0.0 ; htot(I) = 0.0 - ustar(I) = (GV%Z_to_m**2)*visc%kv_bbl_u(I,j)/(cdrag_sqrt*visc%bbl_thick_u(I,j)) + ustar(I) = GV%Z_to_m*visc%kv_bbl_u(I,j)/(cdrag_sqrt*visc%bbl_thick_u(I,j)) else do_i(I) = .false. ; ustar(I) = 0.0 ; htot(I) = 0.0 endif ; enddo do k=nz,1,-1 ; domore = .false. do I=is-1,ie ; if (do_i(I)) then - hvel = 0.5*GV%H_to_m*(h(i,j,k) + h(i+1,j,k)) + hvel = 0.5*GV%H_to_Z*(h(i,j,k) + h(i+1,j,k)) if ((htot(I) + hvel) >= visc%bbl_thick_u(I,j)) then uhtot(I) = uhtot(I) + (visc%bbl_thick_u(I,j) - htot(I))*u(I,j,k) htot(I) = visc%bbl_thick_u(I,j) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index f533d73d78..acebe8e6cf 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -883,11 +883,11 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) if (m==1) then visc%kv_bbl_u(I,j) = max(CS%KV_BBL_min, & cdrag_sqrt*ustar(i)*bbl_thick_Z*BBL_visc_frac) - visc%bbl_thick_u(I,j) = GV%Z_to_m * bbl_thick_Z + visc%bbl_thick_u(I,j) = bbl_thick_Z else visc%kv_bbl_v(i,J) = max(CS%KV_BBL_min, & cdrag_sqrt*ustar(i)*bbl_thick_Z*BBL_visc_frac) - visc%bbl_thick_v(i,J) = GV%Z_to_m * bbl_thick_Z + visc%bbl_thick_v(i,J) = bbl_thick_Z endif else ! Not Channel_drag. @@ -896,10 +896,10 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) bbl_thick_Z = bbl_thick * GV%H_to_Z if (m==1) then visc%kv_bbl_u(I,j) = max(CS%KV_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick_Z) - visc%bbl_thick_u(I,j) = GV%Z_to_m * bbl_thick_Z + visc%bbl_thick_u(I,j) = bbl_thick_Z else visc%kv_bbl_v(i,J) = max(CS%KV_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick_Z) - visc%bbl_thick_v(i,J) = GV%Z_to_m * bbl_thick_Z + visc%bbl_thick_v(i,J) = bbl_thick_Z endif endif endif ; enddo ! end of i loop @@ -926,7 +926,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) call uvchksum("kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, G%HI, haloshift=0, scale=GV%Z_to_m**2) if (associated(visc%bbl_thick_u) .and. associated(visc%bbl_thick_v)) & call uvchksum("bbl_thick_[uv]", visc%bbl_thick_u, & - visc%bbl_thick_v, G%HI, haloshift=0) + visc%bbl_thick_v, G%HI, haloshift=0, scale=GV%Z_to_m) endif end subroutine set_viscous_BBL @@ -1438,7 +1438,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) htot(i) = htot(i) + h_at_vel(i,nz) endif ! use_EOS - !visc%tbl_thick_shelf_u(I,j) = max(CS%Htbl_shelf_min, & + !visc%tbl_thick_shelf_u(I,j) = GV%H_to_Z * max(CS%Htbl_shelf_min, & ! htot(I) / (0.5 + sqrt(0.25 + & ! (htot(i)*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)))**2 / & ! (ustar(i)*GV%Z_to_H)**2 )) ) @@ -1446,7 +1446,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) h2f2 = (htot(i)*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)) + h_neglect*CS%Omega)**2 tbl_thick_Z = GV%H_to_Z * max(CS%Htbl_shelf_min, & ( htot(I)*ustar1 ) / ( 0.5*ustar1 + sqrt((0.5*ustar1)**2 + h2f2 ) ) ) - visc%tbl_thick_shelf_u(I,j) = GV%Z_to_m * tbl_thick_Z + visc%tbl_thick_shelf_u(I,j) = tbl_thick_Z visc%kv_tbl_shelf_u(I,j) = max(CS%KV_TBL_min, cdrag_sqrt*ustar(i)*tbl_thick_Z) endif ; enddo ! I-loop endif ! do_any_shelf @@ -1683,7 +1683,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) htot(i) = htot(i) + h_at_vel(i,nz) endif ! use_EOS - !visc%tbl_thick_shelf_v(i,J) = max(CS%Htbl_shelf_min, & + !visc%tbl_thick_shelf_v(i,J) = GV%H_to_Z * max(CS%Htbl_shelf_min, & ! htot(i) / (0.5 + sqrt(0.25 + & ! (htot(i)*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)))**2 / & ! (ustar(i)*GV%Z_to_H)**2 )) ) @@ -1691,7 +1691,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) h2f2 = (htot(i)*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)) + h_neglect*CS%Omega)**2 tbl_thick_Z = GV%H_to_Z * max(CS%Htbl_shelf_min, & ( htot(i)*ustar1 ) / ( 0.5*ustar1 + sqrt((0.5*ustar1)**2 + h2f2 ) ) ) - visc%tbl_thick_shelf_v(i,J) = GV%Z_to_m * tbl_thick_Z + visc%tbl_thick_shelf_v(i,J) = tbl_thick_Z visc%kv_tbl_shelf_v(i,J) = max(CS%KV_TBL_min, cdrag_sqrt*ustar(i)*tbl_thick_Z) endif ; enddo ! i-loop @@ -2023,11 +2023,11 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) allocate(visc%TKE_bbl(isd:ied,jsd:jed)) ; visc%TKE_bbl = 0.0 CS%id_bbl_thick_u = register_diag_field('ocean_model', 'bbl_thick_u', & - diag%axesCu1, Time, 'BBL thickness at u points', 'm') + diag%axesCu1, Time, 'BBL thickness at u points', 'm', conversion=GV%Z_to_m) CS%id_kv_bbl_u = register_diag_field('ocean_model', 'kv_bbl_u', diag%axesCu1, & Time, 'BBL viscosity at u points', 'm2 s-1', conversion=GV%Z_to_m**2) CS%id_bbl_thick_v = register_diag_field('ocean_model', 'bbl_thick_v', & - diag%axesCv1, Time, 'BBL thickness at v points', 'm') + diag%axesCv1, Time, 'BBL thickness at v points', 'm', conversion=GV%Z_to_m) CS%id_kv_bbl_v = register_diag_field('ocean_model', 'kv_bbl_v', diag%axesCv1, & Time, 'BBL viscosity at v points', 'm2 s-1', conversion=GV%Z_to_m**2) endif diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 54d6daca1b..64aec71fbb 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -677,7 +677,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) if (CS%bottomdraglaw) then ; do I=Isq,Ieq kv_bbl(I) = visc%kv_bbl_u(I,j) - bbl_thick(I) = visc%bbl_thick_u(I,j) * GV%m_to_H + bbl_thick(I) = visc%bbl_thick_u(I,j) * GV%Z_to_H if (do_i(I)) I_Hbbl(I) = 1.0 / (bbl_thick(I) + h_neglect) enddo ; endif @@ -774,7 +774,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) ! Perhaps this needs to be done more carefully, via find_eta. do I=Isq,Ieq ; if (do_i_shelf(I)) then zh(I) = 0.0 ; Ztop_min(I) = min(zcol(i), zcol(i+1)) - I_HTbl(I) = 1.0 / (visc%tbl_thick_shelf_u(I,j)*GV%m_to_H + h_neglect) + I_HTbl(I) = 1.0 / (visc%tbl_thick_shelf_u(I,j)*GV%Z_to_H + h_neglect) endif ; enddo do k=1,nz do i=Isq,Ieq+1 ; zcol(i) = zcol(i) - h(i,j,k) ; enddo @@ -844,7 +844,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) if (CS%bottomdraglaw) then ; do i=is,ie kv_bbl(i) = visc%kv_bbl_v(i,J) - bbl_thick(i) = visc%bbl_thick_v(i,J) * GV%m_to_H + bbl_thick(i) = visc%bbl_thick_v(i,J) * GV%Z_to_H if (do_i(i)) I_Hbbl(i) = 1.0 / bbl_thick(i) enddo ; endif @@ -942,7 +942,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) ! Perhaps this needs to be done more carefully, via find_eta. do i=is,ie ; if (do_i_shelf(i)) then zh(i) = 0.0 ; Ztop_min(I) = min(zcol1(i), zcol2(i)) - I_HTbl(i) = 1.0 / (visc%tbl_thick_shelf_v(i,J)*GV%m_to_H + h_neglect) + I_HTbl(i) = 1.0 / (visc%tbl_thick_shelf_v(i,J)*GV%Z_to_H + h_neglect) endif ; enddo do k=1,nz do i=is,ie ; if (do_i_shelf(i)) then @@ -1258,10 +1258,10 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, do i=is,ie ; if (do_i(i)) then if (work_on_u) then kv_tbl(i) = visc%kv_tbl_shelf_u(I,j) - tbl_thick(i) = visc%tbl_thick_shelf_u(I,j) * GV%m_to_H + tbl_thick(i) = visc%tbl_thick_shelf_u(I,j) * GV%Z_to_H else kv_tbl(i) = visc%kv_tbl_shelf_v(i,J) - tbl_thick(i) = visc%tbl_thick_shelf_v(i,J) * GV%m_to_H + tbl_thick(i) = visc%tbl_thick_shelf_v(i,J) * GV%Z_to_H endif z_t(i) = 0.0 From 9cdfbf69d03e848baa62d46dfb192356f1a1940a Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 28 Sep 2018 17:24:32 -0400 Subject: [PATCH 118/174] Do bulkmixedlayer in units of Z Rescaled several of the variables in bulkmixedlayer to work in units of Z and H instead of m. Also eliminated several unused variables and updated the comments describing others. Several duplicate comment blocks were also removed. All answers are bitwise identical. --- .../vertical/MOM_bulk_mixed_layer.F90 | 452 +++++++----------- 1 file changed, 174 insertions(+), 278 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index ab05237607..48d3729c74 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -42,13 +42,13 @@ module MOM_bulk_mixed_layer !! the mixed layer is converted to TKE, nondim. real :: bulk_Ri_convective !< The efficiency with which convectively !! released mean kinetic energy becomes TKE, nondim. - real :: Hmix_min !< The minimum mixed layer thickness in m. + real :: Hmix_min !< The minimum mixed layer thickness in H. real :: H_limit_fluxes !< When the total ocean depth is less than this - !! value, in m, scale away all surface forcing to + !! value, in H, scale away all surface forcing to !! avoid boiling the ocean. - real :: ustar_min !< A minimum value of ustar to avoid numerical - !! problems, in m s-1. If the value is small enough, - !! this should not affect the solution. + real :: ustar_min !< A minimum value of ustar to avoid numerical problems, + !! in Z s-1. If the value is small enough, this should + !! not affect the solution. real :: omega !< The Earth's rotation rate, in s-1. real :: dT_dS_wt !< When forced to extrapolate T & S to match the !! layer densities, this factor (in deg C / PSU) is @@ -81,8 +81,8 @@ module MOM_bulk_mixed_layer type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. logical :: TKE_diagnostics = .false. !< If true, calculate extensive diagnostics of the TKE budget logical :: do_rivermix = .false. !< Provide additional TKE to mix river runoff - !! at the river mouths to "rivermix_depth" meters - real :: rivermix_depth = 0.0 !< Used if "do_rivermix" = T + !! at the river mouths to rivermix_depth + real :: rivermix_depth = 0.0 !< The depth of mixing if do_rivermix is true, in Z. logical :: limit_det !< If true, limit the extent of buffer layer !! detrainment to be consistent with neighbors. real :: lim_det_dH_sfc !< The fractional limit in the change between grid @@ -105,9 +105,9 @@ module MOM_bulk_mixed_layer real :: Allowed_S_chg !< The amount by which salinity is allowed !! to exceed previous values during detrainment, PSU. -! These are terms in the mixed layer TKE budget, all in m3 s-2. + ! These are terms in the mixed layer TKE budget, all in Z m2 s-3. real, allocatable, dimension(:,:) :: & - ML_depth, & !< The mixed layer depth in m. + ML_depth, & !< The mixed layer depth in H. diag_TKE_wind, & !< The wind source of TKE. diag_TKE_RiBulk, & !< The resolved KE source of TKE. diag_TKE_conv, & !< The convective source of TKE. @@ -116,8 +116,8 @@ module MOM_bulk_mixed_layer diag_TKE_conv_decay, & !< The decay of convective TKE. diag_TKE_mixing, & !< The work done by TKE to deepen the mixed layer. diag_TKE_conv_s2, & !< The convective source of TKE due to to mixing in sigma2. - diag_PE_detrain, & !< The spurious source of potential energy due to mixed layer detrainment, W m-2. - diag_PE_detrain2 !< The spurious source of potential energy due to mixed layer only detrainment, W m-2. + diag_PE_detrain, & !< The spurious source of potential energy due to mixed layer detrainment, W Z m-3. + diag_PE_detrain2 !< The spurious source of potential energy due to mixed layer only detrainment, W Z m-3. logical :: allow_clocks_in_omp_loops !< If true, clocks can be called from inside loops that can !! be threaded. To run with multiple threads, set to False. type(group_pass_type) :: pass_h_sum_hmbl_prev !< For group halo pass @@ -204,7 +204,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & type(optics_type), pointer :: optics !< The structure containing the inverse of the !! vertical absorption decay scale for !! penetrating shortwave radiation, in m-1. - real, dimension(:,:), pointer :: Hml !< active mixed layer depth + real, dimension(:,:), pointer :: Hml !< Active mixed layer depth, in m. logical, intent(in) :: aggregate_FW_forcing !< If true, the net incoming and !! outgoing surface freshwater fluxes are !! combined before being applied, instead of @@ -286,7 +286,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & ! new, sorted index space. Here layer 0 is an initially massless layer that ! will be used to hold the new mixed layer properties. real, dimension(SZI_(G),SZK0_(GV)) :: & - h, & ! The layer thickness, in m or kg m-2. + h, & ! The layer thickness, in H (often m or kg m-2). T, & ! The layer temperatures, in deg C. S, & ! The layer salinities, in psu. R0, & ! The potential density referenced to the surface, in kg m-3. @@ -294,7 +294,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & real, dimension(SZI_(G),SZK_(GV)) :: & u, & ! The zonal velocity, in m s-1. v, & ! The meridional velocity, in m s-1. - h_orig, & ! The original thickness in m or kg m-2. + h_orig, & ! The original thickness in H (often m or kg m-2). d_eb, & ! The downward increase across a layer in the entrainment from ! below, in H. The sign convention is that positive values of ! d_eb correspond to a gain in mass by a layer by upward motion. @@ -305,12 +305,12 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & integer, dimension(SZI_(G),SZK_(GV)) :: & ksort ! The sorted k-index that each original layer goes to. real, dimension(SZI_(G),SZJ_(G)) :: & - h_miss ! The summed absolute mismatch, in m. + h_miss ! The summed absolute mismatch, in H. real, dimension(SZI_(G)) :: & TKE, & ! The turbulent kinetic energy available for mixing over a - ! time step, in m3 s-2. + ! time step, in Z m2 s-2. Conv_En, & ! The turbulent kinetic energy source due to mixing down to - ! the depth of free convection, in m3 s-2. + ! the depth of free convection, in Z m2 s-2. htot, & ! The total depth of the layers being considered for ! entrainment, in H. R0_tot, & ! The integrated potential density referenced to the surface @@ -346,7 +346,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & dRcv_dS, & ! Partial derivative of the coordinate variable potential ! density in the mixed layer with salinity, in kg m-3 psu-1. TKE_river ! The turbulent kinetic energy available for mixing at rivermouths over a - ! time step, in m3 s-2. + ! time step, in Z m2 s-2. real, dimension(max(CS%nsw,1),SZI_(G)) :: & Pen_SW_bnd ! The penetrating fraction of the shortwave heating integrated @@ -365,21 +365,21 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & real, dimension(SZI_(G)) :: & dKE_FC, & ! The change in mean kinetic energy due to free convection, - ! in m3 s-2. + ! in Z m2 s-2. h_CA ! The depth to which convective adjustment has gone in H. real, dimension(SZI_(G),SZK_(GV)) :: & dKE_CA, & ! The change in mean kinetic energy due to convective - ! adjustment, in m3 s-2. + ! adjustment, in Z m2 s-2. cTKE ! The turbulent kinetic energy source due to convective - ! adjustment, m3 s-2. + ! adjustment, Z m2 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, m. + ! after entrainment but before any buffer layer detrainment, H. Hsfc_used, & ! The thickness of the surface region after buffer layer - ! detrainment, in units of m. + ! detrainment, in units of H. Hsfc_min, & ! The minimum thickness of the surface region based on the ! new mixed layer depth and the previous thickness of the - ! neighboring water columns, in m. + ! neighboring water columns, in H. h_sum, & ! The total thickness of the water column, in H. hmbl_prev ! The previous thickness of the mixed and buffer layers, in H. real, dimension(SZI_(G)) :: & @@ -391,16 +391,14 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & real :: H_nbr ! A minimum thickness based on neighboring thicknesses, in H. real :: absf_x_H ! The absolute value of f times the mixed layer thickness, - ! in units of m s-1. - real :: kU_star ! Ustar times the Von Karmen constant, in m s-1. + ! in units of Z s-1. + real :: kU_star ! Ustar times the Von Karmen constant, in Z s-1. real :: dt__diag ! A copy of dt_diag (if present) or dt, in s. logical :: write_diags ! If true, write out diagnostics with this step. logical :: reset_diags ! If true, zero out the accumulated diagnostics. integer :: i, j, k, is, ie, js, je, nz, nkmb, n integer :: nsw ! The number of bands of penetrating shortwave radiation. - real :: H_limit_fluxes ! CS%H_limit fluxes converted to units of H. - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (.not. associated(CS)) call MOM_error(FATAL, "MOM_mixed_layer: "//& @@ -422,19 +420,17 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & Idt = 1.0 / dt Idt_diag = 1.0 / dt__diag write_diags = .true. ; if (present(last_call)) write_diags = last_call - H_limit_fluxes = CS%H_limit_fluxes * GV%m_to_H p_ref(:) = 0.0 ; p_ref_cv(:) = tv%P_Ref nsw = CS%nsw if (CS%limit_det .or. (CS%id_Hsfc_min > 0)) then -!$OMP parallel default(none) shared(is,ie,js,je,nkmb,h_sum,hmbl_prev,h_3d,nz) -!$OMP do + !$OMP parallel do default(shared) do j=js-1,je+1 ; do i=is-1,ie+1 h_sum(i,j) = 0.0 ; hmbl_prev(i,j) = 0.0 enddo ; enddo -!$OMP do + !$OMP parallel do default(shared) do j=js-1,je+1 do k=1,nkmb ; do i=is-1,ie+1 h_sum(i,j) = h_sum(i,j) + h_3d(i,j,k) @@ -444,7 +440,6 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & h_sum(i,j) = h_sum(i,j) + h_3d(i,j,k) enddo ; enddo enddo -!$OMP end parallel call cpu_clock_begin(id_clock_pass) call create_group_pass(CS%pass_h_sum_hmbl_prev, h_sum,G%Domain) @@ -459,9 +454,8 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & reset_diags = .false. ! This is the second call to mixedlayer. if (reset_diags) then -!$OMP parallel default(none) shared(is,ie,js,je,CS) if (CS%TKE_diagnostics) then -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie CS%diag_TKE_wind(i,j) = 0.0 ; CS%diag_TKE_RiBulk(i,j) = 0.0 CS%diag_TKE_conv(i,j) = 0.0 ; CS%diag_TKE_pen_SW(i,j) = 0.0 @@ -470,18 +464,17 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & enddo ; enddo endif if (allocated(CS%diag_PE_detrain)) then -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie CS%diag_PE_detrain(i,j) = 0.0 enddo ; enddo endif if (allocated(CS%diag_PE_detrain2)) then -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie CS%diag_PE_detrain2(i,j) = 0.0 enddo ; enddo endif -!$OMP end parallel endif if (CS%ML_resort) then @@ -567,7 +560,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & ! 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*GV%g_Earth*Irho0**2 + RmixConst = 0.5*CS%rivermix_depth * GV%g_Earth * Irho0**2 do i=is,ie TKE_river(i) = max(0.0, RmixConst*dR0_dS(i)* & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j)) * S(i,1)) @@ -587,7 +580,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & ! net_salt = salt ( g(salt)/m2 for non-Bouss and ppt*m/s for Bouss ) via surface fluxes ! Pen_SW_bnd = components to penetrative shortwave radiation call extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, & - H_limit_fluxes, CS%use_river_heat_content, CS%use_calving_heat_content, & + CS%H_limit_fluxes, CS%use_river_heat_content, CS%use_calving_heat_content, & h(:,1:), T(:,1:), netMassInOut, netMassOut, Net_heat, Net_salt, Pen_SW_bnd,& tv, aggregate_FW_forcing) @@ -621,7 +614,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & cMKE, Idt_diag, nsw, Pen_SW_bnd, opacity_band, TKE, & Idecay_len_TKE, j, ksort, G, GV, CS) - call absorbRemainingSW(G, GV, h(:,1:), opacity_band, nsw, j, dt, H_limit_fluxes, & + call absorbRemainingSW(G, GV, h(:,1:), opacity_band, nsw, j, dt, CS%H_limit_fluxes, & CS%correct_absorption, CS%absorb_all_SW, & T(:,1:), Pen_SW_bnd, eps, ksort, htot, Ttot) @@ -641,10 +634,10 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & h(i,0) = htot(i) endif ; enddo if (write_diags .and. allocated(CS%ML_depth)) then ; do i=is,ie - CS%ML_depth(i,j) = h(i,0) * GV%H_to_m + CS%ML_depth(i,j) = h(i,0) * GV%H_to_m ! Rescale the diagnostic. enddo ; endif if (associated(Hml)) then ; do i=is,ie - Hml(i,j) = G%mask2dT(i,j) * (h(i,0) * GV%H_to_m) + Hml(i,j) = G%mask2dT(i,j) * (h(i,0) * GV%H_to_m) ! Rescale the diagnostic for output. enddo ; endif ! At this point, return water to the original layers, but constrained to @@ -678,14 +671,14 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & hmbl_prev(i,j-1) - dHD*min(h_sum(i,j),h_sum(i,j-1)), & hmbl_prev(i,j+1) - dHD*min(h_sum(i,j),h_sum(i,j+1))) ) - Hsfc_min(i,j) = GV%H_to_m*max(h(i,0), min(Hsfc(i), H_nbr)) + Hsfc_min(i,j) = max(h(i,0), min(Hsfc(i), H_nbr)) if (CS%limit_det) max_BL_det(i) = max(0.0, Hsfc(i)-H_nbr) enddo endif if (CS%id_Hsfc_max > 0) then ; do i=is,ie - Hsfc_max(i,j) = Hsfc(i)*GV%H_to_m + Hsfc_max(i,j) = Hsfc(i) enddo ; endif endif @@ -709,9 +702,9 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & if (CS%id_Hsfc_used > 0) then - do i=is,ie ; Hsfc_used(i,j) = h(i,0)*GV%H_to_m ; enddo + do i=is,ie ; Hsfc_used(i,j) = h(i,0) ; enddo do k=CS%nkml+1,nkmb ; do i=is,ie - Hsfc_used(i,j) = Hsfc_used(i,j) + h(i,k)*GV%H_to_m + Hsfc_used(i,j) = Hsfc_used(i,j) + h(i,k) enddo ; enddo endif @@ -726,20 +719,20 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & ! as the third piece will then optimally describe mixed layer ! restratification. For nkml>=4 the whole strategy should be revisited. do i=is,ie - kU_Star = 0.41*fluxes%ustar(i,j) ! Maybe could be replaced with u*+w*? + kU_Star = 0.41*GV%m_to_Z*fluxes%ustar(i,j) ! Maybe could be replaced with u*+w*? if (associated(fluxes%ustar_shelf) .and. & associated(fluxes%frac_shelf_h)) then if (fluxes%frac_shelf_h(i,j) > 0.0) & kU_Star = (1.0 - fluxes%frac_shelf_h(i,j)) * kU_star + & - fluxes%frac_shelf_h(i,j) * (0.41*fluxes%ustar_shelf(i,j)) + fluxes%frac_shelf_h(i,j) * (0.41*GV%m_to_Z*fluxes%ustar_shelf(i,j)) endif - absf_x_H = 0.25 * h(i,0) * & + absf_x_H = 0.25 * GV%m_to_Z * h(i,0) * & !### I think this should be H_to_Z -RWH ((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & (abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J)))) ! If the mixed layer vertical viscosity specification is changed in ! MOM_vert_friction.F90, this line will have to be modified accordingly. h_3d(i,j,1) = h(i,0) / (3.0 + sqrt(absf_x_H*(absf_x_H + 2.0*kU_star) / & - (kU_star**2)) ) + (kU_star**2)) ) do k=2,CS%nkml ! The other layers are evenly distributed through the mixed layer. h_3d(i,j,k) = (h(i,0)-h_3d(i,j,1)) * Inkmlm1 @@ -805,18 +798,17 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & do i=is,ie h_miss(i,j) = h_miss(i,j) + abs(h_3d(i,j,nz) - (h_orig(i,nz) + & ((eaml(i,nz) - ebml(i,nz-1)) + ebml(i,nz)))) - h_miss(i,j) = GV%H_to_m * h_miss(i,j) enddo endif enddo ! j loop + !$OMP end parallel ! Whenever thickness changes let the diag manager know, target grids ! for vertical remapping may need to be regenerated. ! This needs to happen after the H update and before the next post_data. call diag_update_remap_grids(CS%diag) -!$OMP end parallel if (write_diags) then if (CS%id_ML_depth > 0) & @@ -860,9 +852,8 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & dKE_CA, cTKE, j, G, GV, CS, nz_conv) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness, in m or kg m-2. - !! (Intent in/out) The units of h are - !! referred to as H below. + real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness, in H (often 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. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: v !< Zonal velocities interpolated to h @@ -881,10 +872,10 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & !! that will be left in each layer, in H. real, dimension(SZI_(G),SZK_(GV)), intent(out) :: dKE_CA !< The vertically integrated change in !! kinetic energy due to convective - !! adjustment, in m3 s-2. + !! adjustment, in Z m2 s-2. real, dimension(SZI_(G),SZK_(GV)), intent(out) :: cTKE !< The buoyant turbulent kinetic energy !! source due to convective adjustment, - !! in m3 s-2. + !! in Z m2 s-2. integer, intent(in) :: j !< The j-index to work on. type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this module. integer, optional, intent(in) :: nz_conv !< If present, the number of layers @@ -895,27 +886,7 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & ! layers and mixed layers to remove hydrostatic instabilities. Any water that ! is lighter than currently in the mixed- or buffer- layer is entrained. -! Arguments: h - Layer thickness, in m or kg m-2. (Intent in/out) The units -! of h are referred to as H below. -! (in/out) u - Zonal velocities interpolated to h points, m s-1. -! (in/out) v - Zonal velocities interpolated to h points, m s-1. -! (in/out) R0 - Potential density referenced to surface pressure, in kg m-3. -! (in/out) Rcv - The coordinate defining potential density, in kg m-3. -! (in/out) T - Layer temperatures, in deg C. -! (in/out) S - Layer salinities, in psu. -! (in/out) d_eb - The downward increase across a layer in the entrainment from -! below, in H. Positive values go with mass gain by a layer. -! (out) dKE_CA - The vertically integrated change in kinetic energy due -! to convective adjustment, in m3 s-2. -! (out) cTKE - The buoyant turbulent kinetic energy source due to -! convective adjustment, in m3 s-2. -! (in) j - The j-index to work on. -! (in) ksort - The density-sorted k-indicies. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure for this module. -! (in,opt) nz_conv - If present, the number of layers over which to do -! convective adjustment (perhaps CS%nkml). + ! Local variables real, dimension(SZI_(G)) :: & htot, & ! The total depth of the layers being considered for ! entrainment, in H. @@ -934,13 +905,13 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & h_orig_k1 ! The depth of layer k1 before convective adjustment, in H. real :: h_ent ! The thickness from a layer that is entrained, in H. real :: Ih ! The inverse of a thickness, in H-1. - real :: g_H2_2Rho0 ! Half the gravitational acceleration times the - ! square of the conversion from H to m divided - ! by the mean density, in m6 s-2 H-2 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 m7 s-2 Z-1 H-2 kg-1. !### CHECK UNITS integer :: is, ie, nz, i, k, k1, nzc, nkmb is = G%isc ; ie = G%iec ; nz = GV%ke - g_H2_2Rho0 = (GV%g_Earth * GV%H_to_m**2) / (2.0 * GV%Rho0) + g_H2_2Rho0 = (GV%g_Earth * GV%Z_to_m * GV%H_to_Z**2) / (2.0 * GV%Rho0) nzc = nz ; if (present(nz_conv)) nzc = nz_conv nkmb = CS%nkml+CS%nkbl @@ -962,8 +933,8 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & do i=is,ie if ((h(i,k) > eps(i,k)) .and. (R0_tot(i) > h(i,k1)*R0(i,k))) then h_ent = h(i,k)-eps(i,k) - cTKE(i,k1) = cTKE(i,k1) + (h_ent * g_H2_2Rho0 * & - (R0_tot(i) - h(i,k1)*R0(i,k)) * CS%nstar2) + cTKE(i,k1) = cTKE(i,k1) + h_ent * g_H2_2Rho0 * & + (R0_tot(i) - h(i,k1)*R0(i,k)) * CS%nstar2 if (k < nkmb) then cTKE(i,k1) = cTKE(i,k1) + cTKE(i,k) dKE_CA(i,k1) = dKE_CA(i,k1) + dKE_CA(i,k) @@ -990,7 +961,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_m * (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 @@ -1018,7 +989,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZK_(GV)), & - intent(inout) :: h !< Layer thickness, in m or kg m-2. + intent(inout) :: h !< Layer thickness, in H (often m or kg m-2). !! The units of h are referred to as H below. real, dimension(SZI_(G),SZK_(GV)), & intent(inout) :: d_eb !< The downward increase across a layer in the @@ -1081,12 +1052,10 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real, dimension(:,:,:), intent(in) :: opacity_band !< The opacity in each band of penetrating !! shortwave radiation, in H-1. !! The indicies of opacity_band are band, i, k. - real, dimension(SZI_(G)), intent(out) :: Conv_en !< The buoyant turbulent kinetic - !! energy source due to free - !! convection, in m3 s-2. - real, dimension(SZI_(G)), intent(out) :: dKE_FC !< The vertically integrated change - !! in kinetic energy due to free - !! convection, in m3 s-2. + real, dimension(SZI_(G)), intent(out) :: Conv_en !< The buoyant turbulent kinetic energy source + !! due to free convection, in Z m2 s-2. + real, dimension(SZI_(G)), intent(out) :: dKE_FC !< The vertically integrated change in kinetic + !! energy due to free convection, in Z m2 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. @@ -1107,32 +1076,8 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & ! This subroutine causes the mixed layer to entrain to the depth of free ! convection. The depth of free convection is the shallowest depth at which the ! fluid is denser than the average of the fluid above. -! Arguments: h - Layer thickness, in m or kg m-2. (Intent in/out) The units -! of h are referred to as H below. -! (in/out) d_eb - The downward increase across a layer in the entrainment from -! below, in H. Positive values go with mass gain by a layer. -! (out) htot - The accumulated mixed layer thickness, in H. -! (out) Ttot - The depth integrated mixed layer temperature, in deg C H. -! (out) Stot - The depth integrated mixed layer salinity, in psu H. -! (out) uhtot - The depth integrated mixed layer zonal velocity, H m s-1. -! (out) vhtot - The integrated mixed layer meridional velocity, H m s-1. -! (out) R0_tot - The integrated mixed layer potential density referenced -! to 0 pressure, in kg m-2. -! (out) Rcv_tot - The integrated mixed layer coordinate variable -! potential density, in kg m-2. -! (in) nsw - The number of bands of penetrating shortwave radiation. -! (out) Pen_SW_bnd - The penetrating shortwave heating at the sea surface -! in each penetrating band, in K H, size nsw x SZI_(G). -! (out) Conv_en - The buoyant turbulent kinetic energy source due to -! free convection, in m3 s-2. -! (out) dKE_FC - The vertically integrated change in kinetic energy due -! to free convection, in m3 s-2. -! (in) j - The j-index to work on. -! (in) ksort - The density-sorted k-indices. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure for this module. + ! Local variables real, dimension(SZI_(G)) :: & massOutRem, & ! Evaporation that remains to be supplied, in H. netMassIn ! mass entering through ocean surface (H) @@ -1154,9 +1099,9 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real :: h_evap ! The thickness that is evaporated, in H. real :: dh_Newt ! The Newton's method estimate of the change in ! h_ent between iterations, in H. - real :: g_H2_2Rho0 ! Half the gravitational acceleration times the - ! square of the conversion from H to m divided - ! by the mean density, in m6 s-2 H-2 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 m7 s-2 Z-1 H-2 kg-1. !### CHECK UNITS real :: Angstrom ! The minimum layer thickness, in H. real :: opacity ! The opacity converted to units of H-1. real :: sum_Pen_En ! The potential energy change due to penetrating @@ -1171,7 +1116,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 = (GV%g_Earth * GV%H_to_m**2) / (2.0 * GV%Rho0) + g_H2_2Rho0 = (GV%g_Earth * GV%Z_to_m * GV%H_to_Z**2) / (2.0 * GV%Rho0) Idt = 1.0/dt is = G%isc ; ie = G%iec ; nz = GV%ke @@ -1388,7 +1333,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & if (h_ent > 0.0) then if (htot(i) > 0.0) & dKE_FC(i) = dKE_FC(i) + CS%bulk_Ri_convective * 0.5 * & - ((GV%H_to_m*h_ent) / (htot(i)*(h_ent+htot(i)))) * & + ((GV%H_to_Z*h_ent) / (htot(i)*(h_ent+htot(i)))) * & ((uhtot(i)-u(i,k)*htot(i))**2 + (vhtot(i)-v(i,k)*htot(i))**2) htot(i) = htot(i) + h_ent @@ -1411,34 +1356,33 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, j, ksort, G, GV, 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. - real, dimension(SZI_(G)), intent(in) :: htot !< The accumlated mixed layer thickness, in m - !! or kg m-2. (Intent in). + real, dimension(SZI_(G)), intent(in) :: htot !< The accumlated mixed layer thickness, in H + !! (often m or kg m-2). real, dimension(SZI_(G)), intent(in) :: h_CA !< The mixed layer depth after convective !! adjustment, in H. type(forcing), intent(in) :: fluxes !< A structure containing pointers to any !! 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, - !! in m3 s-2. + real, dimension(SZI_(G)), intent(inout) :: Conv_En !< The buoyant turbulent kinetic energy source + !! due to free convection, in Z m2 s-2. real, dimension(SZI_(G)), intent(in) :: dKE_FC !< The vertically integrated change in !! kinetic energy due to free convection, - !! in m3 s-2. + !! in Z m2 s-2. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: cTKE !< The buoyant turbulent kinetic energy !! source due to convective adjustment, - !! in m3 s-2. + !! in Z m2 s-2. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: dKE_CA !< The vertically integrated change in !! kinetic energy due to convective - !! adjustment, in m3 s-2. + !! adjustment, in Z m2 s-2. real, dimension(SZI_(G)), intent(out) :: TKE !< The turbulent kinetic energy available for - !! mixing over a time step, in m3 s-2. + !! mixing over a time step, in Z m2 s-2. real, dimension(SZI_(G)), intent(out) :: Idecay_len_TKE !< The inverse of the vertical decay !! scale for TKE, in H-1. real, dimension(SZI_(G)), intent(in) :: TKE_river !< The turbulent kinetic energy available !! for driving mixing at river mouths - !! integrated over a time step, in m3 s-2. + !! integrated over a time step, in Z m2 s-2. real, dimension(2,SZI_(G)), intent(out) :: cMKE !< Coefficients of HpE and HpE^2 in !! calculating the denominator of MKE_rate, !! in H-1 and H-2. @@ -1453,48 +1397,23 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, ! This subroutine determines the TKE available at the depth of free ! convection to drive mechanical entrainment. -! Arguments: htot - The accumlated mixed layer thickness, in m or kg m-2. (Intent in) -! The units of htot are referred to as H below. -! (in) h_CA - The mixed layer depth after convective adjustment, in H. -! (in) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (in) Conv_en - The buoyant turbulent kinetic energy source due to -! free convection, in m3 s-2. -! (in) cTKE - The buoyant turbulent kinetic energy source due to -! convective adjustment, in m3 s-2. -! (in) dKE_FC - The vertically integrated change in kinetic energy due -! to free convection, in m3 s-2. -! (in) dKE_CA - The vertically integrated change in kinetic energy due -! to convective adjustment, in m3 s-2. -! (out) TKE - The turbulent kinetic energy available for mixing over a -! time step, in m3 s-2. -! (out) Idecay_len_TKE - The inverse of the vertical decay scale for -! TKE, in H-1. -! (out) cMKE - Coefficients of HpE and HpE^2 in calculating the -! denominator of MKE_rate, in H-1 and H-2. -! (in) dt - The time step in s. -! (in) j - The j-index to work on. -! (in) ksort - The density-sorted k-indicies. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure for this module. - real :: dKE_conv ! The change in mean kinetic energy due - ! to all convection, in m3 s-2. + ! Local variables + real :: dKE_conv ! The change in mean kinetic energy due to all convection, in Z m2 s-2. real :: nstar_FC ! The effective efficiency with which the energy released by ! free convection is converted to TKE, often ~0.2, ND. real :: nstar_CA ! The effective efficiency with which the energy released by ! convective adjustment is converted to TKE, often ~0.2, ND. real :: TKE_CA ! The potential energy released by convective adjustment if - ! that release is positive, in m3 s2. + ! that release is positive, in Z m2 s2. real :: MKE_rate_CA ! MKE_rate for convective adjustment, ND, 0 to 1. real :: MKE_rate_FC ! MKE_rate for free convection, ND, 0 to 1. - real :: totEn ! The total potential energy released by convection, m3 s-2. + real :: totEn_Z ! The total potential energy released by convection, Z3 s-2. real :: Ih ! The inverse of a thickness, in H-1. real :: exp_kh ! The nondimensional decay of TKE across a layer, ND. real :: absf ! The absolute value of f averaged to thickness points, s-1. - real :: U_star ! The friction velocity in m s-1. - real :: absf_Ustar ! The absolute value of f divided by U_star, in m-1. - real :: wind_TKE_src ! The surface wind source of TKE, in m3 s-3. + real :: U_star ! The friction velocity in Z s-1. + real :: absf_Ustar ! The absolute value of f divided by U_star, in Z-1. + real :: wind_TKE_src ! The surface wind source of TKE, in Z m2 s-3. real :: diag_wt ! The ratio of the current timestep to the diagnostic ! timestep (which may include 2 calls), ND. integer :: is, ie, nz, i @@ -1504,11 +1423,11 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, if (CS%omega_frac >= 1.0) absf = 2.0*CS%omega do i=is,ie - U_Star = fluxes%ustar(i,j) + U_Star = GV%m_to_Z * fluxes%ustar(i,j) if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then if (fluxes%frac_shelf_h(i,j) > 0.0) & U_Star = (1.0 - fluxes%frac_shelf_h(i,j)) * U_star + & - fluxes%frac_shelf_h(i,j) * fluxes%ustar_shelf(i,j) + fluxes%frac_shelf_h(i,j) * GV%m_to_Z * fluxes%ustar_shelf(i,j) endif if (U_Star < CS%ustar_min) U_Star = CS%ustar_min @@ -1519,7 +1438,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2) endif absf_Ustar = absf / U_Star - Idecay_len_TKE(i) = (absf_Ustar * CS%TKE_decay) * GV%H_to_m + Idecay_len_TKE(i) = (absf_Ustar * CS%TKE_decay) * GV%H_to_Z ! The first number in the denominator could be anywhere up to 16. The ! value of 3 was chosen to minimize the time-step dependence of the amount @@ -1531,8 +1450,8 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, ! scales contribute to mixed layer deepening at similar rates, even though ! small scales are dissipated more rapidly (implying they are less efficient). ! Ih = 1.0/(16.0*0.41*U_star*dt) - Ih = GV%H_to_m/(3.0*0.41*U_star*dt) - cMKE(1,i) = 4.0 * Ih ; cMKE(2,i) = (absf_Ustar*GV%H_to_m) * Ih + Ih = GV%H_to_Z/(3.0*0.41*U_star*dt) + cMKE(1,i) = 4.0 * Ih ; cMKE(2,i) = (absf_Ustar*GV%H_to_Z) * Ih if (Idecay_len_TKE(i) > 0.0) then exp_kh = exp(-htot(i)*Idecay_len_TKE(i)) @@ -1546,11 +1465,11 @@ 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 = Conv_En(i) + TKE_CA + totEn_Z = GV%m_to_Z**2 * (Conv_En(i) + TKE_CA) - if (totEn > 0.0) then - nstar_FC = CS%nstar * totEn / (totEn + 0.2 * & - sqrt(0.5 * dt * (absf*(htot(i)*GV%H_to_m))**3 * totEn)) + if (totEn_Z > 0.0) then + nstar_FC = CS%nstar * totEn_Z / (totEn_Z + 0.2 * & + sqrt(0.5 * dt * (absf*(htot(i)*GV%H_to_Z))**3 * totEn_Z)) else nstar_FC = CS%nstar endif @@ -1558,17 +1477,17 @@ 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 = Conv_En(i) + TKE_CA * (htot(i) / h_CA(i)) - nstar_FC = CS%nstar * totEn / (totEn + 0.2 * & - sqrt(0.5 * dt * (absf*(htot(i)*GV%H_to_m))**3 * totEn)) + totEn_Z = GV%m_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 * (absf*(htot(i)*GV%H_to_Z))**3 * totEn_Z)) else nstar_FC = CS%nstar endif - totEn = Conv_En(i) + TKE_CA + totEn_Z = GV%m_to_Z**2 * (Conv_En(i) + TKE_CA) if (TKE_CA > 0.0) then - nstar_CA = CS%nstar * totEn / (totEn + 0.2 * & - sqrt(0.5 * dt * (absf*(h_CA(i)*GV%H_to_m))**3 * totEn)) + nstar_CA = CS%nstar * totEn_Z / (totEn_Z + 0.2 * & + sqrt(0.5 * dt * (absf*(h_CA(i)*GV%H_to_Z))**3 * totEn_Z)) else nstar_CA = CS%nstar endif @@ -1590,27 +1509,26 @@ 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*CS%mstar)*((U_Star*U_Star*U_Star)*exp_kh) + & - (exp_kh * dKE_conv + nstar_FC*Conv_En(i) + nstar_CA*TKE_CA) -! Add additional TKE at river mouths + TKE(i) = (dt*CS%mstar)*((GV%Z_to_m**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 + if (CS%do_rivermix) then ! Add additional TKE at river mouths TKE(i) = TKE(i) + TKE_river(i)*dt*exp_kh endif if (CS%TKE_diagnostics) then - wind_TKE_src = CS%mstar*(U_Star*U_Star*U_Star) * diag_wt + wind_TKE_src = CS%mstar*(GV%Z_to_m**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 + ( wind_TKE_src + TKE_river(i) * diag_wt ) CS%diag_TKE_RiBulk(i,j) = CS%diag_TKE_RiBulk(i,j) + dKE_conv*Idt_diag CS%diag_TKE_mech_decay(i,j) = CS%diag_TKE_mech_decay(i,j) + & (exp_kh-1.0)*(wind_TKE_src + dKE_conv*Idt_diag) CS%diag_TKE_conv(i,j) = CS%diag_TKE_conv(i,j) + & - Idt_diag*(nstar_FC*Conv_En(i) + nstar_CA*TKE_CA) + Idt_diag * (nstar_FC*Conv_En(i) + nstar_CA*TKE_CA) CS%diag_TKE_conv_decay(i,j) = CS%diag_TKE_conv_decay(i,j) + & - Idt_diag*((CS%nstar-nstar_FC)*Conv_En(i) + (CS%nstar-nstar_CA)*TKE_CA) + Idt_diag * ((CS%nstar-nstar_FC)*Conv_En(i) + (CS%nstar-nstar_CA)*TKE_CA) CS%diag_TKE_conv_s2(i,j) = CS%diag_TKE_conv_s2(i,j) + & - Idt_diag*(cTKE(i,1)-TKE_CA) + Idt_diag * (cTKE(i,1)-TKE_CA) endif enddo @@ -1680,7 +1598,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! The indicies of opacity_band are band, i, k. real, dimension(SZI_(G)), intent(inout) :: TKE !< The turbulent kinetic energy !! available for mixing over a time - !! step, in m3 s-2. + !! step, in Z m2 s-2. real, dimension(SZI_(G)), intent(inout) :: Idecay_len_TKE !< The vertical TKE decay rate, in H-1. integer, intent(in) :: j !< The j-index to work on. integer, dimension(SZI_(G),SZK_(GV)), & @@ -1688,30 +1606,8 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this module. ! This subroutine calculates mechanically driven entrainment. -! Arguments: h - Layer thickness, in m or kg m-2. (Intent in/out) The units -! of h are referred to as H below. -! (in/out) d_eb - The downward increase across a layer in the entrainment from -! below, in H. Positive values go with mass gain by a layer. -! (in/out) htot - The accumlated mixed layer thickness, in H. -! (in/out) Ttot - The depth integrated mixed layer temperature, in deg C H. -! (in/out) Stot - The depth integrated mixed layer salinity, in psu H. -! (in/out) uhtot - The depth integrated mixed layer zonal velocity, H m s-1. -! (in/out) vhtot - The integrated mixed layer meridional velocity, H m s-1. -! (in/out) R0_tot - The integrated mixed layer potential density referenced -! to 0 pressure, in H kg m-3. -! (in/out) Rcv_tot - The integrated mixed layer coordinate variable -! potential density, in H kg m-3. -! (in) nsw - The number of bands of penetrating shortwave radiation. -! (in/out) Pen_SW_bnd - The penetrating shortwave heating at the sea surface -! in each penetrating band, in K H, size nsw x SZI_(G). -! (in/out) TKE - The turbulent kinetic energy available for mixing over a -! time step, in m3 s-2. -! (in) j - The j-index to work on. -! (in) ksort - The density-sorted k-indicies. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure for this module. + ! Local variables real :: SW_trans ! The fraction of shortwave radiation that is not ! absorbed in a layer, nondimensional. real :: Pen_absorbed ! The amount of penetrative shortwave radiation @@ -1729,18 +1625,18 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & ! conversion from H to m divided by the mean density, ! in m5 s-2 H-1 kg-1. real :: TKE_full_ent ! The TKE remaining if a layer is fully entrained, - ! in units of m3 s-2. + ! in units of Z m2 s-2. real :: dRL ! Work required to mix water from the next layer ! across the mixed layer, in m2 s-2. real :: Pen_En_Contrib ! Penetrating SW contributions to the changes in ! TKE, divided by layer thickness in m, in m2 s-2. real :: C1 ! A temporary variable in units of m2 s-2. real :: dMKE ! A temporary variable related to the release of mean - ! kinetic energy, with units of H m3 s-2. - real :: TKE_ent ! The TKE that remains if h_ent were entrained, in m3 s-2. + ! kinetic energy, with units of H Z m2 s-2. + real :: TKE_ent ! The TKE that remains if h_ent were entrained, in Z m2 s-2. real :: TKE_ent1 ! The TKE that would remain, without considering the - ! release of mean kinetic energy, in m3 s2. - real :: dTKE_dh ! The partial derivative of TKE with h_ent, in m3 s-2 H-1. + ! release of mean kinetic energy, in Z m2 s2. + real :: dTKE_dh ! The partial derivative of TKE with h_ent, in Z m2 s-2 H-1. real :: Pen_dTKE_dh_Contrib ! The penetrating shortwave contribution to ! dTKE_dh, in m2 s-2. real :: EF4_val ! The result of EF4() (see later), in H-1. @@ -1748,7 +1644,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & ! in roundoff and can be neglected, in H. real :: dEF4_dh ! The partial derivative of EF4 with h, in H-2. real :: Pen_En1 ! A nondimensional temporary variable. - real :: kh, exp_kh ! Nondimensional temporary variables related to the. + real :: kh, exp_kh ! Nondimensional temporary variables related to the real :: f1_kh ! fractional decay of TKE across a layer. real :: x1, e_x1 ! Nondimensional temporary variables related to real :: f1_x1, f2_x1 ! the relative decay of TKE and SW radiation across @@ -1756,15 +1652,13 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real :: E_HxHpE ! Entrainment divided by the product of the new and old ! thicknesses, in H-1. real :: Hmix_min ! The minimum mixed layer depth in H. - real :: H_to_m ! Local copies of unit conversion factors. real :: opacity real :: C1_3, C1_6, C1_24 ! 1/3, 1/6, and 1/24. 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 - H_to_m = GV%H_to_m - g_H_2Rho0 = (GV%g_Earth * H_to_m) / (2.0 * GV%Rho0) - Hmix_min = CS%Hmix_min * GV%m_to_H + g_H_2Rho0 = (GV%g_Earth * GV%Z_to_m * 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 @@ -1776,7 +1670,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 = (H_to_m * CS%bulk_Ri_ML) * 0.5 * & + 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. @@ -1822,7 +1716,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & HpE = htot(i)+h_avail MKE_rate = 1.0/(1.0 + (cMKE(1,i)*HpE + cMKE(2,i)*HpE**2)) EF4_val = EF4(htot(i)+h_neglect,h_avail,Idecay_len_TKE(i)) - TKE_full_ent = (exp_kh*TKE(i) - (h_avail*H_to_m)*(dRL*f1_kh + Pen_En_Contrib)) + & + TKE_full_ent = (exp_kh*TKE(i) - (h_avail*GV%H_to_Z)*(dRL*f1_kh + Pen_En_Contrib)) + & MKE_rate*dMKE*EF4_val if ((TKE_full_ent >= 0.0) .or. (h_avail+htot(i) <= Hmix_min)) then ! The layer will be fully entrained. @@ -1832,18 +1726,18 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & 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*H_to_m)*dRL*(1.0-f1_kh) + & + (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*(H_to_m*h_ent)*dRL + Idt_diag*(GV%H_to_Z*h_ent)*dRL CS%diag_TKE_pen_SW(i,j) = CS%diag_TKE_pen_SW(i,j) - & - Idt_diag*(H_to_m*h_ent)*Pen_En_Contrib + Idt_diag*(GV%H_to_Z*h_ent)*Pen_En_Contrib CS%diag_TKE_RiBulk(i,j) = CS%diag_TKE_RiBulk(i,j) + & Idt_diag*MKE_rate*dMKE*E_HxHpE endif TKE(i) = TKE_full_ent - if (TKE(i) <= 0.0) TKE(i) = 1.0e-150 + if (TKE(i) <= 0.0) TKE(i) = 1.0e-150*GV%m_to_Z else ! The layer is only partially entrained. The amount that will be ! entrained is determined iteratively. No further layers will be @@ -1902,16 +1796,16 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & C1*((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*H_to_m)*(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)) TKE_ent = TKE_ent1 + dMKE*EF4_val*MKE_rate ! TKE_ent is the TKE that would remain if h_ent were entrained. - dTKE_dh = ((-Idecay_len_TKE(i)*TKE_ent1 - dRL*H_to_m) + & - Pen_dTKE_dh_Contrib*H_to_m) + dMKE * MKE_rate* & - (dEF4_dh - EF4_val*MKE_rate*(cMKE(1,i)+2.0*cMKE(2,i)*HpE)) + dTKE_dh = ((-Idecay_len_TKE(i)*TKE_ent1 - dRL*GV%H_to_Z) + & + Pen_dTKE_dh_Contrib*GV%H_to_Z) + dMKE * MKE_rate* & + (dEF4_dh - EF4_val*MKE_rate*(cMKE(1,i)+2.0*cMKE(2,i)*HpE)) ! dh_Newt = -TKE_ent / dTKE_dh ! Bisect if the Newton's method prediction is outside of the bounded range. if (TKE_ent > 0.0) then @@ -1945,12 +1839,12 @@ 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*H_to_m)*dRL*(1.0-f1_kh) + & + (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*H_to_m)*dRL + Idt_diag*(h_ent*GV%H_to_Z)*dRL CS%diag_TKE_pen_SW(i,j) = CS%diag_TKE_pen_SW(i,j) - & - Idt_diag*(h_ent*H_to_m)*Pen_En_Contrib + Idt_diag*(h_ent*GV%H_to_Z)*Pen_En_Contrib CS%diag_TKE_RiBulk(i,j) = CS%diag_TKE_RiBulk(i,j) + & Idt_diag*dMKE*MKE_rate*E_HxHpE endif @@ -2522,7 +2416,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, ! rho_0*g, in units of H2. real :: dPE_det, dPE_merge ! The energy required to mix the detrained water ! into the buffer layer or the merge the two - ! buffer layers, both in units of J H2 m-4. + ! buffer layers, both in units of J H2 Z m-5. real :: h_from_ml ! The amount of additional water that must be ! drawn from the mixed layer, in H. @@ -2564,11 +2458,11 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, ! K psu-1 and psu K-1. real :: I_denom ! A work variable with units of psu2 m6 kg-2. - real :: G_2 ! 1/2 G_Earth, in m s-2. - real :: Rho0xG ! Rho0 times G_Earth, in kg m-2 s-2. + real :: G_2 ! 1/2 G_Earth, in m2 Z-1 s-2. + real :: Rho0xG ! Rho0 times G_Earth, in kg m-1 Z-1 s-2. real :: I2Rho0 ! 1 / (2 Rho0), in m3 kg-1. real :: Idt_H2 ! The square of the conversion from thickness - ! to m divided by the time step in m2 H-2 s-1. + ! to Z divided by the time step in Z2 H-2 s-1. logical :: stable_Rcv ! If true, the buffer layers are stable with ! respect to the coordinate potential density. real :: h_neglect ! A thickness that is so small it is usually lost @@ -2593,17 +2487,17 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, kb1 = CS%nkml+1; kb2 = CS%nkml+2 nkmb = CS%nkml+CS%nkbl h_neglect = GV%H_subroundoff - G_2 = 0.5*GV%g_Earth - Rho0xG = GV%Rho0 * GV%g_Earth - Idt_H2 = GV%H_to_m**2 / dt_diag + G_2 = 0.5*GV%g_Earth*GV%Z_to_m + Rho0xG = GV%Rho0 * GV%g_Earth*GV%Z_to_m + Idt_H2 = GV%H_to_Z**2 / dt_diag I2Rho0 = 0.5 / GV%Rho0 Angstrom = GV%Angstrom_H ! This is hard coding of arbitrary and dimensional numbers. - h_min_bl_thick = 5.0 * GV%m_to_H + h_min_bl_thick = 5.0 * GV%m_to_H !### DIMENSIONAL CONSTANT dT_dS_gauge = CS%dT_dS_wt ; dS_dT_gauge = 1.0 /dT_dS_gauge num_events = 10.0 - detrainment_timescale = 4.0*3600.0 + detrainment_timescale = 4.0*3600.0 !### DIMENSIONAL CONSTANT if (CS%nkbl /= 2) call MOM_error(FATAL, "MOM_mixed_layer"// & "CS%nkbl must be 2 in mixedlayer_detrain_2.") @@ -3242,7 +3136,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, if (allocated(CS%diag_PE_detrain)) & CS%diag_PE_detrain(i,j) = CS%diag_PE_detrain(i,j) + Idt_H2*dPE_merge if (allocated(CS%diag_PE_detrain2)) CS%diag_PE_detrain2(i,j) = & - CS%diag_PE_detrain2(i,j) + Idt_H2*(dPE_det+Rho0xG*dPE_extrap) + CS%diag_PE_detrain2(i,j) + Idt_H2*(dPE_det + Rho0xG*dPE_extrap) else ! Not mergeable_bl. ! There is no further detrainment from the buffer layers, and the ! upper buffer layer water is distributed optimally between the @@ -3318,7 +3212,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, if (allocated(CS%diag_PE_detrain)) & CS%diag_PE_detrain(i,j) = CS%diag_PE_detrain(i,j) + Idt_H2*dPE_det if (allocated(CS%diag_PE_detrain2)) CS%diag_PE_detrain2(i,j) = & - CS%diag_PE_detrain2(i,j) + Idt_H2*(dPE_det+Rho0xG*dPE_extrap) + CS%diag_PE_detrain2(i,j) + Idt_H2*(dPE_det + Rho0xG*dPE_extrap) endif endif ! End of detrainment... @@ -3409,12 +3303,12 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e real :: I_denom ! A work variable with units of psu2 m6 kg-2. real :: Sdown, Tdown real :: dt_Time, Timescale = 86400.0*30.0! *365.0/12.0 - 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, in m6 s-3 H-2 kg-1. + 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, in m7 s-3 Z-1 H-2 kg-1. !### CHECK UNITS real :: g_H2_2dt ! Half the gravitational acceleration times the ! square of the conversion from H to m divided - ! by the diagnostic time step, in m3 H-2 s-3. + ! by the diagnostic time step, in m4 Z-1 H-2 s-3. logical :: splittable_BL(SZI_(G)), orthogonal_extrap real :: x1 @@ -3426,17 +3320,16 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e "CS%nkbl must be 1 in mixedlayer_detrain_1.") Idt = 1.0/dt dt_Time = dt/Timescale - g_H2_2Rho0dt = (GV%g_Earth * GV%H_to_m**2) / (2.0 * GV%Rho0 * dt_diag) - g_H2_2dt = (GV%g_Earth * GV%H_to_m**2) / (2.0 * dt_diag) + g_H2_2Rho0dt = (GV%g_Earth*GV%Z_to_m * GV%H_to_Z**2) / (2.0 * GV%Rho0 * dt_diag) + g_H2_2dt = (GV%g_Earth*GV%Z_to_m * GV%H_to_Z**2) / (2.0 * dt_diag) ! Move detrained water into the buffer layer. do k=1,CS%nkml do i=is,ie ; if (h(i,k) > 0.0) then Ih = 1.0 / (h(i,nkmb) + h(i,k)) if (CS%TKE_diagnostics) & - CS%diag_TKE_conv_s2(i,j) = CS%diag_TKE_conv_s2(i,j) + & - g_H2_2Rho0dt * h(i,k) * h(i,nkmb) * & - (R0(i,nkmb) - R0(i,k)) + CS%diag_TKE_conv_s2(i,j) = CS%diag_TKE_conv_s2(i,j) + & + g_H2_2Rho0dt * h(i,k) * h(i,nkmb) * (R0(i,nkmb) - R0(i,k)) if (allocated(CS%diag_PE_detrain)) & CS%diag_PE_detrain(i,j) = CS%diag_PE_detrain(i,j) + & g_H2_2dt * h(i,k) * h(i,nkmb) * (R0(i,nkmb) - R0(i,k)) @@ -3667,7 +3560,7 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS) ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_mixed_layer" ! This module's name. - real :: omega_frac_dflt, ustar_min_dflt + real :: omega_frac_dflt, ustar_min_dflt, Hmix_min_m integer :: isd, ied, jsd, jed logical :: use_temperature, use_omega isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -3727,7 +3620,8 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS) units="nondim", default=CS%bulk_Ri_ML) call get_param(param_file, mdl, "HMIX_MIN", CS%Hmix_min, & "The minimum mixed layer depth if the mixed layer depth \n"//& - "is determined dynamically.", units="m", default=0.0) + "is determined dynamically.", units="m", default=0.0, scale=GV%m_to_H, & + unscaled=Hmix_min_m) call get_param(param_file, mdl, "LIMIT_BUFFER_DETRAIN", CS%limit_det, & "If true, limit the detrainment from the buffer layers \n"//& @@ -3755,7 +3649,7 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, "DEPTH_LIMIT_FLUXES", CS%H_limit_fluxes, & "The surface fluxes are scaled away when the total ocean \n"//& "depth is less than DEPTH_LIMIT_FLUXES.", & - units="m", default=0.1*CS%Hmix_min) + units="m", default=0.1*Hmix_min_m, scale=GV%m_to_H) call get_param(param_file, mdl, "OMEGA",CS%omega, & "The rotation rate of the earth.", units="s-1", & default=7.2921e-5) @@ -3787,7 +3681,7 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS) "The minimum value of ustar that should be used by the \n"//& "bulk mixed layer model in setting vertical TKE decay \n"//& "scales. This must be greater than 0.", units="m s-1", & - default=ustar_min_dflt) + default=ustar_min_dflt, scale=GV%m_to_Z) if (CS%ustar_min<=0.0) call MOM_error(FATAL, "BML_USTAR_MIN must be positive.") call get_param(param_file, mdl, "RESOLVE_EKMAN", CS%Resolve_Ekman, & @@ -3808,7 +3702,7 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS) if (CS%do_rivermix) & call get_param(param_file, mdl, "RIVERMIX_DEPTH", CS%rivermix_depth, & "The depth to which rivers are mixed if DO_RIVERMIX is \n"//& - "defined.", units="m", default=0.0) + "defined.", units="m", default=0.0, scale=GV%m_to_Z) call get_param(param_file, mdl, "USE_RIVER_HEAT_CONTENT", CS%use_river_heat_content, & "If true, use the fluxes%runoff_Hflx field to set the \n"//& "heat carried by runoff, instead of using SST*CP*liq_runoff.", & @@ -3827,33 +3721,36 @@ subroutine bulkmixedlayer_init(Time, G, GV, 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') + Time, 'Wind-stirring source of mixed layer TKE', 'm3 s-3', conversion=GV%Z_to_m) 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') + Time, 'Mean kinetic energy source of mixed layer TKE', 'm3 s-3', conversion=GV%Z_to_m) CS%id_TKE_conv = register_diag_field('ocean_model', 'TKE_conv', diag%axesT1, & - Time, 'Convective source of mixed layer TKE', 'm3 s-3') + Time, 'Convective source of mixed layer TKE', 'm3 s-3', conversion=GV%Z_to_m) 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') + Time, 'TKE consumed by mixing penetrative shortwave radation through the mixed layer', & + 'm3 s-3', conversion=GV%Z_to_m) 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') + Time, 'TKE consumed by mixing that deepens the mixed layer', 'm3 s-3', conversion=GV%Z_to_m) 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') + Time, 'Mechanical energy decay sink of mixed layer TKE', 'm3 s-3', conversion=GV%Z_to_m) 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') + Time, 'Convective energy decay sink of mixed layer TKE', 'm3 s-3', conversion=GV%Z_to_m) 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') + Time, 'Spurious source of mixed layer TKE from sigma2', 'm3 s-3', conversion=GV%Z_to_m) 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') + Time, 'Spurious source of potential energy from mixed layer detrainment', & + 'W m-2', conversion=GV%Z_to_m) 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') + Time, 'Spurious source of potential energy from mixed layer only detrainment', & + 'W m-2', conversion=GV%Z_to_m) CS%id_h_mismatch = register_diag_field('ocean_model', 'h_miss_ML', diag%axesT1, & - Time, 'Summed absolute mismatch in entrainment terms', 'm') + Time, 'Summed absolute mismatch in entrainment terms', 'm', conversion=GV%H_to_m) CS%id_Hsfc_used = register_diag_field('ocean_model', 'Hs_used', diag%axesT1, & - Time, 'Surface region thickness that is used', 'm') + Time, 'Surface region thickness that is used', 'm', conversion=GV%H_to_m) CS%id_Hsfc_max = register_diag_field('ocean_model', 'Hs_max', diag%axesT1, & - Time, 'Maximum surface region thickness', 'm') + Time, 'Maximum surface region thickness', 'm', conversion=GV%H_to_m) CS%id_Hsfc_min = register_diag_field('ocean_model', 'Hs_min', diag%axesT1, & - Time, 'Minimum surface region thickness', 'm') + Time, 'Minimum surface region thickness', 'm', conversion=GV%H_to_m) !CS%lim_det_dH_sfc = 0.5 ; CS%lim_det_dH_bathy = 0.2 ! Technically these should not get used if limit_det is false? if (CS%limit_det .or. (CS%id_Hsfc_min > 0)) then call get_param(param_file, mdl, "LIMIT_BUFFER_DET_DH_SFC", CS%lim_det_dH_sfc, & @@ -3875,9 +3772,8 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS) endif - if (max(CS%id_TKE_wind, CS%id_TKE_RiBulk, CS%id_TKE_conv, & - CS%id_TKE_mixing, CS%id_TKE_pen_SW, CS%id_TKE_mech_decay, & - CS%id_TKE_conv_decay) > 0) then + if (max(CS%id_TKE_wind, CS%id_TKE_RiBulk, CS%id_TKE_conv, CS%id_TKE_mixing, & + CS%id_TKE_pen_SW, CS%id_TKE_mech_decay, CS%id_TKE_conv_decay) > 0) then call safe_alloc_alloc(CS%diag_TKE_wind, isd, ied, jsd, jed) call safe_alloc_alloc(CS%diag_TKE_RiBulk, isd, ied, jsd, jed) call safe_alloc_alloc(CS%diag_TKE_conv, isd, ied, jsd, jed) From 84927f1206f04af11e3e8b1fe638a6b944b30e37 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 28 Sep 2018 17:24:52 -0400 Subject: [PATCH 119/174] Calculate viscosity diagnostics in Z2 s-1 Do the internal calculation inside of MOM_vert_friction.F90 of the viscosity at velocity points in units of Z2 s-1, instead of m2 s-2. All answers are bitwise identical. --- src/parameterizations/vertical/MOM_vert_friction.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 64aec71fbb..7eb6ae5436 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -644,7 +644,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) "Module must be initialized before it is used.") h_neglect = GV%H_subroundoff - I_Hbbl(:) = 1.0 / (CS%Hbbl * GV%m_to_H + h_neglect) + I_Hbbl(:) = 1.0 / (CS%Hbbl + h_neglect) I_valBL = 0.0 ; if (CS%harm_BL_val > 0.0) I_valBL = 1.0 / CS%harm_BL_val if (CS%id_Kv_u > 0) then @@ -828,7 +828,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) ! Diagnose total Kv at u-points if (CS%id_Kv_u > 0) then do k=1,nz ; do I=Isq,Ieq - if (do_i(I)) Kv_u(I,j,k) = 0.5 * GV%Z_to_m*(CS%a_u(I,j,K)+CS%a_u(I,j,K+1)) * CS%h_u(I,j,k) + if (do_i(I)) Kv_u(I,j,k) = 0.5 * GV%H_to_Z*(CS%a_u(I,j,K)+CS%a_u(I,j,K+1)) * CS%h_u(I,j,k) enddo ; enddo endif @@ -996,7 +996,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) ! Diagnose total Kv at v-points if (CS%id_Kv_v > 0) then do k=1,nz ; do i=is,ie - if (do_i(I)) Kv_v(i,J,k) = 0.5 * GV%Z_to_m*(CS%a_v(i,J,K)+CS%a_v(i,J,K+1)) * CS%h_v(i,J,k) + if (do_i(I)) Kv_v(i,J,k) = 0.5 * GV%H_to_Z*(CS%a_v(i,J,K)+CS%a_v(i,J,K+1)) * CS%h_v(i,J,k) enddo ; enddo endif @@ -1679,7 +1679,7 @@ subroutine vertvisc_init(MIS, Time, G, GV, param_file, diag, ADp, dirs, & "viscosity of KVBBL if BOTTOMDRAGLAW is not defined, or \n"//& "the thickness over which near-bottom velocities are \n"//& "averaged for the drag law if BOTTOMDRAGLAW is defined \n"//& - "but LINEAR_DRAG is not.", units="m", fail_if_missing=.true.) + "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 \n"//& "components are truncated.", units="m s-1", default=3.0e8) @@ -1737,10 +1737,10 @@ subroutine vertvisc_init(MIS, Time, G, GV, param_file, diag, ADp, dirs, & 'Slow varying vertical viscosity', 'm2 s-1') CS%id_Kv_u = register_diag_field('ocean_model', 'Kv_u', diag%axesCuL, Time, & - 'Total vertical viscosity at u-points', 'm2 s-1') + 'Total vertical viscosity at u-points', 'm2 s-1', conversion=GV%Z_to_m**2) CS%id_Kv_v = register_diag_field('ocean_model', 'Kv_v', diag%axesCvL, Time, & - 'Total vertical viscosity at v-points', 'm2 s-1') + 'Total vertical viscosity at v-points', 'm2 s-1', conversion=GV%Z_to_m**2) CS%id_au_vv = register_diag_field('ocean_model', 'au_visc', diag%axesCui, Time, & 'Zonal Viscous Vertical Coupling Coefficient', 'm s-1', conversion=GV%Z_to_m) From 70e95522af0675e4b15ba23659e8f0061849b9fb Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 28 Sep 2018 17:25:12 -0400 Subject: [PATCH 120/174] Do MOM_diabatic_aux calculations in units of Z Rescaled several of the variables in MOM_diabatic_aux to work in units of Z and H instead of m. Also added several temporary variables and updated the comments describing others. All answers are bitwise identical. --- .../vertical/MOM_diabatic_aux.F90 | 62 +++++++++++-------- 1 file changed, 35 insertions(+), 27 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 657c243b2c..50f49426fe 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -29,9 +29,9 @@ module MOM_diabatic_aux !> Control structure for diabatic_aux type, public :: diabatic_aux_CS ; private - logical :: do_rivermix = .false. !< Provide additional TKE to mix river runoff - !! at the river mouths to "rivermix_depth" meters - real :: rivermix_depth = 0.0 !< The depth to which rivers are mixed if do_rivermix = T, in m. + logical :: do_rivermix = .false. !< Provide additional TKE to mix river runoff at the + !! river mouths to a depth of "rivermix_depth" + real :: rivermix_depth = 0.0 !< The depth to which rivers are mixed if do_rivermix = T, in Z. logical :: reclaim_frazil !< If true, try to use any frazil heat deficit to !! to cool the topmost layer down to the freezing !! point. The default is false. @@ -660,25 +660,32 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, dia integer, optional, intent(in) :: id_MLDsq !< Optional handle (ID) of squared MLD ! Local variables - real, dimension(SZI_(G)) :: rhoSurf, deltaRhoAtKm1, deltaRhoAtK, dK, dKm1, pRef_MLD - real, dimension(SZI_(G)) :: rhoAtK, rho1, d1, pRef_N2 ! Used for N2 - real, dimension(SZI_(G), SZJ_(G)) :: MLD ! Diagnosed mixed layer depth - real, dimension(SZI_(G), SZJ_(G)) :: subMLN2 ! Diagnosed stratification below ML - real, dimension(SZI_(G), SZJ_(G)) :: MLD2 ! Diagnosed MLD^2 - real, parameter :: dz_subML = 50. ! Depth below ML over which to diagnose stratification (m) + real, dimension(SZI_(G)) :: deltaRhoAtKm1, deltaRhoAtK ! Density differences, in kg m-3. + real, dimension(SZI_(G)) :: pRef_MLD, pRef_N2 ! Reference pressures in Pa. + real, dimension(SZI_(G)) :: dK, dKm1, d1 ! Depths in Z. + real, dimension(SZI_(G)) :: rhoSurf, rhoAtK, rho1 ! Densities used for N2, in kg m-3. + real, dimension(SZI_(G), SZJ_(G)) :: MLD ! Diagnosed mixed layer depth, in m. + real, dimension(SZI_(G), SZJ_(G)) :: subMLN2 ! Diagnosed stratification below ML, in s-2. + real, dimension(SZI_(G), SZJ_(G)) :: MLD2 ! Diagnosed MLD^2, in m2. + real :: Rho_x_gE ! The product of density, gravitational acceleartion and a unit + ! conversion factor, in kg m-1 Z-1 s-2. + real :: gE_Rho0 ! The gravitational acceleration divided by a mean density, in m4 s-2 kg-1. + real :: dz_subML ! Depth below ML over which to diagnose stratification, in Z. integer :: i, j, is, ie, js, je, k, nz, id_N2, id_SQ real :: aFac, ddRho - id_N2 = -1 - if (PRESENT(id_N2subML)) id_N2 = id_N2subML + id_N2 = -1 ; if (PRESENT(id_N2subML)) id_N2 = id_N2subML - id_SQ = -1 - if (PRESENT(id_N2subML)) id_SQ = id_MLDsq + id_SQ = -1 ; if (PRESENT(id_N2subML)) id_SQ = id_MLDsq + + Rho_x_gE = (GV%g_Earth * GV%Z_to_m) * GV%Rho0 + gE_rho0 = GV%m_to_Z * GV%g_Earth / GV%Rho0 + dz_subML = 50.*GV%m_to_Z is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke pRef_MLD(:) = 0. ; pRef_N2(:) = 0. do j=js,je - do i=is,ie ; dK(i) = 0.5 * h(i,j,1) * GV%H_to_m ; enddo ! Depth of center of surface layer + do i=is,ie ; dK(i) = 0.5 * h(i,j,1) * GV%H_to_Z ; enddo ! Depth of center of surface layer call calculate_density(tv%T(:,j,1), tv%S(:,j,1), pRef_MLD, rhoSurf, is, ie-is+1, tv%eqn_of_state) do i=is,ie deltaRhoAtK(i) = 0. @@ -687,20 +694,20 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, dia subMLN2(i,j) = 0. rho1(i) = 0. d1(i) = 0. - pRef_N2(i) = GV%g_Earth * GV%Rho0 * h(i,j,1) * GV%H_to_m ! Boussinesq approximation!!!! ????? + pRef_N2(i) = Rho_x_gE * h(i,j,1) * GV%H_to_Z ! Boussinesq approximation!!!! ????? !### This should be: pRef_N2(i) = GV%g_Earth * GV%H_to_kg_m2 * h(i,j,1) ! This might change answers at roundoff. endif enddo do k=2,nz do i=is,ie dKm1(i) = dK(i) ! Depth of center of layer K-1 - dK(i) = dK(i) + 0.5 * ( h(i,j,k) + h(i,j,k-1) ) * GV%H_to_m ! Depth of center of layer K + dK(i) = dK(i) + 0.5 * ( h(i,j,k) + h(i,j,k-1) ) * GV%H_to_Z ! Depth of center of layer K enddo ! Stratification, N2, immediately below the mixed layer, averaged over at least 50 m. if (id_N2>0) then do i=is,ie - pRef_N2(i) = pRef_N2(i) + GV%g_Earth * GV%Rho0 * h(i,j,k) * GV%H_to_m ! Boussinesq approximation!!!! ????? + pRef_N2(i) = pRef_N2(i) + Rho_x_gE * h(i,j,k) * GV%H_to_Z ! Boussinesq approximation!!!! ????? !### This should be: pRef_N2(i) = pRev_N2(i) + GV%g_Earth * GV%H_to_kg_m2 * h(i,j,k) !### This might change answers at roundoff. enddo @@ -712,12 +719,12 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, dia d1(i) = dK(i) !### It looks to me like there is bad logic here. - RWH ! Use pressure at the bottom of the upper layer used in calculating d/dz rho - pRef_N2(i) = pRef_N2(i) + GV%g_Earth * GV%Rho0 * h(i,j,k) * GV%H_to_m ! Boussinesq approximation!!!! ????? + pRef_N2(i) = pRef_N2(i) + Rho_x_gE * h(i,j,k) * GV%H_to_Z ! Boussinesq approximation!!!! ????? !### This line should be: pRef_N2(i) = pRev_N2(i) + GV%g_Earth * GV%H_to_kg_m2 * h(i,j,k) !### This might change answers at roundoff. endif if (d1(i)>0. .and. dK(i)-d1(i)>=dz_subML) then - subMLN2(i,j) = GV%g_Earth/ GV%Rho0 * (rho1(i)-rhoAtK(i)) / (d1(i) - dK(i)) + subMLN2(i,j) = gE_rho0 * (rho1(i)-rhoAtK(i)) / (d1(i) - dK(i)) endif endif enddo ! i-loop @@ -741,7 +748,7 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, dia if ((MLD(i,j)==0.) .and. (deltaRhoAtK(i)0 .and. subMLN2(i,j)==0. .and. d1(i)>0. .and. dK(i)-d1(i)>0.) then ! ! Use what ever stratification we can, measured over what ever distance is available - ! subMLN2(i,j) = GV%g_Earth/ GV%Rho0 * (rho1(i)-rhoAtK(i)) / (d1(i) - dK(i)) + ! subMLN2(i,j) = gE_rho0 * (rho1(i)-rhoAtK(i)) / (d1(i) - dK(i)) ! endif enddo enddo ! j-loop @@ -818,8 +825,9 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & real, dimension(max(optics%nbands,1),SZI_(G),SZK_(G)) :: opacityBand real :: hGrounding(maxGroundings) real :: Temp_in, Salin_in - real :: I_G_Earth, g_Hconv2 - real :: GoRho + real :: I_G_Earth + real :: g_Hconv2 + real :: GoRho ! g_Earth times a unit conversion factor divided by density, in Z m3 s-2 kg-1 logical :: calculate_energetics logical :: calculate_buoyancy integer :: i, j, is, ie, js, je, k, nz, n, nsw @@ -844,7 +852,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & if (present(cTKE)) cTKE(:,:,:) = 0.0 if (calculate_buoyancy) then SurfPressure(:) = 0.0 - GoRho = GV%g_Earth / GV%Rho0 + GoRho = GV%Z_to_m*GV%g_Earth / GV%Rho0 start = 1 + G%isc - G%isd npts = 1 + G%iec - G%isc endif @@ -1032,7 +1040,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & ! 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) - RivermixConst = -0.5*(CS%rivermix_depth*dt)*GV%m_to_H*GV%H_to_Pa + RivermixConst = -0.5*(CS%rivermix_depth*dt)*GV%Z_to_H*GV%H_to_Pa cTKE(i,j,k) = cTKE(i,j,k) + max(0.0, RivermixConst*dSV_dS(i,j,1) * & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j)) * tv%S(i,j,1)) @@ -1099,7 +1107,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & tv%T(i,j,k) * min(0.,dThickness) * GV%H_to_kg_m2 * fluxes%C_p * Idt if (associated(tv%TempxPmE)) tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + & tv%T(i,j,k) * dThickness * GV%H_to_kg_m2 -!NOTE tv%T should be T2d +!### NOTE: tv%T should be T2d in the expressions above. ! Update state by the appropriate increment. hOld = h2d(i,k) ! Keep original thickness in hand @@ -1249,7 +1257,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & ! 3. Convert to a buoyancy flux, excluding penetrating SW heating ! BGR-Jul 5, 2017: The contribution of SW heating here needs investigated for ePBL. do i=is,ie - SkinBuoyFlux(i,j) = - GoRho * GV%H_to_m * ( & + SkinBuoyFlux(i,j) = - GoRho * GV%H_to_Z * ( & dRhodS(i) * (netSalt_rate(i) - tv%S(i,j,1)*netMassInOut_rate(i)) + & dRhodT(i) * ( netHeat_rate(i) + netPen(i,1)) ) ! m^2/s^3 enddo @@ -1345,7 +1353,7 @@ subroutine diabatic_aux_init(Time, G, GV, param_file, diag, CS, useALEalgorithm, if (CS%do_rivermix) & call get_param(param_file, mdl, "RIVERMIX_DEPTH", CS%rivermix_depth, & "The depth to which rivers are mixed if DO_RIVERMIX is \n"//& - "defined.", units="m", default=0.0) + "defined.", units="m", default=0.0, scale=GV%m_to_Z) else ; CS%do_rivermix = .false. ; CS%rivermix_depth = 0.0 ; endif if (GV%nkml == 0) then call get_param(param_file, mdl, "USE_RIVER_HEAT_CONTENT", CS%use_river_heat_content, & From 36f04342dd4c4ca79a5d3dbba691c5c9ff901062 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 29 Sep 2018 07:19:23 -0400 Subject: [PATCH 121/174] Changed the units of GV%g_Earth to m2 Z-1 s-2 Rescaled the units of GV%g_Earth for dimensional consistency testing. All answers are bitwise identical, including rescaling Z over a large range. --- src/ALE/MOM_ALE.F90 | 2 +- src/core/MOM.F90 | 17 +++++----- src/core/MOM_PressureForce_Montgomery.F90 | 12 +++---- src/core/MOM_PressureForce_analytic_FV.F90 | 10 +++--- src/core/MOM_PressureForce_blocked_AFV.F90 | 10 +++--- src/core/MOM_forcing_type.F90 | 2 +- src/core/MOM_isopycnal_slopes.F90 | 2 +- src/core/MOM_verticalGrid.F90 | 7 ++-- src/diagnostics/MOM_diagnostics.F90 | 16 +++++----- src/diagnostics/MOM_sum_output.F90 | 2 +- src/diagnostics/MOM_wave_speed.F90 | 8 ++--- src/diagnostics/MOM_wave_structure.F90 | 4 +-- .../MOM_coord_initialization.F90 | 32 +++++++++---------- .../MOM_state_initialization.F90 | 16 +++++----- .../lateral/MOM_lateral_mixing_coeffs.F90 | 2 +- .../lateral/MOM_mixed_layer_restrat.F90 | 4 +-- .../lateral/MOM_thickness_diffuse.F90 | 6 ++-- .../vertical/MOM_CVMix_KPP.F90 | 2 +- .../vertical/MOM_CVMix_conv.F90 | 2 +- .../vertical/MOM_CVMix_shear.F90 | 2 +- .../vertical/MOM_bulk_mixed_layer.F90 | 16 +++++----- .../vertical/MOM_diabatic_aux.F90 | 18 +++++------ .../vertical/MOM_diabatic_driver.F90 | 4 +-- .../vertical/MOM_diapyc_energy_req.F90 | 10 +++--- .../vertical/MOM_energetic_PBL.F90 | 6 ++-- .../vertical/MOM_entrain_diffusive.F90 | 2 +- .../vertical/MOM_internal_tide_input.F90 | 2 +- .../vertical/MOM_kappa_shear.F90 | 6 ++-- .../vertical/MOM_set_diffusivity.F90 | 12 +++---- .../vertical/MOM_set_viscosity.F90 | 6 ++-- .../vertical/MOM_shortwave_abs.F90 | 2 +- src/user/BFB_initialization.F90 | 4 +-- src/user/DOME_initialization.F90 | 2 +- src/user/MOM_wave_interface.F90 | 24 +++++++------- src/user/Rossby_front_2d_initialization.F90 | 2 +- 35 files changed, 137 insertions(+), 137 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index a7ac3cc4c7..72acafef51 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -329,7 +329,7 @@ subroutine ALE_main( G, GV, h, u, v, tv, Reg, CS, dt, frac_shelf_h) if (CS%id_T_preale > 0) call post_data(CS%id_T_preale, tv%T, CS%diag) if (CS%id_S_preale > 0) call post_data(CS%id_S_preale, tv%S, CS%diag) if (CS%id_e_preale > 0) then - call find_eta(h, tv, GV%g_Earth, G, GV, eta_preale) + call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, eta_preale) call post_data(CS%id_e_preale, eta_preale, CS%diag) endif diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 04b3cdc600..deef3fa629 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -749,7 +749,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & ! Determining the time-average sea surface height is part of the algorithm. ! This may be eta_av if Boussinesq, or need to be diagnosed if not. CS%time_in_cycle = CS%time_in_cycle + dt - call find_eta(h, CS%tv, GV%g_Earth, G, GV, ssh, CS%eta_av_bc) + call find_eta(h, CS%tv, (GV%g_Earth*GV%m_to_Z), G, GV, ssh, CS%eta_av_bc) do j=js,je ; do i=is,ie CS%ssh_rint(i,j) = CS%ssh_rint(i,j) + dt*ssh(i,j) enddo ; enddo @@ -1943,7 +1943,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call verticalGridInit( param_file, CS%GV ) GV => CS%GV -! dG%g_Earth = GV%g_Earth +! dG%g_Earth = (GV%g_Earth*GV%m_to_Z) !### These should be merged with the get_param calls, but must follow verticalGridInit. if (.not.bulkmixedlayer) then CS%Hmix = CS%Hmix * GV%m_to_Z @@ -2150,7 +2150,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & else ; G%Domain_aux => G%Domain ; endif ! Copy common variables from the vertical grid to the horizontal grid. ! Consider removing this later? - G%ke = GV%ke ; G%g_Earth = GV%g_Earth + G%ke = GV%ke ; G%g_Earth = (GV%g_Earth*GV%m_to_Z) call MOM_initialize_state(CS%u, CS%v, CS%h, CS%tv, Time, G, GV, param_file, & dirs, restart_CSp, CS%ALE_CSp, CS%tracer_Reg, & @@ -2179,7 +2179,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (CS%debug .or. CS%G%symmetric) then call clone_MOM_domain(CS%G%Domain, CS%G%Domain_aux, symmetric=.false.) else ; CS%G%Domain_aux => CS%G%Domain ;endif - G%ke = GV%ke ; G%g_Earth = GV%g_Earth + G%ke = GV%ke ; G%g_Earth = (GV%g_Earth*GV%m_to_Z) endif @@ -2431,9 +2431,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (.not.query_initialized(CS%ave_ssh_ibc,"ave_ssh",restart_CSp)) then if (CS%split) then - call find_eta(CS%h, CS%tv, GV%g_Earth, G, GV, CS%ave_ssh_ibc, eta) + call find_eta(CS%h, CS%tv, (GV%g_Earth*GV%m_to_Z), G, GV, CS%ave_ssh_ibc, eta) else - call find_eta(CS%h, CS%tv, GV%g_Earth, G, GV, CS%ave_ssh_ibc) + call find_eta(CS%h, CS%tv, (GV%g_Earth*GV%m_to_Z), G, GV, CS%ave_ssh_ibc) endif endif if (CS%split) deallocate(eta) @@ -2470,7 +2470,6 @@ subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) type(verticalGrid_type), pointer :: GV => NULL() type(MOM_restart_CS), pointer :: restart_CSp_tmp => NULL() real, allocatable :: z_interface(:,:,:) ! Interface heights (meter) - real, allocatable :: eta(:,:) ! Interface heights (meter) type(vardesc) :: vd call cpu_clock_begin(id_clock_init) @@ -2484,7 +2483,7 @@ subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) allocate(restart_CSp_tmp) restart_CSp_tmp = restart_CSp allocate(z_interface(SZI_(G),SZJ_(G),SZK_(G)+1)) - call find_eta(CS%h, CS%tv, GV%g_Earth, G, GV, z_interface) + call find_eta(CS%h, CS%tv, (GV%g_Earth*GV%m_to_Z), G, GV, z_interface) call register_restart_field(z_interface, "eta", .true., restart_CSp_tmp, & "Interface heights", "meter", z_grid='i') @@ -2653,7 +2652,7 @@ subroutine adjust_ssh_for_p_atm(tv, G, GV, ssh, p_atm, use_EOS) else Rho_conv=GV%Rho0 endif - IgR0 = 1.0 / (Rho_conv * GV%g_Earth) + IgR0 = 1.0 / (Rho_conv * (GV%g_Earth*GV%m_to_Z)) ssh(i,j) = ssh(i,j) + p_atm(i,j) * IgR0 enddo ; enddo endif ; endif diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 4ed4438d58..4887d1a3e1 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -142,7 +142,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, "can no longer be used with a compressible EOS. Use #define ANALYTIC_FV_PGF.") endif - g_Earth_z = GV%g_Earth*GV%Z_to_m + g_Earth_z = GV%g_Earth I_gEarth = 1.0 / g_Earth_z dp_neglect = GV%H_to_Pa * GV%H_subroundoff do k=1,nz ; alpha_Lay(k) = 1.0 / GV%Rlay(k) ; enddo @@ -302,7 +302,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, ! Note that ddM/dPb = alpha_star(i,j,1) if (present(pbce)) then - call Set_pbce_nonBouss(p, tv_tmp, G, GV, GV%g_Earth, CS%GFS_scale, pbce, & + call Set_pbce_nonBouss(p, tv_tmp, G, GV, (GV%g_Earth*GV%m_to_Z), CS%GFS_scale, pbce, & alpha_star) endif @@ -432,7 +432,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta h_neglect = GV%H_subroundoff * GV%H_to_Z I_Rho0 = 1.0/CS%Rho0 - G_Rho0 = GV%Z_to_m*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 @@ -537,7 +537,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta endif ! use_EOS if (present(pbce)) then - call Set_pbce_Bouss(e, tv_tmp, G, GV, GV%g_Earth, CS%Rho0, CS%GFS_scale, pbce, rho_star) + call Set_pbce_Bouss(e, tv_tmp, G, GV, (GV%g_Earth*GV%m_to_Z), CS%Rho0, CS%GFS_scale, pbce, rho_star) endif ! Calculate the pressure force. On a Cartesian grid, @@ -636,7 +636,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = G%ke Rho0xG = Rho0*g_Earth*GV%Z_to_m - G_Rho0 = GV%Z_to_m*GV%g_Earth / GV%Rho0 + G_Rho0 = GV%g_Earth / GV%Rho0 use_EOS = associated(tv%eqn_of_state) z_neglect = GV%H_subroundoff*GV%H_to_Z @@ -871,7 +871,7 @@ subroutine PressureForce_Mont_init(Time, G, GV, param_file, diag, CS, tides_CSp) endif CS%GFS_scale = 1.0 - if (GV%g_prime(1) /= GV%g_Earth) CS%GFS_scale = GV%g_prime(1) / GV%g_Earth + if (GV%g_prime(1) /= (GV%g_Earth*GV%m_to_Z)) CS%GFS_scale = GV%g_prime(1) / (GV%g_Earth*GV%m_to_Z) call log_param(param_file, mdl, "GFS / G_EARTH", CS%GFS_scale) diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index 470636126c..aa9d43610e 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -186,7 +186,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm dp_neglect = GV%H_to_Pa * GV%H_subroundoff alpha_ref = 1.0/CS%Rho0 - g_Earth_z = GV%g_Earth*GV%Z_to_m + g_Earth_z = GV%g_Earth I_gEarth = 1.0 / g_Earth_z if (use_p_atm) then @@ -403,7 +403,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm enddo if (present(pbce)) then - call set_pbce_nonBouss(p, tv_tmp, G, GV, GV%g_Earth, CS%GFS_scale, pbce) + call set_pbce_nonBouss(p, tv_tmp, G, GV, (GV%g_Earth*GV%m_to_Z), CS%GFS_scale, pbce) endif if (present(eta)) then @@ -523,7 +523,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff * GV%H_to_Z I_Rho0 = 1.0/GV%Rho0 - g_Earth_z = GV%g_Earth*GV%Z_to_m + g_Earth_z = GV%g_Earth G_Rho0 = g_Earth_z/GV%Rho0 rho_ref = CS%Rho0 @@ -748,7 +748,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p endif if (present(pbce)) then - call set_pbce_Bouss(e, tv_tmp, G, GV, GV%g_Earth, CS%Rho0, CS%GFS_scale, pbce) + call set_pbce_Bouss(e, tv_tmp, G, GV, (GV%g_Earth*GV%m_to_Z), CS%Rho0, CS%GFS_scale, pbce) endif if (present(eta)) then @@ -838,7 +838,7 @@ subroutine PressureForce_AFV_init(Time, G, GV, param_file, diag, CS, tides_CSp) endif CS%GFS_scale = 1.0 - if (GV%g_prime(1) /= GV%g_Earth) CS%GFS_scale = GV%g_prime(1) / GV%g_Earth + if (GV%g_prime(1) /= (GV%g_Earth*GV%m_to_Z)) CS%GFS_scale = GV%g_prime(1) / (GV%g_Earth*GV%m_to_Z) call log_param(param_file, mdl, "GFS / G_EARTH", CS%GFS_scale) diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index f8f2abd35b..4da52327a2 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -184,7 +184,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc dp_neglect = GV%H_to_Pa * GV%H_subroundoff alpha_ref = 1.0/CS%Rho0 - g_Earth_z = GV%g_Earth*GV%Z_to_m + g_Earth_z = GV%g_Earth I_gEarth = 1.0 / g_Earth_z if (use_p_atm) then @@ -385,7 +385,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc enddo if (present(pbce)) then - call set_pbce_nonBouss(p, tv_tmp, G, GV, GV%g_Earth, CS%GFS_scale, pbce) + call set_pbce_nonBouss(p, tv_tmp, G, GV, (GV%g_Earth*GV%m_to_Z), CS%GFS_scale, pbce) endif if (present(eta)) then @@ -509,7 +509,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, 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 - g_Earth_z = GV%g_Earth*GV%Z_to_m + g_Earth_z = GV%g_Earth G_Rho0 = g_Earth_z / GV%Rho0 rho_ref = CS%Rho0 @@ -742,7 +742,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at enddo if (present(pbce)) then - call set_pbce_Bouss(e, tv_tmp, G, GV, GV%g_Earth, CS%Rho0, CS%GFS_scale, pbce) + call set_pbce_Bouss(e, tv_tmp, G, GV, (GV%g_Earth*GV%m_to_Z), CS%Rho0, CS%GFS_scale, pbce) endif if (present(eta)) then @@ -832,7 +832,7 @@ subroutine PressureForce_blk_AFV_init(Time, G, GV, param_file, diag, CS, tides_C endif CS%GFS_scale = 1.0 - if (GV%g_prime(1) /= GV%g_Earth) CS%GFS_scale = GV%g_prime(1) / GV%g_Earth + if (GV%g_prime(1) /= (GV%g_Earth*GV%m_to_Z)) CS%GFS_scale = GV%g_prime(1) / (GV%g_Earth*GV%m_to_Z) call log_param(param_file, mdl, "GFS / G_EARTH", CS%GFS_scale) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index c2042bee51..11b94a2c0c 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -858,7 +858,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, fluxes, optics, h, Temp, Salt, tv, j, depthBeforeScalingFluxes = max( GV%Angstrom_H, 1.e-30*GV%m_to_H ) pressure(:) = 0. ! Ignore atmospheric pressure - GoRho = GV%g_Earth / GV%Rho0 + GoRho = (GV%g_Earth*GV%m_to_Z) / GV%Rho0 start = 1 + G%isc - G%isd npts = 1 + G%iec - G%isc diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index c677f3863c..119eca7b56 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -100,7 +100,7 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & present_N2_u = PRESENT(N2_u) present_N2_v = PRESENT(N2_v) - G_Rho0 = GV%g_Earth / GV%Rho0 + G_Rho0 = (GV%g_Earth*GV%m_to_Z) / GV%Rho0 if (present_N2_u) then do j=js,je ; do I=is-1,ie N2_u(I,j,1) = 0. diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index 0fbef525af..eeb9e66647 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -19,8 +19,8 @@ module MOM_verticalGrid ! Commonly used parameters integer :: ke !< The number of layers/levels in the vertical - real :: max_depth !< The maximum depth of the ocean in meters. - real :: g_Earth !< The gravitational acceleration in m s-2. + real :: max_depth !< The maximum depth of the ocean in Z (often m). + real :: g_Earth !< The gravitational acceleration in m2 Z-1 s-2. real :: Rho0 !< The density used in the Boussinesq approximation or nominal !! density used to convert depths into mass units, in kg m-3. @@ -125,6 +125,7 @@ subroutine verticalGridInit( param_file, GV ) if (Z_power /= 0) Z_rescale_factor = 2.0**Z_power GV%Z_to_m = 1.0 * Z_rescale_factor GV%m_to_Z = 1.0 / Z_rescale_factor + GV%g_Earth = GV%g_Earth * GV%Z_to_m #ifdef STATIC_MEMORY_ ! Here NK_ is a macro, while nk is a variable. call get_param(param_file, mdl, "NK", nk, & @@ -151,7 +152,7 @@ subroutine verticalGridInit( param_file, GV ) GV%Angstrom_H = GV%Angstrom_m*1000.0*GV%kg_m2_to_H endif GV%H_subroundoff = 1e-20 * max(GV%Angstrom_H,GV%m_to_H*1e-17) - GV%H_to_Pa = GV%g_Earth * GV%H_to_kg_m2 + GV%H_to_Pa = (GV%g_Earth*GV%m_to_Z) * GV%H_to_kg_m2 GV%H_to_Z = GV%H_to_m * GV%m_to_Z GV%Z_to_H = GV%Z_to_m * GV%m_to_H diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index eb6f02daae..60340287a3 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -284,7 +284,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_h > 0) call post_data(CS%id_h, h, CS%diag) if (associated(CS%e)) then - call find_eta(h, tv, GV%g_Earth, G, GV, CS%e, eta_bt) + call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, CS%e, eta_bt) if (CS%id_e > 0) call post_data(CS%id_e, CS%e, CS%diag) endif @@ -294,7 +294,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & CS%e_D(i,j,k) = CS%e(i,j,k) + G%Zd_to_m*G%bathyT(i,j) enddo ; enddo ; enddo else - call find_eta(h, tv, GV%g_Earth, G, GV, CS%e_D, eta_bt) + call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, CS%e_D, eta_bt) do k=1,nz+1 ; do j=js,je ; do i=is,ie CS%e_D(i,j,k) = CS%e_D(i,j,k) + G%Zd_to_m*G%bathyT(i,j) enddo ; enddo ; enddo @@ -351,7 +351,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & endif do k=1,nz ! Integrate vertically downward for pressure do i=is,ie ! Pressure for EOS at the layer center (Pa) - pressure_1d(i) = pressure_1d(i) + 0.5*(GV%g_Earth*GV%H_to_kg_m2)*h(i,j,k) + pressure_1d(i) = pressure_1d(i) + 0.5*GV%H_to_Pa*h(i,j,k) enddo ! Store in-situ density (kg/m3) in work_3d call calculate_density(tv%T(:,j,k),tv%S(:,j,k), pressure_1d, & @@ -360,7 +360,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & work_3d(i,j,k) = (GV%H_to_kg_m2*h(i,j,k)) / work_3d(i,j,k) enddo do i=is,ie ! Pressure for EOS at the bottom interface (Pa) - pressure_1d(i) = pressure_1d(i) + 0.5*(GV%g_Earth*GV%H_to_kg_m2)*h(i,j,k) + pressure_1d(i) = pressure_1d(i) + 0.5*GV%H_to_Pa*h(i,j,k) enddo enddo ! k enddo ! j @@ -815,7 +815,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, CS) endif if (CS%id_col_ht > 0) then - call find_eta(h, tv, GV%g_Earth, G, GV, z_top) + call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, z_top) do j=js,je ; do i=is,ie z_bot(i,j) = z_top(i,j) + G%Zd_to_m*G%bathyT(i,j) enddo ; enddo @@ -826,7 +826,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, CS) do j=js,je ; do i=is,ie ; mass(i,j) = 0.0 ; enddo ; enddo if (GV%Boussinesq) then if (associated(tv%eqn_of_state)) then - IG_Earth = 1.0 / GV%g_Earth + IG_Earth = 1.0 / (GV%g_Earth*GV%m_to_Z) ! do j=js,je ; do i=is,ie ; z_bot(i,j) = -P_SURF(i,j)/GV%H_to_Pa ; enddo ; enddo do j=js,je ; do i=is,ie ; z_bot(i,j) = 0.0 ; enddo ; enddo do k=1,nz @@ -835,7 +835,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, CS) z_bot(i,j) = z_top(i,j) - GV%H_to_m*h(i,j,k) enddo ; enddo call int_density_dz(tv%T(:,:,k), tv%S(:,:,k), & - z_top, z_bot, 0.0, GV%H_to_kg_m2, GV%g_Earth, & + z_top, z_bot, 0.0, GV%H_to_kg_m2, (GV%g_Earth*GV%m_to_Z), & G%HI, G%HI, tv%eqn_of_state, dpress) do j=js,je ; do i=is,ie mass(i,j) = mass(i,j) + dpress(i,j) * IG_Earth @@ -860,7 +860,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, CS) ! pbo = (mass * g) + p_surf ! where p_surf is the sea water pressure at sea water surface. do j=js,je ; do i=is,ie - btm_pres(i,j) = mass(i,j) * GV%g_Earth + btm_pres(i,j) = mass(i,j) * (GV%g_Earth*GV%m_to_Z) if (associated(p_surf)) then btm_pres(i,j) = btm_pres(i,j) + p_surf(i,j) endif diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index e21fb3da3d..0e37fbd3d2 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -498,7 +498,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp, OBC, dt_forc enddo ; enddo ; enddo mass_tot = reproducing_sum(tmp1, sums=mass_lay, EFP_sum=mass_EFP) - call find_eta(h, tv, GV%g_Earth, G, GV, eta) + call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, eta) do k=1,nz ; do j=js,je ; do i=is,ie tmp1(i,j,k) = (eta(i,j,K)-eta(i,j,K+1)) * areaTm(i,j) enddo ; enddo ; enddo diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 29ea15021c..ea2212a4ab 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -124,10 +124,10 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & endif S => tv%S ; T => tv%T - g_Rho0 = GV%g_Earth/GV%Rho0 + g_Rho0 = (GV%g_Earth*GV%m_to_Z)/GV%Rho0 use_EOS = associated(tv%eqn_of_state) - H_to_pres = GV%g_Earth * GV%Rho0 + H_to_pres = (GV%g_Earth*GV%m_to_Z) * GV%Rho0 H_to_m = GV%H_to_m rescale = 1024.0**4 ; I_rescale = 1.0/rescale @@ -596,10 +596,10 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) endif ; endif S => tv%S ; T => tv%T - g_Rho0 = GV%g_Earth/GV%Rho0 + g_Rho0 = (GV%g_Earth*GV%m_to_Z)/GV%Rho0 use_EOS = associated(tv%eqn_of_state) - H_to_pres = GV%g_Earth * GV%Rho0 + H_to_pres = (GV%g_Earth*GV%m_to_Z) * GV%Rho0 H_to_m = GV%H_to_m min_h_frac = tol1 / real(nz) diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index 0890006c98..45e71e70ba 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -178,10 +178,10 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) Pi = (4.0*atan(1.0)) S => tv%S ; T => tv%T - g_Rho0 = GV%g_Earth/GV%Rho0 + g_Rho0 = (GV%g_Earth*GV%m_to_Z)/GV%Rho0 use_EOS = associated(tv%eqn_of_state) - H_to_pres = GV%g_Earth * GV%Rho0 + H_to_pres = (GV%g_Earth*GV%m_to_Z) * GV%Rho0 H_to_m = GV%H_to_m rescale = 1024.0**4 ; I_rescale = 1.0/rescale diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index 140983d0fb..b1d68f9dd3 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -133,7 +133,7 @@ subroutine set_coord_from_gprime(Rlay, g_prime, GV, param_file) call get_param(param_file, mdl, "GFS" , g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=GV%g_Earth) + default=(GV%g_Earth*GV%m_to_Z)) call get_param(param_file, mdl, "GINT", g_int, & "The reduced gravity across internal interfaces.", & units="m s-2", fail_if_missing=.true.) @@ -141,7 +141,7 @@ subroutine set_coord_from_gprime(Rlay, g_prime, GV, param_file) g_prime(1) = g_fs do k=2,nz ; g_prime(k) = g_int ; enddo Rlay(1) = GV%Rho0 - do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%g_Earth) ; enddo + do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/(GV%g_Earth*GV%m_to_Z)) ; enddo call callTree_leave(trim(mdl)//'()') @@ -167,7 +167,7 @@ subroutine set_coord_from_layer_density(Rlay, g_prime, GV, param_file) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=GV%g_Earth) + default=(GV%g_Earth*GV%m_to_Z)) call get_param(param_file, mdl, "LIGHTEST_DENSITY", Rlay_Ref, & "The reference potential density used for layer 1.", & units="kg m-3", default=GV%Rho0) @@ -182,7 +182,7 @@ subroutine set_coord_from_layer_density(Rlay, g_prime, GV, param_file) enddo ! These statements set the interface reduced gravities. ! do k=2,nz - g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) + g_prime(k) = ((GV%g_Earth*GV%m_to_Z)/GV%Rho0) * (Rlay(k) - Rlay(k-1)) enddo call callTree_leave(trim(mdl)//'()') @@ -219,7 +219,7 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, param_file, eqn_of_state, & "The initial salinities.", units="PSU", default=35.0) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=GV%g_Earth) + default=(GV%g_Earth*GV%m_to_Z)) call get_param(param_file, mdl, "GINT", g_int, & "The reduced gravity across internal interfaces.", & units="m s-2", fail_if_missing=.true.) @@ -234,7 +234,7 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, param_file, eqn_of_state, & call calculate_density(T_ref, S_ref, P_ref, Rlay(1), eqn_of_state) ! These statements set the layer densities. ! - do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%g_Earth) ; enddo + do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/(GV%g_Earth*GV%m_to_Z)) ; enddo call callTree_leave(trim(mdl)//'()') end subroutine set_coord_from_TS_ref @@ -264,7 +264,7 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, param_file, & call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=GV%g_Earth) + default=(GV%g_Earth*GV%m_to_Z)) call get_param(param_file, mdl, "COORD_FILE", coord_file, & "The file from which the coordinate temperatures and \n"//& "salinities are read.", fail_if_missing=.true.) @@ -282,7 +282,7 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, param_file, & g_prime(1) = g_fs do k=1,nz ; Pref(k) = P_ref ; enddo call calculate_density(T0, S0, Pref, Rlay, 1,nz,eqn_of_state) - do k=2,nz; g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)); enddo + do k=2,nz; g_prime(k) = ((GV%g_Earth*GV%m_to_Z)/GV%Rho0) * (Rlay(k) - Rlay(k-1)); enddo call callTree_leave(trim(mdl)//'()') end subroutine set_coord_from_TS_profile @@ -343,7 +343,7 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, param_file, & call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=GV%g_Earth) + default=(GV%g_Earth*GV%m_to_Z)) k_light = GV%nk_rho_varies + 1 @@ -364,7 +364,7 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, param_file, & do k=k_light-1,1,-1 Rlay(k) = 2.0*Rlay(k+1) - Rlay(k+2) enddo - do k=2,nz; g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)); enddo + do k=2,nz; g_prime(k) = ((GV%g_Earth*GV%m_to_Z)/GV%Rho0) * (Rlay(k) - Rlay(k-1)); enddo call callTree_leave(trim(mdl)//'()') end subroutine set_coord_from_TS_range @@ -389,7 +389,7 @@ subroutine set_coord_from_file(Rlay, g_prime, GV, param_file) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=GV%g_Earth) + default=(GV%g_Earth*GV%m_to_Z)) call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) call get_param(param_file, mdl, "COORD_FILE", coord_file, & @@ -405,7 +405,7 @@ subroutine set_coord_from_file(Rlay, g_prime, GV, param_file) call read_axis_data(filename, coord_var, Rlay) g_prime(1) = g_fs - do k=2,nz ; g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) ; enddo + do k=2,nz ; g_prime(k) = ((GV%g_Earth*GV%m_to_Z)/GV%Rho0) * (Rlay(k) - Rlay(k-1)) ; enddo do k=1,nz ; if (g_prime(k) <= 0.0) then call MOM_error(FATAL, "MOM_initialization set_coord_from_file: "//& "Zero or negative g_primes read from variable "//"Layer"//" in file "//& @@ -443,7 +443,7 @@ subroutine set_coord_linear(Rlay, g_prime, GV, param_file) "all interfaces.", units="kg m-3", default=2.0) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=GV%g_Earth) + default=(GV%g_Earth*GV%m_to_Z)) ! This following sets the target layer densities such that a the ! surface interface has density Rlay_ref and the bottom @@ -454,7 +454,7 @@ subroutine set_coord_linear(Rlay, g_prime, GV, param_file) ! These statements set the interface reduced gravities. g_prime(1) = g_fs do k=2,nz - g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) + g_prime(k) = ((GV%g_Earth*GV%m_to_Z)/GV%Rho0) * (Rlay(k) - Rlay(k-1)) enddo call callTree_leave(trim(mdl)//'()') @@ -480,12 +480,12 @@ subroutine set_coord_to_none(Rlay, g_prime, GV, param_file) call get_param(param_file, mdl, "GFS" , g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=GV%g_Earth) + default=(GV%g_Earth*GV%m_to_Z)) g_prime(1) = g_fs do k=2,nz ; g_prime(k) = 0. ; enddo Rlay(1) = GV%Rho0 - do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%g_Earth) ; enddo + do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/(GV%g_Earth*GV%m_to_Z)) ; enddo call callTree_leave(trim(mdl)//'()') diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 6849acf27e..0046a4f168 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -925,8 +925,8 @@ subroutine convert_thickness(h, G, GV, tv) Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB max_itt = 10 Boussinesq = GV%Boussinesq - I_gEarth = 1.0 / GV%g_Earth - Hm_rho_to_Pa = (GV%g_Earth * GV%H_to_m) ! = GV%H_to_Pa / GV%Rho0 + I_gEarth = 1.0 / (GV%g_Earth*GV%m_to_Z) + Hm_rho_to_Pa = GV%g_Earth * GV%H_to_Z ! = GV%H_to_Pa / GV%Rho0 if (Boussinesq) then call MOM_error(FATAL,"Not yet converting thickness with Boussinesq approx.") @@ -1026,7 +1026,7 @@ subroutine depress_surface(h, G, GV, param_file, tv, just_read_params) call MOM_read_data(filename, eta_srf_var, eta_sfc, G%Domain, scale=scale_factor) ! Convert thicknesses to interface heights. - call find_eta(h, tv, GV%g_Earth, G, GV, eta) + call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, eta) do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.0) then ! if (eta_sfc(i,j) < eta(i,j,nz+1)) then @@ -1126,7 +1126,7 @@ subroutine trim_for_ice(PF, G, GV, ALE_CSp, tv, h, just_read_params) endif do j=G%jsc,G%jec ; do i=G%isc,G%iec - call cut_off_column_top(GV%ke, tv, GV, GV%g_Earth*GV%Z_to_m, G%bathyT(i,j), & + call cut_off_column_top(GV%ke, tv, GV, GV%g_Earth, G%bathyT(i,j), & min_thickness, tv%T(i,j,:), T_t(i,j,:), T_b(i,j,:), & tv%S(i,j,:), S_t(i,j,:), S_b(i,j,:), p_surf(i,j), h(i,j,:), remap_CS, & z_tol=1.0e-5*GV%m_to_Z) @@ -2361,15 +2361,15 @@ subroutine MOM_state_init_tests(G, GV, tv) S_t(k) = 35.-(0./500.)*e(k) S(k) = 35.+(0./500.)*z(k) S_b(k) = 35.-(0./500.)*e(k+1) - call calculate_density(0.5*(T_t(k)+T_b(k)), 0.5*(S_t(k)+S_b(k)), -GV%Rho0*GV%g_Earth*z(k), & + call calculate_density(0.5*(T_t(k)+T_b(k)), 0.5*(S_t(k)+S_b(k)), -GV%Rho0*(GV%g_Earth*GV%m_to_Z)*z(k), & rho(k), tv%eqn_of_state) - P_tot = P_tot + GV%g_Earth * rho(k) * h(k) + P_tot = P_tot + (GV%g_Earth*GV%m_to_Z) * rho(k) * h(k) enddo P_t = 0. do k = 1, nk call find_depth_of_pressure_in_cell(T_t(k), T_b(k), S_t(k), S_b(k), e(K), e(K+1), & - P_t, 0.5*P_tot, GV%Rho0, GV%g_Earth, tv%eqn_of_state, P_b, z_out) + P_t, 0.5*P_tot, GV%Rho0, (GV%g_Earth*GV%m_to_Z), tv%eqn_of_state, P_b, z_out) write(0,*) k,P_t,P_b,0.5*P_tot,e(K),e(K+1),z_out P_t = P_b enddo @@ -2379,7 +2379,7 @@ subroutine MOM_state_init_tests(G, GV, tv) write(0,*) ' ==================================================================== ' write(0,*) '' write(0,*) h - call cut_off_column_top(nk, tv, GV, GV%g_Earth, -e(nk+1), GV%Angstrom_H, & + call cut_off_column_top(nk, tv, GV, (GV%g_Earth*GV%m_to_Z), -e(nk+1), GV%Angstrom_H, & T, T_t, T_b, S, S_t, S_b, 0.5*P_tot, h, remap_CS) write(0,*) h diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 34a5436f34..86f60b3e2c 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -393,7 +393,7 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, CS) "Module must be initialized before it is used.") if (CS%calculate_Eady_growth_rate) then - call find_eta(h, tv, GV%g_Earth, G, GV, e, halo_size=2) + call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, e, halo_size=2) if (CS%use_stored_slopes) then call calc_isoneutral_slopes(G, GV, h, e, tv, dt*CS%kappa_smooth, & CS%slope_x, CS%slope_y, N2_u, N2_v, 1) diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 1d156620a0..c9939b6693 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -273,7 +273,7 @@ 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/GV%Rho0 + g_Rho0 = (GV%g_Earth*GV%m_to_Z)/GV%Rho0 h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff*GV%H_to_m proper_averaging = .not. CS%MLE_use_MLD_ave_bug @@ -597,7 +597,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, CS) uDml(:) = 0.0 ; vDml(:) = 0.0 I4dt = 0.25 / dt - g_Rho0 = GV%g_Earth/GV%Rho0 + g_Rho0 = (GV%g_Earth*GV%m_to_Z)/GV%Rho0 use_EOS = associated(tv%eqn_of_state) h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff*GV%H_to_m diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 0cf6880e7c..2a0ae1b769 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -162,7 +162,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS enddo ; enddo ! Calculates interface heights, e, in m. - call find_eta(h, tv, GV%g_Earth, G, GV, e, halo_size=1) + call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, e, halo_size=1) ! Set the diffusivities. !$OMP parallel default(none) shared(is,ie,js,je,Khth_Loc_u,CS,use_VarMix,VarMix, & @@ -518,10 +518,10 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV H_to_m = GV%H_to_m ; m_to_H = GV%m_to_H I4dt = 0.25 / dt I_slope_max2 = 1.0 / (CS%slope_max**2) - G_scale = GV%g_Earth + G_scale = (GV%g_Earth*GV%m_to_Z) h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect**2 dz_neglect = GV%H_subroundoff*H_to_m - G_rho0 = GV%g_Earth / GV%Rho0 + G_rho0 = (GV%g_Earth*GV%m_to_Z) / GV%Rho0 N2_floor = CS%N2_floor use_EOS = associated(tv%eqn_of_state) diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 3253003119..7802651c9c 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -931,7 +931,7 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux, #endif ! some constants - GoRho = GV%g_Earth / GV%Rho0 + GoRho = (GV%g_Earth*GV%m_to_Z) / GV%Rho0 ! loop over horizontal points on processor !$OMP parallel do default(shared) diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index 74fc2d6f2d..9407e4d1e3 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -166,7 +166,7 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, CS, hbl) real :: pref, g_o_rho0, rhok, rhokm1, dz, dh, hcorr integer :: i, j, k - g_o_rho0 = GV%g_Earth / GV%Rho0 + g_o_rho0 = (GV%g_Earth*GV%m_to_Z) / GV%Rho0 ! initialize dummy variables rho_lwr(:) = 0.0; rho_1d(:) = 0.0 diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index 6f73d7984c..f3b1570930 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -73,7 +73,7 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, & real, parameter :: epsln = 1.e-10 !< Threshold to identify vanished layers ! some constants - GoRho = GV%g_Earth / GV%Rho0 + GoRho = (GV%g_Earth*GV%m_to_Z) / GV%Rho0 do j = G%jsc, G%jec do i = G%isc, G%iec diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 48d3729c74..a851eee838 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -560,7 +560,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & ! 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 * GV%g_Earth * Irho0**2 + RmixConst = 0.5*CS%rivermix_depth * (GV%g_Earth*GV%m_to_Z) * Irho0**2 do i=is,ie TKE_river(i) = max(0.0, RmixConst*dR0_dS(i)* & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j)) * S(i,1)) @@ -911,7 +911,7 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & integer :: is, ie, nz, i, k, k1, nzc, nkmb is = G%isc ; ie = G%iec ; nz = GV%ke - g_H2_2Rho0 = (GV%g_Earth * GV%Z_to_m * 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 @@ -1116,7 +1116,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 = (GV%g_Earth * GV%Z_to_m * 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 is = G%isc ; ie = G%iec ; nz = GV%ke @@ -1657,7 +1657,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 = (GV%g_Earth * GV%Z_to_m * 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 @@ -2487,8 +2487,8 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, kb1 = CS%nkml+1; kb2 = CS%nkml+2 nkmb = CS%nkml+CS%nkbl h_neglect = GV%H_subroundoff - G_2 = 0.5*GV%g_Earth*GV%Z_to_m - Rho0xG = GV%Rho0 * GV%g_Earth*GV%Z_to_m + 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 @@ -3320,8 +3320,8 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e "CS%nkbl must be 1 in mixedlayer_detrain_1.") Idt = 1.0/dt dt_Time = dt/Timescale - g_H2_2Rho0dt = (GV%g_Earth*GV%Z_to_m * GV%H_to_Z**2) / (2.0 * GV%Rho0 * dt_diag) - g_H2_2dt = (GV%g_Earth*GV%Z_to_m * 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 diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 50f49426fe..1032bba617 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -678,8 +678,8 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, dia id_SQ = -1 ; if (PRESENT(id_N2subML)) id_SQ = id_MLDsq - Rho_x_gE = (GV%g_Earth * GV%Z_to_m) * GV%Rho0 - gE_rho0 = GV%m_to_Z * GV%g_Earth / GV%Rho0 + Rho_x_gE = (GV%g_Earth) * GV%Rho0 + gE_rho0 = GV%m_to_Z * (GV%g_Earth*GV%m_to_Z) / GV%Rho0 dz_subML = 50.*GV%m_to_Z is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -695,7 +695,7 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, dia rho1(i) = 0. d1(i) = 0. pRef_N2(i) = Rho_x_gE * h(i,j,1) * GV%H_to_Z ! Boussinesq approximation!!!! ????? - !### This should be: pRef_N2(i) = GV%g_Earth * GV%H_to_kg_m2 * h(i,j,1) ! This might change answers at roundoff. + !### This should be: pRef_N2(i) = GV%H_to_Pa * h(i,j,1) ! This might change answers at roundoff. endif enddo do k=2,nz @@ -708,7 +708,7 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, dia if (id_N2>0) then do i=is,ie pRef_N2(i) = pRef_N2(i) + Rho_x_gE * h(i,j,k) * GV%H_to_Z ! Boussinesq approximation!!!! ????? - !### This should be: pRef_N2(i) = pRev_N2(i) + GV%g_Earth * GV%H_to_kg_m2 * h(i,j,k) + !### This should be: pRef_N2(i) = pRev_N2(i) + GV%H_to_Pa * h(i,j,k) !### This might change answers at roundoff. enddo call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pRef_N2, rhoAtK, is, ie-is+1, tv%eqn_of_state) @@ -720,7 +720,7 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, dia !### It looks to me like there is bad logic here. - RWH ! Use pressure at the bottom of the upper layer used in calculating d/dz rho pRef_N2(i) = pRef_N2(i) + Rho_x_gE * h(i,j,k) * GV%H_to_Z ! Boussinesq approximation!!!! ????? - !### This line should be: pRef_N2(i) = pRev_N2(i) + GV%g_Earth * GV%H_to_kg_m2 * h(i,j,k) + !### This line should be: pRef_N2(i) = pRev_N2(i) + GV%H_to_Pa * h(i,j,k) !### This might change answers at roundoff. endif if (d1(i)>0. .and. dK(i)-d1(i)>=dz_subML) then @@ -846,13 +846,13 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & calculate_energetics = (present(cTKE) .and. present(dSV_dT) .and. present(dSV_dS)) calculate_buoyancy = present(SkinBuoyFlux) if (calculate_buoyancy) SkinBuoyFlux(:,:) = 0.0 - I_G_Earth = 1.0 / GV%g_Earth - g_Hconv2 = GV%g_Earth * GV%H_to_kg_m2**2 + I_G_Earth = 1.0 / (GV%g_Earth*GV%m_to_Z) + g_Hconv2 = GV%H_to_Pa * GV%H_to_kg_m2 if (present(cTKE)) cTKE(:,:,:) = 0.0 if (calculate_buoyancy) then SurfPressure(:) = 0.0 - GoRho = GV%Z_to_m*GV%g_Earth / GV%Rho0 + GoRho = GV%g_Earth / GV%Rho0 start = 1 + G%isc - G%isd npts = 1 + G%iec - G%isc endif @@ -905,7 +905,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & do i=is,ie ; pres(i) = 0.0 ; enddo ! Add surface pressure? do k=1,nz do i=is,ie - d_pres(i) = GV%g_Earth * GV%H_to_kg_m2 * h2d(i,k) + d_pres(i) = GV%H_to_Pa * h2d(i,k) p_lay(i) = pres(i) + 0.5*d_pres(i) pres(i) = pres(i) + d_pres(i) enddo diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index b294bbc64b..262e6bcaed 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -407,7 +407,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%id_T_predia > 0) call post_data(CS%id_T_predia, tv%T, CS%diag) if (CS%id_S_predia > 0) call post_data(CS%id_S_predia, tv%S, CS%diag) if (CS%id_e_predia > 0) then - call find_eta(h, tv, GV%g_Earth, G, GV, eta) + call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, eta) call post_data(CS%id_e_predia, eta, CS%diag) endif @@ -1285,7 +1285,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%id_T_predia > 0) call post_data(CS%id_T_predia, tv%T, CS%diag) if (CS%id_S_predia > 0) call post_data(CS%id_S_predia, tv%S, CS%diag) if (CS%id_e_predia > 0) then - call find_eta(h, tv, GV%g_Earth, G, GV, eta) + call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, eta) call post_data(CS%id_e_predia, eta, CS%diag) endif diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index acd0c9336c..5248a0fb66 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -251,7 +251,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & nz = G%ke h_neglect = GV%H_subroundoff - I_G_Earth = 1.0 / GV%g_Earth + I_G_Earth = 1.0 / (GV%g_Earth*GV%m_to_Z) debug = .true. surface_BL = .true. ; bottom_BL = .true. ; halves = .true. @@ -269,7 +269,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & T0(k) = T_in(k) ; S0(k) = S_in(k) h_tr(k) = h_in(k) htot = htot + h_tr(k) - pres(K+1) = pres(K) + GV%g_Earth * GV%H_to_kg_m2 * h_tr(k) + pres(K+1) = pres(K) + GV%H_to_Pa * h_tr(k) p_lay(k) = 0.5*(pres(K) + pres(K+1)) Z_int(K+1) = Z_int(K) - GV%H_to_m * h_tr(k) enddo @@ -290,7 +290,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & do k=1,nz dMass = GV%H_to_kg_m2 * h_tr(k) - dPres = GV%g_Earth * dMass + dPres = (GV%g_Earth*GV%m_to_Z) * dMass dT_to_dPE(k) = (dMass * (pres(K) + 0.5*dPres)) * dSV_dT(k) dS_to_dPE(k) = (dMass * (pres(K) + 0.5*dPres)) * dSV_dS(k) dT_to_dColHt(k) = dMass * dSV_dT(k) * CS%ColHt_scaling @@ -931,7 +931,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & do K=2,nz call calculate_density(0.5*(T0(k-1) + T0(k)), 0.5*(S0(k-1) + S0(k)), & pres(K), rho_here, tv%eqn_of_state) - N2(K) = (GV%g_Earth * rho_here / (0.5*GV%H_to_m*(h_tr(k-1) + h_tr(k)))) * & + N2(K) = ((GV%g_Earth*GV%m_to_Z) * rho_here / (0.5*GV%H_to_m*(h_tr(k-1) + h_tr(k)))) * & ( 0.5*(dSV_dT(k-1) + dSV_dT(k)) * (T0(k-1) - T0(k)) + & 0.5*(dSV_dS(k-1) + dSV_dS(k)) * (S0(k-1) - S0(k)) ) enddo @@ -942,7 +942,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & do K=2,nz call calculate_density(0.5*(Tf(k-1) + Tf(k)), 0.5*(Sf(k-1) + Sf(k)), & pres(K), rho_here, tv%eqn_of_state) - N2(K) = (GV%g_Earth * rho_here / (0.5*GV%H_to_m*(h_tr(k-1) + h_tr(k)))) * & + N2(K) = ((GV%g_Earth*GV%m_to_Z) * rho_here / (0.5*GV%H_to_m*(h_tr(k-1) + h_tr(k)))) * & ( 0.5*(dSV_dT(k-1) + dSV_dT(k)) * (Tf(k-1) - Tf(k)) + & 0.5*(dSV_dS(k-1) + dSV_dS(k)) * (Sf(k-1) - Sf(k)) ) enddo diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 22204ae3f6..590b866761 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -692,7 +692,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & pres(i,1) = 0.0 do k=1,nz dMass = GV%H_to_kg_m2 * h(i,k) - dPres = GV%g_Earth * dMass + dPres = (GV%g_Earth*GV%m_to_Z) * dMass dT_to_dPE(i,k) = (dMass * (pres(i,K) + 0.5*dPres)) * dSV_dT(i,j,k) dS_to_dPE(i,k) = (dMass * (pres(i,K) + 0.5*dPres)) * dSV_dS(i,j,k) dT_to_dColHt(i,k) = dMass * dSV_dT(i,j,k) @@ -1892,7 +1892,7 @@ subroutine ust_2_u10_coare3p5(USTair,U10,GV) CT=CT+1 u10a = u10 alpha = min(0.028,0.0017 * u10 - 0.005) - z0rough = alpha * USTair**2/GV%g_Earth ! Compute z0rough from ustar guess + z0rough = alpha * USTair**2/(GV%g_Earth*GV%m_to_Z) ! Compute z0rough from ustar guess z0=z0sm+z0rough CD = ( vonkar / log(10/z0) )**2 ! Compute CD from derived roughness u10 = USTair/sqrt(CD);!Compute new u10 from derived CD, while loop @@ -1959,7 +1959,7 @@ subroutine get_LA_windsea(ustar, hbl, GV, LA) ! ! peak frequency (PM, Bouws, 1998) tmp = 2.0 * PI * u19p5_to_u10 * u10 - fp = 0.877 * GV%g_Earth / tmp + fp = 0.877 * (GV%g_Earth*GV%m_to_Z) / tmp ! ! mean frequency fm = fm_to_fp * fp diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 95a43c8a3c..961176e94b 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -226,7 +226,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & H_to_m = GV%H_to_m ; m_to_H = GV%m_to_H tolerance = m_to_H * CS%Tolerance_Ent - g_2dt = 0.5 * GV%g_Earth / dt + g_2dt = 0.5 * (GV%g_Earth*GV%m_to_Z) / dt kmb = GV%nk_rho_varies K2 = max(kmb+1,2) ; kb_min = K2 if (.not. CS%bulkmixedlayer) then diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index b05dfed2aa..4251f0dd1f 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -153,7 +153,7 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, N2_bot) logical :: do_i(SZI_(G)), do_any integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - G_Rho0 = GV%g_Earth / GV%Rho0 + G_Rho0 = (GV%g_Earth*GV%m_to_Z) / GV%Rho0 ! Find the (limited) density jump across each interface. do i=is,ie diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 0b0ee0a3d7..bccb55ea5f 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -194,7 +194,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & new_kappa = .true. ; if (present(initialize_all)) new_kappa = initialize_all ! Ri_crit = CS%Rino_crit -! gR0 = GV%Rho0*GV%g_Earth ; g_R0 = GV%g_Earth/GV%Rho0 +! gR0 = GV%Rho0*(GV%g_Earth*GV%m_to_Z) ; g_R0 = (GV%g_Earth*GV%m_to_Z)/GV%Rho0 k0dt = dt*CS%kappa_0 dz_massless = 0.1*sqrt(k0dt) @@ -492,7 +492,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ new_kappa = .true. ; if (present(initialize_all)) new_kappa = initialize_all ! Ri_crit = CS%Rino_crit -! gR0 = GV%Rho0*GV%g_Earth ; g_R0 = GV%g_Earth/GV%Rho0 +! gR0 = GV%Rho0*(GV%g_Earth*GV%m_to_Z) ; g_R0 = (GV%g_Earth*GV%m_to_Z)/GV%Rho0 k0dt = dt*CS%kappa_0 dz_massless = 0.1*sqrt(k0dt) @@ -821,7 +821,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & integer :: k, itt, itt_dt Ri_crit = CS%Rino_crit - gR0 = GV%Rho0*GV%g_Earth ; g_R0 = GV%g_Earth/GV%Rho0 + gR0 = GV%Rho0*(GV%g_Earth*GV%m_to_Z) ; g_R0 = (GV%g_Earth*GV%m_to_Z)/GV%Rho0 k0dt = dt*CS%kappa_0 ! These are hard-coded for now. Perhaps these could be made dynamic later? ! tol_dksrc = 0.5*tol_ksrc_chg ; tol_dksrc_low = 1.0 - 1.0/tol_ksrc_chg ? diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 5db6034db3..11e7040718 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -721,7 +721,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & I_dt = 1.0/dt Omega2 = CS%Omega**2 - G_Rho0 = GV%g_Earth / GV%Rho0 + G_Rho0 = (GV%g_Earth*GV%m_to_Z) / GV%Rho0 H_neglect = GV%H_subroundoff I_Rho0 = 1.0/GV%Rho0 @@ -846,11 +846,11 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & ! ### This should be 1 / G_Earth * (delta rho_InSitu) ! kappa_max = I_dt * dRho_int(i,K+1) * maxEnt(i,k) * & ! (GV%H_to_m*h(i,j,k) + dh_max) / dRho_lay - ! maxTKE(i,k) = GV%g_Earth * dRho_lay * kappa_max + ! maxTKE(i,k) = (GV%g_Earth*GV%m_to_Z) * dRho_lay * kappa_max ! dRho_int should already be non-negative, so the max is redundant? dh_max = maxEnt(i,k) * (1.0 + dsp1_ds(i,k)) dRho_lay = 0.5 * max(dRho_int(i,K) + dRho_int(i,K+1), 0.0) - maxTKE(i,k) = I_dt * ((GV%g_Earth * I_Rho0) * & + maxTKE(i,k) = I_dt * (((GV%g_Earth*GV%m_to_Z) * I_Rho0) * & (0.5*max(dRho_int(i,K+1) + dsp1_ds(i,k)*dRho_int(i,K),0.0))) * & ((GV%H_to_m*h(i,j,k) + dh_max) * maxEnt(i,k)) TKE_to_Kd(i,k) = 1.0 / (G_Rho0 * dRho_lay + & @@ -910,7 +910,7 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, & integer :: i, k, is, ie, nz is = G%isc ; ie = G%iec ; nz = G%ke - G_Rho0 = GV%g_Earth / GV%Rho0 + G_Rho0 = (GV%g_Earth*GV%m_to_Z) / GV%Rho0 H_neglect = GV%H_subroundoff ! Find the (limited) density jump across each interface. @@ -1195,7 +1195,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) Rayleigh_drag = .true. I_Rho0 = 1.0/GV%Rho0 - R0_g = GV%Rho0/GV%g_Earth + R0_g = GV%Rho0/(GV%g_Earth*GV%m_to_Z) do K=2,nz ; Rint(K) = 0.5*(GV%Rlay(k-1)+GV%Rlay(k)) ; enddo @@ -1833,7 +1833,7 @@ subroutine set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0) enddo if (CS%bulkmixedlayer) then - g_R0 = GV%g_Earth/GV%Rho0 + g_R0 = (GV%g_Earth*GV%m_to_Z)/GV%Rho0 kmb = GV%nk_rho_varies eps = 0.1 do i=is,ie ; p_ref(i) = tv%P_Ref ; enddo diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index acebe8e6cf..1b37cb23e9 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -282,7 +282,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB nkmb = GV%nk_rho_varies ; nkml = GV%nkml h_neglect = GV%H_subroundoff - Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth) * GV%Z_to_m*GV%Z_to_H + Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth) * GV%Z_to_m**2 * GV%Z_to_H Vol_quit = 0.9*GV%Angstrom_H + h_neglect C2pi_3 = 8.0*atan(1.0)/3.0 @@ -1154,7 +1154,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) Jsq = js-1 ; Isq = is-1 endif ; endif - Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth) * GV%Z_to_m*GV%Z_to_H + Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth) * GV%Z_to_m**2 * GV%Z_to_H U_bg_sq = CS%drag_bg_vel * CS%drag_bg_vel cdrag_sqrt = sqrt(CS%cdrag) cdrag_sqrt_Z = GV%m_to_Z * sqrt(CS%cdrag) @@ -1164,7 +1164,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) dt_Rho0 = dt/GV%H_to_kg_m2 h_neglect = GV%H_subroundoff h_tiny = 2.0*GV%Angstrom_H + h_neglect - g_H_Rho0 = (GV%g_Earth * GV%H_to_m) / GV%Rho0 + g_H_Rho0 = (GV%g_Earth*GV%H_to_Z) / GV%Rho0 if (associated(forces%frac_shelf_u) .neqv. associated(forces%frac_shelf_v)) & call MOM_error(FATAL, "set_viscous_ML: one of forces%frac_shelf_u and "//& diff --git a/src/parameterizations/vertical/MOM_shortwave_abs.F90 b/src/parameterizations/vertical/MOM_shortwave_abs.F90 index a81a7803da..410a41583a 100644 --- a/src/parameterizations/vertical/MOM_shortwave_abs.F90 +++ b/src/parameterizations/vertical/MOM_shortwave_abs.F90 @@ -148,7 +148,7 @@ subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, C1_6 = 1.0 / 6.0 ; C1_60 = 1.0 / 60.0 TKE_calc = (present(TKE) .and. present(dSV_dT)) - g_Hconv2 = GV%g_Earth * GV%H_to_kg_m2**2 + g_Hconv2 = GV%H_to_Pa * GV%H_to_kg_m2 h_heat(:) = 0.0 if (present(htot)) then ; do i=is,ie ; h_heat(i) = htot(i) ; enddo ; endif diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index ed965393a4..8b33fc8c2b 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -56,9 +56,9 @@ subroutine BFB_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state) do k = 1,nz Rlay(k) = (rho_bot - rho_top)/(nz-1)*real(k-1) + rho_top if (k >1) then - g_prime(k) = (Rlay(k) - Rlay(k-1))*GV%g_earth/GV%rho0 + g_prime(k) = (Rlay(k) - Rlay(k-1))*(GV%g_Earth*GV%m_to_Z)/GV%rho0 else - g_prime(k) = GV%g_earth + g_prime(k) = (GV%g_Earth*GV%m_to_Z) endif !Rlay(:) = 0.0 !g_prime(:) = 0.0 diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index a4dc83d9ca..3f740beda2 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -277,7 +277,7 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, param_file, tr_Reg) if (.not.associated(OBC)) return - g_prime_tot = (GV%g_Earth/GV%Rho0)*2.0 + g_prime_tot = ((GV%g_Earth*GV%m_to_Z)/GV%Rho0)*2.0 Def_Rad = sqrt(D_edge*g_prime_tot) / (1.0e-4*1000.0) tr_0 = (-D_edge*sqrt(D_edge*g_prime_tot)*0.5e3*Def_Rad) * GV%m_to_H diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index c8ce37ad55..1a35ebccd2 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -525,11 +525,11 @@ subroutine Update_Stokes_Drift(G,GV,CS,h,ustar) elseif (PartitionMode==1) then if (CS%StkLevelMode==0) then ! Take the value at the midpoint - CMN_FAC = exp(MidPoint*2.*(2.*PI*CS%Freq_Cen(b))**2/GV%g_Earth) + CMN_FAC = exp(MidPoint*2.*(2.*PI*CS%Freq_Cen(b))**2/(GV%g_Earth*GV%m_to_Z)) elseif (CS%StkLevelMode==1) then ! Use a numerical integration and then ! divide by layer thickness - WN = (2.*PI*CS%Freq_Cen(b))**2 / GV%g_Earth !bgr bug-fix missing g + WN = (2.*PI*CS%Freq_Cen(b))**2 / (GV%g_Earth*GV%m_to_Z) !bgr bug-fix missing g CMN_FAC = (exp(2.*WN*Top)-exp(2.*WN*Bottom)) / (2.*WN*(Top-Bottom)) endif endif @@ -568,11 +568,11 @@ subroutine Update_Stokes_Drift(G,GV,CS,h,ustar) elseif (PartitionMode==1) then if (CS%StkLevelMode==0) then ! Take the value at the midpoint - CMN_FAC = exp(MidPoint*2.*(2.*PI*CS%Freq_Cen(b))**2/GV%g_Earth) + CMN_FAC = exp(MidPoint*2.*(2.*PI*CS%Freq_Cen(b))**2/(GV%g_Earth*GV%m_to_Z)) elseif (CS%StkLevelMode==1) then ! Use a numerical integration and then ! divide by layer thickness - WN = (2.*PI*CS%Freq_Cen(b))**2 / GV%g_Earth + WN = (2.*PI*CS%Freq_Cen(b))**2 / (GV%g_Earth*GV%m_to_Z) CMN_FAC = (exp(2.*WN*Top)-exp(2.*WN*Bottom)) / (2.*WN*(Top-Bottom)) endif endif @@ -770,7 +770,7 @@ subroutine Surface_Bands_by_data_override(day_center,G,GV,CS) endif NUMBANDS = ID do B = 1,NumBands - CS%WaveNum_Cen(b) = (2.*PI*CS%Freq_Cen(b))**2 / GV%g_Earth + CS%WaveNum_Cen(b) = (2.*PI*CS%Freq_Cen(b))**2 / (GV%g_Earth*GV%m_to_Z) enddo endif @@ -968,7 +968,7 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US_SL, LA) ! ! peak frequency (PM, Bouws, 1998) tmp = 2.0 * PI * u19p5_to_u10 * u10 - fp = 0.877 * GV%g_Earth / tmp + fp = 0.877 * (GV%g_Earth*GV%m_to_Z) / tmp ! ! mean frequency fm = fm_to_fp * fp @@ -1102,14 +1102,14 @@ subroutine DHH85_mid(GV, ust, zpt, US) !/ omega_min = 0.1 ! Hz ! Cut off at 30cm for now... - omega_max = 6.5 ! ~sqrt(0.2*GV%g_earth*2*pi/0.3) + omega_max = 6.5 ! ~sqrt(0.2*(GV%g_Earth*GV%m_to_Z)*2*pi/0.3) domega=0.05 NOmega = (omega_max-omega_min)/domega ! if (WaveAgePeakFreq) then - omega_peak = GV%G_EARTH/WA/u10 + omega_peak = (GV%g_Earth*GV%m_to_Z)/WA/u10 else - omega_peak = 2. * pi * 0.13 * GV%g_earth / U10 + omega_peak = 2. * pi * 0.13 * (GV%g_Earth*GV%m_to_Z) / U10 endif !/ Ann = 0.006 * WaveAge**(-0.55) @@ -1125,11 +1125,11 @@ subroutine DHH85_mid(GV, ust, zpt, US) do oi = 1,nomega-1 Dnn = exp ( -0.5 * (omega-omega_peak)**2 / Snn**2 / omega_peak**2 ) ! wavespec units = m2s - wavespec = (Ann * GV%g_earth**2 / (omega_peak*omega**4 ) ) & + wavespec = (Ann * (GV%g_Earth*GV%m_to_Z)**2 / (omega_peak*omega**4 ) ) & *exp(-bnn*(omega_peak/omega)**4)*Cnn**Dnn ! Stokes units m (multiply by frequency range for units of m/s) Stokes = 2.0 * wavespec * omega**3 * & - exp( 2.0 * omega**2 * zpt/GV%g_earth)/GV%g_earth + exp( 2.0 * omega**2 * zpt/(GV%g_Earth*GV%m_to_Z))/(GV%g_Earth*GV%m_to_Z) US=US+Stokes*domega omega = omega + domega enddo @@ -1290,7 +1290,7 @@ subroutine ust_2_u10_coare3p5(USTair,U10,GV) CT=CT+1 u10a = u10 alpha = min(0.028,0.0017 * u10 - 0.005) - z0rough = alpha * USTair**2/GV%g_Earth ! Compute z0rough from ustar guess + z0rough = alpha * USTair**2/(GV%g_Earth*GV%m_to_Z) ! Compute z0rough from ustar guess z0=z0sm+z0rough CD = ( vonkar / log(10/z0) )**2 ! Compute CD from derived roughness u10 = USTair/sqrt(CD);!Compute new u10 from derived CD, while loop diff --git a/src/user/Rossby_front_2d_initialization.F90 b/src/user/Rossby_front_2d_initialization.F90 index c619f3db64..975b96e866 100644 --- a/src/user/Rossby_front_2d_initialization.F90 +++ b/src/user/Rossby_front_2d_initialization.F90 @@ -202,7 +202,7 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, param_file, just_rea do j = G%jsc,G%jec ; do I = G%isc-1,G%iec+1 f = 0.5*( G%CoriolisBu(I,j) + G%CoriolisBu(I,j-1) ) dUdT = 0.0 ; if (abs(f) > 0.0) & - dUdT = ( GV%Z_to_m*GV%g_Earth * dRho_dT ) / ( f * GV%Rho0 ) + dUdT = ( GV%g_Earth * dRho_dT ) / ( f * GV%Rho0 ) Dml = Hml( G, G%geoLatT(i,j) ) Ty = dTdy( G, T_range, G%geoLatT(i,j) ) zi = 0. From 47c8ce61a34b26fa6d3d11b0ce5820bcf22d3e8c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 30 Sep 2018 11:42:34 -0400 Subject: [PATCH 122/174] Changed the units of GV%g_prime to m2 Z-1 s-2 Rescaled the units of GV%g_prime for dimensional consistency testing. All answers are bitwise identical, including rescaling Z over a large range. --- src/core/MOM_PressureForce_Montgomery.F90 | 10 +-- src/core/MOM_PressureForce_analytic_FV.F90 | 2 +- src/core/MOM_PressureForce_blocked_AFV.F90 | 2 +- src/core/MOM_barotropic.F90 | 14 ++-- src/core/MOM_open_boundary.F90 | 4 +- src/core/MOM_verticalGrid.F90 | 2 +- src/diagnostics/MOM_sum_output.F90 | 4 +- .../MOM_coord_initialization.F90 | 70 +++++++++---------- .../lateral/MOM_lateral_mixing_coeffs.F90 | 4 +- .../lateral/MOM_thickness_diffuse.F90 | 4 +- .../vertical/MOM_entrain_diffusive.F90 | 2 +- .../vertical/MOM_set_diffusivity.F90 | 4 +- src/user/BFB_initialization.F90 | 6 +- src/user/DOME_initialization.F90 | 10 +-- src/user/Phillips_initialization.F90 | 2 +- src/user/user_initialization.F90 | 4 +- 16 files changed, 72 insertions(+), 72 deletions(-) diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 4887d1a3e1..395dccc018 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -527,11 +527,11 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - M(i,j,1) = GV%g_prime(1) * GV%Z_to_m*e(i,j,1) + M(i,j,1) = 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 enddo do k=2,nz ; do i=Isq,Ieq+1 - M(i,j,k) = M(i,j,k-1) + GV%g_prime(K) * GV%Z_to_m*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 @@ -687,11 +687,11 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star do j=Jsq,Jeq+1 do i=Isq,Ieq+1 Ihtot(i) = 1.0 / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect) - pbce(i,j,1) = GV%g_prime(1) * GV%H_to_m + pbce(i,j,1) = GV%g_prime(1) * GV%H_to_Z enddo do k=2,nz ; do i=Isq,Ieq+1 pbce(i,j,k) = pbce(i,j,k-1) + & - (GV%g_prime(K)*GV%H_to_m) * ((e(i,j,K) - e(i,j,nz+1)) * Ihtot(i)) + (GV%g_prime(K)*GV%H_to_Z) * ((e(i,j,K) - e(i,j,nz+1)) * Ihtot(i)) enddo ; enddo enddo ! end of j loop endif ! use_EOS @@ -871,7 +871,7 @@ subroutine PressureForce_Mont_init(Time, G, GV, param_file, diag, CS, tides_CSp) endif CS%GFS_scale = 1.0 - if (GV%g_prime(1) /= (GV%g_Earth*GV%m_to_Z)) CS%GFS_scale = GV%g_prime(1) / (GV%g_Earth*GV%m_to_Z) + if (GV%g_prime(1) /= GV%g_Earth) CS%GFS_scale = GV%g_prime(1) / GV%g_Earth call log_param(param_file, mdl, "GFS / G_EARTH", CS%GFS_scale) diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index aa9d43610e..a245b1f4d4 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -838,7 +838,7 @@ subroutine PressureForce_AFV_init(Time, G, GV, param_file, diag, CS, tides_CSp) endif CS%GFS_scale = 1.0 - if (GV%g_prime(1) /= (GV%g_Earth*GV%m_to_Z)) CS%GFS_scale = GV%g_prime(1) / (GV%g_Earth*GV%m_to_Z) + if (GV%g_prime(1) /= GV%g_Earth) CS%GFS_scale = GV%g_prime(1) / GV%g_Earth call log_param(param_file, mdl, "GFS / G_EARTH", CS%GFS_scale) diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index 4da52327a2..e53d44a88a 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -832,7 +832,7 @@ subroutine PressureForce_blk_AFV_init(Time, G, GV, param_file, diag, CS, tides_C endif CS%GFS_scale = 1.0 - if (GV%g_prime(1) /= (GV%g_Earth*GV%m_to_Z)) CS%GFS_scale = GV%g_prime(1) / (GV%g_Earth*GV%m_to_Z) + if (GV%g_prime(1) /= GV%g_Earth) CS%GFS_scale = GV%g_prime(1) / GV%g_Earth call log_param(param_file, mdl, "GFS / G_EARTH", CS%GFS_scale) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index f240f4318c..733cf7a9d2 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -2640,14 +2640,14 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, MS, halo, use_BT_co else if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then BT_OBC%H_u(i,j) = eta(i,j) - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (GV%Z_to_m*G%bathyT(i,j) + eta(i,j))) !### * GV%H_to_m? + BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%bathyT(i,j) + GV%m_to_Z*eta(i,j))) !### * GV%H_to_m? elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then BT_OBC%H_u(i,j) = eta(i+1,j) - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (GV%Z_to_m*G%bathyT(i+1,j) + eta(i+1,j))) !### * GV%H_to_m? + BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%bathyT(i+1,j) + GV%m_to_Z*eta(i+1,j))) !### * GV%H_to_m? endif endif if (GV%Boussinesq) then - BT_OBC%Cg_u(I,j) = SQRT(GV%g_prime(1) * BT_OBC%H_u(i,j)) !### * GV%H_to_m? + BT_OBC%Cg_u(I,j) = SQRT(GV%g_prime(1)*GV%m_to_Z * BT_OBC%H_u(i,j)) !### * GV%H_to_m? endif endif endif ; enddo ; enddo @@ -2696,14 +2696,14 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, MS, halo, use_BT_co else if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then BT_OBC%H_v(i,J) = eta(i,j) - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (GV%Z_to_m*G%bathyT(i,j) + eta(i,j))) !### * GV%H_to_m? + BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%bathyT(i,j) + eta(i,j)*GV%m_to_Z)) !### * GV%H_to_m? elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then BT_OBC%H_v(i,J) = eta(i,j+1) - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (GV%Z_to_m*G%bathyT(i,j+1) + eta(i,j+1))) !### * GV%H_to_m? + BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%bathyT(i,j+1) + eta(i,j+1)*GV%m_to_Z)) !### * GV%H_to_m? endif endif if (GV%Boussinesq) then - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * BT_OBC%H_v(i,J)) !### * GV%H_to_m? + BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1)*GV%m_to_Z * BT_OBC%H_v(i,J)) !### * GV%H_to_m? endif endif endif ; enddo ; enddo @@ -4143,7 +4143,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & ! Estimate the maximum stable barotropic time step. gtot_estimate = 0.0 - do k=1,G%ke ; gtot_estimate = gtot_estimate + GV%g_prime(K) ; enddo + do k=1,G%ke ; gtot_estimate = gtot_estimate + GV%g_prime(K)*GV%m_to_Z ; enddo call set_dtbt(G, GV, CS, gtot_est = gtot_estimate, SSH_add = SSH_extra) if (dtbt_input > 0.0) then diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index bd23331e14..6296dbc35b 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -2977,7 +2977,7 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) if (segment%direction == OBC_DIRECTION_W) ishift=1 I=segment%HI%IsdB do j=segment%HI%jsd,segment%HI%jed - segment%Cg(I,j) = sqrt(GV%g_prime(1)*G%Zd_to_m*G%bathyT(i+ishift,j)) + segment%Cg(I,j) = sqrt(GV%g_prime(1)*G%bathyT(i+ishift,j)) segment%Htot(I,j)=0.0 do k=1,G%ke segment%h(I,j,k) = h(i+ishift,j,k) @@ -2990,7 +2990,7 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) if (segment%direction == OBC_DIRECTION_S) jshift=1 J=segment%HI%JsdB do i=segment%HI%isd,segment%HI%ied - segment%Cg(i,J) = sqrt(GV%g_prime(1)*G%Zd_to_m*G%bathyT(i,j+jshift)) + segment%Cg(i,J) = sqrt(GV%g_prime(1)*G%bathyT(i,j+jshift)) segment%Htot(i,J)=0.0 do k=1,G%ke segment%h(i,J,k) = h(i,j+jshift,k) diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index eeb9e66647..b2ef2dda6a 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -41,7 +41,7 @@ module MOM_verticalGrid !! Angstrom or larger without changing it at the bit level, in thickness units. !! If Angstrom is 0 or exceedingly small, this is negligible compared to 1e-17 m. real, allocatable, dimension(:) :: & - g_prime, & !< The reduced gravity at each interface, in m s-2. + g_prime, & !< The reduced gravity at each interface, in m2 Z-1 s-2. Rlay !< The target coordinate value (potential density) in each layer in kg m-3. integer :: nkml = 0 !< The number of layers at the top that should be treated !! as parts of a homogenous region. diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 0e37fbd3d2..e464d565fa 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -643,7 +643,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp, OBC, dt_forc hint = H_0APE(K) + (hbelow - G%Zd_to_m*G%bathyT(i,j)) hbot = H_0APE(K) - G%Zd_to_m*G%bathyT(i,j) hbot = (hbot + ABS(hbot)) * 0.5 - PE_pt(i,j,K) = 0.5 * areaTm(i,j) * (GV%Rho0*GV%g_prime(K)) * & + PE_pt(i,j,K) = 0.5 * areaTm(i,j) * (GV%Rho0*GV%m_to_Z*GV%g_prime(K)) * & (hint * hint - hbot * hbot) enddo enddo ; enddo @@ -653,7 +653,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp, OBC, dt_forc do k=nz,1,-1 hint = H_0APE(K) + eta(i,j,K) ! eta and H_0 have opposite signs. hbot = max(H_0APE(K) - G%Zd_to_m*G%bathyT(i,j), 0.0) - PE_pt(i,j,K) = 0.5 * (areaTm(i,j) * (GV%Rho0*GV%g_prime(K))) * & + PE_pt(i,j,K) = 0.5 * (areaTm(i,j) * (GV%Rho0*GV%m_to_Z*GV%g_prime(K))) * & (hint * hint - hbot * hbot) enddo enddo ; enddo diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index b1d68f9dd3..54728f61d9 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -99,7 +99,7 @@ subroutine MOM_initialize_coord(GV, PF, write_geom, output_dir, tv, max_depth) "Unrecognized coordinate setup"//trim(config)) end select if (debug) call chksum(GV%Rlay, "MOM_initialize_coord: Rlay ", 1, nz) - if (debug) call chksum(GV%g_prime, "MOM_initialize_coord: g_prime ", 1, nz) + if (debug) call chksum(GV%Z_to_m*GV%g_prime(:), "MOM_initialize_coord: g_prime ", 1, nz) call setVerticalGridAxes( GV%Rlay, GV ) ! Copy the maximum depth across from the input argument @@ -118,8 +118,8 @@ end subroutine MOM_initialize_coord subroutine set_coord_from_gprime(Rlay, g_prime, GV, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). - real, dimension(:), intent(out) :: g_prime !< A structure indicating the open file to - !! parse for model parameter values. + real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces + !! in m2 Z-1 s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters ! Local variables @@ -133,15 +133,15 @@ subroutine set_coord_from_gprime(Rlay, g_prime, GV, param_file) call get_param(param_file, mdl, "GFS" , g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*GV%m_to_Z)) + default=(GV%g_Earth*GV%m_to_Z), scale=GV%Z_to_m) call get_param(param_file, mdl, "GINT", g_int, & "The reduced gravity across internal interfaces.", & - units="m s-2", fail_if_missing=.true.) + units="m s-2", fail_if_missing=.true., scale=GV%Z_to_m) g_prime(1) = g_fs do k=2,nz ; g_prime(k) = g_int ; enddo Rlay(1) = GV%Rho0 - do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/(GV%g_Earth*GV%m_to_Z)) ; enddo + do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%g_Earth) ; enddo call callTree_leave(trim(mdl)//'()') @@ -151,8 +151,8 @@ end subroutine set_coord_from_gprime subroutine set_coord_from_layer_density(Rlay, g_prime, GV, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). - real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces, - !! in m s-2. + real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces + !! in m2 Z-1 s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters ! Local variables @@ -167,7 +167,7 @@ subroutine set_coord_from_layer_density(Rlay, g_prime, GV, param_file) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*GV%m_to_Z)) + default=(GV%g_Earth*GV%m_to_Z), scale=GV%Z_to_m) call get_param(param_file, mdl, "LIGHTEST_DENSITY", Rlay_Ref, & "The reference potential density used for layer 1.", & units="kg m-3", default=GV%Rho0) @@ -182,7 +182,7 @@ subroutine set_coord_from_layer_density(Rlay, g_prime, GV, param_file) enddo ! These statements set the interface reduced gravities. ! do k=2,nz - g_prime(k) = ((GV%g_Earth*GV%m_to_Z)/GV%Rho0) * (Rlay(k) - Rlay(k-1)) + g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) enddo call callTree_leave(trim(mdl)//'()') @@ -193,8 +193,8 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, param_file, eqn_of_state, & P_Ref) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). - real, dimension(:), intent(out) :: g_prime !< the reduced gravity across the interfaces, - !! in m s-2. + real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces + !! in m2 Z-1 s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters @@ -219,10 +219,10 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, param_file, eqn_of_state, & "The initial salinities.", units="PSU", default=35.0) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*GV%m_to_Z)) + default=(GV%g_Earth*GV%m_to_Z), scale=GV%Z_to_m) call get_param(param_file, mdl, "GINT", g_int, & "The reduced gravity across internal interfaces.", & - units="m s-2", fail_if_missing=.true.) + units="m s-2", fail_if_missing=.true., scale=GV%Z_to_m) ! ! These statements set the interface reduced gravities. ! g_prime(1) = g_fs @@ -234,7 +234,7 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, param_file, eqn_of_state, & call calculate_density(T_ref, S_ref, P_ref, Rlay(1), eqn_of_state) ! These statements set the layer densities. ! - do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/(GV%g_Earth*GV%m_to_Z)) ; enddo + do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%g_Earth) ; enddo call callTree_leave(trim(mdl)//'()') end subroutine set_coord_from_TS_ref @@ -244,8 +244,8 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, param_file, & eqn_of_state, P_Ref) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). - real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces, - !! in m s-2. + real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces + !! in m2 Z-1 s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters @@ -264,7 +264,7 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, param_file, & call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*GV%m_to_Z)) + default=(GV%g_Earth*GV%m_to_Z), scale=GV%Z_to_m) call get_param(param_file, mdl, "COORD_FILE", coord_file, & "The file from which the coordinate temperatures and \n"//& "salinities are read.", fail_if_missing=.true.) @@ -282,7 +282,7 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, param_file, & g_prime(1) = g_fs do k=1,nz ; Pref(k) = P_ref ; enddo call calculate_density(T0, S0, Pref, Rlay, 1,nz,eqn_of_state) - do k=2,nz; g_prime(k) = ((GV%g_Earth*GV%m_to_Z)/GV%Rho0) * (Rlay(k) - Rlay(k-1)); enddo + do k=2,nz; g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) ; enddo call callTree_leave(trim(mdl)//'()') end subroutine set_coord_from_TS_profile @@ -292,8 +292,8 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, param_file, & eqn_of_state, P_Ref) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). - real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces, - !! in m s-2. + real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces + !! in m2 Z-1 s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters @@ -343,7 +343,7 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, param_file, & call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*GV%m_to_Z)) + default=(GV%g_Earth*GV%m_to_Z), scale=GV%Z_to_m) k_light = GV%nk_rho_varies + 1 @@ -364,7 +364,7 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, param_file, & do k=k_light-1,1,-1 Rlay(k) = 2.0*Rlay(k+1) - Rlay(k+2) enddo - do k=2,nz; g_prime(k) = ((GV%g_Earth*GV%m_to_Z)/GV%Rho0) * (Rlay(k) - Rlay(k-1)); enddo + do k=2,nz; g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)); enddo call callTree_leave(trim(mdl)//'()') end subroutine set_coord_from_TS_range @@ -373,8 +373,8 @@ end subroutine set_coord_from_TS_range subroutine set_coord_from_file(Rlay, g_prime, GV, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). - real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces, - !! in m s-2. + real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces + !! in m2 Z-1 s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters ! Local variables @@ -389,7 +389,7 @@ subroutine set_coord_from_file(Rlay, g_prime, GV, param_file) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*GV%m_to_Z)) + default=(GV%g_Earth*GV%m_to_Z), scale=GV%Z_to_m) call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) call get_param(param_file, mdl, "COORD_FILE", coord_file, & @@ -405,7 +405,7 @@ subroutine set_coord_from_file(Rlay, g_prime, GV, param_file) call read_axis_data(filename, coord_var, Rlay) g_prime(1) = g_fs - do k=2,nz ; g_prime(k) = ((GV%g_Earth*GV%m_to_Z)/GV%Rho0) * (Rlay(k) - Rlay(k-1)) ; enddo + do k=2,nz ; g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) ; enddo do k=1,nz ; if (g_prime(k) <= 0.0) then call MOM_error(FATAL, "MOM_initialization set_coord_from_file: "//& "Zero or negative g_primes read from variable "//"Layer"//" in file "//& @@ -423,8 +423,8 @@ end subroutine set_coord_from_file subroutine set_coord_linear(Rlay, g_prime, GV, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). - real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces, - !! in m s-2. + real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces + !! in m2 Z-1 s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters ! Local variables @@ -443,7 +443,7 @@ subroutine set_coord_linear(Rlay, g_prime, GV, param_file) "all interfaces.", units="kg m-3", default=2.0) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*GV%m_to_Z)) + default=(GV%g_Earth*GV%m_to_Z), scale=GV%Z_to_m) ! This following sets the target layer densities such that a the ! surface interface has density Rlay_ref and the bottom @@ -454,7 +454,7 @@ subroutine set_coord_linear(Rlay, g_prime, GV, param_file) ! These statements set the interface reduced gravities. g_prime(1) = g_fs do k=2,nz - g_prime(k) = ((GV%g_Earth*GV%m_to_Z)/GV%Rho0) * (Rlay(k) - Rlay(k-1)) + g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) enddo call callTree_leave(trim(mdl)//'()') @@ -466,8 +466,8 @@ end subroutine set_coord_linear subroutine set_coord_to_none(Rlay, g_prime, GV, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). - real, dimension(:), intent(out) :: g_prime !< A structure indicating the open file to - !! parse for model parameter values. + real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces, + !! in m s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters ! Local variables @@ -480,12 +480,12 @@ subroutine set_coord_to_none(Rlay, g_prime, GV, param_file) call get_param(param_file, mdl, "GFS" , g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*GV%m_to_Z)) + default=(GV%g_Earth*GV%m_to_Z), scale=GV%Z_to_m) g_prime(1) = g_fs do k=2,nz ; g_prime(k) = 0. ; enddo Rlay(1) = GV%Rho0 - do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/(GV%g_Earth*GV%m_to_Z)) ; enddo + do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%g_Earth) ; enddo call callTree_leave(trim(mdl)//'()') diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 86f60b3e2c..6065062b83 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -666,7 +666,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) Hdn = 2.*h(i,j,k)*h(i,j,k-1) / (h(i,j,k) + h(i,j,k-1) + h_neglect) Hup = 2.*h(i+1,j,k)*h(i+1,j,k-1) / (h(i+1,j,k) + h(i+1,j,k-1) + h_neglect) H_geom = sqrt(Hdn*Hup) - N2 = GV%g_prime(k) / (GV%H_to_m * max(Hdn,Hup,one_meter)) + N2 = GV%g_prime(k)*GV%m_to_Z**2 / (GV%H_to_Z * max(Hdn,Hup,one_meter)) if (min(h(i,j,k-1), h(i+1,j,k-1), h(i,j,k), h(i+1,j,k)) < H_cutoff) & S2 = 0.0 SN_u_local(I,j,k) = (H_geom * GV%H_to_m) * S2 * N2 @@ -677,7 +677,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) Hdn = 2.*h(i,j,k)*h(i,j,k-1) / (h(i,j,k) + h(i,j,k-1) + h_neglect) Hup = 2.*h(i,j+1,k)*h(i,j+1,k-1) / (h(i,j+1,k) + h(i,j+1,k-1) + h_neglect) H_geom = sqrt(Hdn*Hup) - N2 = GV%g_prime(k) / (GV%H_to_m * max(Hdn,Hup,one_meter)) + N2 = GV%g_prime(k)*GV%m_to_Z**2 / (GV%H_to_Z * max(Hdn,Hup,one_meter)) if (min(h(i,j,k-1), h(i,j+1,k-1), h(i,j,k), h(i,j+1,k)) < H_cutoff) & S2 = 0.0 SN_v_local(i,J,k) = (H_geom * GV%H_to_m) * S2 * N2 diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 2a0ae1b769..5a72723b07 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -729,7 +729,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV 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))*Slope) - hN2_u(I,K) = GV%g_prime(K) + hN2_u(I,K) = GV%g_prime(K)*GV%m_to_Z endif ! if (use_EOS) else ! if (k > nk_linear) hN2_u(I,K) = N2_floor * dz_neglect @@ -975,7 +975,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV 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))*Slope) - hN2_v(i,K) = GV%g_prime(K) + hN2_v(i,K) = GV%g_prime(K)*GV%m_to_Z endif ! if (use_EOS) else ! if (k > nk_linear) hN2_v(i,K) = N2_floor * dz_neglect diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 961176e94b..d3a510fea7 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -384,7 +384,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & htot(i) = h(i,j,1) - Angstrom enddo if (associated(fluxes%buoy)) then ; do i=is,ie - maxF(i,1) = (dt*fluxes%buoy(i,j)) / GV%g_prime(2) + maxF(i,1) = (dt*fluxes%buoy(i,j)) / (GV%g_prime(2)*GV%m_to_Z) enddo ; endif endif diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 11e7040718..f185f5aab4 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -1810,7 +1810,7 @@ subroutine set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0) ! below it (nondimensional) ! (in) rho_0 - layer potential densities relative to surface press (kg/m3) - real :: g_R0 ! g_R0 is g/Rho (m4 kg-1 s-2) + real :: g_R0 ! g_R0 is g/Rho (m5 Z-1 kg-1 s-2) real :: eps, tmp ! nondimensional temproray variables real :: a(SZK_(G)), a_0(SZK_(G)) ! nondimensional temporary variables real :: p_ref(SZI_(G)) ! an array of tv%P_Ref pressures @@ -1833,7 +1833,7 @@ subroutine set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0) enddo if (CS%bulkmixedlayer) then - g_R0 = (GV%g_Earth*GV%m_to_Z)/GV%Rho0 + g_R0 = GV%g_Earth/GV%Rho0 kmb = GV%nk_rho_varies eps = 0.1 do i=is,ie ; p_ref(i) = tv%P_Ref ; enddo diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index 8b33fc8c2b..2eda7d2f1d 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -32,7 +32,7 @@ module BFB_initialization subroutine BFB_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state) real, dimension(NKMEM_), intent(out) :: Rlay !< Layer potential density. real, dimension(NKMEM_), intent(out) :: g_prime !< The reduced gravity at - !! each interface, in m s-2. + !! each interface, in m2 Z-1 s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(EOS_type), pointer :: eqn_of_state !< Integer that selects the @@ -56,9 +56,9 @@ subroutine BFB_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state) do k = 1,nz Rlay(k) = (rho_bot - rho_top)/(nz-1)*real(k-1) + rho_top if (k >1) then - g_prime(k) = (Rlay(k) - Rlay(k-1))*(GV%g_Earth*GV%m_to_Z)/GV%rho0 + g_prime(k) = (Rlay(k) - Rlay(k-1)) * GV%g_Earth/GV%rho0 else - g_prime(k) = (GV%g_Earth*GV%m_to_Z) + g_prime(k) = GV%g_Earth endif !Rlay(:) = 0.0 !g_prime(:) = 0.0 diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 3f740beda2..4315420e9a 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -252,9 +252,9 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, param_file, tr_Reg) real :: rho_guess(SZK_(G)) ! Potential density at T0 & S0 in kg m-3. ! The following variables are used to set up the transport in the DOME example. real :: tr_0, y1, y2, tr_k, rst, rsb, rc, v_k, lon_im1 - real :: D_edge ! The thickness in m of the dense fluid at the + real :: D_edge ! The thickness in Z of the dense fluid at the ! inner edge of the inflow. - real :: g_prime_tot ! The reduced gravity across all layers, m s-2. + real :: g_prime_tot ! The reduced gravity across all layers, m2 Z-1 s-2. real :: Def_Rad ! The deformation radius, based on fluid of ! thickness D_edge, in the same units as lat. real :: Ri_trans ! The shear Richardson number in the transition @@ -271,15 +271,15 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, param_file, tr_Reg) IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB ! The following variables should be transformed into runtime parameters. - D_edge = 300.0 ! The thickness of dense fluid in the inflow. + D_edge = 300.0*GV%m_to_Z ! The thickness of dense fluid in the inflow. Ri_trans = 1.0/3.0 ! The shear Richardson number in the transition region ! region of the specified shear profile. if (.not.associated(OBC)) return - g_prime_tot = ((GV%g_Earth*GV%m_to_Z)/GV%Rho0)*2.0 + g_prime_tot = (GV%g_Earth/GV%Rho0)*2.0 Def_Rad = sqrt(D_edge*g_prime_tot) / (1.0e-4*1000.0) - tr_0 = (-D_edge*sqrt(D_edge*g_prime_tot)*0.5e3*Def_Rad) * GV%m_to_H + tr_0 = (-D_edge*sqrt(D_edge*g_prime_tot)*0.5e3*Def_Rad) * GV%Z_to_H if (OBC%number_of_segments /= 1) then call MOM_error(WARNING, 'Error in DOME OBC segment setup', .true.) diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index f94ff86272..580638e415 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -139,7 +139,7 @@ subroutine Phillips_initialize_velocity(u, v, G, GV, param_file, just_read_param fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl, "JET_HEIGHT", jet_height, & "The interface height scale associated with the \n"//& - "zonal-mean jet.", units="m", & + "zonal-mean jet.", units="m", scale=GV%m_to_Z, & fail_if_missing=.not.just_read, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index 3564ff9f3f..174cd0ac8f 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -36,7 +36,7 @@ subroutine USER_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state) !! structure. real, dimension(:), intent(out) :: Rlay !< Layer potential density. real, dimension(:), intent(out) :: g_prime !< The reduced gravity at - !! each interface, in m s-2. + !! each interface, in m2 Z-1 s-2. type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model !! parameter values. @@ -240,7 +240,7 @@ end subroutine write_user_log !! - h - Layer thickness in H. (Must be positive.) !! - G%bathyT - Basin depth in Z. (Must be positive.) !! - G%CoriolisBu - The Coriolis parameter, in s-1. -!! - GV%g_prime - The reduced gravity at each interface, in m s-2. +!! - GV%g_prime - The reduced gravity at each interface, in m2 Z-1 s-2. !! - GV%Rlay - Layer potential density (coordinate variable), kg m-3. !! If ENABLE_THERMODYNAMICS is defined: !! - T - Temperature in C. From 030b6c2d76825e90d040bec5150d20a08157fdb4 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 30 Sep 2018 12:07:46 -0400 Subject: [PATCH 123/174] +Remove g_Earth argument from set_pbce_Bous Remove g_Earth argument from set_pbce_Bous and set_pbce_nonBous, instead using the value from inside GV. Also simplified an expression converting layer thicknesses to pressure. All answers are bitwise identical. --- src/core/MOM_PressureForce_Montgomery.F90 | 25 +++++++++------------- src/core/MOM_PressureForce_analytic_FV.F90 | 4 ++-- src/core/MOM_PressureForce_blocked_AFV.F90 | 4 ++-- 3 files changed, 14 insertions(+), 19 deletions(-) diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 395dccc018..f8657fca2d 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -116,8 +116,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, ! barotropic and baroclinic pieces. type(thermo_var_ptrs) :: tv_tmp! A structure of temporary T & S. - real :: g_Earth_z ! A scaled version of g_Earth, in m2 Z-1 s-2. - real :: I_gEarth ! The inverse of g_Earth_z, in s2 Z m-2 + real :: I_gEarth ! The inverse of g_Earth, in s2 Z m-2 real :: dalpha real :: Pa_to_H ! A factor to convert from Pa to the thicknesss units (H). real :: alpha_Lay(SZK_(G)) ! The specific volume of each layer, in kg m-3. @@ -142,8 +141,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, "can no longer be used with a compressible EOS. Use #define ANALYTIC_FV_PGF.") endif - g_Earth_z = GV%g_Earth - I_gEarth = 1.0 / g_Earth_z + I_gEarth = 1.0 / GV%g_Earth dp_neglect = GV%H_to_Pa * GV%H_subroundoff do k=1,nz ; alpha_Lay(k) = 1.0 / GV%Rlay(k) ; enddo do k=2,nz ; dalpha_int(K) = alpha_Lay(k-1) - alpha_Lay(k) ; enddo @@ -202,12 +200,12 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=GV%m_to_Z) !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - geopot_bot(i,j) = -g_Earth_z*(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) = -g_Earth_z*G%bathyT(i,j) + geopot_bot(i,j) = -GV%g_Earth*G%bathyT(i,j) enddo ; enddo endif @@ -302,8 +300,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, ! Note that ddM/dPb = alpha_star(i,j,1) if (present(pbce)) then - call Set_pbce_nonBouss(p, tv_tmp, G, GV, (GV%g_Earth*GV%m_to_Z), CS%GFS_scale, pbce, & - alpha_star) + call Set_pbce_nonBouss(p, tv_tmp, G, GV, CS%GFS_scale, pbce, alpha_star) endif ! Calculate the pressure force. On a Cartesian grid, @@ -537,7 +534,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta endif ! use_EOS if (present(pbce)) then - call Set_pbce_Bouss(e, tv_tmp, G, GV, (GV%g_Earth*GV%m_to_Z), CS%Rho0, CS%GFS_scale, pbce, rho_star) + call Set_pbce_Bouss(e, tv_tmp, G, GV, CS%Rho0, CS%GFS_scale, pbce, rho_star) endif ! Calculate the pressure force. On a Cartesian grid, @@ -600,12 +597,11 @@ end subroutine PressureForce_Mont_Bouss !> Determines the partial derivative of the acceleration due !! to pressure forces with the free surface height. -subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star) +subroutine Set_pbce_Bouss(e, tv, G, GV, Rho0, GFS_scale, pbce, rho_star) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface height, in Z. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables - real, intent(in) :: g_Earth !< The gravitational acceleration, in m s-2. real, intent(in) :: Rho0 !< The "Boussinesq" ocean density, in kg m-3. real, intent(in) :: GFS_scale !< Ratio between gravity applied to top interface !! and the gravitational acceleration of the planet. @@ -635,7 +631,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = G%ke - Rho0xG = Rho0*g_Earth*GV%Z_to_m + Rho0xG = Rho0*GV%g_Earth G_Rho0 = GV%g_Earth / GV%Rho0 use_EOS = associated(tv%eqn_of_state) z_neglect = GV%H_subroundoff*GV%H_to_Z @@ -700,12 +696,11 @@ end subroutine Set_pbce_Bouss !> Determines the partial derivative of the acceleration due !! to pressure forces with the column mass. -subroutine Set_pbce_nonBouss(p, tv, G, GV, g_Earth, GFS_scale, pbce, alpha_star) +subroutine Set_pbce_nonBouss(p, tv, G, GV, GFS_scale, pbce, alpha_star) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: p !< Interface pressures, in Pa. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables - real, intent(in) :: g_Earth !< The gravitational acceleration, in m s-2. real, intent(in) :: GFS_scale !< Ratio between gravity applied to top interface !! and the gravitational acceleration of the planet. !! Usually this ratio is 1. @@ -738,7 +733,7 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, g_Earth, GFS_scale, pbce, alpha_star) use_EOS = associated(tv%eqn_of_state) - dP_dH = g_Earth * GV%H_to_kg_m2 + dP_dH = GV%H_to_Pa dp_neglect = dP_dH * GV%H_subroundoff do k=1,nz ; alpha_Lay(k) = 1.0 / GV%Rlay(k) ; enddo diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index a245b1f4d4..a27f72cae2 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -403,7 +403,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm enddo if (present(pbce)) then - call set_pbce_nonBouss(p, tv_tmp, G, GV, (GV%g_Earth*GV%m_to_Z), CS%GFS_scale, pbce) + call set_pbce_nonBouss(p, tv_tmp, G, GV, CS%GFS_scale, pbce) endif if (present(eta)) then @@ -748,7 +748,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p endif if (present(pbce)) then - call set_pbce_Bouss(e, tv_tmp, G, GV, (GV%g_Earth*GV%m_to_Z), CS%Rho0, CS%GFS_scale, pbce) + call set_pbce_Bouss(e, tv_tmp, G, GV, CS%Rho0, CS%GFS_scale, pbce) endif if (present(eta)) then diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index e53d44a88a..7cd449f86f 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -385,7 +385,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc enddo if (present(pbce)) then - call set_pbce_nonBouss(p, tv_tmp, G, GV, (GV%g_Earth*GV%m_to_Z), CS%GFS_scale, pbce) + call set_pbce_nonBouss(p, tv_tmp, G, GV, CS%GFS_scale, pbce) endif if (present(eta)) then @@ -742,7 +742,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at enddo if (present(pbce)) then - call set_pbce_Bouss(e, tv_tmp, G, GV, (GV%g_Earth*GV%m_to_Z), CS%Rho0, CS%GFS_scale, pbce) + call set_pbce_Bouss(e, tv_tmp, G, GV, CS%Rho0, CS%GFS_scale, pbce) endif if (present(eta)) then From 6aecaf77b882194dc6dbba6309337b6d55306b3c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 2 Oct 2018 14:03:43 -0400 Subject: [PATCH 124/174] Rescale MOM_continuity_PPM variables via get_param Rescale MOM_continuity_PPM variables from m to Z directly in the get_param calls that read them. All answers are bitwise identical. --- src/core/MOM_continuity_PPM.F90 | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index faa5ec79e2..bdf6e3f9b1 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -2221,6 +2221,7 @@ subroutine continuity_PPM_init(Time, G, GV, param_file, diag, CS) type(continuity_PPM_CS), pointer :: CS !< Module's control structure. !> This include declares and sets the variable "version". #include "version_variable.h" + real :: tol_eta_m ! An unscaled version of tol_eta, in m. character(len=40) :: mdl = "MOM_continuity_PPM" ! This module's name. if (associated(CS)) then @@ -2254,8 +2255,8 @@ subroutine continuity_PPM_init(Time, G, GV, param_file, diag, CS) "height due to the fluxes through each face. The total \n"//& "tolerance for SSH is 4 times this value. The default \n"//& "is 0.5*NK*ANGSTROM, and this should not be set less x\n"//& - "than about 10^-15*MAXIMUM_DEPTH.", units="m", & - default=0.5*G%ke*GV%Angstrom_m) + "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) call get_param(param_file, mdl, "ETA_TOLERANCE_AUX", CS%tol_eta_aux, & "The tolerance for free-surface height discrepancies \n"//& @@ -2263,7 +2264,7 @@ subroutine continuity_PPM_init(Time, G, GV, param_file, diag, CS) "layer thicknesses when calculating the auxiliary \n"//& "corrected velocities. By default, this is the same as \n"//& "ETA_TOLERANCE, but can be made larger for efficiency.", & - units="m", default=CS%tol_eta) + units="m", default=tol_eta_m, scale=GV%m_to_H) call get_param(param_file, mdl, "VELOCITY_TOLERANCE", CS%tol_vel, & "The tolerance for barotropic velocity discrepancies \n"//& "between the barotropic solution and the sum of the \n"//& @@ -2299,9 +2300,6 @@ subroutine continuity_PPM_init(Time, G, GV, param_file, diag, CS) id_clock_update = cpu_clock_id('(Ocean continuity update)', grain=CLOCK_ROUTINE) id_clock_correct = cpu_clock_id('(Ocean continuity correction)', grain=CLOCK_ROUTINE) - CS%tol_eta = CS%tol_eta * GV%m_to_H - CS%tol_eta_aux = CS%tol_eta_aux * GV%m_to_H - end subroutine continuity_PPM_init !> continuity_PPM_stencil returns the continuity solver stencil size From d6ada47d02b887bcaa929b3124603a0904efe445 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 2 Oct 2018 14:04:39 -0400 Subject: [PATCH 125/174] Do MOM_tidal_mixing calculations in units of Z Rescaled several of the variables in MOM_tidal_mixing to work in units of Z instead of m, for expanded dimensional consistency testing. Also updated the comments describing several variables. All answers are bitwise identical. --- .../vertical/MOM_tidal_mixing.F90 | 91 +++++++++---------- 1 file changed, 45 insertions(+), 46 deletions(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index cc6d73e3eb..a9937219ea 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -84,7 +84,7 @@ module MOM_tidal_mixing !! for dissipation of the lee waves. Schemes that are !! currently encoded are St Laurent et al (2002) and !! Polzin (2009). - real :: Int_tide_decay_scale !< decay scale for internal wave TKE (meter) + real :: Int_tide_decay_scale !< decay scale for internal wave TKE (Z) real :: Mu_itides !< efficiency for conversion of dissipation !! to potential energy (nondimensional) @@ -115,7 +115,7 @@ module MOM_tidal_mixing !! profile in Polzin formulation should not exceed !! Polzin_decay_scale_max_factor * depth of the ocean (nondimensional). real :: Polzin_min_decay_scale !< minimum decay scale of the tidal dissipation - !! profile in Polzin formulation (meter) + !! profile in Polzin formulation (Z) real :: TKE_itide_max !< maximum internal tide conversion (W m-2) !! available to mix above the BBL @@ -378,7 +378,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, "When the Polzin decay profile is used, this is the \n"//& "minimum vertical decay scale for the vertical profile\n"//& "of internal tide dissipation with the Polzin (2009) formulation", & - units="m", default=0.0) + units="m", default=0.0, scale=GV%m_to_Z) endif if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation) then @@ -386,7 +386,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, "The decay scale away from the bottom for tidal TKE with \n"//& "the new coding when INT_TIDE_DISSIPATION is used.", & !units="m", default=0.0) - units="m", default=500.0) ! TODO: confirm this new default + units="m", default=500.0, scale=GV%m_to_Z) ! TODO: confirm this new default call get_param(param_file, mdl, "MU_ITIDES", CS%Mu_itides, & "A dimensionless turbulent mixing efficiency used with \n"//& "INT_TIDE_DISSIPATION, often 0.2.", units="nondim", default=0.2) @@ -543,7 +543,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, call CVMix_init_tidal(CVmix_tidal_params_user = CS%CVMix_tidal_params, & mix_scheme = CVMix_tidal_scheme_str, & efficiency = CS%Mu_itides, & - vertical_decay_scale = CS%int_tide_decay_scale, & + vertical_decay_scale = CS%int_tide_decay_scale*GV%Z_to_m, & max_coefficient = CS%tidal_max_coef, & local_mixing_frac = CS%Gamma_itides, & depth_cutoff = CS%min_zbot_itides) @@ -772,13 +772,13 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd, Kv) CVMix_tidal_params_user = CS%CVMix_tidal_params) ! Update diffusivity - do k=1,G%ke + do k=1,G%ke ! GV%m_to_Z**2 * Kd(i,j,k) = Kd(i,j,k) + 0.5*(Kd_tidal(k) + Kd_tidal(k+1) ) enddo ! Update viscosity if (associated(Kv)) then - do k=1,G%ke+1 + do k=1,G%ke+1 ! GV%m_to_Z**2 * Kv(i,j,k) = Kv(i,j,k) + Kv_tidal(k) enddo endif @@ -871,13 +871,13 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd, Kv) CVmix_tidal_params_user = CS%CVMix_tidal_params) ! Update diffusivity - do k=1,G%ke + do k=1,G%ke ! GV%m_to_Z**2 * Kd(i,j,k) = Kd(i,j,k) + 0.5*(Kd_tidal(k) + Kd_tidal(k+1) ) enddo ! Update viscosity if (associated(Kv)) then - do k=1,G%ke+1 + do k=1,G%ke+1 ! GV%m_to_Z**2 * Kv(i,j,k) = Kv(i,j,k) + Kv_tidal(k) enddo endif @@ -947,16 +947,16 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, real, dimension(SZI_(G)) :: & htot, & ! total thickness above or below a layer, or the - ! integrated thickness in the BBL (meter) - htot_WKB, & ! distance from top to bottom (meter) WKB scaled + ! integrated thickness in the BBL (Z) + htot_WKB, & ! distance from top to bottom (Z) WKB scaled TKE_itidal_bot, & ! internal tide TKE at ocean bottom (m3/s3) TKE_Niku_bot, & ! lee-wave TKE at ocean bottom (m3/s3) TKE_lowmode_bot, & ! internal tide TKE at ocean bottom lost from all remote low modes (m3/s3) (BDM) Inv_int, & ! inverse of TKE decay for int tide over the depth of the ocean (nondim) Inv_int_lee, & ! inverse of TKE decay for lee waves over the depth of the ocean (nondim) Inv_int_low, & ! inverse of TKE decay for low modes over the depth of the ocean (nondim) (BDM) - z0_Polzin, & ! TKE decay scale in Polzin formulation (meter) - z0_Polzin_scaled, & ! TKE decay scale in Polzin formulation (meter) + z0_Polzin, & ! TKE decay scale in Polzin formulation (Z) + z0_Polzin_scaled, & ! TKE decay scale in Polzin formulation (Z) ! multiplied by N2_bot/N2_meanz to be coherent with the WKB scaled z ! z*=int(N2/N2_bot) * N2_bot/N2_meanz = int(N2/N2_meanz) ! z0_Polzin_scaled = z0_Polzin * N2_bot/N2_meanz @@ -968,8 +968,8 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, TKE_frac_top_lee, & ! fraction of bottom TKE that should appear at top of a layer (nondim) TKE_frac_top_lowmode, & ! fraction of bottom TKE that should appear at top of a layer (nondim) (BDM) - z_from_bot, & ! distance from bottom (meter) - z_from_bot_WKB ! distance from bottom (meter), WKB scaled + z_from_bot, & ! distance from bottom (Z) + z_from_bot_WKB ! distance from bottom (Z), WKB scaled real :: I_rho0 ! 1 / RHO0, (m3/kg) real :: Kd_add ! diffusivity to add in a layer (m2/sec) @@ -977,9 +977,9 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, real :: TKE_Niku_lay ! lee-wave TKE imparted to a layer (m3/s3) real :: TKE_lowmode_lay ! internal tide TKE imparted to a layer (from low mode) (m3/s3) (BDM) real :: frac_used ! fraction of TKE that can be used in a layer (nondim) - real :: Izeta ! inverse of TKE decay scale (1/meter) - real :: Izeta_lee ! inverse of TKE decay scale for lee waves (1/meter) - real :: z0_psl ! temporary variable with units of meter + real :: Izeta ! inverse of TKE decay scale (1/Z) + real :: Izeta_lee ! inverse of TKE decay scale for lee waves (1/Z) + real :: z0_psl ! temporary variable with units of Z real :: TKE_lowmode_tot ! TKE from all low modes (W/m2) (BDM) logical :: use_Polzin, use_Simmons @@ -995,7 +995,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, do i=is,ie ; htot(i) = 0.0 ; Inv_int(i) = 0.0 ; Inv_int_lee(i) = 0.0 ; Inv_int_low(i) = 0.0 ;enddo do k=1,nz ; do i=is,ie - htot(i) = htot(i) + GV%H_to_m*h(i,j,k) + htot(i) = htot(i) + GV%H_to_Z*h(i,j,k) enddo ; enddo I_Rho0 = 1.0/GV%Rho0 @@ -1010,9 +1010,9 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, ! Calculate parameters for vertical structure of dissipation ! Simmons: if ( use_Simmons ) then - Izeta = 1.0 / max(CS%Int_tide_decay_scale, GV%H_subroundoff*GV%H_to_m) + Izeta = 1.0 / max(CS%Int_tide_decay_scale, GV%H_subroundoff*GV%H_to_Z) Izeta_lee = 1.0 / max(CS%Int_tide_decay_scale*CS%Decay_scale_factor_lee, & - GV%H_subroundoff*GV%H_to_m) + GV%H_subroundoff*GV%H_to_Z) do i=is,ie CS%Nb(i,j) = sqrt(N2_bot(i)) if (associated(dd%N2_bot)) dd%N2_bot(i,j) = N2_bot(i) @@ -1031,7 +1031,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, Inv_int_low(i) = 1.0 / (1.0 - exp(-Izeta*htot(i))) endif endif - z_from_bot(i) = GV%H_to_m*h(i,j,nz) + z_from_bot(i) = GV%H_to_Z*h(i,j,nz) enddo endif ! Simmons @@ -1040,10 +1040,10 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, ! WKB scaling of the vertical coordinate do i=is,ie ; N2_meanz(i)=0.0 ; enddo do k=1,nz ; do i=is,ie - N2_meanz(i) = N2_meanz(i) + N2_lay(i,k)*GV%H_to_m*h(i,j,k) + N2_meanz(i) = N2_meanz(i) + N2_lay(i,k)*GV%H_to_Z*h(i,j,k) enddo ; enddo do i=is,ie - N2_meanz(i) = N2_meanz(i) / (htot(i) + GV%H_subroundoff*GV%H_to_m) + N2_meanz(i) = N2_meanz(i) / (htot(i) + GV%H_subroundoff*GV%H_to_Z) if (associated(dd%N2_meanz)) dd%N2_meanz(i,j) = N2_meanz(i) enddo @@ -1051,7 +1051,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, do i=is,ie ; htot_WKB(i) = htot(i) ; enddo ! do i=is,ie ; htot_WKB(i) = 0.0 ; enddo ! do k=1,nz ; do i=is,ie -! htot_WKB(i) = htot_WKB(i) + GV%H_to_m*h(i,j,k)*N2_lay(i,k) / N2_meanz(i) +! htot_WKB(i) = htot_WKB(i) + GV%H_to_Z*h(i,j,k)*N2_lay(i,k) / N2_meanz(i) ! enddo ; enddo ! htot_WKB(i) = htot(i) ! Nearly equivalent and simpler @@ -1059,7 +1059,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, CS%Nb(i,j) = sqrt(N2_bot(i)) if ((CS%tideamp(i,j) > 0.0) .and. & (CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 > 1.0e-14) ) then - z0_polzin(i) = CS%Polzin_decay_scale_factor * CS%Nu_Polzin * & + z0_polzin(i) = GV%m_to_Z * CS%Polzin_decay_scale_factor * CS%Nu_Polzin * & CS%Nbotref_Polzin**2 * CS%tideamp(i,j) / & ( CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 ) if (z0_polzin(i) < CS%Polzin_min_decay_scale) & @@ -1077,38 +1077,37 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, endif if (associated(dd%Polzin_decay_scale)) & - dd%Polzin_decay_scale(i,j) = z0_polzin(i) + dd%Polzin_decay_scale(i,j) = GV%Z_to_m * z0_polzin(i) if (associated(dd%Polzin_decay_scale_scaled)) & - dd%Polzin_decay_scale_scaled(i,j) = z0_polzin_scaled(i) + dd%Polzin_decay_scale_scaled(i,j) = GV%Z_to_m * z0_polzin_scaled(i) if (associated(dd%N2_bot)) dd%N2_bot(i,j) = CS%Nb(i,j)*CS%Nb(i,j) if ( CS%Int_tide_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then ! For the Polzin formulation, this if loop prevents the vertical ! flux of energy dissipation from having NaN values - if (htot_WKB(i) > 1.0e-14) then - Inv_int(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1 + if (htot_WKB(i) > 1.0e-14*GV%m_to_Z) then !### Avoid using this dimensional constant. + Inv_int(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1.0 endif endif if ( CS%lee_wave_dissipation .and. (CS%lee_wave_profile == POLZIN_09) ) then ! For the Polzin formulation, this if loop prevents the vertical ! flux of energy dissipation from having NaN values - if (htot_WKB(i) > 1.0e-14) then - Inv_int_lee(i) = ( z0_polzin_scaled(i)*CS%Decay_scale_factor_lee / htot_WKB(i) ) + 1 + if (htot_WKB(i) > 1.0e-14*GV%m_to_Z) then !### Avoid using this dimensional constant. + Inv_int_lee(i) = ( z0_polzin_scaled(i)*CS%Decay_scale_factor_lee / htot_WKB(i) ) + 1.0 endif endif if ( CS%Lowmode_itidal_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then ! For the Polzin formulation, this if loop prevents the vertical ! flux of energy dissipation from having NaN values - if (htot_WKB(i) > 1.0e-14) then - Inv_int_low(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1 + if (htot_WKB(i) > 1.0e-14*GV%m_to_Z) then !### Avoid using this dimensional constant. + Inv_int_low(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1.0 endif endif - z_from_bot(i) = GV%H_to_m*h(i,j,nz) - ! Use the new formulation for WKB scaling. N2 is referenced to its - ! vertical mean. - if (N2_meanz(i) > 1.0e-14 ) then - z_from_bot_WKB(i) = GV%H_to_m*h(i,j,nz)*N2_lay(i,nz) / N2_meanz(i) + z_from_bot(i) = GV%H_to_Z*h(i,j,nz) + ! Use the new formulation for WKB scaling. N2 is referenced to its vertical mean. + if (N2_meanz(i) > 1.0e-14 ) then !### Avoid using this dimensional constant. + z_from_bot_WKB(i) = GV%H_to_Z*h(i,j,nz)*N2_lay(i,nz) / N2_meanz(i) else ; z_from_bot_WKB(i) = 0 ; endif enddo endif ! Polzin @@ -1152,7 +1151,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, if ( use_Simmons ) then do k=nz-1,2,-1 ; do i=is,ie if (max_TKE(i,k) <= 0.0) cycle - z_from_bot(i) = z_from_bot(i) + GV%H_to_m*h(i,j,k) + z_from_bot(i) = z_from_bot(i) + GV%H_to_Z*h(i,j,k) ! Fraction of bottom flux predicted to reach top of this layer TKE_frac_top(i) = Inv_int(i) * exp(-Izeta * z_from_bot(i)) @@ -1167,10 +1166,10 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, ! Actual power expended may be less than predicted if stratification is weak; adjust if (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay > max_TKE(i,k)) then - frac_used = max_TKE(i,k) / (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) - TKE_itide_lay = frac_used * TKE_itide_lay - TKE_Niku_lay = frac_used * TKE_Niku_lay - TKE_lowmode_lay = frac_used * TKE_lowmode_lay + frac_used = max_TKE(i,k) / (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) + TKE_itide_lay = frac_used * TKE_itide_lay + TKE_Niku_lay = frac_used * TKE_Niku_lay + TKE_lowmode_lay = frac_used * TKE_lowmode_lay endif ! Calculate vertical flux available to bottom of layer above @@ -1233,9 +1232,9 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, if ( use_Polzin ) then do k=nz-1,2,-1 ; do i=is,ie if (max_TKE(i,k) <= 0.0) cycle - z_from_bot(i) = z_from_bot(i) + GV%H_to_m*h(i,j,k) + z_from_bot(i) = z_from_bot(i) + GV%H_to_Z*h(i,j,k) if (N2_meanz(i) > 1.0e-14 ) then - z_from_bot_WKB(i) = z_from_bot_WKB(i) + GV%H_to_m*h(i,j,k)*N2_lay(i,k)/N2_meanz(i) + z_from_bot_WKB(i) = z_from_bot_WKB(i) + GV%H_to_Z*h(i,j,k)*N2_lay(i,k)/N2_meanz(i) else ; z_from_bot_WKB(i) = 0 ; endif ! Fraction of bottom flux predicted to reach top of this layer From da4dd4246e6e5d6042984088a8fa757477f24e78 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 2 Oct 2018 14:43:31 -0400 Subject: [PATCH 126/174] Refactored diapyc_energy_req_calc N2 calculations Rescaled several of the variables in diapyc_energy_req_test to work in units of Z instead of m, and rearranged the unit convsersions in the N2 calculations to reflect anticipated future use. All answers are bitwise identical. --- .../vertical/MOM_diapyc_energy_req.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index 5248a0fb66..767e49ed89 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -89,13 +89,13 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, CS, Kd_int) h_bot(K) = h_bot(K+1) + h_col(k) enddo - ustar = 0.01 ! Change this to being an input parameter? + ustar = 0.01*GV%m_to_Z ! Change this to being an input parameter? absf = 0.25*((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & (abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J)))) Kd(1) = 0.0 ; Kd(nz+1) = 0.0 do K=2,nz - tmp1 = h_top(K) * h_bot(K) * GV%H_to_m - Kd(K) = CS%test_Kh_scaling * & + tmp1 = h_top(K) * h_bot(K) * GV%H_to_Z + Kd(K) = CS%test_Kh_scaling * GV%Z_to_m**2 * & ustar * 0.41 * (tmp1*ustar) / (absf*tmp1 + htot*ustar) enddo endif @@ -117,7 +117,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & 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(GV%ke), intent(in) :: h_in !< Layer thickness before entrainment, - !! in m or kg m-2. + !! in H (m or kg m-2). real, dimension(GV%ke), intent(in) :: T_in !< The layer temperatures, in degC. real, dimension(GV%ke), intent(in) :: S_in !< The layer salinities, in g kg-1. real, dimension(GV%ke+1), intent(in) :: Kd !< The interfaces diapycnal diffusivities, @@ -132,7 +132,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & logical, optional, intent(in) :: may_print !< If present and true, write out diagnostics !! of energy use. type(diapyc_energy_req_CS), & - optional, pointer :: CS !< This module's control structure. + optional, pointer :: CS !< This module's control structure. ! This subroutine uses a substantially refactored tridiagonal equation for ! diapycnal mixing of temperature and salinity to estimate the potential energy @@ -931,7 +931,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & do K=2,nz call calculate_density(0.5*(T0(k-1) + T0(k)), 0.5*(S0(k-1) + S0(k)), & pres(K), rho_here, tv%eqn_of_state) - N2(K) = ((GV%g_Earth*GV%m_to_Z) * rho_here / (0.5*GV%H_to_m*(h_tr(k-1) + h_tr(k)))) * & + N2(K) = ((GV%g_Earth*GV%m_to_Z**2) * rho_here / (0.5*GV%H_to_Z*(h_tr(k-1) + h_tr(k)))) * & ( 0.5*(dSV_dT(k-1) + dSV_dT(k)) * (T0(k-1) - T0(k)) + & 0.5*(dSV_dS(k-1) + dSV_dS(k)) * (S0(k-1) - S0(k)) ) enddo @@ -942,7 +942,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & do K=2,nz call calculate_density(0.5*(Tf(k-1) + Tf(k)), 0.5*(Sf(k-1) + Sf(k)), & pres(K), rho_here, tv%eqn_of_state) - N2(K) = ((GV%g_Earth*GV%m_to_Z) * rho_here / (0.5*GV%H_to_m*(h_tr(k-1) + h_tr(k)))) * & + N2(K) = ((GV%g_Earth*GV%m_to_Z**2) * rho_here / (0.5*GV%H_to_Z*(h_tr(k-1) + h_tr(k)))) * & ( 0.5*(dSV_dT(k-1) + dSV_dT(k)) * (Tf(k-1) - Tf(k)) + & 0.5*(dSV_dS(k-1) + dSV_dS(k)) * (Sf(k-1) - Sf(k)) ) enddo From cf567b2b4d7586b5a057f82a2c1e4f5543ba91b0 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 3 Oct 2018 07:05:52 -0400 Subject: [PATCH 127/174] +(*)Added m_to_Z and m_to_H to restart files Added m_to_Z and m_to_H as optional fields in the MOM6 restart files, along with the ability to rescale units or change from Boussinesq to non-Boussinesq or vice versa over a restart. Also added code to rescale restart variables when the internal representation of thicknesses have changed, which required adding a new restart_CSp argument to mixedlayer_restrat_init. All answers are bitwise identical in test cases, and it has been verified that answers are unchanged when H_to_m changes across a restart in the Baltic_OM4_05 test case. --- src/core/MOM.F90 | 24 +++++++++--- src/core/MOM_barotropic.F90 | 16 +++++--- src/core/MOM_dynamics_split_RK2.F90 | 18 ++++++++- src/core/MOM_verticalGrid.F90 | 13 ++++++- .../MOM_state_initialization.F90 | 11 ++++-- .../lateral/MOM_mixed_layer_restrat.F90 | 37 ++++++++++++++++--- 6 files changed, 97 insertions(+), 22 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index deef3fa629..aa34a5a181 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -114,6 +114,7 @@ module MOM use MOM_variables, only : thermo_var_ptrs, vertvisc_type use MOM_variables, only : accel_diag_ptrs, cont_diag_ptrs, ocean_internal_state use MOM_verticalGrid, only : verticalGrid_type, verticalGridInit, verticalGridEnd +use MOM_verticalGrid, only : fix_restart_scaling use MOM_verticalGrid, only : get_thickness_units, get_flux_units, get_tr_flux_units use MOM_wave_interface, only : wave_parameters_CS, waves_end use MOM_wave_interface, only : Update_Stokes_Drift @@ -2324,7 +2325,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call thickness_diffuse_init(Time, G, GV, param_file, diag, CS%CDp, CS%thickness_diffuse_CSp) CS%mixedlayer_restrat = mixedlayer_restrat_init(Time, G, GV, param_file, diag, & - CS%mixedlayer_restrat_CSp) + CS%mixedlayer_restrat_CSp, restart_CSp) if (CS%mixedlayer_restrat) then if (.not.(bulkmixedlayer .or. CS%use_ALE_algorithm)) & call MOM_error(FATAL, "MOM: MIXEDLAYER_RESTRAT true requires a boundary layer scheme.") @@ -2448,17 +2449,19 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & .not.((dirs%input_filename(1:1) == 'r') .and. & (LEN_TRIM(dirs%input_filename) == 1)) - if (CS%ensemble_ocean) then - call init_oda(Time, G, GV, CS%odaCS) + call init_oda(Time, G, GV, CS%odaCS) endif + !### This could perhaps go here instead of in finish_MOM_initialization? + ! call fix_restart_scaling(GV) + call callTree_leave("initialize_MOM()") call cpu_clock_end(id_clock_init) end subroutine initialize_MOM -!> Finishe initializing MOM and writes out the initial conditions. +!> Finishes initializing MOM and writes out the initial conditions. subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) type(time_type), intent(in) :: Time !< model time, used in this routine type(directories), intent(in) :: dirs !< structure with directory paths @@ -2478,6 +2481,9 @@ subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) ! Pointers for convenience G => CS%G ; GV => CS%GV + !### Move to initialize_MOM? + call fix_restart_scaling(GV) + ! Write initial conditions if (CS%write_IC) then allocate(restart_CSp_tmp) @@ -2616,10 +2622,16 @@ subroutine set_restart_fields(GV, param_file, CS, restart_CSp) call get_param(param_file, '', "ICE_SHELF", use_ice_shelf, default=.false., & do_not_log=.true.) if (use_ice_shelf .and. associated(CS%Hml)) then - call register_restart_field(CS%Hml, "hML", .false., restart_CSp, & - "Mixed layer thickness", "meter") + call register_restart_field(CS%Hml, "hML", .false., restart_CSp, & + "Mixed layer thickness", "meter") endif + ! Register scalar unit conversion factors. + call register_restart_field(GV%m_to_Z_restart, "m_to_Z", .false., restart_CSp, & + "Height unit conversion factor", "Z meter-1") + call register_restart_field(GV%m_to_H_restart, "m_to_H", .false., restart_CSp, & + "Thickness unit conversion factor", "Z meter-1") + end subroutine set_restart_fields !> Apply a correction to the sea surface height to compensate diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 733cf7a9d2..17d0779ef1 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -2639,11 +2639,11 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, MS, halo, use_BT_co endif else if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then - BT_OBC%H_u(i,j) = eta(i,j) - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%bathyT(i,j) + GV%m_to_Z*eta(i,j))) !### * GV%H_to_m? + BT_OBC%H_u(I,j) = eta(i,j) + BT_OBC%Cg_u(I,j) = SQRT(GV%g_prime(1) * (G%bathyT(i,j) + GV%m_to_Z*eta(i,j))) !### * GV%H_to_m? elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then - BT_OBC%H_u(i,j) = eta(i+1,j) - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%bathyT(i+1,j) + GV%m_to_Z*eta(i+1,j))) !### * GV%H_to_m? + BT_OBC%H_u(I,j) = eta(i+1,j) + BT_OBC%Cg_u(I,j) = SQRT(GV%g_prime(1) * (G%bathyT(i+1,j) + GV%m_to_Z*eta(i+1,j))) !### * GV%H_to_m? endif endif if (GV%Boussinesq) then @@ -3732,6 +3732,8 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & ! drag piston velocity. character(len=80) :: wave_drag_var ! The wave drag piston velocity variable ! name in wave_drag_file. + real :: uH_rescale ! A rescaling factor for thickness transports from the representation in + ! a restart file to the internal representation in this run. real, allocatable, dimension(:,:) :: lin_drag_h type(memory_size_type) :: MS type(group_pass_type) :: pass_static_data, pass_q_D_Cor @@ -4330,6 +4332,10 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & .NOT.query_initialized(CS%vhbt_IC,"vhbt_IC",restart_CS)) then do j=js,je ; do I=is-1,ie ; CS%uhbt_IC(I,j) = CS%ubtav(I,j) * Datu(I,j) ; enddo ; enddo do J=js-1,je ; do i=is,ie ; CS%vhbt_IC(i,J) = CS%vbtav(i,J) * Datv(i,J) ; enddo ; enddo + elseif ((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 + do j=js,je ; do I=is-1,ie ; CS%uhbt_IC(I,j) = uH_rescale * CS%uhbt_IC(I,j) ; enddo ; enddo + do J=js-1,je ; do i=is,ie ; CS%vhbt_IC(i,J) = uH_rescale * CS%vhbt_IC(I,j) ; enddo ; enddo endif call create_group_pass(pass_bt_hbt_btav, CS%ubt_IC, CS%vbt_IC, G%Domain) @@ -4414,7 +4420,7 @@ subroutine register_barotropic_restarts(HI, GV, param_file, CS, restart_CS) call register_restart_field(CS%vbt_IC, vd(3), .false., restart_CS) if (GV%Boussinesq) then - vd(2) = var_desc("uhbt_IC", "m3 s-1", & + vd(2) = var_desc("uhbt_IC", "m3 s-1", & longname="Next initial condition for the barotropic zonal transport", & hor_grid='u', z_grid='1') vd(3) = var_desc("vhbt_IC", "m3 s-1", & diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 30db43cc0c..8ab7e0d337 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -992,6 +992,10 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_fil real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_tmp character(len=40) :: mdl = "MOM_dynamics_split_RK2" ! This module's name. 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 :: uH_rescale ! A rescaling factor for thickness transports 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 @@ -1115,6 +1119,9 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_fil do k=1,nz ; do j=js,je ; do i=is,ie CS%eta(i,j) = CS%eta(i,j) + h(i,j,k) enddo ; enddo ; enddo + elseif ((GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= GV%m_to_H)) then + H_rescale = GV%m_to_H / GV%m_to_H_restart + do j=js,je ; do i=is,ie ; CS%eta(i,j) = H_rescale * CS%eta(i,j) ; enddo ; enddo endif ! Copy eta into an output array. do j=js,je ; do i=is,ie ; eta(i,j) = CS%eta(i,j) ; enddo ; enddo @@ -1141,8 +1148,17 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_fil call pass_var(h_tmp, G%Domain, clock=id_clock_pass_init) CS%h_av(:,:,:) = 0.5*(h(:,:,:) + h_tmp(:,:,:)) else - if (.not. query_initialized(CS%h_av,"h2",restart_CS)) & + if (.not. query_initialized(CS%h_av,"h2",restart_CS)) then CS%h_av(:,:,:) = h(:,:,:) + elseif ((GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= GV%m_to_H)) then + 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 + 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 endif call cpu_clock_begin(id_clock_pass_init) diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index b2ef2dda6a..7b7feadb3c 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -11,7 +11,7 @@ module MOM_verticalGrid #include public verticalGridInit, verticalGridEnd -public setVerticalGridAxes +public setVerticalGridAxes, fix_restart_scaling public get_flux_units, get_thickness_units, get_tr_flux_units !> Describes the vertical ocean grid, including unit conversion factors @@ -56,6 +56,9 @@ module MOM_verticalGrid real :: Z_to_m !< A constant that translates distances in the units of depth to m. real :: H_to_Z !< A constant that translates thickness units to the units of depth. real :: Z_to_H !< A constant that translates depth units to thickness units. + + real :: m_to_Z_restart = 0.0 !< A copy of the m_to_Z that is used in restart files. + real :: m_to_H_restart = 0.0 !< A copy of the m_to_H that is used in restart files. end type verticalGrid_type contains @@ -171,6 +174,14 @@ subroutine verticalGridInit( param_file, GV ) end subroutine verticalGridInit +!> Set the scaling factors for restart files to the scaling factors for this run. +subroutine fix_restart_scaling(GV) + type(verticalGrid_type), intent(inout) :: GV !< The ocean's vertical grid structure + + GV%m_to_Z_restart = GV%m_to_Z + GV%m_to_H_restart = GV%m_to_H +end subroutine fix_restart_scaling + !> Returns the model's thickness units, usually m or kg/m^2. function get_thickness_units(GV) character(len=48) :: get_thickness_units !< The vertical thickness units diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 0046a4f168..02ca818dfb 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -147,6 +147,9 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, 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, in s. logical :: from_Z_file, useALE logical :: new_sim integer :: write_geom @@ -159,7 +162,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & ! by a large surface pressure, such as with an ice sheet. logical :: regrid_accelerate integer :: regrid_iterations - logical :: Analytic_FV_PGF, obsol_test +! logical :: Analytic_FV_PGF, obsol_test logical :: convert logical :: just_read ! If true, only read the parameters because this ! is a run from a restart file; this option @@ -174,8 +177,6 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB - real :: dt - 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 isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -486,6 +487,10 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & call restore_state(dirs%input_filename, dirs%restart_input_dir, Time, & G, restart_CS) if (present(Time_in)) Time = Time_in + if ((GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= GV%m_to_H)) then + 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 endif if ( use_temperature ) then diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index c9939b6693..78993633b3 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -15,7 +15,7 @@ module MOM_mixed_layer_restrat use MOM_hor_index, only : hor_index_type use MOM_io, only : vardesc, var_desc use MOM_lateral_mixing_coeffs, only : VarMix_CS -use MOM_restart, only : register_restart_field, MOM_restart_CS +use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density @@ -771,17 +771,22 @@ end subroutine mixedlayer_restrat_BML !> Initialize the mixed layer restratification module -logical function mixedlayer_restrat_init(Time, G, GV, param_file, diag, CS) +logical function mixedlayer_restrat_init(Time, G, GV, param_file, diag, CS, restart_CS) type(time_type), intent(in) :: Time !< Current model time type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(param_file_type), intent(in) :: param_file !< Parameter file to parse type(diag_ctrl), target, intent(inout) :: diag !< Regulate diagnostics type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure + ! Local variables -! This include declares and sets the variable "version". -#include "version_variable.h" - real :: flux_to_kg_per_s + real :: H_rescale ! A rescaling factor for thicknesses from the representation in + ! a restart file to the internal representation in this run. + real :: flux_to_kg_per_s ! A unit conversion factor for fluxes. + ! This include declares and sets the variable "version". +# include "version_variable.h" + integer :: i, j ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") @@ -888,6 +893,26 @@ logical function mixedlayer_restrat_init(Time, G, GV, param_file, diag, CS) CS%id_vml = register_diag_field('ocean_model', 'vml_restrat', diag%axesCv1, Time, & 'Surface meridional velocity component of mixed layer restratification', 'm s-1') + ! 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 + if (query_initialized(CS%MLD_filtered, "MLD_MLE_filtered", restart_CS) .and. & + (GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= GV%m_to_H)) then + H_rescale = GV%m_to_H / GV%m_to_H_restart + do j=G%jsc,G%jec ; do i=G%isc,G%iec + CS%MLD_filtered(i,j) = H_rescale * CS%MLD_filtered(i,j) + enddo ; enddo + endif + endif + if (CS%MLE_MLD_decay_time2>0.) then + if (query_initialized(CS%MLD_filtered_slow, "MLD_MLE_filtered_slow", restart_CS) .and. & + (GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= GV%m_to_H)) then + H_rescale = GV%m_to_H / GV%m_to_H_restart + do j=G%jsc,G%jec ; do i=G%isc,G%iec + CS%MLD_filtered_slow(i,j) = H_rescale * CS%MLD_filtered_slow(i,j) + enddo ; enddo + endif + endif + ! If MLD_filtered is being used, we need to update halo regions after a restart if (associated(CS%MLD_filtered)) call pass_var(CS%MLD_filtered, G%domain) @@ -899,7 +924,7 @@ subroutine mixedlayer_restrat_register_restarts(HI, param_file, CS, restart_CS) type(hor_index_type), intent(in) :: HI !< Horizontal index structure type(param_file_type), intent(in) :: param_file !< Parameter file to parse type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure - type(MOM_restart_CS), pointer :: restart_CS !< Restart structure + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure ! Local variables type(vardesc) :: vd logical :: mixedlayer_restrat_init From ecefa4c7d9d32403319732e0f833b8c0e49c53ec Mon Sep 17 00:00:00 2001 From: "Jessica.Liptak" Date: Wed, 3 Oct 2018 09:45:19 -0400 Subject: [PATCH 128/174] added mol_wt dummy argument to atmos_ocean_fluxes in solo_driver --- config_src/solo_driver/atmos_ocean_fluxes.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/config_src/solo_driver/atmos_ocean_fluxes.F90 b/config_src/solo_driver/atmos_ocean_fluxes.F90 index 5494954398..76c0941c18 100644 --- a/config_src/solo_driver/atmos_ocean_fluxes.F90 +++ b/config_src/solo_driver/atmos_ocean_fluxes.F90 @@ -13,7 +13,7 @@ module atmos_ocean_fluxes_mod !> This subroutine duplicates an interface used by the FMS coupler, but only !! returns a value of -1. None of the arguments are used for anything. function aof_set_coupler_flux(name, flux_type, implementation, atm_tr_index, & - param, flag, ice_restart_file, ocean_restart_file, & + param, flag, mol_wt, ice_restart_file, ocean_restart_file, & units, caller, verbosity) result (coupler_index) character(len=*), intent(in) :: name !< An unused argument @@ -22,6 +22,7 @@ function aof_set_coupler_flux(name, flux_type, implementation, atm_tr_index, integer, optional, intent(in) :: atm_tr_index !< An unused argument real, dimension(:), optional, intent(in) :: param !< An unused argument logical, dimension(:), optional, intent(in) :: flag !< An unused argument + real, intent(in), optional :: mol_wt !< An unused argument character(len=*), optional, intent(in) :: ice_restart_file !< An unused argument character(len=*), optional, intent(in) :: ocean_restart_file !< An unused argument character(len=*), optional, intent(in) :: units !< An unused argument From ced9c35fc8dc6a8102728463bef4c88441bdf106 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 3 Oct 2018 13:08:19 -0400 Subject: [PATCH 129/174] +Changed the units of visc%kv_slow to Z-2 s-1 Rescaled the units of visc%kv_slow from m2 s-1 to Z2 s-1 for dimensional consistency testing. This required the addition of a new restart_CSp argument to set_visc_init. Also, some new 1-d variables were added to avoid using array sections as subroutine arguments. All answers are bitwise identical, including rescaling Z over a large range. --- src/core/MOM.F90 | 2 +- src/core/MOM_variables.F90 | 2 +- .../vertical/MOM_bkgnd_mixing.F90 | 56 ++++++++++--------- .../vertical/MOM_diabatic_driver.F90 | 17 +++--- .../vertical/MOM_set_diffusivity.F90 | 2 +- .../vertical/MOM_set_viscosity.F90 | 42 ++++++++++++-- .../vertical/MOM_tidal_mixing.F90 | 14 ++--- .../vertical/MOM_vert_friction.F90 | 12 ++-- 8 files changed, 90 insertions(+), 57 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index aa34a5a181..c117aad3b1 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2290,7 +2290,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & CS%useMEKE = MEKE_init(Time, G, param_file, diag, CS%MEKE_CSp, CS%MEKE, restart_CSp) call VarMix_init(Time, G, param_file, diag, CS%VarMix) - call set_visc_init(Time, G, GV, param_file, diag, CS%visc, CS%set_visc_CSp, CS%OBC) + call set_visc_init(Time, G, GV, param_file, diag, CS%visc, CS%set_visc_CSp, restart_CSp, CS%OBC) 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, & diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index a2b0db9fb6..b7c89140d7 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -243,7 +243,7 @@ module MOM_variables !! corner columns, in m2 s-1. real, pointer, dimension(:,:,:) :: Kv_slow => NULL() !< The turbulent vertical viscosity component due to "slow" processes (e.g., tidal, - !! background, convection etc), in m2 s-1. + !! background, convection etc), in Z2 s-1. real, pointer, dimension(:,:,:) :: TKE_turb => NULL() !< The turbulent kinetic energy per unit mass at the interfaces, in m2 s-2. !! This may be at the tracer or corner points diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index d25cb8592d..1151044ff3 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -30,7 +30,7 @@ module MOM_bkgnd_mixing public sfc_bkgnd_mixing !> Control structure including parameters for this module. -type, public :: bkgnd_mixing_cs +type, public :: bkgnd_mixing_cs ! TODO: private ! Parameters real :: Bryan_Lewis_c1 !< The vertical diffusivity values for Bryan-Lewis profile @@ -254,9 +254,9 @@ end subroutine bkgnd_mixing_init !> Get surface vertical background diffusivities/viscosities. subroutine sfc_bkgnd_mixing(G, CS) - type(ocean_grid_type), intent(in) :: G !< Grid structure. - type(bkgnd_mixing_cs), pointer, intent(inout) :: CS !< The control structure returned by - !! a previous call to bkgnd_mixing_init. + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(bkgnd_mixing_cs), pointer, intent(inout) :: CS !< The control structure returned by + !! a previous call to bkgnd_mixing_init. ! local variables real :: I_x30 !< 2/acos(2) = 1/(sin(30 deg) * acosh(1/sin(30 deg))) real :: deg_to_rad !< factor converting degrees to radians, pi/180. @@ -305,23 +305,25 @@ end subroutine sfc_bkgnd_mixing !> Calculates the vertical background diffusivities/viscosities -subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, kv, j, G, GV, CS) +subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, CS) type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. - real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay!< squared buoyancy frequency associated + real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay !< squared buoyancy frequency associated !! with layers (1/s2) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: kd_lay!< Diapycnal diffusivity of each layer m2 s-1. - real, dimension(:,:,:), pointer :: kv !< The "slow" vertical viscosity at each interface - !! (not layer!) in m2 s-1. - integer, intent(in) :: j !< Meridional grid indice. - type(bkgnd_mixing_cs), pointer :: CS !< The control structure returned by + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: kd_lay !< Diapycnal diffusivity of each layer m2 s-1. + real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface + !! (not layer!) in Z2 s-1 + integer, intent(in) :: j !< Meridional grid index + type(bkgnd_mixing_cs), pointer :: CS !< The control structure returned by !! a previous call to bkgnd_mixing_init. ! local variables - real, dimension(SZI_(G), SZK_(G)+1) :: depth_2d !< distance from surface of an interface (m) + real, dimension(SZK_(G)+1) :: depth_int !< distance from surface of the interfaces (m) + real, dimension(SZK_(G)+1) :: Kd_col !< Diffusivities at the interfaces (m2 s-1) + real, dimension(SZK_(G)+1) :: Kv_col !< Viscosities at the interfaces (m2 s-1) real, dimension(SZI_(G)) :: & depth !< distance from surface of an interface (meter) real :: depth_c !< depth of the center of a layer (meter) @@ -341,31 +343,33 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, kv, j, G, GV, CS) deg_to_rad = atan(1.0)/45.0 ! = PI/180 epsilon = 1.e-10 - depth_2d(:,:) = 0.0 ! Set up the background diffusivity. if (CS%Bryan_Lewis_diffusivity) then do i=is,ie + depth_int(1) = 0.0 do k=2,nz+1 - depth_2d(i,k) = depth_2d(i,k-1) + GV%H_to_m*h(i,j,k-1) + depth_int(k) = depth_int(k-1) + GV%H_to_m*h(i,j,k-1) enddo call CVMix_init_bkgnd(max_nlev=nz, & - zw = depth_2d(i,:), & !< interface depth, must be positive. + zw = depth_int(:), & !< interface depths relative to the surface in m, must be positive. bl1 = CS%Bryan_Lewis_c1, & bl2 = CS%Bryan_Lewis_c2, & bl3 = CS%Bryan_Lewis_c3, & bl4 = CS%Bryan_Lewis_c4, & prandtl = CS%prandtl_bkgnd) - call CVMix_coeffs_bkgnd(Mdiff_out=CS%kv_bkgnd(i,j,:), & - Tdiff_out=CS%kd_bkgnd(i,j,:), & - nlev=nz, & - max_nlev=nz) + Kd_col(:) = 0.0 ; Kv_col(:) = 0.0 ! Is this line necessary? + call CVMix_coeffs_bkgnd(Mdiff_out=Kv_col, Tdiff_out=Kd_col, nlev=nz, max_nlev=nz) - ! Update Kd + ! Update Kd and Kv. + do K=1,nz+1 + CS%Kv_bkgnd(i,j,K) = Kv_col(K) + CS%Kd_bkgnd(i,j,K) = Kd_col(K) + enddo do k=1,nz - kd_lay(i,j,k) = kd_lay(i,j,k) + 0.5*(CS%kd_bkgnd(i,j,K) + CS%kd_bkgnd(i,j,K+1)) + kd_lay(i,j,k) = kd_lay(i,j,k) + 0.5*(Kd_col(K) + Kd_col(K+1)) enddo enddo ! i loop @@ -413,13 +417,11 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, kv, j, G, GV, CS) enddo endif - ! Update kv + ! Update Kv if (associated(kv)) then - do i=is,ie - do k=1,nz+1 - kv(i,j,k) = kv(i,j,k) + CS%kv_bkgnd(i,j,k) - enddo - enddo + do k=1,nz+1 ; do i=is,ie + Kv(i,j,k) = Kv(i,j,k) + GV%m_to_Z**2 * CS%kv_bkgnd(i,j,k) + enddo ; enddo endif end subroutine calculate_bkgnd_mixing diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 262e6bcaed..b909d5ba66 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -594,7 +594,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call cpu_clock_begin(id_clock_kpp) ! total vertical viscosity in the interior is represented via visc%Kv_shear do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kv_shear(i,j,k) = visc%Kv_shear(i,j,k) + visc%Kv_slow(i,j,k) + visc%Kv_shear(i,j,k) = visc%Kv_shear(i,j,k) + GV%Z_to_m**2*visc%Kv_slow(i,j,k) enddo ; enddo ; enddo ! KPP needs the surface buoyancy flux but does not update state variables. @@ -693,7 +693,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%useKPP) then visc%Kv_shear(i,j,k) = visc%Kv_shear(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) else - visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) + visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + GV%m_to_Z**2 * CS%CVMix_conv_csp%kv_conv(i,j,k) endif enddo ; enddo ; enddo !$OMP end parallel @@ -1577,12 +1577,13 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%use_CVMix_conv) then call calculate_CVMix_conv(h, tv, G, GV, CS%CVMix_conv_csp, Hml) - !!!!!!!! GMM, the following needs to be checked !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - do k=1,nz ; do j=js,je ; do i=is,ie - Kd_int(i,j,k) = Kd_int(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) - visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) - enddo ; enddo ; enddo - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!! GMM, the following needs to be checked !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !### The vertical extent here is more limited that Kv_slow or Kd_int; it might be k=1,nz+1. + do k=1,nz ; do j=js,je ; do i=is,ie + Kd_int(i,j,k) = Kd_int(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) + visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + GV%m_to_Z**2 * CS%CVMix_conv_csp%kv_conv(i,j,k) + enddo ; enddo ; enddo + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! endif diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index f185f5aab4..57cb50d431 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -292,7 +292,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! If nothing else is specified, this will be the value used. Kd(:,:,:) = CS%Kd Kd_int(:,:,:) = CS%Kd - if (associated(visc%Kv_slow)) visc%Kv_slow(:,:,:) = CS%Kv + if (associated(visc%Kv_slow)) visc%Kv_slow(:,:,:) = GV%m_to_Z**2 * CS%Kv ! Set up arrays for diagnostics. diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 1b37cb23e9..ce7d089b7b 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -18,7 +18,7 @@ module MOM_set_visc use MOM_cvmix_shear, only : cvmix_shear_is_used use MOM_cvmix_conv, only : cvmix_conv_is_used use MOM_CVMix_ddiff, only : CVMix_ddiff_is_used -use MOM_restart, only : register_restart_field, MOM_restart_CS +use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS use MOM_safe_alloc, only : safe_alloc_ptr, safe_alloc_alloc use MOM_variables, only : thermo_var_ptrs use MOM_variables, only : vertvisc_type @@ -1720,8 +1720,7 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical !! viscosities and related fields. !! Allocated here. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control - !! structure. + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. ! Local variables logical :: use_kappa_shear, KS_at_vertex logical :: adiabatic, useKPP, useEPBL @@ -1795,7 +1794,7 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) end subroutine set_visc_register_restarts !> Initializes the MOM_set_visc control structure -subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) +subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, restart_CS, OBC) 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 !< The ocean's vertical grid structure. @@ -1807,12 +1806,16 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) !! related fields. Allocated here. type(set_visc_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. type(ocean_OBC_type), pointer :: OBC !< A pointer to an open boundary condition structure ! Local variables real :: Csmag_chan_dflt, smag_const1, TKE_decay_dflt, bulk_Ri_ML_dflt real :: Kv_background real :: omega_frac_dflt - integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz, i, j, n + real :: Z_rescale ! A rescaling factor for heights from the representation in + ! a reastart fole to the internal representation in this run. + integer :: i, j, k, is, ie, js, je, n + integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz logical :: use_kappa_shear, adiabatic, use_omega logical :: use_CVMix_ddiff, differential_diffusion, use_KPP type(OBC_segment_type), pointer :: segment => NULL() ! pointer to OBC segment type @@ -1829,10 +1832,10 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) CS%OBC => OBC + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec 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 - CS%diag => diag ! Set default, read and log parameters @@ -2054,6 +2057,33 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) diag%axesCv1, Time, 'Number of layers in viscous mixed layer at v points', 'm') endif + if ((GV%m_to_Z_restart /= 0.0) .and. (GV%m_to_Z_restart /= GV%m_to_Z)) then + Z_rescale = GV%m_to_Z / GV%m_to_Z_restart +! if (allocated(visc%Kd_shear)) then ; if (query_initialized(visc%Kd_shear, "Kd_shear", restart_CS)) then +! do k=1,nz+1 ; do j=js,je ; do i=is,ie +! visc%Kd_shear(i,j,k) = Z_rescale**2 * visc%Kd_shear(i,j,k) +! enddo ; enddo ; enddo +! endif ; endif + +! if (allocated(visc%Kv_shear)) then ; if (query_initialized(visc%Kv_shear, "Kv_shear", restart_CS)) then +! do k=1,nz+1 ; do j=js,je ; do i=is,ie +! visc%Kv_shear(i,j,k) = Z_rescale**2 * visc%Kv_shear(i,j,k) +! enddo ; enddo ; enddo +! endif ; endif + +! if (allocated(visc%Kv_shear_Bu)) then ; if (query_initialized(visc%Kv_shear_Bu, "Kv_shear_Bu", restart_CS)) then +! do k=1,nz+1 ; do j=js,je ; do i=is,ie +! visc%Kv_shear_Bu(i,j,k) = Z_rescale**2 * visc%Kv_shear_Bu(i,j,k) +! enddo ; enddo ; enddo +! endif ; endif + + if (associated(visc%Kv_slow)) then ; if (query_initialized(visc%Kv_slow, "Kv_slow", restart_CS)) then + do k=1,nz+1 ; do j=js,je ; do i=is,ie + visc%Kv_slow(i,j,k) = Z_rescale**2 * visc%Kv_slow(i,j,k) + enddo ; enddo ; enddo + endif ; endif + endif + end subroutine set_visc_init !> This subroutine dellocates any memory in the set_visc control structure. diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index a9937219ea..8e5f016351 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -675,7 +675,7 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & !! diffusivity due to TKE-based processes, in m2 s-1. !! Set this to a negative value to have no limit. real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface - !! (not layer!) in m2 s-1. + !! (not layer!) in Z2 s-1. if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation .or. CS%Lowmode_itidal_dissipation) then if (CS%use_CVMix_tidal) then @@ -703,7 +703,7 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd, Kv) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: Kd !< The diapycnal diffusivities in the layers, in m2 s-1 real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface - !! (not layer!) in m2 s-1. + !! (not layer!) in Z2 s-1. ! Local variables real, dimension(SZK_(G)+1) :: Kd_tidal ! tidal diffusivity [m2/s] real, dimension(SZK_(G)+1) :: Kv_tidal ! tidal viscosity [m2/s] @@ -776,10 +776,10 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd, Kv) Kd(i,j,k) = Kd(i,j,k) + 0.5*(Kd_tidal(k) + Kd_tidal(k+1) ) enddo - ! Update viscosity + ! Update viscosity with the proper unit conversion. if (associated(Kv)) then - do k=1,G%ke+1 ! GV%m_to_Z**2 * - Kv(i,j,k) = Kv(i,j,k) + Kv_tidal(k) + do k=1,G%ke+1 + Kv(i,j,k) = Kv(i,j,k) + GV%m_to_Z**2 * Kv_tidal(k) enddo endif @@ -877,8 +877,8 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd, Kv) ! Update viscosity if (associated(Kv)) then - do k=1,G%ke+1 ! GV%m_to_Z**2 * - Kv(i,j,k) = Kv(i,j,k) + Kv_tidal(k) + do k=1,G%ke+1 + Kv(i,j,k) = Kv(i,j,k) + GV%m_to_Z**2 * Kv_tidal(k) enddo endif diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 7eb6ae5436..2c558592d0 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1196,14 +1196,14 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, ! GMM/ A factor of 2 is also needed here, see comment above from BGR. if (work_on_u) then do K=2,nz ; do i=is,ie ; if (do_i(i)) then - Kv_add(i,K) = Kv_add(i,K) + 1.0 * m2_to_Z2*(visc%Kv_slow(i,j,k) + visc%Kv_slow(i+1,j,k)) + Kv_add(i,K) = Kv_add(i,K) + 1.0 * (visc%Kv_slow(i,j,k) + visc%Kv_slow(i+1,j,k)) endif ; enddo ; enddo if (do_OBCs) then do I=is,ie ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then - do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * m2_to_Z2*visc%Kv_slow(i,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * visc%Kv_slow(i,j,k) ; enddo elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then - do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * m2_to_Z2*visc%Kv_slow(i+1,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * visc%Kv_slow(i+1,j,k) ; enddo endif endif ; enddo endif @@ -1218,9 +1218,9 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, if (do_OBCs) then do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then - do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * m2_to_Z2*visc%Kv_slow(i,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * visc%Kv_slow(i,j,k) ; enddo elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then - do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * m2_to_Z2*visc%Kv_slow(i,j+1,k) ; enddo + do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * visc%Kv_slow(i,j+1,k) ; enddo endif endif ; enddo endif @@ -1734,7 +1734,7 @@ subroutine vertvisc_init(MIS, Time, G, GV, param_file, diag, ADp, dirs, & ALLOC_(CS%h_v(isd:ied,JsdB:JedB,nz)) ; CS%h_v(:,:,:) = 0.0 CS%id_Kv_slow = register_diag_field('ocean_model', 'Kv_slow', diag%axesTi, Time, & - 'Slow varying vertical viscosity', 'm2 s-1') + 'Slow varying vertical viscosity', 'm2 s-1', conversion=GV%Z_to_m**2) CS%id_Kv_u = register_diag_field('ocean_model', 'Kv_u', diag%axesCuL, Time, & 'Total vertical viscosity at u-points', 'm2 s-1', conversion=GV%Z_to_m**2) From 256d88735014222c8c23475b682c7ce48b742a53 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 3 Oct 2018 15:13:07 -0400 Subject: [PATCH 130/174] +Changed the units of visc%kv_shear to Z-2 s-1 Rescaled the units of visc%kv_shear and visc%Kv_shear_Bu from m2 s-1 to Z2 s-1 for dimensional consistency testing. All answers are bitwise identical, including rescaling Z over a large range. --- src/core/MOM_variables.F90 | 4 +-- .../vertical/MOM_CVMix_KPP.F90 | 16 +++++----- .../vertical/MOM_CVMix_shear.F90 | 29 ++++++++++++------- .../vertical/MOM_diabatic_driver.F90 | 13 +++++---- .../vertical/MOM_kappa_shear.F90 | 12 ++++---- .../vertical/MOM_set_diffusivity.F90 | 12 ++++---- .../vertical/MOM_set_viscosity.F90 | 22 +++++++------- .../vertical/MOM_vert_friction.F90 | 16 +++++----- 8 files changed, 66 insertions(+), 58 deletions(-) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index b7c89140d7..7c976d2fa1 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -237,10 +237,10 @@ module MOM_variables !! in tracer columns, in m2 s-1. real, pointer, dimension(:,:,:) :: Kv_shear => NULL() !< The shear-driven turbulent vertical viscosity at the interfaces between layers - !! in tracer columns, in m2 s-1. + !! in tracer columns, in Z2 s-1. real, pointer, dimension(:,:,:) :: Kv_shear_Bu => NULL() !< The shear-driven turbulent vertical viscosity at the interfaces between layers in - !! corner columns, in m2 s-1. + !! corner columns, in Z2 s-1. real, pointer, dimension(:,:,:) :: Kv_slow => NULL() !< The turbulent vertical viscosity component due to "slow" processes (e.g., tidal, !! background, convection etc), in Z2 s-1. diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 7802651c9c..08828972b7 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -533,7 +533,7 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive, Waves) CS%Vt2(:,:,:) = 0. if (CS%id_OBLdepth_original > 0) allocate( CS%OBLdepth_original( SZI_(G), SZJ_(G) ) ) - allocate( CS%OBLdepthprev( SZI_(G), SZJ_(G) ) );CS%OBLdepthprev(:,:)=0.0 + allocate( CS%OBLdepthprev( SZI_(G), SZJ_(G) ) ) ; CS%OBLdepthprev(:,:) = 0.0 if (CS%id_BulkDrho > 0) allocate( CS%dRho( SZI_(G), SZJ_(G), SZK_(G) ) ) if (CS%id_BulkDrho > 0) CS%dRho(:,:,:) = 0. if (CS%id_BulkUz2 > 0) allocate( CS%Uz2( SZI_(G), SZJ_(G), SZK_(G) ) ) @@ -585,8 +585,8 @@ subroutine KPP_calculate(CS, G, GV, h, uStar, & !< (out) Vertical diffusivity including KPP (m2/s) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Ks !< (in) Vertical diffusivity of salt w/o KPP (m2/s) !< (out) Vertical diffusivity including KPP (m2/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kv !< (in) Vertical viscosity w/o KPP (m2/s) - !< (out) Vertical viscosity including KPP (m2/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kv !< (in) Vertical viscosity w/o KPP (Z2/s) + !< (out) Vertical viscosity including KPP (Z2/s) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransHeat !< Temp non-local transport (m/s) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransScalar !< scalar non-local transport (m/s) @@ -673,7 +673,7 @@ subroutine KPP_calculate(CS, G, GV, h, uStar, & else Kdiffusivity(:,1) = Kt(i,j,:) Kdiffusivity(:,2) = Ks(i,j,:) - Kviscosity(:)=Kv(i,j,:) + Kviscosity(:) = GV%Z_to_m**2 * Kv(i,j,:) endif call CVMix_coeffs_kpp(Kviscosity(:), & ! (inout) Total viscosity (m2/s) @@ -816,15 +816,15 @@ subroutine KPP_calculate(CS, G, GV, h, uStar, & do k=1, G%ke+1 Kt(i,j,k) = Kt(i,j,k) + Kdiffusivity(k,1) Ks(i,j,k) = Ks(i,j,k) + Kdiffusivity(k,2) - Kv(i,j,k) = Kv(i,j,k) + Kviscosity(k) - if (CS%Stokes_Mixing) Waves%KvS(i,j,k)=Kv(i,j,k) + Kv(i,j,k) = Kv(i,j,k) + GV%m_to_Z**2 * Kviscosity(k) + if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = GV%Z_to_m**2 * Kv(i,j,k) enddo else ! KPP replaces prior diffusivity when former is non-zero do k=1, G%ke+1 if (Kdiffusivity(k,1) /= 0.) Kt(i,j,k) = Kdiffusivity(k,1) if (Kdiffusivity(k,2) /= 0.) Ks(i,j,k) = Kdiffusivity(k,2) - if (Kviscosity(k) /= 0.) Kv(i,j,k) = Kviscosity(k) - if (CS%Stokes_Mixing) Waves%KvS(i,j,k)=Kv(i,j,k) + if (Kviscosity(k) /= 0.) Kv(i,j,k) = GV%m_to_Z**2 * Kviscosity(k) + if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = GV%Z_to_m**2 * Kv(i,j,k) enddo endif endif diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index f3b1570930..cdaccafca5 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -22,7 +22,7 @@ module MOM_CVMix_shear public calculate_CVMix_shear, CVMix_shear_init, CVMix_shear_is_used, CVMix_shear_end !> Control structure including parameters for CVMix interior shear schemes. -type, public :: CVMix_shear_cs +type, public :: CVMix_shear_cs ! TODO: private logical :: use_LMD94 !< Flags to use the LMD94 scheme logical :: use_PP81 !< Flags to use Pacanowski and Philander (JPO 1981) logical :: smooth_ri !< If true, smooth Ri using a 1-2-1 filter @@ -61,7 +61,7 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kd !< The vertical diffusivity at each interface !! (not layer!) in m2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kv !< The vertical viscosity at each interface - !! (not layer!) in m2 s-1. + !! (not layer!) in Z2 s-1. type(CVMix_shear_cs), pointer :: CS !< The control structure returned by a previous call to !! CVMix_shear_init. ! Local variables @@ -69,7 +69,8 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, & real :: GoRho real :: pref, DU, DV, DRHO, DZ, N2, S2, dummy real, dimension(2*(G%ke)) :: pres_1d, temp_1d, salt_1d, rho_1d - real, dimension(G%ke+1) :: Ri_Grad !< Gradient Richardson number + real, dimension(G%ke+1) :: Ri_Grad !< Gradient Richardson number + real, dimension(G%ke+1) :: Kvisc ! Vertical viscosity at interfaces (m2/s) real, parameter :: epsln = 1.e-10 !< Threshold to identify vanished layers ! some constants @@ -147,23 +148,29 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, & if (CS%id_ri_grad_smooth > 0) CS%ri_grad_smooth(i,j,:) = Ri_Grad(:) endif + do k=1,G%ke+1 + Kvisc(k) = GV%Z_to_m**2 * kv(i,j,k) + enddo ! Call to CVMix wrapper for computing interior mixing coefficients. - call CVMix_coeffs_shear(Mdiff_out=kv(i,j,:), & + call CVMix_coeffs_shear(Mdiff_out=Kvisc(:), & Tdiff_out=kd(i,j,:), & RICH=Ri_Grad(:), & nlev=G%ke, & max_nlev=G%ke) + do k=1,G%ke+1 + kv(i,j,k) = GV%m_to_Z**2 * Kvisc(k) + enddo enddo enddo ! write diagnostics - if (CS%id_kd > 0) call post_data(CS%id_kd,kd, CS%diag) - if (CS%id_kv > 0) call post_data(CS%id_kv,kv, CS%diag) - if (CS%id_N2 > 0) call post_data(CS%id_N2,CS%N2, CS%diag) - if (CS%id_S2 > 0) call post_data(CS%id_S2,CS%S2, CS%diag) - if (CS%id_ri_grad > 0) call post_data(CS%id_ri_grad,CS%ri_grad, CS%diag) - if (CS%id_ri_grad_smooth > 0) call post_data(CS%id_ri_grad_smooth,CS%ri_grad_smooth, CS%diag) + if (CS%id_kd > 0) call post_data(CS%id_kd, kd, CS%diag) + if (CS%id_kv > 0) call post_data(CS%id_kv, kv, CS%diag) + if (CS%id_N2 > 0) call post_data(CS%id_N2, CS%N2, CS%diag) + if (CS%id_S2 > 0) call post_data(CS%id_S2, CS%S2, CS%diag) + if (CS%id_ri_grad > 0) call post_data(CS%id_ri_grad, CS%ri_grad, CS%diag) + if (CS%id_ri_grad_smooth > 0) call post_data(CS%id_ri_grad_smooth ,CS%ri_grad_smooth, CS%diag) end subroutine calculate_CVMix_shear @@ -270,7 +277,7 @@ logical function CVMix_shear_init(Time, G, GV, param_file, diag, CS) CS%id_kd = register_diag_field('ocean_model', 'kd_shear_CVMix', diag%axesTi, Time, & 'Vertical diffusivity added by MOM_CVMix_shear module', 'm2/s') CS%id_kv = register_diag_field('ocean_model', 'kv_shear_CVMix', diag%axesTi, Time, & - 'Vertical viscosity added by MOM_CVMix_shear module', 'm2/s') + 'Vertical viscosity added by MOM_CVMix_shear module', 'm2/s', conversion=GV%Z_to_m**2) end function CVMix_shear_init diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index b909d5ba66..46ee54ee94 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -594,7 +594,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call cpu_clock_begin(id_clock_kpp) ! total vertical viscosity in the interior is represented via visc%Kv_shear do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kv_shear(i,j,k) = visc%Kv_shear(i,j,k) + GV%Z_to_m**2*visc%Kv_slow(i,j,k) + visc%Kv_shear(i,j,k) = visc%Kv_shear(i,j,k) + visc%Kv_slow(i,j,k) enddo ; enddo ; enddo ! KPP needs the surface buoyancy flux but does not update state variables. @@ -691,7 +691,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & Kd_heat(i,j,k) = Kd_heat(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) Kd_salt(i,j,k) = Kd_salt(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) if (CS%useKPP) then - visc%Kv_shear(i,j,k) = visc%Kv_shear(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) + visc%Kv_shear(i,j,k) = visc%Kv_shear(i,j,k) + GV%m_to_Z**2 * CS%CVMix_conv_csp%kv_conv(i,j,k) else visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + GV%m_to_Z**2 * CS%CVMix_conv_csp%kv_conv(i,j,k) endif @@ -745,12 +745,13 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! Augment the diffusivities and viscosity due to those diagnosed in energetic_PBL. do K=2,nz ; do j=js,je ; do i=is,ie + !### These expressesions assume a Prandtl number of 1. if (CS%ePBL_is_additive) then Kd_add_here = Kd_ePBL(i,j,K) - visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + Kd_ePBL(i,j,K) + visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + GV%m_to_Z**2 * Kd_ePBL(i,j,K) else Kd_add_here = max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) - visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), Kd_ePBL(i,j,K)) + visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), GV%m_to_Z**2 * Kd_ePBL(i,j,K)) endif Kd_heat(i,j,K) = Kd_heat(i,j,K) + Kd_add_here @@ -1725,10 +1726,10 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%ePBL_is_additive) then Kd_add_here = Kd_ePBL(i,j,K) - visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + Kd_ePBL(i,j,K) + visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + GV%m_to_Z**2 * Kd_ePBL(i,j,K) else Kd_add_here = max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) - visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), Kd_ePBL(i,j,K)) + visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), GV%m_to_Z**2 * Kd_ePBL(i,j,K)) endif Ent_int = Kd_add_here * (GV%m_to_H**2 * dt) / & (0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect) diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index bccb55ea5f..79cc4f633c 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -112,7 +112,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & !! toward convergence. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(inout) :: kv_io !< The vertical viscosity at each interface - !! (not layer!) in m2 s-1. This discards any + !! (not layer!) in Z2 s-1. This discards any !! previous value (i.e. it is intent out) and !! simply sets Kv = Prandtl * Kd_shear real, intent(in) :: dt !< Time increment, in s. @@ -350,7 +350,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & do K=1,nz+1 ; do i=is,ie kappa_io(i,j,K) = G%mask2dT(i,j) * kappa_2d(i,K) tke_io(i,j,K) = G%mask2dT(i,j) * tke_2d(i,K) - kv_io(i,j,K) = ( G%mask2dT(i,j) * kappa_2d(i,K) ) * CS%Prandtl_turb + kv_io(i,j,K) = GV%m_to_Z**2 * ( G%mask2dT(i,j) * kappa_2d(i,K) ) * CS%Prandtl_turb #ifdef ADD_DIAGNOSTICS I_Ld2_3d(i,j,K) = I_Ld2_2d(i,K) dz_Int_3d(i,j,K) = dz_Int_2d(i,K) @@ -376,7 +376,7 @@ end subroutine Calculate_kappa_shear !> Subroutine for calculating shear-driven diffusivity and TKE in corner columns subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_io, tke_io, & - kv_io, dt, G, GV, CS, initialize_all) + kv_io, dt, G, GV, CS, initialize_all) 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_(GV)), & @@ -404,7 +404,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ !! timestep, which may accelerate the iteration !! toward convergence. real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)+1), & - intent(inout) :: kv_io !< The vertical viscosity at each interface in m2 s-1. + intent(inout) :: kv_io !< The vertical viscosity at each interface in Z2 s-1. !! The previous value is used to initialize kappa !! in the vertex columes as Kappa = Kv/Prandtl !! to accelerate the iteration toward covergence. @@ -541,7 +541,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ rho_2d(I,k) = GV%Rlay(k) enddo ; enddo ; endif if (.not.new_kappa) then ; do K=1,nz+1 ; do I=IsB,IeB - kappa_2d(I,K,J2) = kv_io(I,J,K)*I_Prandtl + kappa_2d(I,K,J2) = GV%Z_to_m**2 * kv_io(I,J,K) * I_Prandtl enddo ; enddo ; endif !--------------------------------------- @@ -678,7 +678,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ do K=1,nz+1 ; do I=IsB,IeB tke_io(I,J,K) = G%mask2dBu(I,J) * tke_2d(I,K) - kv_io(I,J,K) = ( G%mask2dBu(I,J) * kappa_2d(I,K,J2) ) * CS%Prandtl_turb + kv_io(I,J,K) = GV%m_to_Z**2 * ( G%mask2dBu(I,J) * kappa_2d(I,K,J2) ) * CS%Prandtl_turb #ifdef ADD_DIAGNOSTICS I_Ld2_3d(I,J,K) = I_Ld2_2d(I,K) dz_Int_3d(I,J,K) = dz_Int_2d(I,K) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 57cb50d431..c82037d2d7 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -354,7 +354,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (associated(visc%Kv_shear)) visc%Kv_shear(:,:,:) = 0.0 ! needed for other parameterizations if (CS%debug) then call hchksum(visc%Kd_shear, "after calc_KS_vert visc%Kd_shear",G%HI) - call Bchksum(visc%Kv_shear_Bu, "after calc_KS_vert visc%Kv_shear_Bu",G%HI) + call Bchksum(visc%Kv_shear_Bu, "after calc_KS_vert visc%Kv_shear_Bu", G%HI, scale=GV%Z_to_m**2) call Bchksum(visc%TKE_turb, "after calc_KS_vert visc%TKE_turb",G%HI) endif else @@ -363,9 +363,9 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call calculate_kappa_shear(u_h, v_h, h, tv, fluxes%p_surf, visc%Kd_shear, visc%TKE_turb, & visc%Kv_shear, dt, G, GV, CS%kappaShear_CSp) if (CS%debug) then - call hchksum(visc%Kd_shear, "after calc_KS visc%Kd_shear",G%HI) - call hchksum(visc%Kv_shear, "after calc_KS visc%Kv_shear",G%HI) - call hchksum(visc%TKE_turb, "after calc_KS visc%TKE_turb",G%HI) + call hchksum(visc%Kd_shear, "after calc_KS visc%Kd_shear", G%HI) + call hchksum(visc%Kv_shear, "after calc_KS visc%Kv_shear", G%HI, scale=GV%Z_to_m**2) + call hchksum(visc%TKE_turb, "after calc_KS visc%TKE_turb", G%HI) endif endif call cpu_clock_end(id_clock_kappaShear) @@ -374,8 +374,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & !NOTE{BGR}: this needs to be cleaned up. It works in 1D case, but has not been tested outside. call calculate_CVMix_shear(u_h, v_h, h, tv, visc%Kd_shear, visc%Kv_shear, G, GV, CS%CVMix_shear_CSp) if (CS%debug) then - call hchksum(visc%Kd_shear, "after CVMix_shear visc%Kd_shear",G%HI) - call hchksum(visc%Kv_shear, "after CVMix_shear visc%Kv_shear",G%HI) + call hchksum(visc%Kd_shear, "after CVMix_shear visc%Kd_shear", G%HI) + call hchksum(visc%Kv_shear, "after CVMix_shear visc%Kv_shear", G%HI, scale=GV%Z_to_m**2) endif elseif (associated(visc%Kv_shear)) then visc%Kv_shear(:,:,:) = 0.0 ! needed if calculate_kappa_shear is not enabled diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index ce7d089b7b..2f8e5460a8 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -2059,23 +2059,23 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, restart_CS, OB if ((GV%m_to_Z_restart /= 0.0) .and. (GV%m_to_Z_restart /= GV%m_to_Z)) then Z_rescale = GV%m_to_Z / GV%m_to_Z_restart -! if (allocated(visc%Kd_shear)) then ; if (query_initialized(visc%Kd_shear, "Kd_shear", restart_CS)) then +! if (associated(visc%Kd_shear)) then ; if (query_initialized(visc%Kd_shear, "Kd_shear", restart_CS)) then ! do k=1,nz+1 ; do j=js,je ; do i=is,ie ! visc%Kd_shear(i,j,k) = Z_rescale**2 * visc%Kd_shear(i,j,k) ! enddo ; enddo ; enddo ! endif ; endif -! if (allocated(visc%Kv_shear)) then ; if (query_initialized(visc%Kv_shear, "Kv_shear", restart_CS)) then -! do k=1,nz+1 ; do j=js,je ; do i=is,ie -! visc%Kv_shear(i,j,k) = Z_rescale**2 * visc%Kv_shear(i,j,k) -! enddo ; enddo ; enddo -! endif ; endif + if (associated(visc%Kv_shear)) then ; if (query_initialized(visc%Kv_shear, "Kv_shear", restart_CS)) then + do k=1,nz+1 ; do j=js,je ; do i=is,ie + visc%Kv_shear(i,j,k) = Z_rescale**2 * visc%Kv_shear(i,j,k) + enddo ; enddo ; enddo + endif ; endif -! if (allocated(visc%Kv_shear_Bu)) then ; if (query_initialized(visc%Kv_shear_Bu, "Kv_shear_Bu", restart_CS)) then -! do k=1,nz+1 ; do j=js,je ; do i=is,ie -! visc%Kv_shear_Bu(i,j,k) = Z_rescale**2 * visc%Kv_shear_Bu(i,j,k) -! enddo ; enddo ; enddo -! endif ; endif + if (associated(visc%Kv_shear_Bu)) then ; if (query_initialized(visc%Kv_shear_Bu, "Kv_shear_Bu", restart_CS)) then + do k=1,nz+1 ; do j=js,je ; do i=is,ie + visc%Kv_shear_Bu(i,j,k) = Z_rescale**2 * visc%Kv_shear_Bu(i,j,k) + enddo ; enddo ; enddo + endif ; endif if (associated(visc%Kv_slow)) then ; if (query_initialized(visc%Kv_slow, "Kv_slow", restart_CS)) then do k=1,nz+1 ; do j=js,je ; do i=is,ie diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 2c558592d0..46adf78423 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1146,14 +1146,14 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, ! equal to 2 x \delta z if (work_on_u) then do K=2,nz ; do i=is,ie ; if (do_i(i)) then - Kv_add(i,K) = (2.*0.5)*m2_to_Z2*(visc%Kv_shear(i,j,k) + visc%Kv_shear(i+1,j,k)) + Kv_add(i,K) = (2.*0.5)*(visc%Kv_shear(i,j,k) + visc%Kv_shear(i+1,j,k)) endif ; enddo ; enddo if (do_OBCs) then do I=is,ie ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then - do K=2,nz ; Kv_add(i,K) = 2.*m2_to_Z2*visc%Kv_shear(i,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = 2.*visc%Kv_shear(i,j,k) ; enddo elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then - do K=2,nz ; Kv_add(i,K) = 2.*m2_to_Z2*visc%Kv_shear(i+1,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = 2.*visc%Kv_shear(i+1,j,k) ; enddo endif endif ; enddo endif @@ -1162,14 +1162,14 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, endif ; enddo ; enddo else do K=2,nz ; do i=is,ie ; if (do_i(i)) then - Kv_add(i,K) = (2.*0.5)*m2_to_Z2*(visc%Kv_shear(i,j,k) + visc%Kv_shear(i,j+1,k)) + Kv_add(i,K) = (2.*0.5)*(visc%Kv_shear(i,j,k) + visc%Kv_shear(i,j+1,k)) endif ; enddo ; enddo if (do_OBCs) then do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then - do K=2,nz ; Kv_add(i,K) = 2.*m2_to_Z2*visc%Kv_shear(i,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = 2.*visc%Kv_shear(i,j,k) ; enddo elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then - do K=2,nz ; Kv_add(i,K) = 2.*m2_to_Z2*visc%Kv_shear(i,j+1,k) ; enddo + do K=2,nz ; Kv_add(i,K) = 2.*visc%Kv_shear(i,j+1,k) ; enddo endif endif ; enddo endif @@ -1182,11 +1182,11 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, if (associated(visc%Kv_shear_Bu)) then if (work_on_u) then do K=2,nz ; do I=Is,Ie ; If (do_i(I)) then - a_cpl(I,K) = a_cpl(I,K) + (2.*0.5)*m2_to_Z2*(visc%Kv_shear_Bu(I,J-1,k) + visc%Kv_shear_Bu(I,J,k)) + a_cpl(I,K) = a_cpl(I,K) + (2.*0.5)*(visc%Kv_shear_Bu(I,J-1,k) + visc%Kv_shear_Bu(I,J,k)) endif ; enddo ; enddo else do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a_cpl(i,K) = a_cpl(i,K) + (2.*0.5)*m2_to_Z2*(visc%Kv_shear_Bu(I-1,J,k) + visc%Kv_shear_Bu(I,J,k)) + a_cpl(i,K) = a_cpl(i,K) + (2.*0.5)*(visc%Kv_shear_Bu(I-1,J,k) + visc%Kv_shear_Bu(I,J,k)) endif ; enddo ; enddo endif endif From 6fb94389a4f4e589edf508b0d477f0be01d6e355 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 3 Oct 2018 16:46:18 -0400 Subject: [PATCH 131/174] +Changed the units of visc%Kd_extra_T to Z-2 s-1 Rescaled the units of visc%Kd_extra_T, visc%Kd_extra_S, Kd_heat and Kd_salt from m2 s-1 to Z2 s-1 for dimensional consistency testing. Rescaling the diffusivities for diagnostics required added in a new GV argument to KPP_init. All answers are bitwise identical, including rescaling Z over a large range. --- src/core/MOM_variables.F90 | 4 +- .../vertical/MOM_CVMix_KPP.F90 | 37 +++--- .../vertical/MOM_CVMix_ddiff.F90 | 22 ++-- .../vertical/MOM_diabatic_aux.F90 | 27 ++--- .../vertical/MOM_diabatic_driver.F90 | 112 ++++++++---------- .../vertical/MOM_set_diffusivity.F90 | 8 +- 6 files changed, 102 insertions(+), 108 deletions(-) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 7c976d2fa1..14ab156793 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -225,10 +225,10 @@ module MOM_variables Ray_v => NULL() !< The Rayleigh drag velocity to be applied to each layer at v-points, in Z s-1. real, pointer, dimension(:,:,:) :: Kd_extra_T => NULL() !< The extra diffusivity of temperature due to double diffusion relative to the - !! diffusivity of density, in m2 s-1. + !! diffusivity of density, in Z2 s-1. real, pointer, dimension(:,:,:) :: Kd_extra_S => NULL() !< The extra diffusivity of salinity due to double diffusion relative to the - !! diffusivity of density, in m2 s-1. + !! diffusivity of density, in Z2 s-1. ! One of Kd_extra_T and Kd_extra_S is always 0. Kd_extra_S is positive for salt fingering; ! Kd_extra_T is positive for double diffusive convection. They are only allocated if ! DOUBLE_DIFFUSION is true. diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 08828972b7..e03d217414 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -170,11 +170,12 @@ module MOM_CVMix_KPP !> Initialize the CVMix KPP module and set up diagnostics !! Returns True if KPP is to be used, False otherwise. -logical function KPP_init(paramFile, G, diag, Time, CS, passive, Waves) +logical function KPP_init(paramFile, G, GV, diag, Time, CS, passive, Waves) ! Arguments type(param_file_type), intent(in) :: paramFile !< File parser type(ocean_grid_type), intent(in) :: G !< Ocean grid + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. type(diag_ctrl), target, intent(in) :: diag !< Diagnostics type(time_type), intent(in) :: Time !< Model time type(KPP_CS), pointer :: CS !< Control structure @@ -493,7 +494,7 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive, Waves) CS%id_Kt_KPP = register_diag_field('ocean_model', 'KPP_Kheat', diag%axesTi, Time, & 'Heat diffusivity due to KPP, as calculated by [CVMix] KPP', 'm2/s') CS%id_Kd_in = register_diag_field('ocean_model', 'KPP_Kd_in', diag%axesTi, Time, & - 'Diffusivity passed to KPP', 'm2/s') + 'Diffusivity passed to KPP', 'm2/s', conversion=GV%Z_to_m**2) CS%id_Ks_KPP = register_diag_field('ocean_model', 'KPP_Ksalt', diag%axesTi, Time, & 'Salt diffusivity due to KPP, as calculated by [CVMix] KPP', 'm2/s') CS%id_Kv_KPP = register_diag_field('ocean_model', 'KPP_Kv', diag%axesTi, Time, & @@ -581,10 +582,10 @@ subroutine KPP_calculate(CS, G, GV, h, uStar, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity (m/s) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: buoyFlux !< Surface buoyancy flux (m2/s3) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kt !< (in) Vertical diffusivity of heat w/o KPP (m2/s) - !< (out) Vertical diffusivity including KPP (m2/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Ks !< (in) Vertical diffusivity of salt w/o KPP (m2/s) - !< (out) Vertical diffusivity including KPP (m2/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kt !< (in) Vertical diffusivity of heat w/o KPP (Z2/s) + !< (out) Vertical diffusivity including KPP (Z2/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Ks !< (in) Vertical diffusivity of salt w/o KPP (Z2/s) + !< (out) Vertical diffusivity including KPP (Z2/s) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kv !< (in) Vertical viscosity w/o KPP (Z2/s) !< (out) Vertical viscosity including KPP (Z2/s) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransHeat !< Temp non-local transport (m/s) @@ -612,8 +613,8 @@ subroutine KPP_calculate(CS, G, GV, h, uStar, & call hchksum(h, "KPP in: h",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(uStar, "KPP in: uStar",G%HI,haloshift=0) call hchksum(buoyFlux, "KPP in: buoyFlux",G%HI,haloshift=0) - call hchksum(Kt, "KPP in: Kt",G%HI,haloshift=0) - call hchksum(Ks, "KPP in: Ks",G%HI,haloshift=0) + call hchksum(Kt, "KPP in: Kt",G%HI,haloshift=0, scale=GV%Z_to_m**2) + call hchksum(Ks, "KPP in: Ks",G%HI,haloshift=0, scale=GV%Z_to_m**2) endif #endif @@ -621,9 +622,7 @@ subroutine KPP_calculate(CS, G, GV, h, uStar, & if (CS%id_Kd_in > 0) call post_data(CS%id_Kd_in, Kt, CS%diag) - !$OMP parallel do default(private) firstprivate(nonLocalTrans) & - !$OMP shared(G,GV,CS,uStar,h,Waves,& - !$OMP buoyFlux,nonLocalTransHeat,nonLocalTransScalar,Kt,Ks,Kv) + !$OMP parallel do default(shared) firstprivate(nonLocalTrans) ! loop over horizontal points on processor do j = G%jsc, G%jec do i = G%isc, G%iec @@ -671,8 +670,8 @@ subroutine KPP_calculate(CS, G, GV, h, uStar, & Kdiffusivity(:,:) = 0. ! Diffusivities for heat and salt (m2/s) Kviscosity(:) = 0. ! Viscosity (m2/s) else - Kdiffusivity(:,1) = Kt(i,j,:) - Kdiffusivity(:,2) = Ks(i,j,:) + Kdiffusivity(:,1) = GV%Z_to_m**2 * Kt(i,j,:) + Kdiffusivity(:,2) = GV%Z_to_m**2 * Ks(i,j,:) Kviscosity(:) = GV%Z_to_m**2 * Kv(i,j,:) endif @@ -814,15 +813,15 @@ subroutine KPP_calculate(CS, G, GV, h, uStar, & if (.not. CS%passiveMode) then if (CS%KPPisAdditive) then do k=1, G%ke+1 - Kt(i,j,k) = Kt(i,j,k) + Kdiffusivity(k,1) - Ks(i,j,k) = Ks(i,j,k) + Kdiffusivity(k,2) + Kt(i,j,k) = Kt(i,j,k) + GV%m_to_Z**2 * Kdiffusivity(k,1) + Ks(i,j,k) = Ks(i,j,k) + GV%m_to_Z**2 * Kdiffusivity(k,2) Kv(i,j,k) = Kv(i,j,k) + GV%m_to_Z**2 * Kviscosity(k) if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = GV%Z_to_m**2 * Kv(i,j,k) enddo else ! KPP replaces prior diffusivity when former is non-zero do k=1, G%ke+1 - if (Kdiffusivity(k,1) /= 0.) Kt(i,j,k) = Kdiffusivity(k,1) - if (Kdiffusivity(k,2) /= 0.) Ks(i,j,k) = Kdiffusivity(k,2) + if (Kdiffusivity(k,1) /= 0.) Kt(i,j,k) = GV%m_to_Z**2 * Kdiffusivity(k,1) + if (Kdiffusivity(k,2) /= 0.) Ks(i,j,k) = GV%m_to_Z**2 * Kdiffusivity(k,2) if (Kviscosity(k) /= 0.) Kv(i,j,k) = GV%m_to_Z**2 * Kviscosity(k) if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = GV%Z_to_m**2 * Kv(i,j,k) enddo @@ -837,8 +836,8 @@ subroutine KPP_calculate(CS, G, GV, h, uStar, & #ifdef __DO_SAFETY_CHECKS__ if (CS%debug) then - call hchksum(Kt, "KPP out: Kt",G%HI,haloshift=0) - call hchksum(Ks, "KPP out: Ks",G%HI,haloshift=0) + call hchksum(Kt, "KPP out: Kt", G%HI, haloshift=0, scale=GV%Z_to_m**2) + call hchksum(Ks, "KPP out: Ks", G%HI, haloshift=0, scale=GV%Z_to_m**2) endif #endif diff --git a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 index 117c958acb..fc84367a87 100644 --- a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 @@ -136,10 +136,10 @@ logical function CVMix_ddiff_init(Time, G, GV, param_file, diag, CS) CS%diag => diag CS%id_KT_extra = register_diag_field('ocean_model','KT_extra',diag%axesTi,Time, & - 'Double-diffusive diffusivity for temperature', 'm2 s-1') + 'Double-diffusive diffusivity for temperature', 'm2 s-1', conversion=GV%Z_to_m**2) CS%id_KS_extra = register_diag_field('ocean_model','KS_extra',diag%axesTi,Time, & - 'Double-diffusive diffusivity for salinity', 'm2 s-1') + 'Double-diffusive diffusivity for salinity', 'm2 s-1', conversion=GV%Z_to_m**2) CS%id_R_rho = register_diag_field('ocean_model','R_rho',diag%axesTi,Time, & 'Double-diffusion density ratio', 'nondim') @@ -167,9 +167,9 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, j, Kd_T, Kd_S, CS) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in 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_T !< Interface double diffusion diapycnal - !! diffusivity for temp (m2/sec). + !! diffusivity for temp (Z2/sec). real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: Kd_S !< Interface double diffusion diapycnal - !! diffusivity for salt (m2/sec). + !! diffusivity for salt (Z2/sec). type(CVMix_ddiff_cs), pointer :: CS !< The control structure returned !! by a previous call to CVMix_ddiff_init. integer, intent(in) :: j !< Meridional grid indice. @@ -185,6 +185,9 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, j, Kd_T, Kd_S, CS) beta_dS, & !< beta*dS across interfaces dT, & !< temp. difference between adjacent layers (degC) dS !< salt difference between adjacent layers + real, dimension(SZK_(G)+1) :: & + Kd1_T, & !< Diapycanal diffusivity of temperature, in m2 s-1. + Kd1_S !< Diapycanal diffusivity of salinity, in m2 s-1. real, dimension(SZK_(G)+1) :: iFaceHeight !< Height of interfaces (m) integer :: kOBL !< level of OBL extent @@ -196,8 +199,6 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, j, Kd_T, Kd_S, CS) alpha_dT(:) = 0.0; beta_dS(:) = 0.0; dRho_dT(:) = 0.0 dRho_dS(:) = 0.0; dT(:) = 0.0; dS(:) = 0.0 - ! set Kd_T and Kd_S to zero to avoid passing values from previous call - Kd_T(:,j,:) = 0.0; Kd_S(:,j,:) = 0.0 ! GMM, I am leaving some code commented below. We need to pass BLD to ! this soubroutine to avoid adding diffusivity above that. This needs @@ -263,12 +264,17 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, j, Kd_T, Kd_S, CS) ! gets index of the level and interface above hbl !kOBL = CVmix_kpp_compute_kOBL_depth(iFaceHeight, cellHeight,hbl(i,j)) - call CVMix_coeffs_ddiff(Tdiff_out=Kd_T(i,j,:), & - Sdiff_out=Kd_S(i,j,:), & + Kd1_T(:) = 0.0 ; Kd1_S(:) = 0.0 + call CVMix_coeffs_ddiff(Tdiff_out=Kd1_T(:), & + Sdiff_out=Kd1_S(:), & strat_param_num=alpha_dT(:), & strat_param_denom=beta_dS(:), & nlev=G%ke, & max_nlev=G%ke) + do K=1,G%ke+1 + Kd_T(i,j,K) = GV%m_to_Z**2 * Kd1_T(K) + Kd_S(i,j,K) = GV%m_to_Z**2 * Kd1_S(K) + enddo ! Do not apply mixing due to convection within the boundary layer !do k=1,kOBL diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 1032bba617..df87d3fa1f 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -226,22 +226,21 @@ subroutine differential_diffuse_T_S(h, tv, visc, dt, G, GV) b1_T, b1_S, & ! Variables used by the tridiagonal solvers of T & S, in H. d1_T, d1_S ! Variables used by the tridiagonal solvers, nondim. real, dimension(SZI_(G),SZK_(G)) :: & - c1_T, c1_S ! Variables used by the tridiagonal solvers, in m or kg m-2. + c1_T, c1_S ! Variables used by the tridiagonal solvers, in H. real, dimension(SZI_(G),SZK_(G)+1) :: & - mix_T, mix_S ! Mixing distances in both directions across each - ! interface, in m or kg m-2. + mix_T, mix_S ! Mixing distances in both directions across each interface, in H. real :: h_tr ! h_tr is h at tracer points with a tiny thickness - ! added to ensure positive definiteness, in m or kg m-2. + ! added to ensure positive definiteness, in H. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in m or kg m-2. + ! in roundoff and can be neglected, in H. real :: I_h_int ! The inverse of the thickness associated with an - ! interface, in m-1 or m2 kg-1. + ! interface, in H-1. real :: b_denom_T ! The first term in the denominators for the expressions - real :: b_denom_S ! for b1_T and b1_S, both in m or kg m-2. - - integer :: i, j, k, is, ie, js, je, nz + real :: b_denom_S ! for b1_T and b1_S, both in H. real, dimension(:,:,:), pointer :: T=>NULL(), S=>NULL() - real, dimension(:,:,:), pointer :: Kd_T=>NULL(), Kd_S=>NULL() + real, dimension(:,:,:), pointer :: Kd_T=>NULL(), Kd_S=>NULL() ! Diffusivities in Z2 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 h_neglect = GV%H_subroundoff @@ -262,8 +261,8 @@ subroutine differential_diffuse_T_S(h, tv, visc, dt, G, GV) do j=js,je do i=is,ie I_h_int = 1.0 / (0.5 * (h(i,j,1) + h(i,j,2)) + h_neglect) - mix_T(i,2) = ((dt * Kd_T(i,j,2)) * GV%m_to_H**2) * I_h_int - mix_S(i,2) = ((dt * Kd_S(i,j,2)) * GV%m_to_H**2) * I_h_int + mix_T(i,2) = ((dt * Kd_T(i,j,2)) * GV%Z_to_H**2) * I_h_int + mix_S(i,2) = ((dt * Kd_S(i,j,2)) * GV%Z_to_H**2) * I_h_int h_tr = h(i,j,1) + h_neglect b1_T(i) = 1.0 / (h_tr + mix_T(i,2)) @@ -276,8 +275,8 @@ subroutine differential_diffuse_T_S(h, tv, visc, dt, G, GV) do k=2,nz-1 ; do i=is,ie ! Calculate the mixing across the interface below this layer. I_h_int = 1.0 / (0.5 * (h(i,j,k) + h(i,j,k+1)) + h_neglect) - mix_T(i,K+1) = ((dt * Kd_T(i,j,K+1)) * GV%m_to_H**2) * I_h_int - mix_S(i,K+1) = ((dt * Kd_S(i,j,K+1)) * GV%m_to_H**2) * I_h_int + mix_T(i,K+1) = ((dt * Kd_T(i,j,K+1)) * GV%Z_to_H**2) * I_h_int + mix_S(i,K+1) = ((dt * Kd_S(i,j,K+1)) * GV%Z_to_H**2) * I_h_int c1_T(i,k) = mix_T(i,K) * b1_T(i) c1_S(i,k) = mix_S(i,K) * b1_S(i) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 46ee54ee94..95b3c3d368 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -323,8 +323,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), target :: & Kd_int, & ! diapycnal diffusivity of interfaces (m^2/s) - Kd_heat, & ! diapycnal diffusivity of heat (m^2/s) - Kd_salt, & ! diapycnal diffusivity of salt and passive tracers (m^2/s) + Kd_heat, & ! diapycnal diffusivity of heat (Z^2/s) + Kd_salt, & ! diapycnal diffusivity of salt and passive tracers (Z^2/s) Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces (m^2/s) eta, & ! Interface heights before diapycnal mixing, in m. Tdif_flx, & ! diffusive diapycnal heat flux across interfaces (K m/s) @@ -384,7 +384,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & integer :: ig, jg ! global indices for testing testing itide point source (BDM) logical :: avg_enabled ! for testing internal tides (BDM) - real :: Kd_add_here ! An added diffusivity in m2/s + real :: Kd_add_here ! An added diffusivity in Z2/s 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 @@ -561,33 +561,31 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! Set diffusivities for heat and salt separately -!$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,Kd_int,visc,CS,Kd_heat) -!$OMP do + !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_salt(i,j,k) = Kd_int(i,j,k) - Kd_heat(i,j,k) = Kd_int(i,j,k) + Kd_salt(i,j,k) = GV%m_to_Z**2 * Kd_int(i,j,k) + Kd_heat(i,j,k) = GV%m_to_Z**2 * Kd_int(i,j,k) enddo ; enddo ; enddo ! Add contribution from double diffusion if (associated(visc%Kd_extra_S)) then -!$OMP do + !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie Kd_salt(i,j,k) = Kd_salt(i,j,k) + visc%Kd_extra_S(i,j,k) enddo ; enddo ; enddo endif if (associated(visc%Kd_extra_T)) then -!$OMP do + !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie Kd_heat(i,j,k) = Kd_heat(i,j,k) + visc%Kd_extra_T(i,j,k) enddo ; enddo ; enddo endif -!$OMP end parallel if (CS%debug) then call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, haloshift=0) call MOM_thermovar_chksum("after set_diffusivity ", tv, G) - call hchksum(Kd_heat, "after set_diffusivity Kd_heat",G%HI,haloshift=0) - call hchksum(Kd_salt, "after set_diffusivity Kd_salt",G%HI,haloshift=0) + call hchksum(Kd_heat, "after set_diffusivity Kd_heat", G%HI, haloshift=0, scale=GV%Z_to_m**2) + call hchksum(Kd_salt, "after set_diffusivity Kd_salt", G%HI, haloshift=0, scale=GV%Z_to_m**2) endif if (CS%useKPP) then @@ -625,8 +623,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call MOM_state_chksum("after KPP", u, v, h, G, GV, haloshift=0) call MOM_forcing_chksum("after KPP", fluxes, G, haloshift=0) call MOM_thermovar_chksum("after KPP", tv, G) - call hchksum(Kd_heat, "after KPP Kd_heat",G%HI,haloshift=0) - call hchksum(Kd_salt, "after KPP Kd_salt",G%HI,haloshift=0) + call hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=GV%Z_to_m**2) + call hchksum(Kd_salt, "after KPP Kd_salt", G%HI, haloshift=0, scale=GV%Z_to_m**2) endif endif ! endif for KPP @@ -670,13 +668,11 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! increment heat and salt diffusivity. ! CS%useKPP==.true. already has extra_T and extra_S included if (.not. CS%useKPP) then -!$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,visc,Kd_heat) -!$OMP do + !$OMP parallel do default(shared) do K=2,nz ; do j=js,je ; do i=is,ie Kd_heat(i,j,K) = Kd_heat(i,j,K) + visc%Kd_extra_T(i,j,K) Kd_salt(i,j,K) = Kd_salt(i,j,K) + visc%Kd_extra_S(i,j,K) enddo ; enddo ; enddo -!$OMP end parallel endif endif @@ -685,18 +681,16 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%use_CVMix_conv) then call calculate_CVMix_conv(h, tv, G, GV, CS%CVMix_conv_csp, Hml) ! Increment vertical diffusion and viscosity due to convection -!$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,visc,CS,Kd_heat) -!$OMP do + !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_heat(i,j,k) = Kd_heat(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) - Kd_salt(i,j,k) = Kd_salt(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) + Kd_heat(i,j,k) = Kd_heat(i,j,k) + GV%m_to_Z**2 * CS%CVMix_conv_csp%kd_conv(i,j,k) + Kd_salt(i,j,k) = Kd_salt(i,j,k) + GV%m_to_Z**2 * CS%CVMix_conv_csp%kd_conv(i,j,k) if (CS%useKPP) then visc%Kv_shear(i,j,k) = visc%Kv_shear(i,j,k) + GV%m_to_Z**2 * CS%CVMix_conv_csp%kv_conv(i,j,k) else visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + GV%m_to_Z**2 * CS%CVMix_conv_csp%kv_conv(i,j,k) endif enddo ; enddo ; enddo -!$OMP end parallel endif ! Save fields before boundary forcing is applied for tendency diagnostics @@ -747,10 +741,10 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & do K=2,nz ; do j=js,je ; do i=is,ie !### These expressesions assume a Prandtl number of 1. if (CS%ePBL_is_additive) then - Kd_add_here = Kd_ePBL(i,j,K) + Kd_add_here = GV%m_to_Z**2 * Kd_ePBL(i,j,K) visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + GV%m_to_Z**2 * Kd_ePBL(i,j,K) else - Kd_add_here = max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) + Kd_add_here = GV%m_to_Z**2 * max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), GV%m_to_Z**2 * Kd_ePBL(i,j,K)) endif @@ -829,17 +823,16 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ea_t(i,j,1) = 0.; ea_s(i,j,1) = 0. enddo ; enddo -!$OMP parallel do default(none) shared(is,ie,js,je,nz,h_neglect,h,ea_t,ea_s,GV,dt,Kd_salt,Kd_heat,eb_t,eb_s) & -!$OMP private(hval) + !$OMP parallel do default(shared) private(hval) do k=2,nz ; do j=js,je ; do i=is,ie - hval=1.0/(h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) - ea_t(i,j,k) = (GV%m_to_H**2) * dt * hval * Kd_heat(i,j,k) + hval = 1.0 / (h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) + ea_t(i,j,k) = (GV%Z_to_H**2) * dt * hval * Kd_heat(i,j,k) eb_t(i,j,k-1) = ea_t(i,j,k) - ea_s(i,j,k) = (GV%m_to_H**2) * dt * hval * Kd_salt(i,j,k) + ea_s(i,j,k) = (GV%Z_to_H**2) * dt * hval * Kd_salt(i,j,k) eb_s(i,j,k-1) = ea_s(i,j,k) enddo ; enddo ; enddo do j=js,je ; do i=is,ie - eb_t(i,j,nz) = 0.; eb_s(i,j,nz) = 0. + eb_t(i,j,nz) = 0. ; eb_s(i,j,nz) = 0. enddo ; enddo if (showCallTree) call callTree_waypoint("done setting ea_t,ea_s,eb_t,eb_s from Kd_heat" //& "and Kd_salt (diabatic)") @@ -958,7 +951,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif if (associated(visc%Kd_extra_S)) then ; if (visc%Kd_extra_S(i,j,k) > 0.0) then - add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%m_to_H**2) / & + add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & (0.5 * (h(i,j,k-1) + h(i,j,k)) + & h_neglect) ebtr(i,j,k-1) = ebtr(i,j,k-1) + add_ent @@ -984,7 +977,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & !$OMP parallel do default(shared) private(add_ent) do k=nz,2,-1 ; do j=js,je ; do i=is,ie if (visc%Kd_extra_S(i,j,k) > 0.0) then - add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%m_to_H**2) / & + add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & (0.5 * (h(i,j,k-1) + h(i,j,k)) + & h_neglect) else @@ -1204,8 +1197,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), target :: & Kd_int, & ! diapycnal diffusivity of interfaces (m^2/s) - Kd_heat, & ! diapycnal diffusivity of heat (m^2/s) - Kd_salt, & ! diapycnal diffusivity of salt and passive tracers (m^2/s) + Kd_heat, & ! diapycnal diffusivity of heat (Z^2/s) + Kd_salt, & ! diapycnal diffusivity of salt and passive tracers (Z^2/s) Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces (m^2/s) eta, & ! Interface heights before diapycnal mixing, in m. Tdif_flx, & ! diffusive diapycnal heat flux across interfaces (K m/s) @@ -1265,7 +1258,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en integer :: ig, jg ! global indices for testing testing itide point source (BDM) logical :: avg_enabled ! for testing internal tides (BDM) - real :: Kd_add_here ! An added diffusivity in m2/s + real :: Kd_add_here ! An added diffusivity in Z2/s 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 @@ -1511,32 +1504,29 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux) ! The KPP scheme calculates boundary layer diffusivities and non-local transport. -!$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,Kd_int,visc,CS,Kd_heat) -!$OMP do + !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_salt(i,j,k) = Kd_int(i,j,k) - Kd_heat(i,j,k) = Kd_int(i,j,k) + Kd_salt(i,j,k) = GV%m_to_Z**2 * Kd_int(i,j,k) + Kd_heat(i,j,k) = GV%m_to_Z**2 * Kd_int(i,j,k) enddo ; enddo ; enddo if (associated(visc%Kd_extra_S)) then -!$OMP do + !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie Kd_salt(i,j,k) = Kd_salt(i,j,k) + visc%Kd_extra_S(i,j,k) enddo ; enddo ; enddo endif if (associated(visc%Kd_extra_T)) then -!$OMP do + !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie Kd_heat(i,j,k) = Kd_heat(i,j,k) + visc%Kd_extra_T(i,j,k) enddo ; enddo ; enddo endif -!$OMP end parallel call KPP_compute_BLD(CS%KPP_CSp, G, GV, h, tv%T, tv%S, u, v, tv%eqn_of_state, & fluxes%ustar, CS%KPP_buoy_flux) call KPP_calculate(CS%KPP_CSp, G, GV, h, fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, & Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves) -!$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,Kd_int,visc,CS,G,Kd_heat,Hml) if (associated(Hml)) then call KPP_get_BLD(CS%KPP_CSp, Hml(:,:), G) @@ -1544,24 +1534,24 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en endif if (.not. CS%KPPisPassive) then -!$OMP do + !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_int(i,j,k) = min( Kd_salt(i,j,k), Kd_heat(i,j,k) ) + Kd_int(i,j,k) = GV%Z_to_m**2 * min( Kd_salt(i,j,k), Kd_heat(i,j,k) ) enddo ; enddo ; enddo if (associated(visc%Kd_extra_S)) then -!$OMP do + !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kd_extra_S(i,j,k) = Kd_salt(i,j,k) - Kd_int(i,j,k) + visc%Kd_extra_S(i,j,k) = (Kd_salt(i,j,k) - GV%m_to_Z**2 * Kd_int(i,j,k)) enddo ; enddo ; enddo endif if (associated(visc%Kd_extra_T)) then -!$OMP do + !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kd_extra_T(i,j,k) = Kd_heat(i,j,k) - Kd_int(i,j,k) + visc%Kd_extra_T(i,j,k) = (Kd_heat(i,j,k) - GV%m_to_Z**2 * Kd_int(i,j,k)) enddo ; enddo ; enddo endif endif ! not passive -!$OMP end parallel + call cpu_clock_end(id_clock_kpp) if (showCallTree) call callTree_waypoint("done with KPP_calculate (diabatic)") if (CS%debug) then @@ -1725,21 +1715,21 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en do K=2,nz ; do j=js,je ; do i=is,ie if (CS%ePBL_is_additive) then - Kd_add_here = Kd_ePBL(i,j,K) + Kd_add_here = GV%m_to_Z**2 * Kd_ePBL(i,j,K) visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + GV%m_to_Z**2 * Kd_ePBL(i,j,K) else - Kd_add_here = max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) + Kd_add_here = GV%m_to_Z**2 * max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), GV%m_to_Z**2 * Kd_ePBL(i,j,K)) endif - Ent_int = Kd_add_here * (GV%m_to_H**2 * dt) / & + Ent_int = Kd_add_here * (GV%Z_to_H**2 * dt) / & (0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect) eb(i,j,k-1) = eb(i,j,k-1) + Ent_int ea(i,j,k) = ea(i,j,k) + Ent_int - Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_add_here + Kd_int(i,j,K) = Kd_int(i,j,K) + GV%Z_to_m**2 * Kd_add_here ! for diagnostics - Kd_heat(i,j,K) = Kd_heat(i,j,K) + Kd_int(i,j,K) - Kd_salt(i,j,K) = Kd_salt(i,j,K) + Kd_int(i,j,K) + Kd_heat(i,j,K) = Kd_heat(i,j,K) + GV%m_to_Z**2 * Kd_int(i,j,K) + Kd_salt(i,j,K) = Kd_salt(i,j,K) + GV%m_to_Z**2 * Kd_int(i,j,K) enddo ; enddo ; enddo @@ -2103,7 +2093,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ebtr(i,j,k-1) = eb(i,j,k-1) ; eatr(i,j,k) = ea(i,j,k) endif if (associated(visc%Kd_extra_S)) then ; if (visc%Kd_extra_S(i,j,k) > 0.0) then - add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%m_to_H**2) / & + add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & (0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + & h_neglect) ebtr(i,j,k-1) = ebtr(i,j,k-1) + add_ent @@ -2134,7 +2124,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en !$OMP parallel do default(shared) private(add_ent) do k=nz,2,-1 ; do j=js,je ; do i=is,ie if (visc%Kd_extra_S(i,j,k) > 0.0) then - add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%m_to_H**2) / & + add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & (0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + & h_neglect) else @@ -3060,19 +3050,19 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, endif CS%id_Kd_heat = register_diag_field('ocean_model', 'Kd_heat', diag%axesTi, Time, & - 'Total diapycnal diffusivity for heat at interfaces', 'm2 s-1', & + 'Total diapycnal diffusivity for heat at interfaces', 'm2 s-1', conversion=GV%Z_to_m**2, & cmor_field_name='difvho', & cmor_standard_name='ocean_vertical_heat_diffusivity', & cmor_long_name='Ocean vertical heat diffusivity') CS%id_Kd_salt = register_diag_field('ocean_model', 'Kd_salt', diag%axesTi, Time, & - 'Total diapycnal diffusivity for salt at interfaces', 'm2 s-1', & + 'Total diapycnal diffusivity for salt at interfaces', 'm2 s-1', conversion=GV%Z_to_m**2, & cmor_field_name='difvso', & cmor_standard_name='ocean_vertical_salt_diffusivity', & cmor_long_name='Ocean vertical salt diffusivity') ! CS%useKPP is set to True if KPP-scheme is to be used, False otherwise. ! KPP_init() allocated CS%KPP_Csp and also sets CS%KPPisPassive - CS%useKPP = KPP_init(param_file, G, diag, Time, CS%KPP_CSp, passive=CS%KPPisPassive) + CS%useKPP = KPP_init(param_file, G, GV, diag, Time, CS%KPP_CSp, passive=CS%KPPisPassive) if (CS%useKPP) then allocate( CS%KPP_NLTheat(isd:ied,jsd:jed,nz+1) ) ; CS%KPP_NLTheat(:,:,:) = 0. allocate( CS%KPP_NLTscalar(isd:ied,jsd:jed,nz+1) ) ; CS%KPP_NLTscalar(:,:,:) = 0. diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index c82037d2d7..9062bb9659 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -409,12 +409,12 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (KS_extra(i,K) > KT_extra(i,K)) then ! salt fingering Kd(i,j,k-1) = Kd(i,j,k-1) + 0.5*KT_extra(i,K) Kd(i,j,k) = Kd(i,j,k) + 0.5*KT_extra(i,K) - visc%Kd_extra_S(i,j,k) = KS_extra(i,K)-KT_extra(i,K) + visc%Kd_extra_S(i,j,k) = GV%m_to_Z**2 * (KS_extra(i,K) - KT_extra(i,K)) visc%Kd_extra_T(i,j,k) = 0.0 elseif (KT_extra(i,K) > 0.0) then ! double-diffusive convection Kd(i,j,k-1) = Kd(i,j,k-1) + 0.5*KS_extra(i,K) Kd(i,j,k) = Kd(i,j,k) + 0.5*KS_extra(i,K) - visc%Kd_extra_T(i,j,k) = KT_extra(i,K)-KS_extra(i,K) + visc%Kd_extra_T(i,j,k) = GV%m_to_Z**2 * (KT_extra(i,K) - KS_extra(i,K)) visc%Kd_extra_S(i,j,k) = 0.0 else ! There is no double diffusion at this interface. visc%Kd_extra_T(i,j,k) = 0.0 @@ -534,8 +534,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%useKappaShear) call hchksum(visc%Kd_shear,"Turbulent Kd",G%HI,haloshift=0) if (CS%use_CVMix_ddiff) then - call hchksum(visc%Kd_extra_T, "MOM_set_diffusivity: Kd_extra_T",G%HI,haloshift=0) - call hchksum(visc%Kd_extra_S, "MOM_set_diffusivity: Kd_extra_S",G%HI,haloshift=0) + call hchksum(visc%Kd_extra_T, "MOM_set_diffusivity: Kd_extra_T", G%HI, haloshift=0, scale=GV%Z_to_m**2) + call hchksum(visc%Kd_extra_S, "MOM_set_diffusivity: Kd_extra_S", G%HI, haloshift=0, scale=GV%Z_to_m**2) endif if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) then From 573216994e1d41560895ae02aedca5fc2fc301d7 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 3 Oct 2018 18:11:19 -0400 Subject: [PATCH 132/174] +Changed the units of visc%Kd_shear to Z-2 s-1 Rescaled the units of visc%Kd_shear, and Kd_ePBL from m2 s-1 to Z2 s-1 for dimensional consistency testing. Also corrected some array initialization lines in CVMix_shear_init that could have led to segmentation faults if certain entries are missing from the diag table. All answers are bitwise identical, including rescaling Z over a large range. --- src/core/MOM_variables.F90 | 2 +- .../vertical/MOM_CVMix_shear.F90 | 39 +++++++++++-------- .../vertical/MOM_diabatic_driver.F90 | 26 ++++++------- .../vertical/MOM_energetic_PBL.F90 | 35 ++--------------- .../vertical/MOM_kappa_shear.F90 | 16 ++++---- .../vertical/MOM_set_diffusivity.F90 | 16 ++++---- .../vertical/MOM_set_viscosity.F90 | 10 ++--- 7 files changed, 61 insertions(+), 83 deletions(-) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 14ab156793..91e3e48af3 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -234,7 +234,7 @@ module MOM_variables ! DOUBLE_DIFFUSION is true. real, pointer, dimension(:,:,:) :: Kd_shear => NULL() !< The shear-driven turbulent diapycnal diffusivity at the interfaces between layers - !! in tracer columns, in m2 s-1. + !! in tracer columns, in Z2 s-1. real, pointer, dimension(:,:,:) :: Kv_shear => NULL() !< The shear-driven turbulent vertical viscosity at the interfaces between layers !! in tracer columns, in Z2 s-1. diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index cdaccafca5..a22bda0d9d 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -59,7 +59,7 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in 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!) in m2 s-1. + !! (not layer!) in Z2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kv !< The vertical viscosity at each interface !! (not layer!) in Z2 s-1. type(CVMix_shear_cs), pointer :: CS !< The control structure returned by a previous call to @@ -70,7 +70,8 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, & real :: pref, DU, DV, DRHO, DZ, N2, S2, dummy real, dimension(2*(G%ke)) :: pres_1d, temp_1d, salt_1d, rho_1d real, dimension(G%ke+1) :: Ri_Grad !< Gradient Richardson number - real, dimension(G%ke+1) :: Kvisc ! Vertical viscosity at interfaces (m2/s) + real, dimension(G%ke+1) :: Kvisc !< Vertical viscosity at interfaces (m2/s) + real, dimension(G%ke+1) :: Kdiff !< Diapycnal diffusivity at interfaces (m2/s) real, parameter :: epsln = 1.e-10 !< Threshold to identify vanished layers ! some constants @@ -148,18 +149,20 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, & if (CS%id_ri_grad_smooth > 0) CS%ri_grad_smooth(i,j,:) = Ri_Grad(:) endif - do k=1,G%ke+1 - Kvisc(k) = GV%Z_to_m**2 * kv(i,j,k) + do K=1,G%ke+1 + Kvisc(K) = GV%Z_to_m**2 * kv(i,j,K) + Kdiff(K) = GV%Z_to_m**2 * kd(i,j,K) enddo ! Call to CVMix wrapper for computing interior mixing coefficients. call CVMix_coeffs_shear(Mdiff_out=Kvisc(:), & - Tdiff_out=kd(i,j,:), & + Tdiff_out=Kdiff(:), & RICH=Ri_Grad(:), & nlev=G%ke, & max_nlev=G%ke) - do k=1,G%ke+1 - kv(i,j,k) = GV%m_to_Z**2 * Kvisc(k) + do K=1,G%ke+1 + kv(i,j,K) = GV%m_to_Z**2 * Kvisc(K) + kd(i,j,K) = GV%m_to_Z**2 * Kdiff(K) enddo enddo enddo @@ -255,27 +258,31 @@ logical function CVMix_shear_init(Time, G, GV, param_file, diag, CS) CS%id_N2 = register_diag_field('ocean_model', 'N2_shear', diag%axesTi, Time, & 'Square of Brunt-Vaisala frequency used by MOM_CVMix_shear module', '1/s2') - if (CS%id_N2 > 0) & - allocate( CS%N2( SZI_(G), SZJ_(G), SZK_(G)+1 ) );CS%N2(:,:,:) = 0. + if (CS%id_N2 > 0) then + allocate( CS%N2( SZI_(G), SZJ_(G), SZK_(G)+1 ) ) ; CS%N2(:,:,:) = 0. + endif CS%id_S2 = register_diag_field('ocean_model', 'S2_shear', diag%axesTi, Time, & 'Square of vertical shear used by MOM_CVMix_shear module','1/s2') - if (CS%id_S2 > 0) & - allocate( CS%S2( SZI_(G), SZJ_(G), SZK_(G)+1 ) );CS%S2(:,:,:) = 0. + if (CS%id_S2 > 0) then + allocate( CS%S2( SZI_(G), SZJ_(G), SZK_(G)+1 ) ) ; CS%S2(:,:,:) = 0. + endif CS%id_ri_grad = register_diag_field('ocean_model', 'ri_grad_shear', diag%axesTi, Time, & 'Gradient Richarson number used by MOM_CVMix_shear module','nondim') - if (CS%id_ri_grad > 0) & !Initialize w/ large Richardson value - allocate( CS%ri_grad( SZI_(G), SZJ_(G), SZK_(G)+1 ));CS%ri_grad(:,:,:) = 1.e8 + if (CS%id_ri_grad > 0) then !Initialize w/ large Richardson value + allocate( CS%ri_grad( SZI_(G), SZJ_(G), SZK_(G)+1 )) ; CS%ri_grad(:,:,:) = 1.e8 + endif CS%id_ri_grad_smooth = register_diag_field('ocean_model', 'ri_grad_shear_smooth', & diag%axesTi, Time, & 'Smoothed gradient Richarson number used by MOM_CVMix_shear module','nondim') - if (CS%id_ri_grad_smooth > 0) & !Initialize w/ large Richardson value - allocate( CS%ri_grad_smooth( SZI_(G), SZJ_(G), SZK_(G)+1 ));CS%ri_grad_smooth(:,:,:) = 1.e8 + if (CS%id_ri_grad_smooth > 0) then !Initialize w/ large Richardson value + allocate( CS%ri_grad_smooth( SZI_(G), SZJ_(G), SZK_(G)+1 )) ; CS%ri_grad_smooth(:,:,:) = 1.e8 + endif CS%id_kd = register_diag_field('ocean_model', 'kd_shear_CVMix', diag%axesTi, Time, & - 'Vertical diffusivity added by MOM_CVMix_shear module', 'm2/s') + 'Vertical diffusivity added by MOM_CVMix_shear module', 'm2/s', conversion=GV%Z_to_m**2) CS%id_kv = register_diag_field('ocean_model', 'kv_shear_CVMix', diag%axesTi, Time, & 'Vertical viscosity added by MOM_CVMix_shear module', 'm2/s', conversion=GV%Z_to_m**2) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 95b3c3d368..65af1f4f2b 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -325,7 +325,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & Kd_int, & ! diapycnal diffusivity of interfaces (m^2/s) Kd_heat, & ! diapycnal diffusivity of heat (Z^2/s) Kd_salt, & ! diapycnal diffusivity of salt and passive tracers (Z^2/s) - Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces (m^2/s) + Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces (Z^2/s) eta, & ! Interface heights before diapycnal mixing, in m. Tdif_flx, & ! diffusive diapycnal heat flux across interfaces (K m/s) Tadv_flx, & ! advective diapycnal heat flux across interfaces (K m/s) @@ -741,11 +741,11 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & do K=2,nz ; do j=js,je ; do i=is,ie !### These expressesions assume a Prandtl number of 1. if (CS%ePBL_is_additive) then - Kd_add_here = GV%m_to_Z**2 * Kd_ePBL(i,j,K) - visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + GV%m_to_Z**2 * Kd_ePBL(i,j,K) + Kd_add_here = Kd_ePBL(i,j,K) + visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + Kd_ePBL(i,j,K) else - Kd_add_here = GV%m_to_Z**2 * max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) - visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), GV%m_to_Z**2 * Kd_ePBL(i,j,K)) + Kd_add_here = max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) + visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), Kd_ePBL(i,j,K)) endif Kd_heat(i,j,K) = Kd_heat(i,j,K) + Kd_add_here @@ -758,7 +758,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call hchksum(eb_t, "after ePBL eb_t",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(ea_s, "after ePBL ea_s",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(eb_s, "after ePBL eb_s",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(Kd_ePBL, "after ePBL Kd_ePBL",G%HI,haloshift=0) + call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=GV%Z_to_m**2) endif else @@ -1199,7 +1199,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en Kd_int, & ! diapycnal diffusivity of interfaces (m^2/s) Kd_heat, & ! diapycnal diffusivity of heat (Z^2/s) Kd_salt, & ! diapycnal diffusivity of salt and passive tracers (Z^2/s) - Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces (m^2/s) + Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces (Z^2/s) eta, & ! Interface heights before diapycnal mixing, in m. Tdif_flx, & ! diffusive diapycnal heat flux across interfaces (K m/s) Tadv_flx, & ! advective diapycnal heat flux across interfaces (K m/s) @@ -1715,11 +1715,11 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en do K=2,nz ; do j=js,je ; do i=is,ie if (CS%ePBL_is_additive) then - Kd_add_here = GV%m_to_Z**2 * Kd_ePBL(i,j,K) - visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + GV%m_to_Z**2 * Kd_ePBL(i,j,K) + Kd_add_here = Kd_ePBL(i,j,K) + visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + Kd_ePBL(i,j,K) else - Kd_add_here = GV%m_to_Z**2 * max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) - visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), GV%m_to_Z**2 * Kd_ePBL(i,j,K)) + Kd_add_here = max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) + visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), Kd_ePBL(i,j,K)) endif Ent_int = Kd_add_here * (GV%Z_to_H**2 * dt) / & (0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect) @@ -1736,7 +1736,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%debug) then call hchksum(ea, "after ePBL ea",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(eb, "after ePBL eb",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(Kd_ePBL, "after ePBL Kd_ePBL",G%HI,haloshift=0) + call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=GV%Z_to_m**2) endif else @@ -3046,7 +3046,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, 'Total diapycnal diffusivity at interfaces', 'm2 s-1') if (CS%use_energetic_PBL) then CS%id_Kd_ePBL = register_diag_field('ocean_model', 'Kd_ePBL', diag%axesTi, Time, & - 'ePBL diapycnal diffusivity at interfaces', 'm2 s-1') + 'ePBL diapycnal diffusivity at interfaces', 'm2 s-1', conversion=GV%Z_to_m**2) endif CS%id_Kd_heat = register_diag_field('ocean_model', 'Kd_heat', diag%axesTi, Time, & diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 590b866761..a105bfa6e3 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -183,9 +183,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, 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(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: h_3d !< Layer thickness, in m or kg m-2. - !! (Intent in/out) The units of h are referred - !! to as H below. + intent(inout) :: h_3d !< Layer thicknesses, in H (usually 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. @@ -212,7 +210,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & real, intent(in) :: dt !< Time increment, in s. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(out) :: Kd_int !< The diagnosed diffusivities at interfaces, - !! in m2 s-1. + !! in Z2 s-1. type(energetic_PBL_CS), pointer :: CS !< The control structure returned by a previous !! call to mixedlayer_init. real, dimension(SZI_(G),SZJ_(G)), & @@ -257,33 +255,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & ! For a traditional Kraus-Turner mixed layer, the values are: ! mstar = 1.25, nstar = 0.4, TKE_decay = 0.0, conv_decay = 0.0 -! Arguments: h_3d - Layer thickness, in m or kg m-2. (Intent in/out) -! The units of h are referred to as H below. -! (in) u_3d - Zonal velocities interpolated to h points, m s-1. -! (in) v_3d - Zonal velocities interpolated to h points, m s-1. -! (in/out) tv - A structure containing pointers to any available -! thermodynamic fields. Absent fields have NULL ptrs. -! (in) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (in) dt - Time increment, in s. -! (out) Kd_int - The diagnosed diffusivities at interfaces, in m2 s-1. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! mixedlayer_init. -! (in) dSV_dT - The partial derivative of in-situ specific volume with -! potential temperature, in m3 kg-1 K-1. -! (in) dSV_dS - The partial derivative of in-situ specific volume with -! salinity, in m3 kg-1 ppt-1. -! (in) TKE_forced - The forcing requirements to homogenize the forcing -! that has been applied to each layer through each layer, in J m-2. -! (in) Buoy_Flux - The surface buoyancy flux. in m2/s3. -! (in,opt) dt_diag - The diagnostic time step, which may be less than dt -! if there are two callse to mixedlayer, in s. -! (in,opt) last_call - if true, this is the last call to mixedlayer in the -! current time step, so diagnostics will be written. -! The default is .true. - real, dimension(SZI_(G),SZK_(GV)) :: & h, & ! The layer thickness, in H (usually m or kg m-2). T, & ! The layer temperatures, in deg C. @@ -1503,7 +1474,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & endif do K=1,nz+1 ; do i=is,ie - Kd_int(i,j,K) = Kd(i,K) + Kd_int(i,j,K) = GV%m_to_Z**2 * Kd(i,K) enddo ; enddo enddo ! j-loop diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 79cc4f633c..a6613ed39b 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -101,7 +101,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & !! (or NULL). real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(inout) :: kappa_io !< The diapycnal diffusivity at each interface - !! (not layer!) in m2 s-1. Initially this is the + !! (not layer!) in Z2 s-1. Initially this is the !! value from the previous timestep, which may !! accelerate the iteration toward convergence. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & @@ -215,7 +215,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & rho_2d(i,k) = GV%Rlay(k) ! Could be tv%Rho(i,j,k) ? enddo ; enddo ; endif if (.not.new_kappa) then ; do K=1,nz+1 ; do i=is,ie - kappa_2d(i,K) = kappa_io(i,j,K) + kappa_2d(i,K) = GV%Z_to_m**2*kappa_io(i,j,K) enddo ; enddo ; endif !--------------------------------------- @@ -348,7 +348,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & endif ; enddo ! i-loop do K=1,nz+1 ; do i=is,ie - kappa_io(i,j,K) = G%mask2dT(i,j) * kappa_2d(i,K) + kappa_io(i,j,K) = GV%m_to_Z**2 * G%mask2dT(i,j) * kappa_2d(i,K) tke_io(i,j,K) = G%mask2dT(i,j) * tke_2d(i,K) kv_io(i,j,K) = GV%m_to_Z**2 * ( G%mask2dT(i,j) * kappa_2d(i,K) ) * CS%Prandtl_turb #ifdef ADD_DIAGNOSTICS @@ -360,7 +360,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & enddo ! end of j-loop if (CS%debug) then - call hchksum(kappa_io, "kappa", G%HI) + call hchksum(kappa_io, "kappa", G%HI, scale=GV%Z_to_m**2) call hchksum(tke_io, "tke", G%HI) endif @@ -396,7 +396,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ !! (or NULL). real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(out) :: kappa_io !< The diapycnal diffusivity at each interface - !! (not layer!) in m2 s-1. + !! (not layer!) in Z2 s-1. real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)+1), & intent(inout) :: tke_io !< The turbulent kinetic energy per unit mass at !! each interface (not layer!) in m2 s-2. @@ -686,7 +686,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ enddo ; enddo if (J>=G%jsc) then ; do K=1,nz+1 ; do i=G%isc,G%iec ! Set the diffusivities in tracer columns from the values at vertices. - kappa_io(i,j,K) = G%mask2dT(i,j) * 0.25 * & + kappa_io(i,j,K) = GV%m_to_Z**2 * G%mask2dT(i,j) * 0.25 * & ((kappa_2d(I-1,K,J2m1) + kappa_2d(I,K,J2)) + & (kappa_2d(I-1,K,J2) + kappa_2d(I,K,J2m1))) enddo ; enddo ; endif @@ -694,7 +694,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ enddo ! end of J-loop if (CS%debug) then - call hchksum(kappa_io, "kappa", G%HI) + call hchksum(kappa_io, "kappa", G%HI, scale=GV%Z_to_m**2) call Bchksum(tke_io, "tke", G%HI) endif @@ -2098,7 +2098,7 @@ function kappa_shear_init(Time, G, GV, param_file, diag, CS) CS%diag => diag CS%id_Kd_shear = register_diag_field('ocean_model','Kd_shear',diag%axesTi,Time, & - 'Shear-driven Diapycnal Diffusivity', 'm2 s-1') + 'Shear-driven Diapycnal Diffusivity', 'm2 s-1', conversion=GV%Z_to_m**2) CS%id_TKE = register_diag_field('ocean_model','TKE_shear',diag%axesTi,Time, & 'Shear-driven Turbulent Kinetic Energy', 'm2 s-2') #ifdef ADD_DIAGNOSTICS diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 9062bb9659..a28751fb66 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -353,9 +353,9 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & visc%TKE_turb, visc%Kv_shear_Bu, dt, G, GV, CS%kappaShear_CSp) if (associated(visc%Kv_shear)) visc%Kv_shear(:,:,:) = 0.0 ! needed for other parameterizations if (CS%debug) then - call hchksum(visc%Kd_shear, "after calc_KS_vert visc%Kd_shear",G%HI) + call hchksum(visc%Kd_shear, "after calc_KS_vert visc%Kd_shear", G%HI, scale=GV%Z_to_m**2) call Bchksum(visc%Kv_shear_Bu, "after calc_KS_vert visc%Kv_shear_Bu", G%HI, scale=GV%Z_to_m**2) - call Bchksum(visc%TKE_turb, "after calc_KS_vert visc%TKE_turb",G%HI) + call Bchksum(visc%TKE_turb, "after calc_KS_vert visc%TKE_turb", G%HI) endif else ! Changes: visc%Kd_shear, visc%TKE_turb (not clear that TKE_turb is used as input ????) @@ -363,7 +363,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call calculate_kappa_shear(u_h, v_h, h, tv, fluxes%p_surf, visc%Kd_shear, visc%TKE_turb, & visc%Kv_shear, dt, G, GV, CS%kappaShear_CSp) if (CS%debug) then - call hchksum(visc%Kd_shear, "after calc_KS visc%Kd_shear", G%HI) + call hchksum(visc%Kd_shear, "after calc_KS visc%Kd_shear", G%HI, scale=GV%Z_to_m**2) call hchksum(visc%Kv_shear, "after calc_KS visc%Kv_shear", G%HI, scale=GV%Z_to_m**2) call hchksum(visc%TKE_turb, "after calc_KS visc%TKE_turb", G%HI) endif @@ -374,7 +374,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & !NOTE{BGR}: this needs to be cleaned up. It works in 1D case, but has not been tested outside. call calculate_CVMix_shear(u_h, v_h, h, tv, visc%Kd_shear, visc%Kv_shear, G, GV, CS%CVMix_shear_CSp) if (CS%debug) then - call hchksum(visc%Kd_shear, "after CVMix_shear visc%Kd_shear", G%HI) + call hchksum(visc%Kd_shear, "after CVMix_shear visc%Kd_shear", G%HI, scale=GV%Z_to_m**2) call hchksum(visc%Kv_shear, "after CVMix_shear visc%Kv_shear", G%HI, scale=GV%Z_to_m**2) endif elseif (associated(visc%Kv_shear)) then @@ -442,15 +442,15 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%useKappaShear .or. CS%use_CVMix_shear) then if (present(Kd_int)) then do K=2,nz ; do i=is,ie - Kd_int(i,j,K) = visc%Kd_shear(i,j,K) + 0.5*(Kd(i,j,k-1) + Kd(i,j,k)) + Kd_int(i,j,K) = GV%Z_to_m**2 * visc%Kd_shear(i,j,K) + 0.5*(Kd(i,j,k-1) + Kd(i,j,k)) enddo ; enddo do i=is,ie - Kd_int(i,j,1) = visc%Kd_shear(i,j,1) ! This isn't actually used. It could be 0. + Kd_int(i,j,1) = GV%Z_to_m**2 * visc%Kd_shear(i,j,1) ! This isn't actually used. It could be 0. Kd_int(i,j,nz+1) = 0.0 enddo endif do k=1,nz ; do i=is,ie - Kd(i,j,k) = Kd(i,j,k) + 0.5*(visc%Kd_shear(i,j,K) + visc%Kd_shear(i,j,K+1)) + Kd(i,j,k) = Kd(i,j,k) + GV%Z_to_m**2 * 0.5*(visc%Kd_shear(i,j,K) + visc%Kd_shear(i,j,K+1)) enddo ; enddo else if (present(Kd_int)) then @@ -531,7 +531,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%debug) then call hchksum(Kd ,"Kd",G%HI,haloshift=0) - if (CS%useKappaShear) call hchksum(visc%Kd_shear,"Turbulent Kd",G%HI,haloshift=0) + if (CS%useKappaShear) call hchksum(visc%Kd_shear, "Turbulent Kd", G%HI, haloshift=0, scale=GV%Z_to_m**2) if (CS%use_CVMix_ddiff) then call hchksum(visc%Kd_extra_T, "MOM_set_diffusivity: Kd_extra_T", G%HI, haloshift=0, scale=GV%Z_to_m**2) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 2f8e5460a8..f1906aad7f 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -2059,11 +2059,11 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, restart_CS, OB if ((GV%m_to_Z_restart /= 0.0) .and. (GV%m_to_Z_restart /= GV%m_to_Z)) then Z_rescale = GV%m_to_Z / GV%m_to_Z_restart -! if (associated(visc%Kd_shear)) then ; if (query_initialized(visc%Kd_shear, "Kd_shear", restart_CS)) then -! do k=1,nz+1 ; do j=js,je ; do i=is,ie -! visc%Kd_shear(i,j,k) = Z_rescale**2 * visc%Kd_shear(i,j,k) -! enddo ; enddo ; enddo -! endif ; endif + if (associated(visc%Kd_shear)) then ; if (query_initialized(visc%Kd_shear, "Kd_shear", restart_CS)) then + do k=1,nz+1 ; do j=js,je ; do i=is,ie + visc%Kd_shear(i,j,k) = Z_rescale**2 * visc%Kd_shear(i,j,k) + enddo ; enddo ; enddo + endif ; endif if (associated(visc%Kv_shear)) then ; if (query_initialized(visc%Kv_shear, "Kv_shear", restart_CS)) then do k=1,nz+1 ; do j=js,je ; do i=is,ie From 314210c05475b4b3d883d80e049b2d2f64061505 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 4 Oct 2018 06:35:33 -0400 Subject: [PATCH 133/174] +Changed the units of CVMix%kd_conv to Z-2 s-1 Rescaled the units of Kd_conv and Kv_conv in the CVMix_conv control structure from m2 s-1 to Z2 s-1 for dimensional consistency testing. Also simplified the code around some unit scaling factors, and added the correct conversion factors to 3 mixed layer depth diagnostics. All answers are bitwise identical, including rescaling Z over a large range. --- .../vertical/MOM_CVMix_conv.F90 | 27 ++++++++------ .../vertical/MOM_diabatic_aux.F90 | 16 ++++----- .../vertical/MOM_diabatic_driver.F90 | 35 ++++++++++--------- 3 files changed, 43 insertions(+), 35 deletions(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index 9407e4d1e3..e552cae9c4 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -132,9 +132,9 @@ logical function CVMix_conv_init(Time, G, GV, param_file, diag, CS) CS%id_N2 = register_diag_field('ocean_model', 'N2_conv', diag%axesTi, Time, & 'Square of Brunt-Vaisala frequency used by MOM_CVMix_conv module', '1/s2') CS%id_kd_conv = register_diag_field('ocean_model', 'kd_conv', diag%axesTi, Time, & - 'Additional diffusivity added by MOM_CVMix_conv module', 'm2/s') + 'Additional diffusivity added by MOM_CVMix_conv module', 'm2/s', conversion=GV%Z_to_m**2) CS%id_kv_conv = register_diag_field('ocean_model', 'kv_conv', diag%axesTi, Time, & - 'Additional viscosity added by MOM_CVMix_conv module', 'm2/s') + 'Additional viscosity added by MOM_CVMix_conv module', 'm2/s', conversion=GV%Z_to_m**2) call CVMix_init_conv(convect_diff=CS%kd_conv_const, & convect_visc=CS%kv_conv_const, & @@ -160,6 +160,8 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, CS, hbl) !! computed based on Brunt Vaisala. real, dimension(SZK_(G)) :: rho_1d !< water density in a column, this is also !! a dummy variable, same reason as above. + real, dimension(SZK_(G)+1) :: kv_col !< Viscosities at interfaces in the column (m2 s-1) + real, dimension(SZK_(G)+1) :: kd_col !< Diffusivities at interfaces in the column (m2 s-1) real, dimension(SZK_(G)+1) :: iFaceHeight !< Height of interfaces (m) real, dimension(SZK_(G)) :: cellHeight !< Height of cell centers (m) integer :: kOBL !< level of OBL extent @@ -215,20 +217,25 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, CS, hbl) ! gets index of the level and interface above hbl kOBL = CVMix_kpp_compute_kOBL_depth(iFaceHeight, cellHeight,hbl(i,j)) - call CVMix_coeffs_conv(Mdiff_out=CS%kv_conv(i,j,:), & - Tdiff_out=CS%kd_conv(i,j,:), & + kv_col(:) = 0.0 ; kd_col(:) = 0.0 + call CVMix_coeffs_conv(Mdiff_out=kv_col(:), & + Tdiff_out=kd_col(:), & Nsqr=CS%N2(i,j,:), & dens=rho_1d(:), & dens_lwr=rho_lwr(:), & nlev=G%ke, & max_nlev=G%ke, & OBL_ind=kOBL) - - ! Do not apply mixing due to convection within the boundary layer - do k=1,kOBL - CS%kv_conv(i,j,k) = 0.0 - CS%kd_conv(i,j,k) = 0.0 - enddo + + do K=1,G%ke+1 + CS%kv_conv(i,j,K) = GV%m_to_Z**2 * kv_col(K) + CS%kd_conv(i,j,K) = GV%m_to_Z**2 * kd_col(K) + enddo + ! Do not apply mixing due to convection within the boundary layer + do k=1,kOBL + CS%kv_conv(i,j,k) = 0.0 + CS%kd_conv(i,j,k) = 0.0 + enddo enddo enddo diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index df87d3fa1f..90332c1b85 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -663,9 +663,9 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, dia real, dimension(SZI_(G)) :: pRef_MLD, pRef_N2 ! Reference pressures in Pa. real, dimension(SZI_(G)) :: dK, dKm1, d1 ! Depths in Z. real, dimension(SZI_(G)) :: rhoSurf, rhoAtK, rho1 ! Densities used for N2, in kg m-3. - real, dimension(SZI_(G), SZJ_(G)) :: MLD ! Diagnosed mixed layer depth, in m. + real, dimension(SZI_(G), SZJ_(G)) :: MLD ! Diagnosed mixed layer depth, in Z. real, dimension(SZI_(G), SZJ_(G)) :: subMLN2 ! Diagnosed stratification below ML, in s-2. - real, dimension(SZI_(G), SZJ_(G)) :: MLD2 ! Diagnosed MLD^2, in m2. + real, dimension(SZI_(G), SZJ_(G)) :: MLD2 ! Diagnosed MLD^2, in Z2. real :: Rho_x_gE ! The product of density, gravitational acceleartion and a unit ! conversion factor, in kg m-1 Z-1 s-2. real :: gE_Rho0 ! The gravitational acceleration divided by a mean density, in m4 s-2 kg-1. @@ -677,8 +677,8 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, dia id_SQ = -1 ; if (PRESENT(id_N2subML)) id_SQ = id_MLDsq - Rho_x_gE = (GV%g_Earth) * GV%Rho0 - gE_rho0 = GV%m_to_Z * (GV%g_Earth*GV%m_to_Z) / GV%Rho0 + Rho_x_gE = GV%g_Earth * GV%Rho0 + gE_rho0 = GV%m_to_Z**2 * GV%g_Earth / GV%Rho0 dz_subML = 50.*GV%m_to_Z is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -824,7 +824,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & real, dimension(max(optics%nbands,1),SZI_(G),SZK_(G)) :: opacityBand real :: hGrounding(maxGroundings) real :: Temp_in, Salin_in - real :: I_G_Earth +! real :: I_G_Earth real :: g_Hconv2 real :: GoRho ! g_Earth times a unit conversion factor divided by density, in Z m3 s-2 kg-1 logical :: calculate_energetics @@ -845,7 +845,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & calculate_energetics = (present(cTKE) .and. present(dSV_dT) .and. present(dSV_dS)) calculate_buoyancy = present(SkinBuoyFlux) if (calculate_buoyancy) SkinBuoyFlux(:,:) = 0.0 - I_G_Earth = 1.0 / (GV%g_Earth*GV%m_to_Z) +! I_G_Earth = 1.0 / GV%g_Earth g_Hconv2 = GV%H_to_Pa * GV%H_to_kg_m2 if (present(cTKE)) cTKE(:,:,:) = 0.0 @@ -912,8 +912,8 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & dSV_dT(:,j,k), dSV_dS(:,j,k), is, ie-is+1, tv%eqn_of_state) do i=is,ie ; dSV_dT_2d(i,k) = dSV_dT(i,j,k) ; enddo ! do i=is,ie -! dT_to_dPE(i,k) = I_G_Earth * d_pres(i) * p_lay(i) * dSV_dT(i,j,k) -! dS_to_dPE(i,k) = I_G_Earth * d_pres(i) * p_lay(i) * dSV_dS(i,j,k) +! dT_to_dPE(i,k) = I_G_Earth * GV%Z_to_m * d_pres(i) * p_lay(i) * dSV_dT(i,j,k) +! dS_to_dPE(i,k) = I_G_Earth * GV%Z_to_m * d_pres(i) * p_lay(i) * dSV_dS(i,j,k) ! enddo enddo pen_TKE_2d(:,:) = 0.0 diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 65af1f4f2b..42547d051e 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -683,12 +683,12 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! Increment vertical diffusion and viscosity due to convection !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_heat(i,j,k) = Kd_heat(i,j,k) + GV%m_to_Z**2 * CS%CVMix_conv_csp%kd_conv(i,j,k) - Kd_salt(i,j,k) = Kd_salt(i,j,k) + GV%m_to_Z**2 * CS%CVMix_conv_csp%kd_conv(i,j,k) + Kd_heat(i,j,k) = Kd_heat(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) + Kd_salt(i,j,k) = Kd_salt(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) if (CS%useKPP) then - visc%Kv_shear(i,j,k) = visc%Kv_shear(i,j,k) + GV%m_to_Z**2 * CS%CVMix_conv_csp%kv_conv(i,j,k) + visc%Kv_shear(i,j,k) = visc%Kv_shear(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) else - visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + GV%m_to_Z**2 * CS%CVMix_conv_csp%kv_conv(i,j,k) + visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) endif enddo ; enddo ; enddo endif @@ -1571,8 +1571,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en !!!!!!!! GMM, the following needs to be checked !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !### The vertical extent here is more limited that Kv_slow or Kd_int; it might be k=1,nz+1. do k=1,nz ; do j=js,je ; do i=is,ie - Kd_int(i,j,k) = Kd_int(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) - visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + GV%m_to_Z**2 * CS%CVMix_conv_csp%kv_conv(i,j,k) + Kd_int(i,j,k) = Kd_int(i,j,k) + GV%Z_to_m**2 * CS%CVMix_conv_csp%kd_conv(i,j,k) + visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) enddo ; enddo ; enddo !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -2979,19 +2979,20 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, CS%id_Sadv = register_diag_field('ocean_model',"Sflx_dia_adv",diag%axesTi, & Time, "Advective diapycnal salnity flux across interfaces", & "psu m s-1") - CS%id_MLD_003 = register_diag_field('ocean_model','MLD_003',diag%axesT1,Time, & - 'Mixed layer depth (delta rho = 0.03)', 'm', cmor_field_name='mlotst', & - cmor_long_name='Ocean Mixed Layer Thickness Defined by Sigma T', & + CS%id_MLD_003 = register_diag_field('ocean_model', 'MLD_003', diag%axesT1, Time, & + 'Mixed layer depth (delta rho = 0.03)', 'm', conversion=GV%Z_to_m, & + cmor_field_name='mlotst', cmor_long_name='Ocean Mixed Layer Thickness Defined by Sigma T', & cmor_standard_name='ocean_mixed_layer_thickness_defined_by_sigma_t') - CS%id_mlotstsq = register_diag_field('ocean_model','mlotstsq',diag%axesT1,Time, & - long_name='Square of Ocean Mixed Layer Thickness Defined by Sigma T', & - standard_name='square_of_ocean_mixed_layer_thickness_defined_by_sigma_t',units='m2') + CS%id_mlotstsq = register_diag_field('ocean_model','mlotstsq',diag%axesT1, Time, & + long_name='Square of Ocean Mixed Layer Thickness Defined by Sigma T', & + standard_name='square_of_ocean_mixed_layer_thickness_defined_by_sigma_t', & + units='m2', conversion=GV%Z_to_m**2) CS%id_MLD_0125 = register_diag_field('ocean_model','MLD_0125',diag%axesT1,Time, & - 'Mixed layer depth (delta rho = 0.125)', 'm') + 'Mixed layer depth (delta rho = 0.125)', 'm', conversion=GV%Z_to_m) CS%id_subMLN2 = register_diag_field('ocean_model','subML_N2',diag%axesT1,Time, & 'Squared buoyancy frequency below mixed layer', 's-2') CS%id_MLD_user = register_diag_field('ocean_model','MLD_user',diag%axesT1,Time, & - 'Mixed layer depth (used defined)', 'm') + 'Mixed layer depth (used defined)', 'm', conversion=GV%Z_to_m) call get_param(param_file, mdl, "DIAG_MLD_DENSITY_DIFF", CS%MLDdensityDifference, & "The density difference used to determine a diagnostic mixed\n"//& "layer depth, MLD_user, following the definition of Levitus 1982. \n"//& @@ -3008,15 +3009,15 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, z_grid='z') CS%id_Tdif_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) vd = var_desc("Tflx_dia_adv", "degC m s-1", & - "Advective diapycnal temperature flux across interfaces, interpolated to z",& + "Advective diapycnal temperature flux across interfaces, interpolated to z", & z_grid='z') CS%id_Tadv_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) vd = var_desc("Sflx_dia_diff", "psu m s-1", & - "Diffusive diapycnal salinity flux across interfaces, interpolated to z",& + "Diffusive diapycnal salinity flux across interfaces, interpolated to z", & z_grid='z') CS%id_Sdif_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) vd = var_desc("Sflx_dia_adv", "psu m s-1", & - "Advective diapycnal salinity flux across interfaces, interpolated to z",& + "Advective diapycnal salinity flux across interfaces, interpolated to z", & z_grid='z') CS%id_Sadv_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) endif From 9990e6e4d1161dade722aec08b7fb845ac25a2bd Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 4 Oct 2018 06:37:02 -0400 Subject: [PATCH 134/174] Corrected a rescaling factor in find_coupling_coef One of the unit conversion factors in find_coupling coefficient was not changed when the units of KV_slow were changed with Hallberg-NOAA/MOM6@ced9c35. This has now been corrected. The fact that this change did not impact the rescaling tests is an indication that the MOM6 code testing coverage is not as complete as it should be, especially for recently added code. --- src/parameterizations/vertical/MOM_vert_friction.F90 | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 46adf78423..aec3a68f24 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1085,7 +1085,6 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in H. real :: z2 ! A copy of z_i, nondim. - real :: m2_to_Z2 ! Unit conversion factors. real :: topfn real :: a_top logical :: do_shelf, do_OBCs @@ -1099,7 +1098,6 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, else ; is = G%isc ; ie = G%iec ; endif nz = G%ke h_neglect = GV%H_subroundoff - m2_to_Z2 = GV%m_to_Z*GV%m_to_Z ! The maximum coupling coefficent was originally introduced to avoid ! truncation error problems in the tridiagonal solver. Effectively, the 1e-10 @@ -1212,7 +1210,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, endif ; enddo ; enddo else do K=2,nz ; do i=is,ie ; if (do_i(i)) then - Kv_add(i,K) = Kv_add(i,K) + 1.0*m2_to_Z2*(visc%Kv_slow(i,j,k) + visc%Kv_slow(i,j+1,k)) + Kv_add(i,K) = Kv_add(i,K) + 1.0*(visc%Kv_slow(i,j,k) + visc%Kv_slow(i,j+1,k)) endif ; enddo ; enddo !### I am pretty sure that this is double counting here! - RWH if (do_OBCs) then From b9fc7ad7cf0c83121045ca4b2c69adaa6857b4bc Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 4 Oct 2018 08:54:42 -0400 Subject: [PATCH 135/174] +Changed the units of Kd_lay to Z-2 s-1 Renamed the layer-centered diffusivities uniformly to Kd_lay and rescaled the units of Kd_lay from m2 s-1 to Z2 s-1 for dimensional consistency testing. As a part of these chages, a new GV argument was added to user_change_diff. All answers are bitwise identical, including rescaling Z over a large range. --- .../vertical/MOM_CVMix_conv.F90 | 2 +- .../vertical/MOM_bkgnd_mixing.F90 | 30 +++---- .../vertical/MOM_diabatic_driver.F90 | 32 +++---- .../vertical/MOM_entrain_diffusive.F90 | 6 +- .../vertical/MOM_set_diffusivity.F90 | 90 +++++++++---------- .../vertical/MOM_tidal_mixing.F90 | 28 +++--- src/user/user_change_diffusivity.F90 | 23 ++--- 7 files changed, 107 insertions(+), 104 deletions(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index e552cae9c4..851951af3e 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -226,7 +226,7 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, CS, hbl) nlev=G%ke, & max_nlev=G%ke, & OBL_ind=kOBL) - + do K=1,G%ke+1 CS%kv_conv(i,j,K) = GV%m_to_Z**2 * kv_col(K) CS%kd_conv(i,j,K) = GV%m_to_Z**2 * kd_col(K) diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index 1151044ff3..83b1f70026 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -307,17 +307,17 @@ end subroutine sfc_bkgnd_mixing !> Calculates the vertical background diffusivities/viscosities subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, CS) - type(ocean_grid_type), intent(in) :: G !< Grid structure. - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. - real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay !< squared buoyancy frequency associated + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. + real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay !< squared buoyancy frequency associated !! with layers (1/s2) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: kd_lay !< Diapycnal diffusivity of each layer m2 s-1. - real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: kd_lay !< Diapycnal diffusivity of each layer Z2 s-1. + real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface !! (not layer!) in Z2 s-1 - integer, intent(in) :: j !< Meridional grid index - type(bkgnd_mixing_cs), pointer :: CS !< The control structure returned by + integer, intent(in) :: j !< Meridional grid index + type(bkgnd_mixing_cs), pointer :: CS !< The control structure returned by !! a previous call to bkgnd_mixing_init. ! local variables @@ -369,7 +369,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, CS) CS%Kd_bkgnd(i,j,K) = Kd_col(K) enddo do k=1,nz - kd_lay(i,j,k) = kd_lay(i,j,k) + 0.5*(Kd_col(K) + Kd_col(K+1)) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*(Kd_col(K) + Kd_col(K+1)) enddo enddo ! i loop @@ -382,8 +382,8 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, CS) if (depth_c <= CS%Hmix) then ; CS%kd_bkgnd(i,j,k) = CS%Kdml elseif (depth_c >= 2.0*CS%Hmix) then ; CS%kd_bkgnd(i,j,k) = CS%Kd_sfc(i,j) else - kd_lay(i,j,k) = ((CS%Kd_sfc(i,j) - CS%Kdml) * I_Hmix) * depth_c + & - (2.0*CS%Kdml - CS%Kd_sfc(i,j)) + Kd_lay(i,j,k) = GV%m_to_Z**2*((CS%Kd_sfc(i,j) - CS%Kdml) * I_Hmix) * depth_c + & + GV%m_to_Z**2*(2.0*CS%Kdml - CS%Kd_sfc(i,j)) endif depth(i) = depth(i) + GV%H_to_m*h(i,j,k) @@ -395,13 +395,13 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, CS) abs_sin = max(epsilon,abs(sin(G%geoLatT(i,j)*deg_to_rad))) N_2Omega = max(abs_sin,sqrt(N2_lay(i,k))*I_2Omega) N02_N2 = (CS%N0_2Omega/N_2Omega)**2 - kd_lay(i,j,k) = max(CS%Kd_min, CS%Kd_sfc(i,j) * & + Kd_lay(i,j,k) = max(GV%m_to_Z**2*CS%Kd_min, GV%m_to_Z**2*CS%Kd_sfc(i,j) * & ((abs_sin * invcosh(N_2Omega/abs_sin)) * I_x30)*N02_N2) enddo ; enddo else do k=1,nz ; do i=is,ie - kd_lay(i,j,k) = CS%Kd_sfc(i,j) + Kd_lay(i,j,k) = GV%m_to_Z**2*CS%Kd_sfc(i,j) enddo ; enddo endif @@ -411,7 +411,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, CS) CS%kd_bkgnd(i,j,1) = 0.0; CS%kv_bkgnd(i,j,1) = 0.0 CS%kd_bkgnd(i,j,nz+1) = 0.0; CS%kv_bkgnd(i,j,nz+1) = 0.0 do k=2,nz - CS%kd_bkgnd(i,j,k) = 0.5*(kd_lay(i,j,K-1) + kd_lay(i,j,K)) + CS%kd_bkgnd(i,j,k) = 0.5*GV%Z_to_m**2*(Kd_lay(i,j,K-1) + Kd_lay(i,j,K)) CS%kv_bkgnd(i,j,k) = CS%kd_bkgnd(i,j,k) * CS%prandtl_bkgnd enddo enddo diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 42547d051e..f24a7f3cd4 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -289,9 +289,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! one time step (m for Bouss, kg/m^2 for non-Bouss) eb_t, & ! amount of fluid entrained from the layer below within ! one time step (m for Bouss, kg/m^2 for non-Bouss) - Kd, & ! diapycnal diffusivity of layers (m^2/sec) + Kd_lay, & ! diapycnal diffusivity of layers (Z^2/sec) h_orig, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss) - h_prebound, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss) + h_prebound, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss) ! hold, & ! layer thickness before diapycnal entrainment, and later ! the initial layer thicknesses (if a mixed layer is used), ! (m for Bouss, kg/m^2 for non-Bouss) @@ -553,9 +553,10 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif ! end CS%use_int_tides call cpu_clock_begin(id_clock_set_diffusivity) - ! Sets: Kd, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S + ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S ! Also changes: visc%Kd_shear, visc%Kv_slow and visc%TKE_turb (not clear that TKE_turb is used as input ???? - call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, CS%set_diff_CSp, Kd, Kd_int) + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, 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)") @@ -931,7 +932,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! thicknesses, as this corresponds pretty closely (to within ! differences in the density jumps between layers) with what is done ! in the calculation of the fluxes in the first place. Kd_min_tr - ! should be much less than the values that have been set in Kd, + ! should be much less than the values that have been set in Kd_lay, ! perhaps a molecular diffusivity. add_ent = ((dt * CS%Kd_min_tr) * GV%m_to_H**2) * & ((h(i,j,k-1)+h(i,j,k)+h_neglect) / & @@ -1163,9 +1164,9 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! one time step (m for Bouss, kg/m^2 for non-Bouss) eb, & ! amount of fluid entrained from the layer below within ! one time step (m for Bouss, kg/m^2 for non-Bouss) - Kd, & ! diapycnal diffusivity of layers (m^2/sec) + Kd_lay, & ! diapycnal diffusivity of layers (Z^2/sec) h_orig, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss) - h_prebound, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss) + h_prebound, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss) hold, & ! layer thickness before diapycnal entrainment, and later ! the initial layer thicknesses (if a mixed layer is used), ! (m for Bouss, kg/m^2 for non-Bouss) @@ -1472,7 +1473,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en endif call cpu_clock_begin(id_clock_set_diffusivity) - ! Sets: Kd, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S + ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S ! Also changes: visc%Kd_shear, visc%TKE_turb (not clear that TKE_turb is used as input ???? ! And sets visc%Kv_shear if ((CS%halo_TS_diff > 0) .and. (CS%ML_mix_first > 0.0)) then @@ -1480,7 +1481,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en 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, G, GV, CS%set_diff_CSp, Kd, Kd_int) + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, 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)") @@ -1488,8 +1490,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, haloshift=0) call MOM_thermovar_chksum("after set_diffusivity ", tv, G) - call hchksum(Kd, "after set_diffusivity Kd",G%HI,haloshift=0) - call hchksum(Kd_Int, "after set_diffusivity Kd_Int",G%HI,haloshift=0) + call hchksum(Kd_lay, "after set_diffusivity Kd_lay", G%HI, haloshift=0, scale=GV%Z_to_m**2) + call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0) endif @@ -1558,8 +1560,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call MOM_state_chksum("after KPP", u, v, h, G, GV, haloshift=0) call MOM_forcing_chksum("after KPP", fluxes, G, haloshift=0) call MOM_thermovar_chksum("after KPP", tv, G) - call hchksum(Kd, "after KPP Kd",G%HI,haloshift=0) - call hchksum(Kd_Int, "after KPP Kd_Int",G%HI,haloshift=0) + call hchksum(Kd_lay, "after KPP Kd_lay", G%HI, haloshift=0, scale=GV%Z_to_m**2) + call hchksum(Kd_Int, "after KPP Kd_Int", G%HI, haloshift=0) endif endif ! endif for KPP @@ -1653,7 +1655,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! Calculate appropriately limited diapycnal mass fluxes to account ! for diapycnal diffusion and advection. Sets: ea, eb. Changes: kb call Entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS%entrain_diffusive_CSp, & - ea, eb, kb, Kd_Lay=Kd, Kd_int=Kd_int) + ea, eb, kb, Kd_Lay=Kd_lay, Kd_int=Kd_int) call cpu_clock_end(id_clock_entrain) if (showCallTree) call callTree_waypoint("done with Entrainment_diffusive (diabatic)") @@ -2074,7 +2076,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! thicknesses, as this corresponds pretty closely (to within ! differences in the density jumps between layers) with what is done ! in the calculation of the fluxes in the first place. Kd_min_tr - ! should be much less than the values that have been set in Kd, + ! should be much less than the values that have been set in Kd_lay, ! perhaps a molecular diffusivity. add_ent = ((dt * CS%Kd_min_tr) * GV%m_to_H**2) * & ((h(i,j,k-1)+h(i,j,k)+h_neglect) / & diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index d3a510fea7..e48fb0469a 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -73,7 +73,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & ! At least one of the two following arguments must be present. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: Kd_Lay !< The diapycnal diffusivity of layers, - !! in m2 s-1. + !! in Z2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & optional, intent(in) :: Kd_int !< The diapycnal diffusivity of interfaces, !! in m2 s-1. @@ -270,7 +270,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & if (present(Kd_Lay)) then do k=1,nz ; do i=is,ie - dtKd(i,k) = m_to_H**2 * (dt*Kd_Lay(i,j,k)) + dtKd(i,k) = GV%Z_to_H**2 * (dt*Kd_lay(i,j,k)) enddo ; enddo if (present(Kd_int)) then do K=1,nz+1 ; do i=is,ie @@ -278,7 +278,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & enddo ; enddo else do K=2,nz ; do i=is,ie - dtKd_int(i,K) = m_to_H**2 * (0.5*dt*(Kd_Lay(i,j,k-1) + Kd_Lay(i,j,k))) + dtKd_int(i,K) = GV%Z_to_H**2 * (0.5*dt*(Kd_lay(i,j,k-1) + Kd_lay(i,j,k))) enddo ; enddo endif else ! Kd_int must be present, or there already would have been an error. diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index a28751fb66..2d6f513e67 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -197,7 +197,7 @@ module MOM_set_diffusivity !! visc%Kv_slow. Vertical viscosity due to shear-driven mixing is passed via !! visc%Kv_shear subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & - G, GV, CS, Kd, Kd_int) + G, GV, CS, Kd_lay, Kd_int) 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)), & @@ -220,7 +220,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & real, intent(in) :: dt !< Time increment (sec). type(set_diffusivity_CS), pointer :: CS !< Module control structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(out) :: Kd !< Diapycnal diffusivity of each layer (m2/sec). + intent(out) :: Kd_lay !< Diapycnal diffusivity of each layer (m2/sec). real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & optional, intent(out) :: Kd_int !< Diapycnal diffusivity at each interface (m2/sec). @@ -288,9 +288,9 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call MOM_error(FATAL, "set_diffusivity: both visc%Kd_extra_T and "//& "visc%Kd_extra_S must be associated when USE_CVMIX_DDIFF or DOUBLE_DIFFUSION are true.") - ! Set Kd, Kd_int and Kv_slow to constant values. + ! Set Kd_lay, Kd_int and Kv_slow to constant values. ! If nothing else is specified, this will be the value used. - Kd(:,:,:) = CS%Kd + Kd_lay(:,:,:) = GV%m_to_Z**2*CS%Kd Kd_int(:,:,:) = CS%Kd if (associated(visc%Kv_slow)) visc%Kv_slow(:,:,:) = GV%m_to_Z**2 * CS%Kv @@ -381,7 +381,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & visc%Kv_shear(:,:,:) = 0.0 ! needed if calculate_kappa_shear is not enabled endif - ! Calculate the diffusivity, Kd, for each layer. This would be + ! Calculate the diffusivity, Kd_lay, for each layer. This would be ! the appropriate place to add a depth-dependent parameterization or ! another explicit parameterization of Kd. @@ -400,20 +400,20 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & endif ! Add background mixing - call calculate_bkgnd_mixing(h, tv, N2_lay, Kd, visc%Kv_slow, j, G, GV, CS%bkgnd_mixing_csp) + call calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, visc%Kv_slow, j, G, GV, CS%bkgnd_mixing_csp) ! Double-diffusion (old method) if (CS%double_diffusion) then call double_diffusion(tv, h, T_f, S_f, j, G, GV, CS, KT_extra, KS_extra) do K=2,nz ; do i=is,ie if (KS_extra(i,K) > KT_extra(i,K)) then ! salt fingering - Kd(i,j,k-1) = Kd(i,j,k-1) + 0.5*KT_extra(i,K) - Kd(i,j,k) = Kd(i,j,k) + 0.5*KT_extra(i,K) + Kd_lay(i,j,k-1) = Kd_lay(i,j,k-1) + 0.5*GV%m_to_Z**2*KT_extra(i,K) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*KT_extra(i,K) visc%Kd_extra_S(i,j,k) = GV%m_to_Z**2 * (KS_extra(i,K) - KT_extra(i,K)) visc%Kd_extra_T(i,j,k) = 0.0 elseif (KT_extra(i,K) > 0.0) then ! double-diffusive convection - Kd(i,j,k-1) = Kd(i,j,k-1) + 0.5*KS_extra(i,K) - Kd(i,j,k) = Kd(i,j,k) + 0.5*KS_extra(i,K) + Kd_lay(i,j,k-1) = Kd_lay(i,j,k-1) + 0.5*GV%m_to_Z**2*KS_extra(i,K) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*KS_extra(i,K) visc%Kd_extra_T(i,j,k) = GV%m_to_Z**2 * (KT_extra(i,K) - KS_extra(i,K)) visc%Kd_extra_S(i,j,k) = 0.0 else ! There is no double diffusion at this interface. @@ -442,7 +442,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%useKappaShear .or. CS%use_CVMix_shear) then if (present(Kd_int)) then do K=2,nz ; do i=is,ie - Kd_int(i,j,K) = GV%Z_to_m**2 * visc%Kd_shear(i,j,K) + 0.5*(Kd(i,j,k-1) + Kd(i,j,k)) + Kd_int(i,j,K) = GV%Z_to_m**2 * visc%Kd_shear(i,j,K) + 0.5*GV%Z_to_m**2*(Kd_lay(i,j,k-1) + Kd_lay(i,j,k)) enddo ; enddo do i=is,ie Kd_int(i,j,1) = GV%Z_to_m**2 * visc%Kd_shear(i,j,1) ! This isn't actually used. It could be 0. @@ -450,15 +450,15 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & enddo endif do k=1,nz ; do i=is,ie - Kd(i,j,k) = Kd(i,j,k) + GV%Z_to_m**2 * 0.5*(visc%Kd_shear(i,j,K) + visc%Kd_shear(i,j,K+1)) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*(visc%Kd_shear(i,j,K) + visc%Kd_shear(i,j,K+1)) enddo ; enddo else if (present(Kd_int)) then do i=is,ie - Kd_int(i,j,1) = Kd(i,j,1) ; Kd_int(i,j,nz+1) = 0.0 + Kd_int(i,j,1) = GV%Z_to_m**2*Kd_lay(i,j,1) ; Kd_int(i,j,nz+1) = 0.0 enddo do K=2,nz ; do i=is,ie - Kd_int(i,j,K) = 0.5*(Kd(i,j,k-1) + Kd(i,j,k)) + Kd_int(i,j,K) = 0.5*GV%Z_to_m**2*(Kd_lay(i,j,k-1) + Kd_lay(i,j,k)) enddo ; enddo endif endif @@ -474,21 +474,21 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! Add the ML_Rad diffusivity. if (CS%ML_radiation) & - call add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd, TKE_to_Kd, Kd_int) + call add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_int) ! Add the Nikurashin and / or tidal bottom-driven mixing call calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, maxTKE, G, GV, CS%tm_csp, & - N2_lay, N2_int, Kd, Kd_int, CS%Kd_max, visc%Kv_slow) + N2_lay, N2_int, Kd_lay, Kd_int, CS%Kd_max, visc%Kv_slow) ! This adds the diffusion sustained by the energy extracted from the flow ! by the bottom drag. if (CS%bottomdraglaw .and. (CS%BBL_effic>0.0)) then if (CS%use_LOTW_BBL_diffusivity) then call add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, G, GV, CS, & - Kd, Kd_int, dd%Kd_BBL) + Kd_lay, Kd_int, dd%Kd_BBL) else call add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & - maxTKE, kb, G, GV, CS, Kd, Kd_int, dd%Kd_BBL) + maxTKE, kb, G, GV, CS, Kd_lay, Kd_int, dd%Kd_BBL) endif endif @@ -502,8 +502,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & dissip = max( CS%dissip_min, & ! Const. floor on dissip. CS%dissip_N0 + CS%dissip_N1 * sqrt(N2_lay(i,k)), & ! Floor aka Gargett CS%dissip_N2 * N2_lay(i,k) ) ! Floor of Kd_min*rho0/F_Ri - Kd(i,j,k) = max( Kd(i,j,k) , & ! Apply floor to Kd - dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_lay(i,k) + Omega2))) ) + Kd_lay(i,j,k) = max( Kd_lay(i,j,k) , & ! Apply floor to Kd + GV%m_to_Z**2*dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_lay(i,k) + Omega2))) ) enddo ; enddo if (present(Kd_int)) then ; do K=2,nz ; do i=is,ie @@ -522,14 +522,14 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (associated(dd%Kd_work)) then do k=1,nz ; do i=is,ie - dd%Kd_Work(i,j,k) = GV%Rho0 * Kd(i,j,k) * N2_lay(i,k) * & - GV%H_to_m*h(i,j,k) ! Watt m-2 s or kg s-3 + dd%Kd_Work(i,j,k) = GV%Rho0 * GV%Z_to_m**2*Kd_lay(i,j,k) * N2_lay(i,k) * & + GV%H_to_m*h(i,j,k) ! Watt m-2 s or kg s-3 enddo ; enddo endif enddo ! j-loop if (CS%debug) then - call hchksum(Kd ,"Kd",G%HI,haloshift=0) + call hchksum(Kd_lay ,"Kd_lay", G%HI, haloshift=0, scale=GV%Z_to_m**2) if (CS%useKappaShear) call hchksum(visc%Kd_shear, "Turbulent Kd", G%HI, haloshift=0, scale=GV%Z_to_m**2) @@ -559,18 +559,18 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & !$OMP parallel do default(none) shared(is,ie,js,je,nz,Kd_int,CS,Kd) do k=1,nz ; do j=js,je ; do i=is,ie Kd_int(i,j,K) = Kd_int(i,j,K) + CS%Kd_add - Kd(i,j,k) = Kd(i,j,k) + CS%Kd_add + Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*CS%Kd_add enddo ; enddo ; enddo else !$OMP parallel do default(none) shared(is,ie,js,je,nz,CS,Kd) do k=1,nz ; do j=js,je ; do i=is,ie - Kd(i,j,k) = Kd(i,j,k) + CS%Kd_add + Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*CS%Kd_add enddo ; enddo ; enddo endif endif if (CS%user_change_diff) then - call user_change_diff(h, tv, G, CS%user_change_diff_CSp, Kd, Kd_int, & + call user_change_diff(h, tv, G, GV, CS%user_change_diff_CSp, Kd_lay, Kd_int, & T_f, S_f, dd%Kd_user) endif @@ -590,7 +590,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%CVMix_ddiff_csp%id_R_rho > 0) & call post_data(CS%CVMix_ddiff_csp%id_R_rho, CS%CVMix_ddiff_csp%R_rho, CS%CVMix_ddiff_csp%diag) - if (CS%id_Kd_layer > 0) call post_data(CS%id_Kd_layer, Kd, CS%diag) + if (CS%id_Kd_layer > 0) call post_data(CS%id_Kd_layer, Kd_lay, CS%diag) ! tidal mixing call post_tidal_diagnostics(G,GV,h,CS%tm_csp) @@ -1120,7 +1120,7 @@ end subroutine double_diffusion !> This routine adds diffusion sustained by flow energy extracted by bottom drag. subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & - maxTKE, kb, G, GV, CS, Kd, Kd_int, Kd_BBL) + maxTKE, kb, G, GV, CS, Kd_lay, Kd_int, Kd_BBL) 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)), & @@ -1146,7 +1146,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & !! layer, or -1 without a bulk mixed layer type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd !< The diapycnal diffusvity in layers, in m2 s-1 + intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in m2 s-1 real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in m2 s-1 real, dimension(:,:,:), pointer :: Kd_BBL !< Interface BBL diffusivity, in m2 s-1 @@ -1292,13 +1292,13 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & TKE(i) = TKE(i) - TKE_to_layer - if (Kd(i,j,k) < (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k)) then - delta_Kd = (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k) - Kd(i,j,k) + if (Kd_lay(i,j,k) < (TKE_to_layer+TKE_Ray)*GV%m_to_Z**2*TKE_to_Kd(i,k)) then + delta_Kd = (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k) - GV%Z_to_m**2*Kd_lay(i,j,k) if ((CS%Kd_max >= 0.0) .and. (delta_Kd > CS%Kd_max)) then delta_Kd = CS%Kd_Max - Kd(i,j,k) = Kd(i,j,k) + delta_Kd + Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*delta_Kd else - Kd(i,j,k) = (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k) + Kd_lay(i,j,k) = (TKE_to_layer+TKE_Ray)*GV%m_to_Z**2*TKE_to_Kd(i,k) endif Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*delta_Kd Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*delta_Kd @@ -1308,12 +1308,12 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & endif endif else - if (Kd(i,j,k) >= maxTKE(i,k)*TKE_to_Kd(i,k)) then + if (Kd_lay(i,j,k) >= maxTKE(i,k)*GV%m_to_Z**2*TKE_to_Kd(i,k)) then TKE_here = 0.0 TKE(i) = TKE(i) + TKE_Ray - elseif (Kd(i,j,k) + (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k) > & - maxTKE(i,k)*TKE_to_Kd(i,k)) then - TKE_here = ((TKE_to_layer+TKE_Ray) + Kd(i,j,k)/TKE_to_Kd(i,k)) - & + elseif (Kd_lay(i,j,k) + (TKE_to_layer+TKE_Ray)*GV%m_to_Z**2*TKE_to_Kd(i,k) > & + maxTKE(i,k)*GV%m_to_Z**2*TKE_to_Kd(i,k)) then + TKE_here = ( (TKE_to_layer+TKE_Ray) + Kd_lay(i,j,k)/(GV%m_to_Z**2*TKE_to_Kd(i,k)) ) - & maxTKE(i,k) TKE(i) = TKE(i) - TKE_here + TKE_Ray else @@ -1325,7 +1325,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & if (TKE_here > 0.0) then delta_Kd = TKE_here*TKE_to_Kd(i,k) if (CS%Kd_max >= 0.0) delta_Kd = min(delta_Kd, CS%Kd_max) - Kd(i,j,k) = Kd(i,j,k) + delta_Kd + Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*delta_Kd Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*delta_Kd Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*delta_Kd if (do_diag_Kd_BBL) then @@ -1354,7 +1354,7 @@ end subroutine add_drag_diffusivity !! wall turbulent viscosity, up to a BBL height where the energy used for mixing has !! consumed the mechanical TKE input. subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & - G, GV, CS, Kd, Kd_int, Kd_BBL) + G, GV, CS, Kd_lay, Kd_int, Kd_BBL) 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_(G)), & @@ -1373,7 +1373,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & intent(in) :: N2_int !< Square of Brunt-Vaisala at interfaces (s-2) type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd !< Layer net diffusivity (m2 s-1) + intent(inout) :: Kd_lay !< Layer net diffusivity (m2 s-1) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & intent(inout) :: Kd_int !< Interface net diffusivity (m2 s-1) real, dimension(:,:,:), pointer :: Kd_BBL !< Interface BBL diffusivity (m2 s-1) @@ -1504,7 +1504,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & ! Add this BBL diffusivity to the model net diffusivity. Kd_int(i,j,k) = Kd_int(i,j,k) + Kd_wall - Kd(i,j,k) = Kd(i,j,k) + 0.5*(Kd_wall + Kd_lower) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*(Kd_wall + Kd_lower) Kd_lower = Kd_wall ! Store for next level up. if (do_diag_Kd_BBL) Kd_BBL(i,j,k) = Kd_wall enddo ! k @@ -1513,7 +1513,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & end subroutine add_LOTW_BBL_diffusivity !> This routine adds effects of mixed layer radiation to the layer diffusivities. -subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd, TKE_to_Kd, Kd_int) +subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_int) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -1521,7 +1521,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd, TKE_to_Kd, Kd_int) type(forcing), intent(in) :: fluxes !< Surface fluxes structure type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd !< The diapycnal diffusvity in layers, in m2 s-1. + intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in m2 s-1. integer, intent(in) :: j !< The j-index to work on real, dimension(SZI_(G),SZK_(G)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE !! TKE dissipated within a layer and the @@ -1598,7 +1598,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd, TKE_to_Kd, Kd_int) endif ; enddo do k=1,kml+1 ; do i=is,ie ; if (do_i(i)) then - Kd(i,j,k) = Kd(i,j,k) + Kd_mlr_ml(i) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*Kd_mlr_ml(i) endif ; enddo ; enddo if (present(Kd_int)) then do K=2,kml+1 ; do i=is,ie ; if (do_i(i)) then @@ -1621,7 +1621,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd, TKE_to_Kd, Kd_int) (I_decay(i) * (1.0 - z1 * (0.5 - C1_6*z1))) endif Kd_mlr = min(Kd_mlr,CS%ML_rad_kd_max) - Kd(i,j,k) = Kd(i,j,k) + Kd_mlr + Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*Kd_mlr if (present(Kd_int)) then Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*Kd_mlr Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*Kd_mlr diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 8e5f016351..6976966a50 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -647,7 +647,7 @@ end function tidal_mixing_init !! tidal dissipation and to add the effect of internal-tide-driven mixing to the layer or interface !! diffusivities. subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & - N2_lay, N2_int, Kd, Kd_int, Kd_max, Kv) + N2_lay, N2_int, Kd_lay, Kd_int, Kd_max, Kv) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -668,7 +668,7 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & !! to its maximum realizable thickness, in m3 s-3 type(tidal_mixing_cs), pointer :: CS !< The control structure for this module real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd !< The diapycnal diffusvity in layers, in m2 s-1. + intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in m2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in m2 s-1. real, intent(in) :: Kd_max !< The maximum increment for diapycnal @@ -679,10 +679,10 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation .or. CS%Lowmode_itidal_dissipation) then if (CS%use_CVMix_tidal) then - call calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd, Kv) + call calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd_lay, Kv) else call add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & - N2_lay, Kd, Kd_int, Kd_max) + N2_lay, Kd_lay, Kd_int, Kd_max) endif endif end subroutine @@ -690,7 +690,7 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & !> Calls the CVMix routines to compute tidal dissipation and to add the effect of internal-tide-driven !! mixing to the interface diffusivities. -subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd, Kv) +subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd_lay, Kv) integer, intent(in) :: j !< The j-index to work on type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure @@ -701,7 +701,7 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd, Kv) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd !< The diapycnal diffusivities in the layers, in m2 s-1 + intent(inout) :: Kd_lay!< The diapycnal diffusivities in the layers, in Z2 s-1 real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface !! (not layer!) in Z2 s-1. ! Local variables @@ -772,8 +772,8 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd, Kv) CVMix_tidal_params_user = CS%CVMix_tidal_params) ! Update diffusivity - do k=1,G%ke ! GV%m_to_Z**2 * - Kd(i,j,k) = Kd(i,j,k) + 0.5*(Kd_tidal(k) + Kd_tidal(k+1) ) + do k=1,G%ke + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*(Kd_tidal(k) + Kd_tidal(k+1) ) enddo ! Update viscosity with the proper unit conversion. @@ -871,8 +871,8 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd, Kv) CVmix_tidal_params_user = CS%CVMix_tidal_params) ! Update diffusivity - do k=1,G%ke ! GV%m_to_Z**2 * - Kd(i,j,k) = Kd(i,j,k) + 0.5*(Kd_tidal(k) + Kd_tidal(k+1) ) + do k=1,G%ke + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*(Kd_tidal(k) + Kd_tidal(k+1) ) enddo ! Update viscosity @@ -917,7 +917,7 @@ end subroutine calculate_CVMix_tidal !! Will eventually need to add diffusivity due to other wave-breaking processes (e.g. Bottom friction, !! Froude-number-depending breaking, PSI, etc.). subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & - N2_lay, Kd, Kd_int, Kd_max) + N2_lay, Kd_lay, Kd_int, Kd_max) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -936,7 +936,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, !! to its maximum realizable thickness, in m3 s-3 type(tidal_mixing_cs), pointer :: CS !< The control structure for this module real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd !< The diapycnal diffusvity in layers, in m2 s-1. + intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in Z2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in m2 s-1. real, intent(in) :: Kd_max !< The maximum increment for diapycnal @@ -1181,7 +1181,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, Kd_add = TKE_to_Kd(i,k) * (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) - Kd(i,j,k) = Kd(i,j,k) + Kd_add + Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*Kd_add if (present(Kd_int)) then Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*Kd_add @@ -1268,7 +1268,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, Kd_add = TKE_to_Kd(i,k) * (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) - Kd(i,j,k) = Kd(i,j,k) + Kd_add + Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*Kd_add if (present(Kd_int)) then Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*Kd_add diff --git a/src/user/user_change_diffusivity.F90 b/src/user/user_change_diffusivity.F90 index ea15387f64..f3684f3cdc 100644 --- a/src/user/user_change_diffusivity.F90 +++ b/src/user/user_change_diffusivity.F90 @@ -5,17 +5,17 @@ module user_change_diffusivity use MOM_diag_mediator, only : diag_ctrl, time_type use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE -use MOM_file_parser, only : get_param, log_version, param_file_type -use MOM_grid, only : ocean_grid_type -use MOM_variables, only : thermo_var_ptrs, vertvisc_type, p3d -use MOM_EOS, only : calculate_density +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_grid, only : ocean_grid_type +use MOM_variables, only : thermo_var_ptrs, vertvisc_type, p3d +use MOM_verticalGrid, only : verticalGrid_type +use MOM_EOS, only : calculate_density implicit none ; private #include -public user_change_diff, user_change_diff_init -public user_change_diff_end +public user_change_diff, user_change_diff_init, user_change_diff_end !> Control structure for user_change_diffusivity type, public :: user_change_diff_CS ; private @@ -38,15 +38,16 @@ module user_change_diffusivity !! main code to alter the diffusivities as needed. The specific example !! implemented here augments the diffusivity for a specified range of latitude !! and coordinate potential density. -subroutine user_change_diff(h, tv, G, CS, Kd, Kd_int, T_f, S_f, Kd_int_add) +subroutine user_change_diff(h, tv, G, GV, CS, Kd_lay, Kd_int, T_f, S_f, Kd_int_add) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers !! to any available thermodynamic !! fields. Absent fields have NULL ptrs. type(user_change_diff_CS), pointer :: CS !< This module's control structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(inout) :: Kd !< The diapycnal diffusivity of - !! each layer in m2 s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity of + !! each layer in Z2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), optional, intent(inout) :: Kd_int !< The diapycnal diffusivity !! at each interface in m2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: T_f !< Temperature with massless @@ -109,7 +110,7 @@ subroutine user_change_diff(h, tv, G, CS, Kd, Kd_int, T_f, S_f, Kd_int_add) enddo endif - if (present(Kd)) then + if (present(Kd_lay)) then do k=1,nz ; do i=is,ie if (CS%use_abs_lat) then lat_fn = val_weights(abs(G%geoLatT(i,j)), CS%lat_range) @@ -118,7 +119,7 @@ subroutine user_change_diff(h, tv, G, CS, Kd, Kd_int, T_f, S_f, Kd_int_add) endif rho_fn = val_weights(Rcv(i,k), CS%rho_range) if (rho_fn * lat_fn > 0.0) & - Kd(i,j,k) = Kd(i,j,k) + CS%Kd_add * rho_fn * lat_fn + Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2 * CS%Kd_add * rho_fn * lat_fn enddo ; enddo endif if (present(Kd_int)) then From 7f6647f228b860bc26a3982e03960c546f647a63 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 4 Oct 2018 11:05:49 -0400 Subject: [PATCH 136/174] Changed the units of Kd_int to Z-2 s-1 Rescaled the units of Kd_int from m2 s-1 to Z2 s-1 for dimensional consistency testing. Also eliminated some unneeded variables and corrected some unrelated comments. All answers are bitwise identical, including rescaling Z over a large range. --- .../vertical/MOM_CVMix_shear.F90 | 3 +- .../vertical/MOM_diabatic_driver.F90 | 28 ++++++------- .../vertical/MOM_diapyc_energy_req.F90 | 4 +- .../vertical/MOM_entrain_diffusive.F90 | 20 +++++----- .../vertical/MOM_set_diffusivity.F90 | 40 +++++++++---------- .../vertical/MOM_tidal_mixing.F90 | 14 +++---- .../vertical/MOM_vert_friction.F90 | 10 ++--- src/user/user_change_diffusivity.F90 | 4 +- 8 files changed, 60 insertions(+), 63 deletions(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index a22bda0d9d..d80ccf1114 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -50,8 +50,7 @@ module MOM_CVMix_shear contains !> Subroutine for calculating (internal) vertical diffusivities/viscosities -subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, & - kv, G, GV, CS ) +subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, CS ) type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: u_H !< Initial zonal velocity on T points, in m s-1. diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index f24a7f3cd4..15474051b0 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -564,8 +564,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_salt(i,j,k) = GV%m_to_Z**2 * Kd_int(i,j,k) - Kd_heat(i,j,k) = GV%m_to_Z**2 * Kd_int(i,j,k) + Kd_salt(i,j,k) = Kd_int(i,j,K) + Kd_heat(i,j,k) = Kd_int(i,j,K) enddo ; enddo ; enddo ! Add contribution from double diffusion if (associated(visc%Kd_extra_S)) then @@ -1508,8 +1508,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_salt(i,j,k) = GV%m_to_Z**2 * Kd_int(i,j,k) - Kd_heat(i,j,k) = GV%m_to_Z**2 * Kd_int(i,j,k) + Kd_salt(i,j,k) = Kd_int(i,j,K) + Kd_heat(i,j,k) = Kd_int(i,j,K) enddo ; enddo ; enddo if (associated(visc%Kd_extra_S)) then !$OMP parallel do default(shared) @@ -1538,18 +1538,18 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (.not. CS%KPPisPassive) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_int(i,j,k) = GV%Z_to_m**2 * min( Kd_salt(i,j,k), Kd_heat(i,j,k) ) + Kd_int(i,j,K) = min( Kd_salt(i,j,k), Kd_heat(i,j,k) ) enddo ; enddo ; enddo if (associated(visc%Kd_extra_S)) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kd_extra_S(i,j,k) = (Kd_salt(i,j,k) - GV%m_to_Z**2 * Kd_int(i,j,k)) + visc%Kd_extra_S(i,j,k) = (Kd_salt(i,j,k) - Kd_int(i,j,K)) enddo ; enddo ; enddo endif if (associated(visc%Kd_extra_T)) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kd_extra_T(i,j,k) = (Kd_heat(i,j,k) - GV%m_to_Z**2 * Kd_int(i,j,k)) + visc%Kd_extra_T(i,j,k) = (Kd_heat(i,j,k) - Kd_int(i,j,K)) enddo ; enddo ; enddo endif endif ! not passive @@ -1573,7 +1573,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en !!!!!!!! GMM, the following needs to be checked !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !### The vertical extent here is more limited that Kv_slow or Kd_int; it might be k=1,nz+1. do k=1,nz ; do j=js,je ; do i=is,ie - Kd_int(i,j,k) = Kd_int(i,j,k) + GV%Z_to_m**2 * CS%CVMix_conv_csp%kd_conv(i,j,k) + Kd_int(i,j,K) = Kd_int(i,j,K) + CS%CVMix_conv_csp%kd_conv(i,j,k) visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) enddo ; enddo ; enddo !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -1640,7 +1640,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en !$OMP private(hval) do k=2,nz ; do j=js,je ; do i=is,ie hval=1.0/(h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) - ea(i,j,k) = (GV%m_to_H**2) * dt * hval * Kd_int(i,j,k) + ea(i,j,k) = (GV%Z_to_H**2) * dt * hval * Kd_int(i,j,K) eb(i,j,k-1) = ea(i,j,k) enddo ; enddo ; enddo do j=js,je ; do i=is,ie @@ -1727,11 +1727,11 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en (0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect) eb(i,j,k-1) = eb(i,j,k-1) + Ent_int ea(i,j,k) = ea(i,j,k) + Ent_int - Kd_int(i,j,K) = Kd_int(i,j,K) + GV%Z_to_m**2 * Kd_add_here + Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_add_here ! for diagnostics - Kd_heat(i,j,K) = Kd_heat(i,j,K) + GV%m_to_Z**2 * Kd_int(i,j,K) - Kd_salt(i,j,K) = Kd_salt(i,j,K) + GV%m_to_Z**2 * Kd_int(i,j,K) + Kd_heat(i,j,K) = Kd_heat(i,j,K) + Kd_int(i,j,K) + Kd_salt(i,j,K) = Kd_salt(i,j,K) + Kd_int(i,j,K) enddo ; enddo ; enddo @@ -2909,12 +2909,12 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, call get_param(param_file, mdl, "KD_MIN_TR", CS%Kd_min_tr, & "A minimal diffusivity that should always be applied to \n"//& "tracers, especially in massless layers near the bottom. \n"//& - "The default is 0.1*KD.", units="m2 s-1", default=0.1*Kd) + "The default is 0.1*KD.", units="m2 s-1", default=0.1*Kd) !### This would benefit from rescaling. call get_param(param_file, mdl, "KD_BBL_TR", CS%Kd_BBL_tr, & "A bottom boundary layer tracer diffusivity that will \n"//& "allow for explicitly specified bottom fluxes. The \n"//& "entrainment at the bottom is at least sqrt(Kd_BBL_tr*dt) \n"//& - "over the same distance.", units="m2 s-1", default=0.) + "over the same distance.", units="m2 s-1", default=0.) !### This needs rescaling? endif call get_param(param_file, mdl, "TRACER_TRIDIAG", CS%tracer_tridiag, & diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index 767e49ed89..93676a384c 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -53,7 +53,7 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, CS, Kd_int) !! in s. type(diapyc_energy_req_CS), pointer :: CS !< This module's control structure. real, dimension(G%isd:G%ied,G%jsd:G%jed,GV%ke+1), & - optional, intent(in) :: Kd_int !< Interface diffusivities. + optional, intent(in) :: Kd_int !< Interface diffusivities in Z2 s-1. ! Local variables real, dimension(GV%ke) :: & @@ -75,7 +75,7 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, CS, Kd_int) !$OMP do do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.5) then if (present(Kd_int) .and. .not.CS%use_test_Kh_profile) then - do k=1,nz+1 ; Kd(K) = CS%test_Kh_scaling*Kd_int(i,j,K) ; enddo + do k=1,nz+1 ; Kd(K) = CS%test_Kh_scaling*GV%Z_to_m**2*Kd_int(i,j,K) ; enddo else htot = 0.0 ; h_top(1) = 0.0 do k=1,nz diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index e48fb0469a..b2911d5033 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -76,7 +76,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & !! in Z2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & optional, intent(in) :: Kd_int !< The diapycnal diffusivity of interfaces, - !! in m2 s-1. + !! in Z2 s-1. ! This subroutine calculates ea and eb, the rates at which a layer entrains ! from the layers above and below. The entrainment rates are proportional to @@ -194,7 +194,6 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & real :: h1 ! The layer thickness after entrainment through the ! interface below is taken into account, in H. real :: Idt ! The inverse of the time step, in s-1. - real :: H_to_m, m_to_H ! Local copies of unit conversion factors. logical :: do_any logical :: do_i(SZI_(G)), did_i(SZI_(G)), reiterate, correct_density @@ -224,8 +223,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & &and a linear equation of state to drive the model.") endif - H_to_m = GV%H_to_m ; m_to_H = GV%m_to_H - tolerance = m_to_H * CS%Tolerance_Ent + tolerance = GV%m_to_H * CS%Tolerance_Ent g_2dt = 0.5 * (GV%g_Earth*GV%m_to_Z) / dt kmb = GV%nk_rho_varies K2 = max(kmb+1,2) ; kb_min = K2 @@ -252,7 +250,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & !$OMP parallel do default(none) shared(is,ie,js,je,nz,Kd_Lay,G,GV,dt,Kd_int,CS,h,tv, & !$OMP kmb,Angstrom,fluxes,K2,h_neglect,tolerance, & !$OMP ea,eb,correct_density,Kd_eff,diff_work, & -!$OMP g_2dt, kb_out, m_to_H, H_to_m) & +!$OMP g_2dt, kb_out) & !$OMP firstprivate(kb,ds_dsp1,dsp1_ds,pres,kb_min) & !$OMP private(dtKd,dtKd_int,do_i,Ent_bl,dtKd_kb,h_bl, & !$OMP I2p2dsp1_ds,grats,htot,max_eakb,I_dSkbp1, & @@ -274,7 +272,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & enddo ; enddo if (present(Kd_int)) then do K=1,nz+1 ; do i=is,ie - dtKd_int(i,K) = m_to_H**2 * (dt*Kd_int(i,j,K)) + dtKd_int(i,K) = GV%Z_to_H**2 * (dt*Kd_int(i,j,K)) enddo ; enddo else do K=2,nz ; do i=is,ie @@ -283,10 +281,10 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & endif else ! Kd_int must be present, or there already would have been an error. do k=1,nz ; do i=is,ie - dtKd(i,k) = m_to_H**2 * (0.5*dt*(Kd_int(i,j,K)+Kd_int(i,j,K+1))) + dtKd(i,k) = GV%Z_to_H**2 * (0.5*dt*(Kd_int(i,j,K)+Kd_int(i,j,K+1))) enddo ; enddo dO K=1,nz+1 ; do i=is,ie - dtKd_int(i,K) = m_to_H**2 * (dt*Kd_int(i,j,K)) + dtKd_int(i,K) = GV%Z_to_H**2 * (dt*Kd_int(i,j,K)) enddo ; enddo endif @@ -816,11 +814,11 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & (eb(i,j,k) - ea(i,j,k+1))) ) / (I2p2dsp1_ds(i,k) * grats(i,k)) endif - Kd_eff(i,j,k) = H_to_m**2 * (MAX(dtKd(i,k),Kd_here)*Idt) + Kd_eff(i,j,k) = GV%H_to_m**2 * (MAX(dtKd(i,k),Kd_here)*Idt) enddo ; enddo do i=is,ie - Kd_eff(i,j,1) = H_to_m**2 * (dtKd(i,1)*Idt) - Kd_eff(i,j,nz) = H_to_m**2 * (dtKd(i,nz)*Idt) + Kd_eff(i,j,1) = GV%H_to_m**2 * (dtKd(i,1)*Idt) + Kd_eff(i,j,nz) = GV%H_to_m**2 * (dtKd(i,nz)*Idt) enddo endif diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 2d6f513e67..df6c7df3c1 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -291,7 +291,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! Set Kd_lay, Kd_int and Kv_slow to constant values. ! If nothing else is specified, this will be the value used. Kd_lay(:,:,:) = GV%m_to_Z**2*CS%Kd - Kd_int(:,:,:) = CS%Kd + Kd_int(:,:,:) = GV%m_to_Z**2*CS%Kd if (associated(visc%Kv_slow)) visc%Kv_slow(:,:,:) = GV%m_to_Z**2 * CS%Kv ! Set up arrays for diagnostics. @@ -442,10 +442,10 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%useKappaShear .or. CS%use_CVMix_shear) then if (present(Kd_int)) then do K=2,nz ; do i=is,ie - Kd_int(i,j,K) = GV%Z_to_m**2 * visc%Kd_shear(i,j,K) + 0.5*GV%Z_to_m**2*(Kd_lay(i,j,k-1) + Kd_lay(i,j,k)) + Kd_int(i,j,K) = visc%Kd_shear(i,j,K) + 0.5*(Kd_lay(i,j,k-1) + Kd_lay(i,j,k)) enddo ; enddo do i=is,ie - Kd_int(i,j,1) = GV%Z_to_m**2 * visc%Kd_shear(i,j,1) ! This isn't actually used. It could be 0. + Kd_int(i,j,1) = visc%Kd_shear(i,j,1) ! This isn't actually used. It could be 0. Kd_int(i,j,nz+1) = 0.0 enddo endif @@ -455,10 +455,10 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & else if (present(Kd_int)) then do i=is,ie - Kd_int(i,j,1) = GV%Z_to_m**2*Kd_lay(i,j,1) ; Kd_int(i,j,nz+1) = 0.0 + Kd_int(i,j,1) = Kd_lay(i,j,1) ; Kd_int(i,j,nz+1) = 0.0 enddo do K=2,nz ; do i=is,ie - Kd_int(i,j,K) = 0.5*GV%Z_to_m**2*(Kd_lay(i,j,k-1) + Kd_lay(i,j,k)) + Kd_int(i,j,K) = 0.5*(Kd_lay(i,j,k-1) + Kd_lay(i,j,k)) enddo ; enddo endif endif @@ -516,7 +516,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & CS%dissip_N0 + CS%dissip_N1 * sqrt(N2_int(i,K)), & ! Floor aka Gargett CS%dissip_N2 * N2_int(i,K) ) ! Floor of Kd_min*rho0/F_Ri Kd_int(i,j,K) = max( Kd_int(i,j,K) , & ! Apply floor to Kd - dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_int(i,K) + Omega2))) ) + GV%m_to_Z**2*dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_int(i,K) + Omega2))) ) enddo ; enddo ; endif endif @@ -558,7 +558,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (present(Kd_int)) then !$OMP parallel do default(none) shared(is,ie,js,je,nz,Kd_int,CS,Kd) do k=1,nz ; do j=js,je ; do i=is,ie - Kd_int(i,j,K) = Kd_int(i,j,K) + CS%Kd_add + Kd_int(i,j,K) = Kd_int(i,j,K) + GV%m_to_Z**2*CS%Kd_add Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*CS%Kd_add enddo ; enddo ; enddo else @@ -1146,9 +1146,9 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & !! layer, or -1 without a bulk mixed layer type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in m2 s-1 + intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in Z2 s-1 real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & - intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in m2 s-1 + intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in Z2 s-1 real, dimension(:,:,:), pointer :: Kd_BBL !< Interface BBL diffusivity, in m2 s-1 ! This routine adds diffusion sustained by flow energy extracted by bottom drag. @@ -1300,8 +1300,8 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & else Kd_lay(i,j,k) = (TKE_to_layer+TKE_Ray)*GV%m_to_Z**2*TKE_to_Kd(i,k) endif - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*delta_Kd - Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*delta_Kd + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*GV%m_to_Z**2*delta_Kd + Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*GV%m_to_Z**2*delta_Kd if (do_diag_Kd_BBL) then Kd_BBL(i,j,K) = Kd_BBL(i,j,K) + 0.5*delta_Kd Kd_BBL(i,j,K+1) = Kd_BBL(i,j,K+1) + 0.5*delta_Kd @@ -1326,8 +1326,8 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & delta_Kd = TKE_here*TKE_to_Kd(i,k) if (CS%Kd_max >= 0.0) delta_Kd = min(delta_Kd, CS%Kd_max) Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*delta_Kd - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*delta_Kd - Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*delta_Kd + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*GV%m_to_Z**2*delta_Kd + Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*GV%m_to_Z**2*delta_Kd if (do_diag_Kd_BBL) then Kd_BBL(i,j,K) = Kd_BBL(i,j,K) + 0.5*delta_Kd Kd_BBL(i,j,K+1) = Kd_BBL(i,j,K+1) + 0.5*delta_Kd @@ -1503,7 +1503,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & TKE_remaining = TKE_remaining - TKE_consumed ! Note this will be non-negative ! Add this BBL diffusivity to the model net diffusivity. - Kd_int(i,j,k) = Kd_int(i,j,k) + Kd_wall + Kd_int(i,j,K) = Kd_int(i,j,K) + GV%m_to_Z**2*Kd_wall Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*(Kd_wall + Kd_lower) Kd_lower = Kd_wall ! Store for next level up. if (do_diag_Kd_BBL) Kd_BBL(i,j,k) = Kd_wall @@ -1521,7 +1521,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_ type(forcing), intent(in) :: fluxes !< Surface fluxes structure type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in m2 s-1. + intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in Z2 s-1. integer, intent(in) :: j !< The j-index to work on real, dimension(SZI_(G),SZK_(G)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE !! TKE dissipated within a layer and the @@ -1529,7 +1529,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_ !! usually (~Rho_0 / (G_Earth * dRho_lay)), !! in m2 s-1 / m3 s-3 = s2 m-1 real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & - optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in m2 s-1. + optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in Z2 s-1. ! This routine adds effects of mixed layer radiation to the layer diffusivities. @@ -1602,10 +1602,10 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_ endif ; enddo ; enddo if (present(Kd_int)) then do K=2,kml+1 ; do i=is,ie ; if (do_i(i)) then - Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_mlr_ml(i) + Kd_int(i,j,K) = Kd_int(i,j,K) + GV%m_to_Z**2*Kd_mlr_ml(i) endif ; enddo ; enddo if (kml<=nz-1) then ; do i=is,ie ; if (do_i(i)) then - Kd_int(i,j,Kml+2) = Kd_int(i,j,Kml+2) + 0.5*Kd_mlr_ml(i) + Kd_int(i,j,Kml+2) = Kd_int(i,j,Kml+2) + 0.5*GV%m_to_Z**2*Kd_mlr_ml(i) endif ; enddo ; endif endif @@ -1623,8 +1623,8 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_ Kd_mlr = min(Kd_mlr,CS%ML_rad_kd_max) Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*Kd_mlr if (present(Kd_int)) then - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*Kd_mlr - Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*Kd_mlr + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*GV%m_to_Z**2*Kd_mlr + Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*GV%m_to_Z**2*Kd_mlr endif TKE_ml_flux(i) = TKE_ml_flux(i) * exp(-z1) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 6976966a50..7e4f67c7cb 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -668,9 +668,9 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & !! to its maximum realizable thickness, in m3 s-3 type(tidal_mixing_cs), pointer :: CS !< The control structure for this module real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in m2 s-1. + intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in Z2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & - optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in m2 s-1. + optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in Z2 s-1. real, intent(in) :: Kd_max !< The maximum increment for diapycnal !! diffusivity due to TKE-based processes, in m2 s-1. !! Set this to a negative value to have no limit. @@ -938,7 +938,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in Z2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & - optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in m2 s-1. + optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in Z2 s-1. real, intent(in) :: Kd_max !< The maximum increment for diapycnal !! diffusivity due to TKE-based processes, in m2 s-1. !! Set this to a negative value to have no limit. @@ -1184,8 +1184,8 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*Kd_add if (present(Kd_int)) then - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*Kd_add - Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*Kd_add + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*GV%m_to_Z**2*Kd_add + Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*GV%m_to_Z**2*Kd_add endif ! diagnostics @@ -1271,8 +1271,8 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*Kd_add if (present(Kd_int)) then - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*Kd_add - Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*Kd_add + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*GV%m_to_Z**2*Kd_add + Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*GV%m_to_Z**2*Kd_add endif ! diagnostics diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index aec3a68f24..9014243e56 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1069,15 +1069,15 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, ! h_ml, & ! The mixed layer depth, in m or kg m-2. nk_visc, & ! The (real) interface index of the base of mixed layer. z_t, & ! The distance from the top, sometimes normalized - ! by Hmix, in m or nondimensional. + ! by Hmix, in H or nondimensional. kv_tbl, & ! The viscosity in a top boundary layer under ice, in Z2 s-1. tbl_thick real, dimension(SZIB_(G),SZK_(GV)) :: & Kv_add ! A viscosity to add, in Z2 s-1. - real :: h_shear ! The distance over which shears occur, m or kg m-2. - real :: r ! A thickness to compare with Hbbl, in m or kg m-2. - real :: visc_ml ! The mixed layer viscosity, in m2 s-1. - real :: I_Hmix ! The inverse of the mixed layer thickness, in m-1 or m2 kg-1. + real :: h_shear ! The distance over which shears occur, H. + real :: r ! A thickness to compare with Hbbl, in H. + real :: visc_ml ! The mixed layer viscosity, in Z2 s-1. + real :: I_Hmix ! The inverse of the mixed layer thickness, in H-1. real :: a_ml ! The layer coupling coefficient across an interface in ! the mixed layer, in m s-1. real :: I_amax ! The inverse of the maximum coupling coefficient, in Z-1.??? diff --git a/src/user/user_change_diffusivity.F90 b/src/user/user_change_diffusivity.F90 index f3684f3cdc..deec1cd858 100644 --- a/src/user/user_change_diffusivity.F90 +++ b/src/user/user_change_diffusivity.F90 @@ -49,7 +49,7 @@ subroutine user_change_diff(h, tv, G, GV, CS, Kd_lay, Kd_int, T_f, S_f, Kd_int_a real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity of !! each layer in Z2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), optional, intent(inout) :: Kd_int !< The diapycnal diffusivity - !! at each interface in m2 s-1. + !! at each interface in Z2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: T_f !< Temperature with massless !! layers filled in vertically. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: S_f !< Salinity with massless @@ -132,7 +132,7 @@ subroutine user_change_diff(h, tv, G, GV, CS, Kd_lay, Kd_int, T_f, S_f, Kd_int_a ! rho_int = 0.5*(Rcv(i,k-1) + Rcv(i,k)) rho_fn = val_weights( 0.5*(Rcv(i,k-1) + Rcv(i,k)), CS%rho_range) if (rho_fn * lat_fn > 0.0) then - Kd_int(i,j,K) = Kd_int(i,j,K) + CS%Kd_add * rho_fn * lat_fn + Kd_int(i,j,K) = Kd_int(i,j,K) + GV%m_to_Z**2 * CS%Kd_add * rho_fn * lat_fn if (store_Kd_add) Kd_int_add(i,j,K) = CS%Kd_add * rho_fn * lat_fn endif enddo ; enddo From 138e63a54d9a3aca0843f6ccff24bb704c7a66aa Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 4 Oct 2018 13:11:24 -0400 Subject: [PATCH 137/174] +Do MOM_bkgnd_mixing calculations in units of Z Changed the units of the internal diffusivites used in MOM_bkgnd_mixing from m2 s-1 to Z2 s-1 and depths from m to Z for dimensional consistency testing. Several variables are rescaled via get_param. As a part of these chages, a new GV argument was added to sfc_bkgnd_mixing. All answers are bitwise identical, including rescaling Z over a large range. --- .../vertical/MOM_bkgnd_mixing.F90 | 67 +++++++++---------- .../vertical/MOM_set_diffusivity.F90 | 2 +- 2 files changed, 34 insertions(+), 35 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index 83b1f70026..bdae195c06 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -41,8 +41,8 @@ module MOM_bkgnd_mixing !! Bryan-Lewis diffusivity profile (1/m) real :: Bryan_Lewis_c4 !< The depth where diffusivity is Bryan_Lewis_bl1 in the !! Bryan-Lewis profile (m) - real :: Kd_min !< minimum diapycnal diffusivity (m2/s) - real :: Kd !< interior diapycnal diffusivity (m2/s) + real :: Kd_min !< minimum diapycnal diffusivity (Z2/s) + real :: Kd !< interior diapycnal diffusivity (Z2/s) real :: N0_2Omega !< ratio of the typical Buoyancy frequency to !! twice the Earth's rotation period, used with the !! Henyey scaling from the mixing @@ -51,10 +51,9 @@ module MOM_bkgnd_mixing real :: Kd_tanh_lat_scale !< A nondimensional scaling for the range of !! diffusivities with Kd_tanh_lat_fn. Valid values !! are in the range of -2 to 2; 0.4 reproduces CM2M. - real :: Kdml !< mixed layer diapycnal diffusivity (m2/s) + real :: Kdml !< mixed layer diapycnal diffusivity (Z2/s) !! when bulkmixedlayer==.false. - real :: Hmix !< mixed layer thickness (meter) when - !! bulkmixedlayer==.false. + real :: Hmix !< mixed layer thickness (Z) when bulkmixedlayer==.false. logical :: Kd_tanh_lat_fn !< If true, use the tanh dependence of Kd_sfc on !! latitude, like GFDL CM2.1/CM2M. There is no !! physical justification for this form, and it can @@ -86,10 +85,10 @@ module MOM_bkgnd_mixing integer :: id_kd_bkgnd = -1 !< Diagnotic IDs integer :: id_kv_bkgnd = -1 !< Diagnostic IDs - real, allocatable, dimension(:,:) :: Kd_sfc !< surface value of the diffusivity (m2/s) + real, allocatable, dimension(:,:) :: Kd_sfc !< surface value of the diffusivity (Z2/s) ! Diagnostics arrays - real, allocatable, dimension(:,:,:) :: kd_bkgnd !< Background diffusivity (m2/s) - real, allocatable, dimension(:,:,:) :: kv_bkgnd !< Background viscosity (m2/s) + real, allocatable, dimension(:,:,:) :: kd_bkgnd !< Background diffusivity (Z2/s) + real, allocatable, dimension(:,:,:) :: kv_bkgnd !< Background viscosity (Z2/s) end type bkgnd_mixing_cs @@ -126,11 +125,11 @@ subroutine bkgnd_mixing_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, "KD", CS%Kd, & "The background diapycnal diffusivity of density in the \n"//& "interior. Zero or the molecular value, ~1e-7 m2 s-1, \n"//& - "may be used.", units="m2 s-1", fail_if_missing=.true.) + "may be used.", units="m2 s-1", scale=GV%m_to_Z**2, fail_if_missing=.true.) call get_param(param_file, mdl, "KD_MIN", CS%Kd_min, & "The minimum diapycnal diffusivity.", & - units="m2 s-1", default=0.01*CS%Kd) + units="m2 s-1", default=0.01*CS%Kd*GV%Z_to_m**2, scale=GV%m_to_Z**2) ! The following is needed to set one of the choices of vertical background mixing @@ -150,11 +149,11 @@ subroutine bkgnd_mixing_init(Time, G, GV, param_file, diag, CS) "If BULKMIXEDLAYER is false, KDML is the elevated \n"//& "diapycnal diffusivity in the topmost HMIX of fluid. \n"//& "KDML is only used if BULKMIXEDLAYER is false.", & - units="m2 s-1", default=CS%Kd) + units="m2 s-1", default=CS%Kd*GV%Z_to_m**2, scale=GV%m_to_Z**2) call get_param(param_file, mdl, "HMIX_FIXED", CS%Hmix, & "The prescribed depth over which the near-surface \n"//& "viscosity and diffusivity are elevated when the bulk \n"//& - "mixed layer is not used.", units="m", fail_if_missing=.true.) + "mixed layer is not used.", units="m", scale=GV%m_to_Z, fail_if_missing=.true.) endif call get_param(param_file, mdl, 'DEBUG', CS%debug, default=.False., do_not_log=.True.) @@ -245,16 +244,17 @@ subroutine bkgnd_mixing_init(Time, G, GV, param_file, diag, CS) ! Register diagnostics CS%diag => diag CS%id_kd_bkgnd = register_diag_field('ocean_model', 'Kd_bkgnd', diag%axesTi, Time, & - 'Background diffusivity added by MOM_bkgnd_mixing module', 'm2/s') + 'Background diffusivity added by MOM_bkgnd_mixing module', 'm2/s', conversion=GV%Z_to_m**2) CS%id_kv_bkgnd = register_diag_field('ocean_model', 'Kv_bkgnd', diag%axesTi, Time, & - 'Background viscosity added by MOM_bkgnd_mixing module', 'm2/s') + 'Background viscosity added by MOM_bkgnd_mixing module', 'm2/s', conversion=GV%Z_to_m**2) end subroutine bkgnd_mixing_init !> Get surface vertical background diffusivities/viscosities. -subroutine sfc_bkgnd_mixing(G, CS) +subroutine sfc_bkgnd_mixing(G, GV, CS) type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. type(bkgnd_mixing_cs), pointer, intent(inout) :: CS !< The control structure returned by !! a previous call to bkgnd_mixing_init. ! local variables @@ -299,7 +299,7 @@ subroutine sfc_bkgnd_mixing(G, CS) enddo ; enddo endif - if (CS%debug) call hchksum(CS%Kd_sfc,"After sfc_bkgnd_mixing: Kd_sfc",G%HI,haloshift=0) + if (CS%debug) call hchksum(CS%Kd_sfc,"After sfc_bkgnd_mixing: Kd_sfc",G%HI,haloshift=0, scale=GV%Z_to_m**2) end subroutine sfc_bkgnd_mixing @@ -324,10 +324,9 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, CS) real, dimension(SZK_(G)+1) :: depth_int !< distance from surface of the interfaces (m) real, dimension(SZK_(G)+1) :: Kd_col !< Diffusivities at the interfaces (m2 s-1) real, dimension(SZK_(G)+1) :: Kv_col !< Viscosities at the interfaces (m2 s-1) - real, dimension(SZI_(G)) :: & - depth !< distance from surface of an interface (meter) - real :: depth_c !< depth of the center of a layer (meter) - real :: I_Hmix !< inverse of fixed mixed layer thickness (1/m) + real, dimension(SZI_(G)) :: depth !< distance from surface of an interface (Z) + real :: depth_c !< depth of the center of a layer (Z) + real :: I_Hmix !< inverse of fixed mixed layer thickness (1/Z) real :: I_2Omega !< 1/(2 Omega) (sec) real :: N_2Omega real :: N02_N2 @@ -365,8 +364,8 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, CS) ! Update Kd and Kv. do K=1,nz+1 - CS%Kv_bkgnd(i,j,K) = Kv_col(K) - CS%Kd_bkgnd(i,j,K) = Kd_col(K) + CS%Kv_bkgnd(i,j,K) = GV%m_to_Z**2*Kv_col(K) + CS%Kd_bkgnd(i,j,K) = GV%m_to_Z**2*Kd_col(K) enddo do k=1,nz Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*(Kd_col(K) + Kd_col(K+1)) @@ -374,19 +373,19 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, CS) enddo ! i loop elseif ((.not. CS%Bryan_Lewis_diffusivity) .and. (.not.CS%bulkmixedlayer) .and. & - (CS%Kd/= CS%Kdml)) then + (CS%Kd /= CS%Kdml)) then I_Hmix = 1.0 / CS%Hmix do i=is,ie ; depth(i) = 0.0 ; enddo do k=1,nz ; do i=is,ie - depth_c = depth(i) + 0.5*GV%H_to_m*h(i,j,k) - if (depth_c <= CS%Hmix) then ; CS%kd_bkgnd(i,j,k) = CS%Kdml - elseif (depth_c >= 2.0*CS%Hmix) then ; CS%kd_bkgnd(i,j,k) = CS%Kd_sfc(i,j) + depth_c = depth(i) + 0.5*GV%H_to_Z*h(i,j,k) + if (depth_c <= CS%Hmix) then ; CS%Kd_bkgnd(i,j,k) = CS%Kdml + elseif (depth_c >= 2.0*CS%Hmix) then ; CS%Kd_bkgnd(i,j,k) = CS%Kd_sfc(i,j) else - Kd_lay(i,j,k) = GV%m_to_Z**2*((CS%Kd_sfc(i,j) - CS%Kdml) * I_Hmix) * depth_c + & - GV%m_to_Z**2*(2.0*CS%Kdml - CS%Kd_sfc(i,j)) + Kd_lay(i,j,k) = ((CS%Kd_sfc(i,j) - CS%Kdml) * I_Hmix) * depth_c + & + (2.0*CS%Kdml - CS%Kd_sfc(i,j)) endif - depth(i) = depth(i) + GV%H_to_m*h(i,j,k) + depth(i) = depth(i) + GV%H_to_Z*h(i,j,k) enddo ; enddo elseif (CS%Henyey_IGW_background_new) then @@ -395,13 +394,13 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, CS) abs_sin = max(epsilon,abs(sin(G%geoLatT(i,j)*deg_to_rad))) N_2Omega = max(abs_sin,sqrt(N2_lay(i,k))*I_2Omega) N02_N2 = (CS%N0_2Omega/N_2Omega)**2 - Kd_lay(i,j,k) = max(GV%m_to_Z**2*CS%Kd_min, GV%m_to_Z**2*CS%Kd_sfc(i,j) * & + Kd_lay(i,j,k) = max(CS%Kd_min, CS%Kd_sfc(i,j) * & ((abs_sin * invcosh(N_2Omega/abs_sin)) * I_x30)*N02_N2) enddo ; enddo else do k=1,nz ; do i=is,ie - Kd_lay(i,j,k) = GV%m_to_Z**2*CS%Kd_sfc(i,j) + Kd_lay(i,j,k) = CS%Kd_sfc(i,j) enddo ; enddo endif @@ -411,8 +410,8 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, CS) CS%kd_bkgnd(i,j,1) = 0.0; CS%kv_bkgnd(i,j,1) = 0.0 CS%kd_bkgnd(i,j,nz+1) = 0.0; CS%kv_bkgnd(i,j,nz+1) = 0.0 do k=2,nz - CS%kd_bkgnd(i,j,k) = 0.5*GV%Z_to_m**2*(Kd_lay(i,j,K-1) + Kd_lay(i,j,K)) - CS%kv_bkgnd(i,j,k) = CS%kd_bkgnd(i,j,k) * CS%prandtl_bkgnd + CS%Kd_bkgnd(i,j,k) = 0.5*(Kd_lay(i,j,K-1) + Kd_lay(i,j,K)) + CS%Kv_bkgnd(i,j,k) = CS%Kd_bkgnd(i,j,k) * CS%prandtl_bkgnd enddo enddo endif @@ -420,7 +419,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, CS) ! Update Kv if (associated(kv)) then do k=1,nz+1 ; do i=is,ie - Kv(i,j,k) = Kv(i,j,k) + GV%m_to_Z**2 * CS%kv_bkgnd(i,j,k) + Kv(i,j,k) = Kv(i,j,k) + CS%Kv_bkgnd(i,j,k) enddo ; enddo endif diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index df6c7df3c1..2223fa1bc9 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -386,7 +386,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! another explicit parameterization of Kd. ! set surface diffusivities (CS%bkgnd_mixing_csp%Kd_sfc) - call sfc_bkgnd_mixing(G, CS%bkgnd_mixing_csp) + call sfc_bkgnd_mixing(G, GV, CS%bkgnd_mixing_csp) !$OMP parallel do default(shared) private(dRho_int, N2_lay, N2_int, N2_bot, KT_extra, & !$OMP KS_extra, TKE_to_Kd,maxTKE, dissip, kb) From a42e3dc98d4ef4c35a810a97168c242eab74bab5 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 4 Oct 2018 13:23:51 -0400 Subject: [PATCH 138/174] +Changed the units of Kd_min_tr to Z-2 s-1 Rescaled the units of Kd_min_tr and Kd_BBL_tr in the diabatic control structure from m2 s-1 to Z2 s-1 for dimensional consistency testing. Also converted HMIX_MIN from m to Z when it is read in via get_param in regularize_layers_init, which in turn requred a new GV argument to regularize_layers_init. All answers are bitwise identical, including rescaling Z over a large range. --- .../vertical/MOM_diabatic_driver.F90 | 22 +++++++++---------- .../vertical/MOM_regularize_layers.F90 | 9 ++++---- 2 files changed, 16 insertions(+), 15 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 15474051b0..61ba757a7e 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -145,11 +145,11 @@ module MOM_diabatic_driver !! operating. real :: Kd_BBL_tr !< A bottom boundary layer tracer diffusivity that !! will allow for explicitly specified bottom fluxes - !! in m2 s-1. The entrainment at the bottom is at + !! in Z2 s-1. The entrainment at the bottom is at !! least sqrt(Kd_BBL_tr*dt) over the same distance. real :: Kd_min_tr !< A minimal diffusivity that should always be !! applied to tracers, especially in massless layers - !! near the bottom, in m2 s-1. + !! near the bottom, in Z2 s-1. real :: minimum_forcing_depth = 0.001 !< The smallest depth over which heat and freshwater !! fluxes are applied, in m. real :: evap_CFL_limit = 0.8 !< The largest fraction of a layer that can be @@ -319,7 +319,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! These are targets so that the space can be shared with eaml & ebml. eatr, & ! The equivalent of ea and eb for tracers, which differ from ea and ebtr ! eb in that they tend to homogenize tracers in massless layers - ! near the boundaries (m for Bouss and kg/m^2 for non-Bouss) + ! near the boundaries in H (m for Bouss and kg/m^2 for non-Bouss) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), target :: & Kd_int, & ! diapycnal diffusivity of interfaces (m^2/s) @@ -334,7 +334,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! The following 5 variables are only used with a bulk mixed layer. real, pointer, dimension(:,:,:) :: & - eaml, & ! The equivalent of ea and eb due to mixed layer processes, + eaml, & ! The equivalent of ea and eb due to mixed layer processes, in H ebml ! (m for Bouss and kg/m^2 for non-Bouss). These will be ! pointers to eatr and ebtr so as to reuse the memory as ! the arrays are not needed at the same time. @@ -366,7 +366,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & real :: Tr_ea_BBL ! The diffusive tracer thickness in the BBL that is ! coupled to the bottom within a timestep (m) - real :: htot(SZIB_(G)) ! The summed thickness from the bottom, in m. + real :: htot(SZIB_(G)) ! The summed thickness from the bottom, in H. real :: b1(SZIB_(G)), d1(SZIB_(G)) ! b1, c1, and d1 are variables used by the real :: c1(SZIB_(G),SZK_(G)) ! tridiagonal solver. @@ -915,7 +915,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call cpu_clock_begin(id_clock_tracers) if (CS%mix_boundary_tracers) then - Tr_ea_BBL = sqrt(dt*CS%Kd_BBL_tr) + Tr_ea_BBL = GV%Z_to_H * sqrt(dt*CS%Kd_BBL_tr) !$OMP parallel do default(shared) private(htot,in_boundary,add_ent) do j=js,je do i=is,ie @@ -934,7 +934,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! in the calculation of the fluxes in the first place. Kd_min_tr ! should be much less than the values that have been set in Kd_lay, ! perhaps a molecular diffusivity. - add_ent = ((dt * CS%Kd_min_tr) * GV%m_to_H**2) * & + add_ent = ((dt * CS%Kd_min_tr) * GV%Z_to_H**2) * & ((h(i,j,k-1)+h(i,j,k)+h_neglect) / & (h(i,j,k-1)*h(i,j,k)+h_neglect2)) - & 0.5*(ea_s(i,j,k) + eb_s(i,j,k-1)) @@ -2078,7 +2078,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! in the calculation of the fluxes in the first place. Kd_min_tr ! should be much less than the values that have been set in Kd_lay, ! perhaps a molecular diffusivity. - add_ent = ((dt * CS%Kd_min_tr) * GV%m_to_H**2) * & + add_ent = ((dt * CS%Kd_min_tr) * GV%Z_to_H**2) * & ((h(i,j,k-1)+h(i,j,k)+h_neglect) / & (h(i,j,k-1)*h(i,j,k)+h_neglect2)) - & 0.5*(ea(i,j,k) + eb(i,j,k-1)) @@ -2909,12 +2909,12 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, call get_param(param_file, mdl, "KD_MIN_TR", CS%Kd_min_tr, & "A minimal diffusivity that should always be applied to \n"//& "tracers, especially in massless layers near the bottom. \n"//& - "The default is 0.1*KD.", units="m2 s-1", default=0.1*Kd) !### This would benefit from rescaling. + "The default is 0.1*KD.", units="m2 s-1", default=0.1*Kd, scale=GV%m_to_Z**2) call get_param(param_file, mdl, "KD_BBL_TR", CS%Kd_BBL_tr, & "A bottom boundary layer tracer diffusivity that will \n"//& "allow for explicitly specified bottom fluxes. The \n"//& "entrainment at the bottom is at least sqrt(Kd_BBL_tr*dt) \n"//& - "over the same distance.", units="m2 s-1", default=0.) !### This needs rescaling? + "over the same distance.", units="m2 s-1", default=0., scale=GV%m_to_Z**2) endif call get_param(param_file, mdl, "TRACER_TRIDIAG", CS%tracer_tridiag, & @@ -3310,7 +3310,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, if (CS%use_energetic_PBL) & call energetic_PBL_init(Time, G, GV, param_file, diag, CS%energetic_PBL_CSp) - call regularize_layers_init(Time, G, param_file, diag, CS%regularize_layers_CSp) + call regularize_layers_init(Time, G, GV, param_file, diag, CS%regularize_layers_CSp) if (CS%debug_energy_req) & call diapyc_energy_req_init(Time, G, param_file, diag, CS%diapyc_en_rec_CSp) diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index 2b5aa4802b..5bf74bf66c 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -42,7 +42,7 @@ module MOM_regularize_layers real :: h_def_tol4 !< The value of the relative thickness deficit at which to do !! detrainment from the buffer layers to the interior at full !! force, now 50% of the way from h_def_tol1 to 1. - real :: Hmix_min !< The minimum mixed layer thickness in m. + real :: Hmix_min !< The minimum mixed layer thickness in H. 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. @@ -773,7 +773,7 @@ subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, & endif nkmb = GV%nk_rho_varies h_neglect = GV%H_subroundoff - Hmix_min = CS%Hmix_min * GV%m_to_H + Hmix_min = CS%Hmix_min ! Determine which zonal faces are problematic. do j=js,je ; do I=is-1,ie @@ -876,9 +876,10 @@ subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, & end subroutine find_deficit_ratios !> Initializes the regularize_layers control structure -subroutine regularize_layers_init(Time, G, param_file, diag, CS) +subroutine regularize_layers_init(Time, G, GV, 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 !< The ocean's vertical grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for !! run-time parameters. type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate @@ -916,7 +917,7 @@ subroutine regularize_layers_init(Time, G, param_file, diag, CS) call get_param(param_file, mdl, "HMIX_MIN", CS%Hmix_min, & "The minimum mixed layer depth if the mixed layer depth \n"//& - "is determined dynamically.", units="m", default=0.0) + "is determined dynamically.", units="m", default=0.0, scale=GV%m_to_H) call get_param(param_file, mdl, "REG_SFC_DEFICIT_TOLERANCE", CS%h_def_tol1, & "The value of the relative thickness deficit at which \n"//& "to start modifying the layer structure when \n"//& From 85afb793343e0c5e9734b17fce766c2a678befef Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 4 Oct 2018 13:24:16 -0400 Subject: [PATCH 139/174] Rescaled TOLERANCE_ENT from m to Z when it is read Rescaled TOLERANCE_ENT from m to Z when it is read in entrain_diffusive_init. All answers are bitwise identical, including rescaling Z over a large range. --- .../vertical/MOM_entrain_diffusive.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index b2911d5033..3c7f21236a 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -223,7 +223,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & &and a linear equation of state to drive the model.") endif - tolerance = GV%m_to_H * CS%Tolerance_Ent + tolerance = CS%Tolerance_Ent g_2dt = 0.5 * (GV%g_Earth*GV%m_to_Z) / dt kmb = GV%nk_rho_varies K2 = max(kmb+1,2) ; kb_min = K2 @@ -1509,7 +1509,7 @@ subroutine F_kb_to_ea_kb(h_bl, Sref, Ent_bl, I_dSkbp1, F_kb, kmb, i, & val = dS_kbp1 * F_kb(i) err_min = -val - tolerance = GV%m_to_H * CS%Tolerance_Ent + tolerance = CS%Tolerance_Ent if (present(tol_in)) tolerance = tol_in bisect_next = .true. @@ -1714,7 +1714,7 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & call MOM_error(FATAL, "determine_Ea_kb should not be called "//& "unless BULKMIXEDLAYER is defined.") endif - tolerance = GV%m_to_H * CS%Tolerance_Ent + tolerance = CS%Tolerance_Ent large_err = GV%m_to_H**2 * 1.0e30 do i=is,ie ; redo_i(i) = do_i(i) ; enddo @@ -1902,7 +1902,7 @@ subroutine find_maxF_kb(h_bl, Sref, Ent_bl, I_dSkbp1, min_ent_in, max_ent_in, & integer :: i, it, is1, ie1 integer, parameter :: MAXIT = 20 - tolerance = GV%m_to_H * CS%Tolerance_Ent + tolerance = CS%Tolerance_Ent if (present(do_i_in)) then do i=is,ie ; do_i(i) = do_i_in(i) ; enddo @@ -2186,7 +2186,7 @@ subroutine entrain_diffusive_init(Time, G, GV, param_file, diag, CS) ! CS%Tolerance_Ent = MAX(100.0*GV%Angstrom_H,1.0e-4*sqrt(dt*Kd)) ! call get_param(param_file, mdl, "TOLERANCE_ENT", CS%Tolerance_Ent, & "The tolerance with which to solve for entrainment values.", & - units="m", default=MAX(100.0*GV%Angstrom_m,1.0e-4*sqrt(dt*Kd))) + units="m", default=MAX(100.0*GV%Angstrom_m,1.0e-4*sqrt(dt*Kd)), scale=GV%m_to_H) CS%id_Kd = register_diag_field('ocean_model', 'Kd_effective', diag%axesTL, Time, & 'Diapycnal diffusivity as applied', 'm2 s-1') From 98b98522838576767f14d3979f186bb4e6860e94 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 4 Oct 2018 14:44:00 -0400 Subject: [PATCH 140/174] Fixed unit conversions in the diff_work diagnostic Corrected the unit conversion factors in the diff_work diagnostic in entrainment_diffusive. This diagnostic is not often used, and the answers are bitwise identical. --- src/parameterizations/vertical/MOM_entrain_diffusive.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 3c7f21236a..6bd8aa484f 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -171,7 +171,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & real :: dRHo ! The change in locally referenced potential density between ! the layers above and below an interface, in kg m-3. - real :: g_2dt ! 0.5 * G_Earth / dt, in m s-3. + real :: g_2dt ! 0.5 * G_Earth / dt, times unit conversion factors, in m3 H-2 s-3. real, dimension(SZI_(G)) :: & pressure, & ! The pressure at an interface, in Pa. T_eos, S_eos, & ! The potential temperature and salinity at which to @@ -224,7 +224,6 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & endif tolerance = CS%Tolerance_Ent - g_2dt = 0.5 * (GV%g_Earth*GV%m_to_Z) / dt kmb = GV%nk_rho_varies K2 = max(kmb+1,2) ; kb_min = K2 if (.not. CS%bulkmixedlayer) then @@ -823,6 +822,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & endif if (CS%id_diff_work > 0) then + g_2dt = 0.5 * (GV%H_to_Z*GV%H_to_m) * (GV%g_Earth / dt) do i=is,ie ; diff_work(i,j,1) = 0.0 ; diff_work(i,j,nz+1) = 0.0 ; enddo if (associated(tv%eqn_of_state)) then if (associated(fluxes%p_surf)) then From d8ff40968909f826fa1590bea3476a5504578469 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 4 Oct 2018 14:47:51 -0400 Subject: [PATCH 141/174] Use bottom roughness in units of Z Recast the internal tide diffusivity calculations to use units of Z for the bottom roughness scales and other vertical lengths for dimensional consistency testing. All answers are bitwise identical, including rescaling Z over a large range. --- .../vertical/MOM_internal_tide_input.F90 | 13 +++++----- .../vertical/MOM_tidal_mixing.F90 | 24 +++++++++---------- 2 files changed, 19 insertions(+), 18 deletions(-) diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index 4251f0dd1f..4a59b9f610 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -255,7 +255,7 @@ subroutine int_tide_input_init(Time, G, GV, param_file, diag, CS, itide) ! tidal amplitude file is not present. real :: kappa_h2_factor ! factor for the product of wavenumber * rms sgs height. real :: kappa_itides ! topographic wavenumber and non-dimensional scaling - real :: min_zbot_itides ! Minimum ocean depth for internal tide conversion, in m. + real :: min_zbot_itides ! Minimum ocean depth for internal tide conversion, in Z. integer :: i, j, is, ie, js, je, isd, ied, jsd, jed if (associated(CS)) then @@ -286,7 +286,7 @@ subroutine int_tide_input_init(Time, G, GV, param_file, diag, CS, itide) call get_param(param_file, mdl, "MIN_ZBOT_ITIDES", min_zbot_itides, & "Turn off internal tidal dissipation when the total \n"//& - "ocean depth is less than this value.", units="m", default=0.0) + "ocean depth is less than this value.", units="m", default=0.0, scale=GV%m_to_Z) call get_param(param_file, mdl, "UTIDE", utide, & "The constant tidal amplitude used with INT_TIDE_DISSIPATION.", & @@ -329,20 +329,21 @@ subroutine int_tide_input_init(Time, G, GV, param_file, diag, CS, itide) fail_if_missing=.true.) filename = trim(CS%inputdir) // trim(h2_file) call log_param(param_file, mdl, "INPUTDIR/H2_FILE", filename) - call MOM_read_data(filename, 'h2', itide%h2, G%domain, timelevel=1) + call MOM_read_data(filename, 'h2', itide%h2, G%domain, timelevel=1, scale=GV%m_to_Z**2) do j=js,je ; do i=is,ie mask_itidal = 1.0 - if (G%bathyT(i,j) < min_zbot_itides*GV%m_to_Z) mask_itidal = 0.0 + if (G%bathyT(i,j) < min_zbot_itides) mask_itidal = 0.0 itide%tideamp(i,j) = itide%tideamp(i,j) * mask_itidal * G%mask2dT(i,j) ! Restrict rms topo to 10 percent of column depth. - itide%h2(i,j) = min(0.01*(G%bathyT(i,j)*G%Zd_to_m)**2, itide%h2(i,j)) + !### Note the use here of a hard-coded nondimensional constant. + itide%h2(i,j) = min(0.01*G%bathyT(i,j)**2, itide%h2(i,j)) ! Compute the fixed part of internal tidal forcing; units are [J m-2] here. CS%TKE_itidal_coef(i,j) = 0.5*kappa_h2_factor*GV%Rho0*& - kappa_itides * itide%h2(i,j) * itide%tideamp(i,j)**2 + kappa_itides * GV%Z_to_m**2*itide%h2(i,j) * itide%tideamp(i,j)**2 enddo ; enddo diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 7e4f67c7cb..04ca9dc922 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -96,7 +96,7 @@ module MOM_tidal_mixing real :: Decay_scale_factor_lee !< Scaling factor for the decay scale of lee !! wave energy dissipation (nondimensional) - real :: min_zbot_itides !< minimum depth for internal tide conversion (meter) + real :: min_zbot_itides !< minimum depth for internal tide conversion (Z) logical :: Lowmode_itidal_dissipation = .false. !< If true, consider mixing due to breaking low !! modes that have been remotely generated using an internal tidal !! dissipation scheme to specify the vertical profile of the energy @@ -220,7 +220,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, character(len=200) :: filename, h2_file, Niku_TKE_input_file character(len=200) :: tidal_energy_file, tideamp_file type(vardesc) :: vd - real :: utide, zbot, hamp, prandtl_tidal + real :: utide, hamp, prandtl_tidal real :: Niku_scale ! local variable for scaling the Nikurashin TKE flux data integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed @@ -397,7 +397,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, units="nondim", default=0.3333) call get_param(param_file, mdl, "MIN_ZBOT_ITIDES", CS%min_zbot_itides, & "Turn off internal tidal dissipation when the total \n"//& - "ocean depth is less than this value.", units="m", default=0.0) + "ocean depth is less than this value.", units="m", default=0.0, scale=GV%m_to_Z) endif if ( (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation) .and. & @@ -448,22 +448,21 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, fail_if_missing=(.not.CS%use_CVMix_tidal)) filename = trim(CS%inputdir) // trim(h2_file) call log_param(param_file, mdl, "INPUTDIR/H2_FILE", filename) - call MOM_read_data(filename, 'h2', CS%h2, G%domain, timelevel=1) + call MOM_read_data(filename, 'h2', CS%h2, G%domain, timelevel=1, scale=GV%m_to_Z**2) do j=js,je ; do i=is,ie - if (G%bathyT(i,j)*G%Zd_to_m < CS%min_zbot_itides) CS%mask_itidal(i,j) = 0.0 + if (G%bathyT(i,j) < CS%min_zbot_itides) CS%mask_itidal(i,j) = 0.0 CS%tideamp(i,j) = CS%tideamp(i,j) * CS%mask_itidal(i,j) * G%mask2dT(i,j) ! Restrict rms topo to 10 percent of column depth. - zbot = G%bathyT(i,j)*G%Zd_to_m - hamp = sqrt(CS%h2(i,j)) - hamp = min(0.1*zbot,hamp) + !### Note the hard-coded nondimensional constant, and that this could be simplified. + hamp = min(0.1*G%bathyT(i,j),sqrt(CS%h2(i,j))) CS%h2(i,j) = hamp*hamp utide = CS%tideamp(i,j) ! Compute the fixed part of internal tidal forcing; units are [kg s-2] here. CS%TKE_itidal(i,j) = 0.5*CS%kappa_h2_factor*GV%Rho0*& - CS%kappa_itides*CS%h2(i,j)*utide*utide + CS%kappa_itides*(GV%Z_to_m**2)*CS%h2(i,j)*utide*utide enddo ; enddo endif @@ -546,7 +545,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, vertical_decay_scale = CS%int_tide_decay_scale*GV%Z_to_m, & max_coefficient = CS%tidal_max_coef, & local_mixing_frac = CS%Gamma_itides, & - depth_cutoff = CS%min_zbot_itides) + depth_cutoff = CS%min_zbot_itides*GV%Z_to_m) call read_tidal_energy(G, tidal_energy_type, tidal_energy_file, CS) @@ -1057,11 +1056,12 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, do i=is,ie CS%Nb(i,j) = sqrt(N2_bot(i)) + !### In the code below 1.0e-14 is a dimensional constant. if ((CS%tideamp(i,j) > 0.0) .and. & - (CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 > 1.0e-14) ) then + (CS%kappa_itides**2 * (GV%Z_to_m**2)*CS%h2(i,j) * CS%Nb(i,j)**3 > 1.0e-14) ) then z0_polzin(i) = GV%m_to_Z * CS%Polzin_decay_scale_factor * CS%Nu_Polzin * & CS%Nbotref_Polzin**2 * CS%tideamp(i,j) / & - ( CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 ) + ( CS%kappa_itides**2 * GV%Z_to_m**2*CS%h2(i,j) * CS%Nb(i,j)**3 ) if (z0_polzin(i) < CS%Polzin_min_decay_scale) & z0_polzin(i) = CS%Polzin_min_decay_scale if (N2_meanz(i) > 1.0e-14 ) then From 7cb717f46c9d8aeeda282edf458f183822c2057c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 4 Oct 2018 14:48:11 -0400 Subject: [PATCH 142/174] Recast find_N2 to work in units of Z Recast the internal calculations in find_N2 to use units of Z. All answers are bitwise identical, including rescaling Z over a large range. --- .../vertical/MOM_set_diffusivity.F90 | 27 ++++++++++--------- 1 file changed, 14 insertions(+), 13 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 2223fa1bc9..07348a895b 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -897,20 +897,21 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, & Temp_int, & ! temperature at each interface (degC) Salin_int, & ! salinity at each interface (PPT) drho_bot, & - h_amp, & - hb, & - z_from_bot + h_amp, & ! The topographic roughness amplitude, in Z. + hb, & ! The thickness of the bottom layer in Z + z_from_bot ! The hieght above the bottom in Z real :: Rml_base ! density of the deepest variable density layer - real :: dz_int ! thickness associated with an interface (meter) - real :: G_Rho0 ! gravitation acceleration divided by Bouss reference density (m4 s-2 kg-1) + real :: dz_int ! thickness associated with an interface (Z) + real :: G_Rho0 ! gravitation acceleration divided by Bouss reference density + ! times some unit conversion factors, in (Z m3 s-2 kg-1) real :: H_neglect ! negligibly small thickness, in the same units as h. logical :: do_i(SZI_(G)), do_any integer :: i, k, is, ie, nz is = G%isc ; ie = G%iec ; nz = G%ke - G_Rho0 = (GV%g_Earth*GV%m_to_Z) / GV%Rho0 + G_Rho0 = (GV%g_Earth*GV%m_to_Z**2) / GV%Rho0 H_neglect = GV%H_subroundoff ! Find the (limited) density jump across each interface. @@ -948,18 +949,18 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, & ! Set the buoyancy frequencies. do k=1,nz ; do i=is,ie N2_lay(i,k) = G_Rho0 * 0.5*(dRho_int(i,K) + dRho_int(i,K+1)) / & - (GV%H_to_m*(h(i,j,k) + H_neglect)) + (GV%H_to_Z*(h(i,j,k) + H_neglect)) enddo ; enddo do i=is,ie ; N2_int(i,1) = 0.0 ; N2_int(i,nz+1) = 0.0 ; enddo do K=2,nz ; do i=is,ie N2_int(i,K) = G_Rho0 * dRho_int(i,K) / & - (0.5*GV%H_to_m*(h(i,j,k-1) + h(i,j,k) + H_neglect)) + (0.5*GV%H_to_Z*(h(i,j,k-1) + h(i,j,k) + H_neglect)) enddo ; enddo ! Find the bottom boundary layer stratification, and use this in the deepest layers. do i=is,ie hb(i) = 0.0 ; dRho_bot(i) = 0.0 - z_from_bot(i) = 0.5*GV%H_to_m*h(i,j,nz) + z_from_bot(i) = 0.5*GV%H_to_Z*h(i,j,nz) do_i(i) = (G%mask2dT(i,j) > 0.5) if ( (CS%tm_csp%Int_tide_dissipation .or. CS%tm_csp%Lee_wave_dissipation) .and. & @@ -973,7 +974,7 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, & do k=nz,2,-1 do_any = .false. do i=is,ie ; if (do_i(i)) then - dz_int = 0.5*GV%H_to_m*(h(i,j,k) + h(i,j,k-1)) + dz_int = 0.5*GV%H_to_Z*(h(i,j,k) + h(i,j,k-1)) z_from_bot(i) = z_from_bot(i) + dz_int ! middle of the layer above hb(i) = hb(i) + dz_int @@ -982,7 +983,7 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, & if (z_from_bot(i) > h_amp(i)) then if (k>2) then ! Always include at least one full layer. - hb(i) = hb(i) + 0.5*GV%H_to_m*(h(i,j,k-1) + h(i,j,k-2)) + hb(i) = hb(i) + 0.5*GV%H_to_Z*(h(i,j,k-1) + h(i,j,k-2)) dRho_bot(i) = dRho_bot(i) + dRho_int(i,K-1) endif do_i(i) = .false. @@ -997,14 +998,14 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, & if (hb(i) > 0.0) then N2_bot(i) = (G_Rho0 * dRho_bot(i)) / hb(i) else ; N2_bot(i) = 0.0 ; endif - z_from_bot(i) = 0.5*GV%H_to_m*h(i,j,nz) + z_from_bot(i) = 0.5*GV%H_to_Z*h(i,j,nz) do_i(i) = (G%mask2dT(i,j) > 0.5) enddo do k=nz,2,-1 do_any = .false. do i=is,ie ; if (do_i(i)) then - dz_int = 0.5*GV%H_to_m*(h(i,j,k) + h(i,j,k-1)) + dz_int = 0.5*GV%H_to_Z*(h(i,j,k) + h(i,j,k-1)) z_from_bot(i) = z_from_bot(i) + dz_int ! middle of the layer above N2_int(i,K) = N2_bot(i) From 6f12f84f0d6d4efe407f4de017913455a604cb65 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 4 Oct 2018 17:47:11 -0600 Subject: [PATCH 143/174] Adds a missing parameter and fixes a bug Add option to use the wrong sign for adjusting net fresh-water. Fixes a bug in MOM_surface_forcing.F90 that occured when IOB was re-introduced. --- config_src/mct_driver/MOM_surface_forcing.F90 | 18 +++++++++++++----- config_src/mct_driver/ocn_cap_methods.F90 | 4 ++-- 2 files changed, 15 insertions(+), 7 deletions(-) diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 5c4a43bfc0..6955c20aa1 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -250,6 +250,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, & real :: delta_sst ! temporary storage for sst diff from restoring value real :: C_p ! heat capacity of seawater ( J/(K kg) ) + real :: sign_for_net_FW_bug ! Should be +1. but an old bug can be recovered by using -1. call cpu_clock_begin(id_clock_forcing) @@ -461,15 +462,17 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, & ! salt flux ! more salt restoring logic if (associated(fluxes%salt_flux)) & - fluxes%salt_flux(i,j) = G%mask2dT(i,j)*(IOB%salt_flux(i-i0,j-j0) + fluxes%salt_flux(i,j)) + fluxes%salt_flux(i,j) = G%mask2dT(i,j)*(fluxes%salt_flux(i,j) - IOB%salt_flux(i-i0,j-j0)) if (associated(fluxes%salt_flux_in)) & - fluxes%salt_flux_in(i,j) = G%mask2dT(i,j)*IOB%salt_flux(i-i0,j-j0) + fluxes%salt_flux_in(i,j) = G%mask2dT(i,j)*(-IOB%salt_flux(i-i0,j-j0)) enddo; enddo ! adjust the NET fresh-water flux to zero, if flagged if (CS%adjust_net_fresh_water_to_zero) then + sign_for_net_FW_bug = 1. + if (CS%use_net_FW_adjustment_sign_bug) sign_for_net_FW_bug = -1. 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))) + & @@ -480,9 +483,9 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, & ! Bob thinks this is trying ensure the net fresh-water of the ocean + sea-ice system ! is constant. ! To do this correctly we will need a sea-ice melt field added to IOB. -AJA - if (associated(fluxes%salt_flux) .and. (CS%ice_salt_concentration>0.0)) & - net_FW(i,j) = net_FW(i,j) + G%areaT(i,j) * & - (fluxes%salt_flux(i,j) / CS%ice_salt_concentration) + 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) * & + (IOB%salt_flux(i-i0,j-j0) / CS%ice_salt_concentration) net_FW2(i,j) = net_FW(i,j)/G%areaT(i,j) enddo; enddo @@ -1044,6 +1047,11 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res CS%adjust_net_fresh_water_to_zero, & "If true, adjusts the net fresh-water forcing seen \n"//& "by the ocean (including restoring) to zero.", default=.false.) + if (CS%adjust_net_fresh_water_to_zero) & + call get_param(param_file, mdl, "USE_NET_FW_ADJUSTMENT_SIGN_BUG", & + CS%use_net_FW_adjustment_sign_bug, & + "If true, use the wrong sign for the adjustment to\n"//& + "the net fresh-water.", default=.false.) call get_param(param_file, mdl, "ADJUST_NET_FRESH_WATER_BY_SCALING", & CS%adjust_net_fresh_water_by_scaling, & "If true, adjustments to net fresh water to achieve zero net are\n"//& diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 index 33dbc5b36a..f00942bd04 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -82,8 +82,8 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit, ! surface pressure ice_ocean_boundary%p(i,j) = x2o(ind%x2o_Sa_pslv,k) * GRID%mask2dT(ig,jg) - ! salt flux - ice_ocean_boundary%salt_flux(i,j) = x2o(ind%x2o_Fioi_salt,k) * GRID%mask2dT(ig,jg) + ! salt flux (minus sign needed here -GMM) + ice_ocean_boundary%salt_flux(i,j) = -x2o(ind%x2o_Fioi_salt,k) * GRID%mask2dT(ig,jg) ! 1) visible, direct shortwave (W/m2) ! 2) visible, diffuse shortwave (W/m2) From 94031154684d593306513e9ec492e945c717589f Mon Sep 17 00:00:00 2001 From: Malte Jansen Date: Thu, 4 Oct 2018 19:57:50 -0500 Subject: [PATCH 144/174] Bug fix to compute Rd_dx whenever MEKE is used The default config of MEKE uses Rd_dx to compute barotropic and bottom energy fractions. If Rd_dx not computed here, it will be set to zero in MEKE and as a result gamma_b=gamma_t=1. --- src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index ecc586d025..b9325733e5 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -804,6 +804,7 @@ subroutine VarMix_init(Time, G, param_file, diag, CS) CS%calculate_cg1 = CS%calculate_cg1 .or. use_FGNV_streamfn call get_param(param_file, mdl, "USE_MEKE", use_MEKE, & default=.false., do_not_log=.true.) + CS%calculate_Rd_dx = CS%calculate_Rd_dx .or. use_MEKE CS%calculate_Eady_growth_rate = CS%calculate_Eady_growth_rate .or. use_MEKE call get_param(param_file, mdl, "KHTR_PASSIVITY_COEFF", KhTr_passivity_coeff, & default=0., do_not_log=.true.) From a4d84a2659677fd554578b723d0bfff2542ba9e2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 4 Oct 2018 21:56:27 -0400 Subject: [PATCH 145/174] Added a conversion factor for Kd_interface Added a conversion factor for the diagnostic of Kd_interface, so that it does not change when Z is rescaled. All answers are bitwise identical. --- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 61ba757a7e..76a64f932a 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -3046,7 +3046,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, !call set_diffusivity_init(Time, G, param_file, diag, CS%set_diff_CSp, diag_to_Z_CSp, CS%int_tide_CSp) CS%id_Kd_interface = register_diag_field('ocean_model', 'Kd_interface', diag%axesTi, Time, & - 'Total diapycnal diffusivity at interfaces', 'm2 s-1') + 'Total diapycnal diffusivity at interfaces', 'm2 s-1', conversion=GV%Z_to_m**2) if (CS%use_energetic_PBL) then CS%id_Kd_ePBL = register_diag_field('ocean_model', 'Kd_ePBL', diag%axesTi, Time, & 'ePBL diapycnal diffusivity at interfaces', 'm2 s-1', conversion=GV%Z_to_m**2) From 469645bd744197b21f4381ca451dc1ad633cd221 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 4 Oct 2018 21:57:17 -0400 Subject: [PATCH 146/174] +Added conversion argument to register_Zint_diag Added optional conversion argument to register_Zint_diag, which is then passed on to register_diag. All answers are bitwise identical. --- src/diagnostics/MOM_diag_to_Z.F90 | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/diagnostics/MOM_diag_to_Z.F90 b/src/diagnostics/MOM_diag_to_Z.F90 index 0e966e7ff6..f8ea773f74 100644 --- a/src/diagnostics/MOM_diag_to_Z.F90 +++ b/src/diagnostics/MOM_diag_to_Z.F90 @@ -115,7 +115,7 @@ function global_z_mean(var,G,CS,tracer) weight(i,j,k) = depth_weight * ( (valid_point * (G%areaT(i,j) * G%mask2dT(i,j))) ) - ! If the point is flagged, set the variable itsef to zero to avoid NaNs + ! If the point is flagged, set the variable itself to zero to avoid NaNs if (valid_point == 0.) then tmpForSumming(i,j,k) = 0.0 else @@ -1291,12 +1291,13 @@ function register_Z_diag(var_desc, CS, day, missing) end function register_Z_diag !> Register a diagnostic to be output at depth space interfaces -function register_Zint_diag(var_desc, CS, day) +function register_Zint_diag(var_desc, CS, day, conversion) integer :: register_Zint_diag !< The returned z-interface diagnostic index type(vardesc), intent(in) :: var_desc !< A type with metadata for this diagnostic type(diag_to_Z_CS), pointer :: CS !< Control structure returned by !! previous call to diag_to_Z_init. type(time_type), intent(in) :: day !< The current model time + real, optional, intent(in) :: conversion !< A value to multiply data by before writing to file ! Local variables character(len=64) :: var_name ! A variable's name. character(len=48) :: units ! A variable's units. @@ -1327,8 +1328,9 @@ function register_Zint_diag(var_desc, CS, day) "register_Z_diag: unknown hor_grid component "//trim(hor_grid)) end select - register_Zint_diag = register_diag_field("ocean_model_zold", trim(var_name),& - axes, day, trim(longname), trim(units), missing_value=CS%missing_value) + register_Zint_diag = register_diag_field("ocean_model_zold", trim(var_name), & + axes, day, trim(longname), trim(units), missing_value=CS%missing_value, & + conversion=conversion) end function register_Zint_diag From df75031df84b473c5e404d6497c1c946d3070303 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 4 Oct 2018 21:58:14 -0400 Subject: [PATCH 147/174] Changed diffusvity units in MOM_set_diffusvities Changed the units of several diffusivities in MOM_set_diffusivities, including KT_extra, KS_extra, Kd_add, delta_Kd and Kd_wall from m2 s-1 to Z2 s-1, for dimensional consistency testing. All answers are bitwise identical, including rescaling Z over a large range. --- .../vertical/MOM_CVMix_ddiff.F90 | 4 +- .../vertical/MOM_set_diffusivity.F90 | 140 +++++++++--------- 2 files changed, 74 insertions(+), 70 deletions(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 index fc84367a87..eabce5056b 100644 --- a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 @@ -46,8 +46,8 @@ module MOM_CVMix_ddiff !!@} ! Diagnostics arrays - real, allocatable, dimension(:,:,:) :: KT_extra !< Double diffusion diffusivity for temp (m2/s) - real, allocatable, dimension(:,:,:) :: KS_extra !< Double diffusion diffusivity for salt (m2/s) +! real, allocatable, dimension(:,:,:) :: KT_extra !< Double diffusion diffusivity for temp (Z2/s) +! real, allocatable, dimension(:,:,:) :: KS_extra !< Double diffusion diffusivity for salt (Z2/s) real, allocatable, dimension(:,:,:) :: R_rho !< Double-diffusion density ratio (nondim) end type CVMix_ddiff_cs diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 07348a895b..80a4b9fe18 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -171,8 +171,8 @@ module MOM_set_diffusivity Kd_BBL => NULL(),& !< BBL diffusivity at interfaces (m2/s) Kd_work => NULL(),& !< layer integrated work by diapycnal mixing (W/m2) maxTKE => NULL(),& !< energy required to entrain to h_max (m3/s3) - KT_extra => NULL(),& !< double diffusion diffusivity for temp (m2/s) - KS_extra => NULL() !< double diffusion diffusivity for saln (m2/s) + KT_extra => NULL(),& !< double diffusion diffusivity for temp (Z2/s) + KS_extra => NULL() !< double diffusion diffusivity for saln (Z2/s) real, pointer, dimension(:,:,:) :: TKE_to_Kd => NULL() !< conversion rate (~1.0 / (G_Earth + dRho_lay)) !! between TKE dissipated within a layer and Kd @@ -247,8 +247,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & real, dimension(SZI_(G),SZK_(G)+1) :: & N2_int, & !< squared buoyancy frequency associated at interfaces (1/s2) dRho_int, & !< locally ref potential density difference across interfaces (kg/m3) - KT_extra, & !< double difusion diffusivity of temperature (m2/sec) - KS_extra !< double difusion diffusivity of salinity (m2/sec) + KT_extra, & !< double difusion diffusivity of temperature (Z2/sec) + KS_extra !< double difusion diffusivity of salinity (Z2/sec) real :: I_Rho0 ! inverse of Boussinesq density (m3/kg) real :: dissip ! local variable for dissipation calculations (W/m3) @@ -407,14 +407,14 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call double_diffusion(tv, h, T_f, S_f, j, G, GV, CS, KT_extra, KS_extra) do K=2,nz ; do i=is,ie if (KS_extra(i,K) > KT_extra(i,K)) then ! salt fingering - Kd_lay(i,j,k-1) = Kd_lay(i,j,k-1) + 0.5*GV%m_to_Z**2*KT_extra(i,K) - Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*KT_extra(i,K) - visc%Kd_extra_S(i,j,k) = GV%m_to_Z**2 * (KS_extra(i,K) - KT_extra(i,K)) + Kd_lay(i,j,k-1) = Kd_lay(i,j,k-1) + 0.5*KT_extra(i,K) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*KT_extra(i,K) + visc%Kd_extra_S(i,j,k) = (KS_extra(i,K) - KT_extra(i,K)) visc%Kd_extra_T(i,j,k) = 0.0 elseif (KT_extra(i,K) > 0.0) then ! double-diffusive convection - Kd_lay(i,j,k-1) = Kd_lay(i,j,k-1) + 0.5*GV%m_to_Z**2*KS_extra(i,K) - Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*KS_extra(i,K) - visc%Kd_extra_T(i,j,k) = GV%m_to_Z**2 * (KT_extra(i,K) - KS_extra(i,K)) + Kd_lay(i,j,k-1) = Kd_lay(i,j,k-1) + 0.5**KS_extra(i,K) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5**KS_extra(i,K) + visc%Kd_extra_T(i,j,k) = (KT_extra(i,K) - KS_extra(i,K)) visc%Kd_extra_S(i,j,k) = 0.0 else ! There is no double diffusion at this interface. visc%Kd_extra_T(i,j,k) = 0.0 @@ -558,13 +558,13 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (present(Kd_int)) then !$OMP parallel do default(none) shared(is,ie,js,je,nz,Kd_int,CS,Kd) do k=1,nz ; do j=js,je ; do i=is,ie - Kd_int(i,j,K) = Kd_int(i,j,K) + GV%m_to_Z**2*CS%Kd_add - Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*CS%Kd_add + Kd_int(i,j,K) = Kd_int(i,j,K) + CS%Kd_add + Kd_lay(i,j,k) = Kd_lay(i,j,k) + CS%Kd_add enddo ; enddo ; enddo else !$OMP parallel do default(none) shared(is,ie,js,je,nz,CS,Kd) do k=1,nz ; do j=js,je ; do i=is,ie - Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*CS%Kd_add + Kd_lay(i,j,k) = Kd_lay(i,j,k) + CS%Kd_add enddo ; enddo ; enddo endif endif @@ -624,21 +624,21 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%id_Kd_BBL > 0) call post_data(CS%id_Kd_BBL, dd%Kd_BBL, CS%diag) if (CS%id_KT_extra_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_KT_extra_z - z_ptrs(num_z_diags)%p => dd%KT_extra + num_z_diags = num_z_diags + 1 + z_ids(num_z_diags) = CS%id_KT_extra_z + z_ptrs(num_z_diags)%p => dd%KT_extra endif if (CS%id_KS_extra_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_KS_extra_z - z_ptrs(num_z_diags)%p => dd%KS_extra + num_z_diags = num_z_diags + 1 + z_ids(num_z_diags) = CS%id_KS_extra_z + z_ptrs(num_z_diags)%p => dd%KS_extra endif if (CS%id_Kd_BBL_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_Kd_BBL_z - z_ptrs(num_z_diags)%p => dd%KS_extra + num_z_diags = num_z_diags + 1 + z_ids(num_z_diags) = CS%id_Kd_BBL_z + z_ptrs(num_z_diags)%p => dd%Kd_BBL endif if (num_z_diags > 0) & @@ -1053,10 +1053,10 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, CS, Kd_T_dd, Kd_S_dd) type(set_diffusivity_CS), pointer :: CS !< Module control structure. real, dimension(SZI_(G),SZK_(G)+1), & intent(out) :: Kd_T_dd !< Interface double diffusion diapycnal - !! diffusivity for temp (m2/sec). + !! diffusivity for temp (Z2/sec). real, dimension(SZI_(G),SZK_(G)+1), & intent(out) :: Kd_S_dd !< Interface double diffusion diapycnal - !! diffusivity for saln (m2/sec). + !! diffusivity for saln (Z2/sec). real, dimension(SZI_(G)) :: & dRho_dT, & ! partial derivatives of density wrt temp (kg m-3 degC-1) @@ -1068,18 +1068,22 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, CS, Kd_T_dd, Kd_S_dd) real :: alpha_dT ! density difference between layers due to temp diffs (kg/m3) real :: beta_dS ! density difference between layers due to saln diffs (kg/m3) - real :: Rrho ! vertical density ratio - real :: diff_dd ! factor for double-diffusion - real :: prandtl ! flux ratio for diffusive convection regime + real :: Rrho ! vertical density ratio + real :: diff_dd ! factor for double-diffusion (nondim) + real :: Kd_dd ! The dominant double diffusive diffusivity in Z2/sec + real :: prandtl ! flux ratio for diffusive convection regime - real, parameter :: Rrho0 = 1.9 ! limit for double-diffusive density ratio - real, parameter :: dsfmax = 1.e-4 ! max diffusivity in case of salt fingering - real, parameter :: Kv_molecular = 1.5e-6 ! molecular viscosity (m2/sec) + real, parameter :: Rrho0 = 1.9 ! limit for double-diffusive density ratio + real :: dsfmax ! max diffusivity in case of salt fingering (Z2/sec) + real :: Kv_molecular ! molecular viscosity (Z2/sec) integer :: i, k, is, ie, nz is = G%isc ; ie = G%iec ; nz = G%ke if (associated(tv%eqn_of_state)) then + dsfmax = GV%m_to_Z**2 * 1.e-4 ! max salt fingering diffusivity rescaled to (Z2/sec) + Kv_molecular = GV%m_to_Z**2 * 1.5e-6 ! molecular viscosity rescaled to (Z2/sec) + do i=is,ie pres(i) = 0.0 ; Kd_T_dd(i,1) = 0.0 ; Kd_S_dd(i,1) = 0.0 Kd_T_dd(i,nz+1) = 0.0 ; Kd_S_dd(i,nz+1) = 0.0 @@ -1098,18 +1102,18 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, CS, Kd_T_dd, Kd_S_dd) beta_dS = dRho_dS(i) * (S_f(i,j,k-1) - S_f(i,j,k)) if ((alpha_dT > beta_dS) .and. (beta_dS > 0.0)) then ! salt finger case - Rrho = min(alpha_dT/beta_dS,Rrho0) + Rrho = min(alpha_dT / beta_dS, Rrho0) diff_dd = 1.0 - ((RRho-1.0)/(RRho0-1.0)) - diff_dd = dsfmax*diff_dd*diff_dd*diff_dd - Kd_T_dd(i,K) = 0.7*diff_dd - Kd_S_dd(i,K) = diff_dd + Kd_dd = dsfmax * diff_dd*diff_dd*diff_dd + Kd_T_dd(i,K) = 0.7*Kd_dd + Kd_S_dd(i,K) = Kd_dd elseif ((alpha_dT < 0.) .and. (beta_dS < 0.) .and. (alpha_dT > beta_dS)) then ! diffusive convection - Rrho = alpha_dT/beta_dS - diff_dd = Kv_molecular*0.909*exp(4.6*exp(-0.54*(1/Rrho-1))) + Rrho = alpha_dT / beta_dS + Kd_dd = Kv_molecular * 0.909*exp(4.6*exp(-0.54*(1/Rrho-1))) prandtl = 0.15*Rrho if (Rrho > 0.5) prandtl = (1.85-0.85/Rrho)*Rrho - Kd_T_dd(i,K) = diff_dd - Kd_S_dd(i,K) = prandtl*diff_dd + Kd_T_dd(i,K) = Kd_dd + Kd_S_dd(i,K) = prandtl*Kd_dd else Kd_T_dd(i,K) = 0.0 ; Kd_S_dd(i,K) = 0.0 endif @@ -1176,7 +1180,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & real :: absf ! average absolute Coriolis parameter around a thickness point (1/s) real :: R0_g ! Rho0 / G_Earth (kg s2 m-2) real :: I_rho0 ! 1 / RHO0 - real :: delta_Kd ! increment to Kd from the bottom boundary layer mixing (m2/s) + real :: delta_Kd ! increment to Kd from the bottom boundary layer mixing (Z2/s) logical :: Rayleigh_drag ! Set to true if Rayleigh drag velocities ! defined in visc, on the assumption that this ! extracted energy also drives diapycnal mixing. @@ -1294,18 +1298,18 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & TKE(i) = TKE(i) - TKE_to_layer if (Kd_lay(i,j,k) < (TKE_to_layer+TKE_Ray)*GV%m_to_Z**2*TKE_to_Kd(i,k)) then - delta_Kd = (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k) - GV%Z_to_m**2*Kd_lay(i,j,k) - if ((CS%Kd_max >= 0.0) .and. (delta_Kd > CS%Kd_max)) then - delta_Kd = CS%Kd_Max - Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*delta_Kd + delta_Kd = (TKE_to_layer+TKE_Ray)*GV%m_to_Z**2*TKE_to_Kd(i,k) - Kd_lay(i,j,k) + if ((CS%Kd_max >= 0.0) .and. (delta_Kd > GV%m_to_Z**2*CS%Kd_max)) then + delta_Kd = GV%m_to_Z**2*CS%Kd_Max + Kd_lay(i,j,k) = Kd_lay(i,j,k) + delta_Kd else Kd_lay(i,j,k) = (TKE_to_layer+TKE_Ray)*GV%m_to_Z**2*TKE_to_Kd(i,k) endif - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*GV%m_to_Z**2*delta_Kd - Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*GV%m_to_Z**2*delta_Kd + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*delta_Kd + Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*delta_Kd if (do_diag_Kd_BBL) then - Kd_BBL(i,j,K) = Kd_BBL(i,j,K) + 0.5*delta_Kd - Kd_BBL(i,j,K+1) = Kd_BBL(i,j,K+1) + 0.5*delta_Kd + Kd_BBL(i,j,K) = Kd_BBL(i,j,K) + 0.5*GV%Z_to_m**2*delta_Kd + Kd_BBL(i,j,K+1) = Kd_BBL(i,j,K+1) + 0.5*GV%Z_to_m**2*delta_Kd endif endif else @@ -1324,14 +1328,14 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & if (TKE(i) < 0.0) TKE(i) = 0.0 ! This should be unnecessary? if (TKE_here > 0.0) then - delta_Kd = TKE_here*TKE_to_Kd(i,k) - if (CS%Kd_max >= 0.0) delta_Kd = min(delta_Kd, CS%Kd_max) - Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*delta_Kd - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*GV%m_to_Z**2*delta_Kd - Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*GV%m_to_Z**2*delta_Kd + delta_Kd = TKE_here * GV%m_to_Z**2*TKE_to_Kd(i,k) + if (CS%Kd_max >= 0.0) delta_Kd = min(delta_Kd, GV%m_to_Z**2*CS%Kd_max) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + delta_Kd + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*delta_Kd + Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*delta_Kd if (do_diag_Kd_BBL) then - Kd_BBL(i,j,K) = Kd_BBL(i,j,K) + 0.5*delta_Kd - Kd_BBL(i,j,K+1) = Kd_BBL(i,j,K+1) + 0.5*delta_Kd + Kd_BBL(i,j,K) = Kd_BBL(i,j,K) + 0.5*GV%Z_to_m**2*delta_Kd + Kd_BBL(i,j,K+1) = Kd_BBL(i,j,K+1) + 0.5*GV%Z_to_m**2*delta_Kd endif endif endif @@ -1388,15 +1392,15 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & real :: TKE_Kd_wall ! TKE associated with unlimited law of the wall mixing (m3 s-3) real :: cdrag_sqrt ! square root of the drag coefficient (nondimensional) real :: ustar ! value of ustar at a thickness point (m/s) - real :: ustar2 ! square of ustar, for convenience (m2/s2) + real :: ustar2 ! square of ustar, for convenience (Z2/s2) real :: absf ! average absolute value of Coriolis parameter around a thickness point (1/sec) real :: dh, dhm1 ! thickness of layers k and k-1, respecitvely (meter) real :: z ! distance to interface k from bottom (meter) real :: D_minus_z ! distance to interface k from surface (meter) real :: total_thickness ! total thickness of water column (meter) real :: Idecay ! inverse of decay scale used for "Joule heating" loss of TKE with height (1/m) - real :: Kd_wall ! Law of the wall diffusivity (m2/s) - real :: Kd_lower ! diffusivity for lower interface (m2/sec) + real :: Kd_wall ! Law of the wall diffusivity (Z2/s) + real :: Kd_lower ! diffusivity for lower interface (Z2/sec) real :: ustar_D ! u* x D (m2/s) real :: I_Rho0 ! 1 / rho0 real :: N2_min ! Minimum value of N2 to use in calculation of TKE_Kd_wall (1/s2) @@ -1427,7 +1431,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & ! u* at the bottom, in m s-1. ustar = visc%ustar_BBL(i,j) - ustar2 = ustar**2 + ustar2 = GV%m_to_Z**2*ustar**2 ! In add_drag_diffusivity(), fluxes%ustar_tidal is added in. This might be double counting ! since ustar_BBL should already include all contributions to u*? -AJA if (associated(fluxes%ustar_tidal)) ustar = ustar + fluxes%ustar_tidal(i,j) @@ -1484,7 +1488,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & ! TKE associated with Kd_wall, in m3 s-2. ! This calculation if for the volume spanning the interface. - TKE_Kd_wall = Kd_wall * 0.5 * (dh + dhm1) * max(N2_int(i,k), N2_min) + TKE_Kd_wall = GV%Z_to_m**2*Kd_wall * 0.5 * (dh + dhm1) * max(N2_int(i,k), N2_min) ! Now bound Kd such that the associated TKE is no greater than available TKE for mixing. if (TKE_Kd_wall>0.) then @@ -1493,7 +1497,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & else ! Either N2=0 or dh = 0. if (TKE_remaining>0.) then - Kd_wall = CS%Kd_max + Kd_wall = GV%m_to_Z**2*CS%Kd_max else Kd_wall = 0. endif @@ -1504,10 +1508,10 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & TKE_remaining = TKE_remaining - TKE_consumed ! Note this will be non-negative ! Add this BBL diffusivity to the model net diffusivity. - Kd_int(i,j,K) = Kd_int(i,j,K) + GV%m_to_Z**2*Kd_wall - Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*(Kd_wall + Kd_lower) + Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_wall + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*(Kd_wall + Kd_lower) Kd_lower = Kd_wall ! Store for next level up. - if (do_diag_Kd_BBL) Kd_BBL(i,j,k) = Kd_wall + if (do_diag_Kd_BBL) Kd_BBL(i,j,k) = GV%Z_to_m**2*Kd_wall enddo ! k enddo ! i @@ -2086,7 +2090,7 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp call get_param(param_file, mdl, "KD_ADD", CS%Kd_add, & "A uniform diapycnal diffusivity that is added \n"//& "everywhere without any filtering or scaling.", & - units="m2 s-1", default=0.0) + units="m2 s-1", default=0.0, scale=GV%m_to_Z**2) if (CS%use_LOTW_BBL_diffusivity .and. CS%Kd_max<=0.) call MOM_error(FATAL, & "set_diffusivity_init: KD_MAX must be set (positive) when "// & "USE_LOTW_BBL_DIFFUSIVITY=True.") @@ -2190,20 +2194,20 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp ! The default molecular viscosity follows the CCSM4.0 and MOM4p1 defaults. CS%id_KT_extra = register_diag_field('ocean_model','KT_extra',diag%axesTi,Time, & - 'Double-diffusive diffusivity for temperature', 'm2 s-1') + 'Double-diffusive diffusivity for temperature', 'm2 s-1', conversion=GV%Z_to_m**2) CS%id_KS_extra = register_diag_field('ocean_model','KS_extra',diag%axesTi,Time, & - 'Double-diffusive diffusivity for salinity', 'm2 s-1') + 'Double-diffusive diffusivity for salinity', 'm2 s-1', conversion=GV%Z_to_m**2) if (associated(diag_to_Z_CSp)) then vd = var_desc("KT_extra", "m2 s-1", & "Double-Diffusive Temperature Diffusivity, interpolated to z", & z_grid='z') - CS%id_KT_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + CS%id_KT_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=GV%Z_to_m**2) vd = var_desc("KS_extra", "m2 s-1", & "Double-Diffusive Salinity Diffusivity, interpolated to z",& z_grid='z') - CS%id_KS_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + CS%id_KS_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=GV%Z_to_m**2) vd = var_desc("Kd_BBL", "m2 s-1", & "Bottom Boundary Layer Diffusivity", z_grid='z') CS%id_Kd_BBL_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) From 8bfefc9a175fb6d2681df97748e1a960fa2beff7 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 5 Oct 2018 05:50:41 -0400 Subject: [PATCH 148/174] Changed the units of Kd_BBL to Z-2 s-1 Rescaled the units of Kd_BBL from m2 s-1 to Z2 s-1 for dimensional consistency testing. Also changed the units of several diffusivity parameters in MOM_set_diffusivity, including CV%Kd, CS%Kv, and CS%Kd_max, via calls to get_param. All answers are bitwise identical, including rescaling Z over a large range. --- .../vertical/MOM_set_diffusivity.F90 | 104 +++++++++--------- .../vertical/MOM_tidal_mixing.F90 | 22 ++-- 2 files changed, 63 insertions(+), 63 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 80a4b9fe18..1894e2ae25 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -51,8 +51,7 @@ module MOM_set_diffusivity logical :: debug !< If true, write verbose checksums for debugging. logical :: bulkmixedlayer !< If true, a refined bulk mixed layer is used with - !! GV%nk_rho_varies variable density mixed & buffer - !! layers. + !! GV%nk_rho_varies variable density mixed & buffer layers. real :: FluxRi_max !< The flux Richardson number where the stratification is !! large enough that N2 > omega2. The full expression for !! the Flux Richardson number is usually @@ -70,14 +69,14 @@ module MOM_set_diffusivity real :: cdrag !< quadratic drag coefficient (nondim) real :: IMax_decay !< inverse of a maximum decay scale for !! bottom-drag driven turbulence, (1/m) - real :: Kv !< The interior vertical viscosity (m2/s) - real :: Kd !< interior diapycnal diffusivity (m2/s) - real :: Kd_min !< minimum diapycnal diffusivity (m2/s) - real :: Kd_max !< maximum increment for diapycnal diffusivity (m2/s) + real :: Kv !< The interior vertical viscosity (Z2/s) + real :: Kd !< interior diapycnal diffusivity (Z2/s) + real :: Kd_min !< minimum diapycnal diffusivity (Z2/s) + real :: Kd_max !< maximum increment for diapycnal diffusivity (Z2/s) !! Set to a negative value to have no limit. real :: Kd_add !< uniform diffusivity added everywhere without - !! filtering or scaling (m2/s) - real :: Kdml !< mixed layer diapycnal diffusivity (m2/s) + !! filtering or scaling (Z2/s) + real :: Kdml !< mixed layer diapycnal diffusivity (Z2/s) !! when bulkmixedlayer==.false. real :: Hmix !< mixed layer thickness (meter) when !! bulkmixedlayer==.false. @@ -108,7 +107,7 @@ module MOM_set_diffusivity !! where N2 is the squared buoyancy frequency (s-2) and OMEGA2 !! is the rotation rate of the earth squared. real :: ML_rad_kd_max !< Maximum diapycnal diffusivity due to turbulence - !! radiated from the base of the mixed layer (m2/s) + !! radiated from the base of the mixed layer (Z2/s) real :: ML_rad_efold_coeff !< non-dim coefficient to scale penetration depth real :: ML_rad_coeff !< coefficient, which scales MSTAR*USTAR^3 to !! obtain energy available for mixing below @@ -290,9 +289,9 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! Set Kd_lay, Kd_int and Kv_slow to constant values. ! If nothing else is specified, this will be the value used. - Kd_lay(:,:,:) = GV%m_to_Z**2*CS%Kd - Kd_int(:,:,:) = GV%m_to_Z**2*CS%Kd - if (associated(visc%Kv_slow)) visc%Kv_slow(:,:,:) = GV%m_to_Z**2 * CS%Kv + Kd_lay(:,:,:) = CS%Kd + Kd_int(:,:,:) = CS%Kd + if (associated(visc%Kv_slow)) visc%Kv_slow(:,:,:) = CS%Kv ! Set up arrays for diagnostics. @@ -734,7 +733,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & else; TKE_to_Kd(i,k) = 0.; endif ! The maximum TKE conversion we allow is really a statement ! about the upper diffusivity we allow. Kd_max must be set. - maxTKE(i,k) = hN2pO2 * CS%Kd_max ! Units of m3 s-3. + maxTKE(i,k) = hN2pO2 * GV%Z_to_m**2*CS%Kd_max ! Units of m3 s-3. enddo ; enddo kb(is:ie) = -1 ! kb should not be used by any code in non-layered mode -AJA return @@ -1299,8 +1298,8 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & if (Kd_lay(i,j,k) < (TKE_to_layer+TKE_Ray)*GV%m_to_Z**2*TKE_to_Kd(i,k)) then delta_Kd = (TKE_to_layer+TKE_Ray)*GV%m_to_Z**2*TKE_to_Kd(i,k) - Kd_lay(i,j,k) - if ((CS%Kd_max >= 0.0) .and. (delta_Kd > GV%m_to_Z**2*CS%Kd_max)) then - delta_Kd = GV%m_to_Z**2*CS%Kd_Max + if ((CS%Kd_max >= 0.0) .and. (delta_Kd > CS%Kd_max)) then + delta_Kd = CS%Kd_max Kd_lay(i,j,k) = Kd_lay(i,j,k) + delta_Kd else Kd_lay(i,j,k) = (TKE_to_layer+TKE_Ray)*GV%m_to_Z**2*TKE_to_Kd(i,k) @@ -1308,8 +1307,8 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*delta_Kd Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*delta_Kd if (do_diag_Kd_BBL) then - Kd_BBL(i,j,K) = Kd_BBL(i,j,K) + 0.5*GV%Z_to_m**2*delta_Kd - Kd_BBL(i,j,K+1) = Kd_BBL(i,j,K+1) + 0.5*GV%Z_to_m**2*delta_Kd + Kd_BBL(i,j,K) = Kd_BBL(i,j,K) + 0.5*delta_Kd + Kd_BBL(i,j,K+1) = Kd_BBL(i,j,K+1) + 0.5*delta_Kd endif endif else @@ -1329,13 +1328,13 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & if (TKE_here > 0.0) then delta_Kd = TKE_here * GV%m_to_Z**2*TKE_to_Kd(i,k) - if (CS%Kd_max >= 0.0) delta_Kd = min(delta_Kd, GV%m_to_Z**2*CS%Kd_max) + if (CS%Kd_max >= 0.0) delta_Kd = min(delta_Kd, CS%Kd_max) Kd_lay(i,j,k) = Kd_lay(i,j,k) + delta_Kd Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*delta_Kd Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*delta_Kd if (do_diag_Kd_BBL) then - Kd_BBL(i,j,K) = Kd_BBL(i,j,K) + 0.5*GV%Z_to_m**2*delta_Kd - Kd_BBL(i,j,K+1) = Kd_BBL(i,j,K+1) + 0.5*GV%Z_to_m**2*delta_Kd + Kd_BBL(i,j,K) = Kd_BBL(i,j,K) + 0.5*delta_Kd + Kd_BBL(i,j,K+1) = Kd_BBL(i,j,K+1) + 0.5*delta_Kd endif endif endif @@ -1491,13 +1490,13 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & TKE_Kd_wall = GV%Z_to_m**2*Kd_wall * 0.5 * (dh + dhm1) * max(N2_int(i,k), N2_min) ! Now bound Kd such that the associated TKE is no greater than available TKE for mixing. - if (TKE_Kd_wall>0.) then + if (TKE_Kd_wall > 0.) then TKE_consumed = min(TKE_Kd_wall, TKE_remaining) Kd_wall = (TKE_consumed/TKE_Kd_wall) * Kd_wall ! Scale Kd so that only TKE_consumed is used. else ! Either N2=0 or dh = 0. - if (TKE_remaining>0.) then - Kd_wall = GV%m_to_Z**2*CS%Kd_max + if (TKE_remaining > 0.) then + Kd_wall = CS%Kd_max else Kd_wall = 0. endif @@ -1511,7 +1510,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_wall Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*(Kd_wall + Kd_lower) Kd_lower = Kd_wall ! Store for next level up. - if (do_diag_Kd_BBL) Kd_BBL(i,j,k) = GV%Z_to_m**2*Kd_wall + if (do_diag_Kd_BBL) Kd_BBL(i,j,K) = Kd_wall enddo ! k enddo ! i @@ -1538,13 +1537,14 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_ ! This routine adds effects of mixed layer radiation to the layer diffusivities. - real, dimension(SZI_(G)) :: & - h_ml, & - TKE_ml_flux, & - I_decay, & - Kd_mlr_ml + real, dimension(SZI_(G)) :: h_ml + real, dimension(SZI_(G)) :: TKE_ml_flux + real, dimension(SZI_(G)) :: I_decay + real, dimension(SZI_(G)) :: Kd_mlr_ml ! Diffusivities associated with mixed layer radiation, in Z2 s-1. - real :: f_sq, h_ml_sq, ustar_sq, Kd_mlr, C1_6 + real :: f_sq, h_ml_sq, ustar_sq + real :: Kd_mlr ! A diffusivity associated with mixed layer turbulence radiation, in Z2 s-1. + real :: C1_6 ! 1/6 real :: Omega2 ! rotation rate squared (1/s2) real :: z1 ! layer thickness times I_decay (nondim) real :: dzL ! thickness converted to meter @@ -1592,25 +1592,25 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_ ! a more accurate Taylor series approximations for very thin layers. z1 = (GV%H_to_m*h(i,j,kml+1)) * I_decay(i) if (z1 > 1e-5) then - Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,kml+1)) * & + Kd_mlr = (TKE_ml_flux(i) * GV%m_to_Z**2*TKE_to_Kd(i,kml+1)) * & (1.0 - exp(-z1)) else - Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,kml+1)) * & + Kd_mlr = (TKE_ml_flux(i) * GV%m_to_Z**2*TKE_to_Kd(i,kml+1)) * & (z1 * (1.0 - z1 * (0.5 - C1_6*z1))) endif - Kd_mlr_ml(i) = min(Kd_mlr,CS%ML_rad_kd_max) + Kd_mlr_ml(i) = min(Kd_mlr, CS%ML_rad_kd_max) TKE_ml_flux(i) = TKE_ml_flux(i) * exp(-z1) endif ; enddo do k=1,kml+1 ; do i=is,ie ; if (do_i(i)) then - Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*Kd_mlr_ml(i) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + Kd_mlr_ml(i) endif ; enddo ; enddo if (present(Kd_int)) then do K=2,kml+1 ; do i=is,ie ; if (do_i(i)) then - Kd_int(i,j,K) = Kd_int(i,j,K) + GV%m_to_Z**2*Kd_mlr_ml(i) + Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_mlr_ml(i) endif ; enddo ; enddo if (kml<=nz-1) then ; do i=is,ie ; if (do_i(i)) then - Kd_int(i,j,Kml+2) = Kd_int(i,j,Kml+2) + 0.5*GV%m_to_Z**2*Kd_mlr_ml(i) + Kd_int(i,j,Kml+2) = Kd_int(i,j,Kml+2) + 0.5*Kd_mlr_ml(i) endif ; enddo ; endif endif @@ -1619,21 +1619,21 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_ do i=is,ie ; if (do_i(i)) then dzL = GV%H_to_m*h(i,j,k) ; z1 = dzL*I_decay(i) if (z1 > 1e-5) then - Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & + Kd_mlr = (TKE_ml_flux(i) * GV%m_to_Z**2*TKE_to_Kd(i,k)) * & ((1.0 - exp(-z1)) / dzL) else - Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & + Kd_mlr = (TKE_ml_flux(i) * GV%m_to_Z**2*TKE_to_Kd(i,k)) * & (I_decay(i) * (1.0 - z1 * (0.5 - C1_6*z1))) endif - Kd_mlr = min(Kd_mlr,CS%ML_rad_kd_max) - Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*Kd_mlr + Kd_mlr = min(Kd_mlr, CS%ML_rad_kd_max) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + Kd_mlr if (present(Kd_int)) then - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*GV%m_to_Z**2*Kd_mlr - Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*GV%m_to_Z**2*Kd_mlr + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*Kd_mlr + Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*Kd_mlr endif TKE_ml_flux(i) = TKE_ml_flux(i) * exp(-z1) - if (TKE_ml_flux(i) * I_decay(i) < 0.1*CS%Kd_min*Omega2) then + if (TKE_ml_flux(i) * I_decay(i) < 0.1*CS%Kd_min*GV%Z_to_m**2*Omega2) then do_i(i) = .false. else ; do_any = .true. ; endif endif ; enddo @@ -1982,8 +1982,8 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp call get_param(param_file, mdl, "ML_RAD_KD_MAX", CS%ML_rad_kd_max, & "The maximum diapycnal diffusivity due to turbulence \n"//& "radiated from the base of the mixed layer. \n"//& - "This is only used if ML_RADIATION is true.", units="m2 s-1", & - default=1.0e-3) + "This is only used if ML_RADIATION is true.", & + units="m2 s-1", default=1.0e-3, scale=GV%m_to_Z**2) call get_param(param_file, mdl, "ML_RAD_COEFF", CS%ML_rad_coeff, & "The coefficient which scales MSTAR*USTAR^3 to obtain \n"//& "the energy available for mixing below the base of the \n"//& @@ -2058,7 +2058,7 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp CS%use_LOTW_BBL_diffusivity = .false. ! This parameterization depends on a u* from viscous BBL endif CS%id_Kd_BBL = register_diag_field('ocean_model','Kd_BBL',diag%axesTi,Time, & - 'Bottom Boundary Layer Diffusivity', 'm2 s-1') + 'Bottom Boundary Layer Diffusivity', 'm2 s-1', conversion=GV%Z_to_m**2) call get_param(param_file, mdl, "SIMPLE_TKE_TO_KD", CS%simple_TKE_to_Kd, & "If true, uses a simple estimate of Kd/TKE that will\n"//& "work for arbitrary vertical coordinates. If false,\n"//& @@ -2072,19 +2072,19 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp call get_param(param_file, mdl, "KV", CS%Kv, & "The background kinematic viscosity in the interior. \n"//& "The molecular value, ~1e-6 m2 s-1, may be used.", & - units="m2 s-1", fail_if_missing=.true.) + units="m2 s-1", scale=GV%m_to_Z**2, fail_if_missing=.true.) call get_param(param_file, mdl, "KD", CS%Kd, & "The background diapycnal diffusivity of density in the \n"//& "interior. Zero or the molecular value, ~1e-7 m2 s-1, \n"//& - "may be used.", units="m2 s-1", fail_if_missing=.true.) + "may be used.", units="m2 s-1", scale=GV%m_to_Z**2, fail_if_missing=.true.) call get_param(param_file, mdl, "KD_MIN", CS%Kd_min, & "The minimum diapycnal diffusivity.", & - units="m2 s-1", default=0.01*CS%Kd) + units="m2 s-1", default=0.01*CS%Kd*GV%Z_to_m**2, scale=GV%m_to_Z**2) call get_param(param_file, mdl, "KD_MAX", CS%Kd_max, & "The maximum permitted increment for the diapycnal \n"//& "diffusivity from TKE-based parameterizations, or a \n"//& - "negative value for no limit.", units="m2 s-1", default=-1.0) + "negative value for no limit.", units="m2 s-1", default=-1.0, scale=GV%m_to_Z**2) if (CS%simple_TKE_to_Kd .and. CS%Kd_max<=0.) call MOM_error(FATAL, & "set_diffusivity_init: To use SIMPLE_TKE_TO_KD, KD_MAX must be set to >0.") call get_param(param_file, mdl, "KD_ADD", CS%Kd_add, & @@ -2108,7 +2108,7 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp "If BULKMIXEDLAYER is false, KDML is the elevated \n"//& "diapycnal diffusivity in the topmost HMIX of fluid. \n"//& "KDML is only used if BULKMIXEDLAYER is false.", & - units="m2 s-1", default=CS%Kd) + units="m2 s-1", default=CS%Kd*GV%Z_to_m**2, scale=GV%m_to_Z**2) call get_param(param_file, mdl, "HMIX_FIXED", CS%Hmix, & "The prescribed depth over which the near-surface \n"//& "viscosity and diffusivity are elevated when the bulk \n"//& @@ -2210,7 +2210,7 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp CS%id_KS_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=GV%Z_to_m**2) vd = var_desc("Kd_BBL", "m2 s-1", & "Bottom Boundary Layer Diffusivity", z_grid='z') - CS%id_Kd_BBL_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + CS%id_Kd_BBL_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=GV%Z_to_m**2) endif endif ! old double-diffusion diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 04ca9dc922..b75557af9e 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -671,7 +671,7 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in Z2 s-1. real, intent(in) :: Kd_max !< The maximum increment for diapycnal - !! diffusivity due to TKE-based processes, in m2 s-1. + !! diffusivity due to TKE-based processes, in Z2 s-1. !! Set this to a negative value to have no limit. real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface !! (not layer!) in Z2 s-1. @@ -684,7 +684,7 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & N2_lay, Kd_lay, Kd_int, Kd_max) endif endif -end subroutine +end subroutine calculate_tidal_mixing !> Calls the CVMix routines to compute tidal dissipation and to add the effect of internal-tide-driven @@ -939,7 +939,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in Z2 s-1. real, intent(in) :: Kd_max !< The maximum increment for diapycnal - !! diffusivity due to TKE-based processes, in m2 s-1. + !! diffusivity due to TKE-based processes, in Z2 s-1. !! Set this to a negative value to have no limit. ! local @@ -1180,7 +1180,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, ! Convert power to diffusivity Kd_add = TKE_to_Kd(i,k) * (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) - if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) + if (Kd_max >= 0.0) Kd_add = min(Kd_add, GV%Z_to_m**2*Kd_max) Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*Kd_add if (present(Kd_int)) then @@ -1193,7 +1193,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, ! If at layers, dd%Kd_itidal is just TKE_to_Kd(i,k) * TKE_itide_lay ! The following sets the interface diagnostics. Kd_add = TKE_to_Kd(i,k) * TKE_itide_lay - if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) + if (Kd_max >= 0.0) Kd_add = min(Kd_add, GV%Z_to_m**2*Kd_max) if (k>1) dd%Kd_itidal(i,j,K) = dd%Kd_itidal(i,j,K) + 0.5*Kd_add if (k= 0.0) Kd_add = min(Kd_add, Kd_max) + if (Kd_max >= 0.0) Kd_add = min(Kd_add, GV%Z_to_m**2*Kd_max) if (k>1) dd%Kd_Niku(i,j,K) = dd%Kd_Niku(i,j,K) + 0.5*Kd_add if (k= 0.0) Kd_add = min(Kd_add, Kd_max) + if (Kd_max >= 0.0) Kd_add = min(Kd_add, GV%Z_to_m**2*Kd_max) if (k>1) dd%Kd_lowmode(i,j,K) = dd%Kd_lowmode(i,j,K) + 0.5*Kd_add if (k= 0.0) Kd_add = min(Kd_add, Kd_max) + if (Kd_max >= 0.0) Kd_add = min(Kd_add, GV%Z_to_m**2*Kd_max) Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*Kd_add if (present(Kd_int)) then @@ -1280,7 +1280,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, ! If at layers, this is just dd%Kd_itidal(i,j,K) = TKE_to_Kd(i,k) * TKE_itide_lay ! The following sets the interface diagnostics. Kd_add = TKE_to_Kd(i,k) * TKE_itide_lay - if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) + if (Kd_max >= 0.0) Kd_add = min(Kd_add, GV%Z_to_m**2*Kd_max) if (k>1) dd%Kd_itidal(i,j,K) = dd%Kd_itidal(i,j,K) + 0.5*Kd_add if (k= 0.0) Kd_add = min(Kd_add, Kd_max) + if (Kd_max >= 0.0) Kd_add = min(Kd_add, GV%Z_to_m**2*Kd_max) if (k>1) dd%Kd_Niku(i,j,K) = dd%Kd_Niku(i,j,K) + 0.5*Kd_add if (k= 0.0) Kd_add = min(Kd_add, Kd_max) + if (Kd_max >= 0.0) Kd_add = min(Kd_add, GV%Z_to_m**2*Kd_max) if (k>1) dd%Kd_lowmode(i,j,K) = dd%Kd_lowmode(i,j,K) + 0.5*Kd_add if (k Date: Fri, 5 Oct 2018 08:27:49 -0400 Subject: [PATCH 149/174] +Changed the units of TKE_to_Kd to Z2 s2 m-3 Rescaled the units of TKE_to_Kd from s2 m-1 to Z2 s2 m-3 for dimensional consistency testing. Also changed the internal units of Kd_add and three diagnostic diffusivities from m2 s-1 to Z2 s-1 in MOM_tidal_mixing. All answers are bitwise identical, including rescaling Z over a large range. --- .../vertical/MOM_set_diffusivity.F90 | 50 +++++----- .../vertical/MOM_tidal_mixing.F90 | 93 +++++++++---------- 2 files changed, 71 insertions(+), 72 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 1894e2ae25..237b0aeb12 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -175,7 +175,7 @@ module MOM_set_diffusivity real, pointer, dimension(:,:,:) :: TKE_to_Kd => NULL() !< conversion rate (~1.0 / (G_Earth + dRho_lay)) !! between TKE dissipated within a layer and Kd - !! in that layer, in m2 s-1 / m3 s-3 = s2 m-1 + !! in that layer, in Z2 s-1 / m3 s-3 = Z2 s2 m-3 end type diffusivity_diags @@ -676,7 +676,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & !! TKE dissipated within a layer and the !! diapycnal diffusivity witin that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)), - !! in m2 s-1 / m3 s-3 = s2 m-1 + !! in Z2 s-1 / m3 s-3 = Z2 s2 m-3 real, dimension(SZI_(G),SZK_(G)), intent(out) :: maxTKE !< The energy required to for a layer to entrain !! to its maximum realizable thickness, in m3 s-3 integer, dimension(SZI_(G)), intent(out) :: kb !< Index of lightest layer denser than the buffer @@ -712,7 +712,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & real :: I_Rho0 ! inverse of Boussinesq reference density (m3/kg) real :: I_dt ! 1/dt (1/sec) real :: H_neglect ! negligibly small thickness (units as h) - real :: hN2pO2 ! h * (N^2 + Omega^2), in m s-2. + real :: hN2pO2 ! h * (N^2 + Omega^2), in m3 s-2 Z-2. logical :: do_i(SZI_(G)) integer :: i, k, is, ie, nz, i_rem, kmb, kb_min @@ -720,20 +720,20 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & I_dt = 1.0/dt Omega2 = CS%Omega**2 - G_Rho0 = (GV%g_Earth*GV%m_to_Z) / GV%Rho0 + G_Rho0 = (GV%g_Earth*GV%m_to_Z**2) / GV%Rho0 H_neglect = GV%H_subroundoff I_Rho0 = 1.0/GV%Rho0 ! Simple but coordinate-independent estimate of Kd/TKE if (CS%simple_TKE_to_Kd) then do k=1,nz ; do i=is,ie - hN2pO2 = ( GV%H_to_m * h(i,j,k) ) * ( N2_lay(i,k) + Omega2 ) ! Units of m s-2. + hN2pO2 = GV%Z_to_m**2*( GV%H_to_m * h(i,j,k) ) * ( N2_lay(i,k) + Omega2 ) ! Units of m3 Z-2 s-2. if (hN2pO2>0.) then - TKE_to_Kd(i,k) = 1./ hN2pO2 ! Units of s2 m-1. + TKE_to_Kd(i,k) = 1.0 / hN2pO2 ! Units of Z2 s2 m-3. else; TKE_to_Kd(i,k) = 0.; endif ! The maximum TKE conversion we allow is really a statement ! about the upper diffusivity we allow. Kd_max must be set. - maxTKE(i,k) = hN2pO2 * GV%Z_to_m**2*CS%Kd_max ! Units of m3 s-3. + maxTKE(i,k) = hN2pO2 * CS%Kd_max ! Units of m3 s-3. enddo ; enddo kb(is:ie) = -1 ! kb should not be used by any code in non-layered mode -AJA return @@ -828,7 +828,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & enddo do k=2,kmb ; do i=is,ie maxTKE(i,k) = 0.0 - TKE_to_Kd(i,k) = 1.0 / ((N2_lay(i,k) + Omega2) * & + TKE_to_Kd(i,k) = GV%m_to_Z**2 / ((N2_lay(i,k) + Omega2) * & (GV%H_to_m*(h(i,j,k) + H_neglect))) enddo ; enddo do k=kmb+1,kb_min-1 ; do i=is,ie @@ -852,8 +852,8 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & maxTKE(i,k) = I_dt * (((GV%g_Earth*GV%m_to_Z) * I_Rho0) * & (0.5*max(dRho_int(i,K+1) + dsp1_ds(i,k)*dRho_int(i,K),0.0))) * & ((GV%H_to_m*h(i,j,k) + dh_max) * maxEnt(i,k)) - TKE_to_Kd(i,k) = 1.0 / (G_Rho0 * dRho_lay + & - CS%Omega**2 * GV%H_to_m*(h(i,j,k) + H_neglect)) + TKE_to_Kd(i,k) = GV%m_to_Z**3 / (G_Rho0 * dRho_lay + & + CS%Omega**2 * GV%H_to_Z*(h(i,j,k) + H_neglect)) endif enddo ; enddo @@ -1143,7 +1143,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & !! TKE dissipated within a layer and the !! diapycnal diffusivity witin that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)), - !! in m2 s-1 / m3 s-3 = s2 m-1 + !! in Z2 s-1 / m3 s-3 = Z2 s2 m-3 real, dimension(SZI_(G),SZK_(G)), intent(in) :: maxTKE !< The energy required to for a layer to entrain !! to its maximum realizable thickness, in m3 s-3 integer, dimension(SZI_(G)), intent(in) :: kb !< Index of lightest layer denser than the buffer @@ -1296,13 +1296,13 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & TKE(i) = TKE(i) - TKE_to_layer - if (Kd_lay(i,j,k) < (TKE_to_layer+TKE_Ray)*GV%m_to_Z**2*TKE_to_Kd(i,k)) then - delta_Kd = (TKE_to_layer+TKE_Ray)*GV%m_to_Z**2*TKE_to_Kd(i,k) - Kd_lay(i,j,k) + if (Kd_lay(i,j,k) < (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k)) then + delta_Kd = (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k) - Kd_lay(i,j,k) if ((CS%Kd_max >= 0.0) .and. (delta_Kd > CS%Kd_max)) then delta_Kd = CS%Kd_max Kd_lay(i,j,k) = Kd_lay(i,j,k) + delta_Kd else - Kd_lay(i,j,k) = (TKE_to_layer+TKE_Ray)*GV%m_to_Z**2*TKE_to_Kd(i,k) + Kd_lay(i,j,k) = (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k) endif Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*delta_Kd Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*delta_Kd @@ -1312,12 +1312,12 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & endif endif else - if (Kd_lay(i,j,k) >= maxTKE(i,k)*GV%m_to_Z**2*TKE_to_Kd(i,k)) then + if (Kd_lay(i,j,k) >= maxTKE(i,k)*TKE_to_Kd(i,k)) then TKE_here = 0.0 TKE(i) = TKE(i) + TKE_Ray - elseif (Kd_lay(i,j,k) + (TKE_to_layer+TKE_Ray)*GV%m_to_Z**2*TKE_to_Kd(i,k) > & - maxTKE(i,k)*GV%m_to_Z**2*TKE_to_Kd(i,k)) then - TKE_here = ( (TKE_to_layer+TKE_Ray) + Kd_lay(i,j,k)/(GV%m_to_Z**2*TKE_to_Kd(i,k)) ) - & + elseif (Kd_lay(i,j,k) + (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k) > & + maxTKE(i,k)*TKE_to_Kd(i,k)) then + TKE_here = ( (TKE_to_layer+TKE_Ray) + Kd_lay(i,j,k)/TKE_to_Kd(i,k) ) - & maxTKE(i,k) TKE(i) = TKE(i) - TKE_here + TKE_Ray else @@ -1327,7 +1327,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & if (TKE(i) < 0.0) TKE(i) = 0.0 ! This should be unnecessary? if (TKE_here > 0.0) then - delta_Kd = TKE_here * GV%m_to_Z**2*TKE_to_Kd(i,k) + delta_Kd = TKE_here * TKE_to_Kd(i,k) if (CS%Kd_max >= 0.0) delta_Kd = min(delta_Kd, CS%Kd_max) Kd_lay(i,j,k) = Kd_lay(i,j,k) + delta_Kd Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*delta_Kd @@ -1531,7 +1531,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_ !! TKE dissipated within a layer and the !! diapycnal diffusivity witin that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)), - !! in m2 s-1 / m3 s-3 = s2 m-1 + !! in Z2 s-1 / m3 s-3 = Z2 s2 m-3 real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in Z2 s-1. @@ -1592,10 +1592,10 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_ ! a more accurate Taylor series approximations for very thin layers. z1 = (GV%H_to_m*h(i,j,kml+1)) * I_decay(i) if (z1 > 1e-5) then - Kd_mlr = (TKE_ml_flux(i) * GV%m_to_Z**2*TKE_to_Kd(i,kml+1)) * & + Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,kml+1)) * & (1.0 - exp(-z1)) else - Kd_mlr = (TKE_ml_flux(i) * GV%m_to_Z**2*TKE_to_Kd(i,kml+1)) * & + Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,kml+1)) * & (z1 * (1.0 - z1 * (0.5 - C1_6*z1))) endif Kd_mlr_ml(i) = min(Kd_mlr, CS%ML_rad_kd_max) @@ -1619,10 +1619,10 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_ do i=is,ie ; if (do_i(i)) then dzL = GV%H_to_m*h(i,j,k) ; z1 = dzL*I_decay(i) if (z1 > 1e-5) then - Kd_mlr = (TKE_ml_flux(i) * GV%m_to_Z**2*TKE_to_Kd(i,k)) * & + Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & ((1.0 - exp(-z1)) / dzL) else - Kd_mlr = (TKE_ml_flux(i) * GV%m_to_Z**2*TKE_to_Kd(i,k)) * & + Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & (I_decay(i) * (1.0 - z1 * (0.5 - C1_6*z1))) endif Kd_mlr = min(Kd_mlr, CS%ML_rad_kd_max) @@ -2157,7 +2157,7 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp CS%id_maxTKE = register_diag_field('ocean_model','maxTKE',diag%axesTL,Time, & 'Maximum layer TKE', 'm3 s-3') CS%id_TKE_to_Kd = register_diag_field('ocean_model','TKE_to_Kd',diag%axesTL,Time, & - 'Convert TKE to Kd', 's2 m') + 'Convert TKE to Kd', 's2 m', conversion=GV%Z_to_m**2) CS%id_N2 = register_diag_field('ocean_model','N2',diag%axesTi,Time, & 'Buoyancy frequency squared', 's-2', cmor_field_name='obvfsq', & cmor_long_name='Square of seawater buoyancy frequency',& diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index b75557af9e..fba82d7f5d 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -38,9 +38,9 @@ module MOM_tidal_mixing !> Containers for tidal mixing diagnostics type, public :: tidal_mixing_diags ; private real, pointer, dimension(:,:,:) :: & - Kd_itidal => NULL(),& !< internal tide diffusivity at interfaces (m2 s-1) + Kd_itidal => NULL(),& !< internal tide diffusivity at interfaces (Z2 s-1) Fl_itidal => NULL(),& !< vertical flux of tidal turbulent dissipation (m3 s-3) - Kd_Niku => NULL(),& !< lee-wave diffusivity at interfaces (m2 s-1) + Kd_Niku => NULL(),& !< lee-wave diffusivity at interfaces (Z2 s-1) Kd_Niku_work => NULL(),& !< layer integrated work by lee-wave driven mixing (W m-2) Kd_Itidal_Work => NULL(),& !< layer integrated work by int tide driven mixing (W m-2) Kd_Lowmode_Work => NULL(),& !< layer integrated work by low mode driven mixing (W m-2) @@ -50,7 +50,7 @@ module MOM_tidal_mixing real, pointer, dimension(:,:,:) :: tidal_qe_md => NULL() !< Input tidal energy dissipated locally, !! interpolated to model vertical coordinate (W m-3?) real, pointer, dimension(:,:,:) :: Kd_lowmode => NULL() !< internal tide diffusivity at interfaces - !! due to propagating low modes (m2/s) + !! due to propagating low modes (Z2/s) real, pointer, dimension(:,:,:) :: Fl_lowmode => NULL() !< vertical flux of tidal turbulent !! dissipation due to propagating low modes (m3/s3) real, pointer, dimension(:,:) :: & @@ -121,7 +121,7 @@ module MOM_tidal_mixing !! available to mix above the BBL real :: utide !< constant tidal amplitude (m s-1) used if - real :: kappa_itides !< topographic wavenumber and non-dimensional scaling + real :: kappa_itides !< topographic wavenumber and non-dimensional scaling, in Z-1 real :: kappa_h2_factor !< factor for the product of wavenumber * rms sgs height character(len=200) :: inputdir !< The directory in which to find input files @@ -411,7 +411,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, call get_param(param_file, mdl, "KAPPA_ITIDES", CS%kappa_itides, & "A topographic wavenumber used with INT_TIDE_DISSIPATION. \n"//& "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=GV%Z_to_m) call get_param(param_file, mdl, "UTIDE", CS%utide, & "The constant tidal amplitude used with INT_TIDE_DISSIPATION.", & @@ -461,8 +461,8 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, utide = CS%tideamp(i,j) ! Compute the fixed part of internal tidal forcing; units are [kg s-2] here. - CS%TKE_itidal(i,j) = 0.5*CS%kappa_h2_factor*GV%Rho0*& - CS%kappa_itides*(GV%Z_to_m**2)*CS%h2(i,j)*utide*utide + CS%TKE_itidal(i,j) = 0.5*GV%Z_to_m * CS%kappa_h2_factor*GV%Rho0*& + CS%kappa_itides * CS%h2(i,j) * utide*utide enddo ; enddo endif @@ -559,7 +559,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, CS%Lowmode_itidal_dissipation) then CS%id_Kd_itidal = register_diag_field('ocean_model','Kd_itides',diag%axesTi,Time, & - 'Internal Tide Driven Diffusivity', 'm2 s-1') + 'Internal Tide Driven Diffusivity', 'm2 s-1', conversion=GV%Z_to_m**2) if (CS%use_CVMix_tidal) then CS%id_N2_int = register_diag_field('ocean_model','N2_int',diag%axesTi,Time, & @@ -581,7 +581,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, 'Bottom Buoyancy Frequency', 's-1') CS%id_Kd_lowmode = register_diag_field('ocean_model','Kd_lowmode',diag%axesTi,Time, & - 'Internal Tide Driven Diffusivity (from propagating low modes)', 'm2 s-1') + 'Internal Tide Driven Diffusivity (from propagating low modes)', 'm2 s-1', conversion=GV%Z_to_m**2) CS%id_Fl_itidal = register_diag_field('ocean_model','Fl_itides',diag%axesTi,Time, & 'Vertical flux of tidal turbulent dissipation', 'm3 s-3') @@ -590,12 +590,12 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, 'Vertical flux of tidal turbulent dissipation (from propagating low modes)', 'm3 s-3') CS%id_Polzin_decay_scale = register_diag_field('ocean_model','Polzin_decay_scale',diag%axesT1,Time, & - 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme', 'm') + 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme', 'm', conversion=GV%Z_to_m) CS%id_Polzin_decay_scale_scaled = register_diag_field('ocean_model', & - 'Polzin_decay_scale_scaled',diag%axesT1,Time, & + 'Polzin_decay_scale_scaled', diag%axesT1, Time, & 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme, '// & - 'scaled by N2_bot/N2_meanz', 'm') + 'scaled by N2_bot/N2_meanz', 'm', conversion=GV%Z_to_m) CS%id_N2_bot = register_diag_field('ocean_model','N2_b',diag%axesT1,Time, & 'Bottom Buoyancy frequency squared', 's-2') @@ -616,24 +616,24 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, CS%id_TKE_leewave = register_diag_field('ocean_model','TKE_leewave',diag%axesT1,Time, & 'Lee wave Driven Turbulent Kinetic Energy', 'W m-2') CS%id_Kd_Niku = register_diag_field('ocean_model','Kd_Nikurashin',diag%axesTi,Time, & - 'Lee Wave Driven Diffusivity', 'm2 s-1') + 'Lee Wave Driven Diffusivity', 'm2 s-1', conversion=GV%Z_to_m**2) endif endif ! S%use_CVMix_tidal if (associated(CS%diag_to_Z_CSp)) then vd = var_desc("Kd_itides","m2 s-1", & "Internal Tide Driven Diffusivity, interpolated to z", z_grid='z') - CS%id_Kd_itidal_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + CS%id_Kd_itidal_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=GV%Z_to_m**2) if (CS%Lee_wave_dissipation) then vd = var_desc("Kd_Nikurashin", "m2 s-1", & "Lee Wave Driven Diffusivity, interpolated to z", z_grid='z') - CS%id_Kd_Niku_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + CS%id_Kd_Niku_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=GV%Z_to_m**2) endif if (CS%Lowmode_itidal_dissipation) then vd = var_desc("Kd_lowmode","m2 s-1", & "Internal Tide Driven Diffusivity (from low modes), interpolated to z",& z_grid='z') - CS%id_Kd_lowmode_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + CS%id_Kd_lowmode_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=GV%Z_to_m**2) endif endif @@ -662,7 +662,7 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & !! TKE dissipated within a layer and the !! diapycnal diffusivity witin that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)), - !! in m2 s-1 / m3 s-3 = s2 m-1 + !! in Z2 s-1 / m3 s-3 = Z2 s2 m-3 real, dimension(SZI_(G),SZK_(G)), intent(in) :: max_TKE !< The energy required to for a layer to entrain !! to its maximum realizable thickness, in m3 s-3 type(tidal_mixing_cs), pointer :: CS !< The control structure for this module @@ -736,7 +736,7 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd_lay, Kv) hcorr = 0.0 do k=1,G%ke ! cell center and cell bottom in meters (negative values in the ocean) - dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment + dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment, rescaled to m for use by CVMix. dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness @@ -772,13 +772,13 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd_lay, Kv) ! Update diffusivity do k=1,G%ke - Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*(Kd_tidal(k) + Kd_tidal(k+1) ) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*(Kd_tidal(k) + Kd_tidal(k+1)) ! Rescale from m2 s-1 to Z2 s-1. enddo ! Update viscosity with the proper unit conversion. if (associated(Kv)) then do k=1,G%ke+1 - Kv(i,j,k) = Kv(i,j,k) + GV%m_to_Z**2 * Kv_tidal(k) + Kv(i,j,k) = Kv(i,j,k) + GV%m_to_Z**2 * Kv_tidal(k) ! Rescale from m2 s-1 to Z2 s-1. enddo endif @@ -817,11 +817,10 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd_lay, Kv) iFaceHeight = 0.0 ! BBL is all relative to the surface hcorr = 0.0 - h_m = h(i,j,:)*GV%H_to_m do k=1,G%ke + h_m(k) = h(i,j,k)*GV%H_to_m ! Rescale thicknesses to m for use by CVmix. ! cell center and cell bottom in meters (negative values in the ocean) - dh = h_m(k) ! Nominal thickness to use for increment - dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) + dh = h_m(k) + hcorr ! Nominal thickness less the accumulated error (could temporarily make dh<0) hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness cellHeight(k) = iFaceHeight(k) - 0.5 * dh @@ -871,13 +870,13 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd_lay, Kv) ! Update diffusivity do k=1,G%ke - Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*(Kd_tidal(k) + Kd_tidal(k+1) ) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*(Kd_tidal(k) + Kd_tidal(k+1)) ! Rescale from m2 s-1 to Z2 s-1. enddo ! Update viscosity if (associated(Kv)) then do k=1,G%ke+1 - Kv(i,j,k) = Kv(i,j,k) + GV%m_to_Z**2 * Kv_tidal(k) + Kv(i,j,k) = Kv(i,j,k) + GV%m_to_Z**2 * Kv_tidal(k) ! Rescale from m2 s-1 to Z2 s-1. enddo endif @@ -930,7 +929,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, !! TKE dissipated within a layer and the !! diapycnal diffusivity witin that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)), - !! in m2 s-1 / m3 s-3 = s2 m-1 + !! in Z2 s-1 / m3 s-3 = Z2 s2 m-3 real, dimension(SZI_(G),SZK_(G)), intent(in) :: max_TKE !< The energy required to for a layer to entrain !! to its maximum realizable thickness, in m3 s-3 type(tidal_mixing_cs), pointer :: CS !< The control structure for this module @@ -971,7 +970,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, z_from_bot_WKB ! distance from bottom (Z), WKB scaled real :: I_rho0 ! 1 / RHO0, (m3/kg) - real :: Kd_add ! diffusivity to add in a layer (m2/sec) + real :: Kd_add ! diffusivity to add in a layer (Z2/sec) real :: TKE_itide_lay ! internal tide TKE imparted to a layer (from barotropic) (m3/s3) real :: TKE_Niku_lay ! lee-wave TKE imparted to a layer (m3/s3) real :: TKE_lowmode_lay ! internal tide TKE imparted to a layer (from low mode) (m3/s3) (BDM) @@ -1056,15 +1055,15 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, do i=is,ie CS%Nb(i,j) = sqrt(N2_bot(i)) - !### In the code below 1.0e-14 is a dimensional constant. + !### In the code below 1.0e-14 is a dimensional constant in s-3 if ((CS%tideamp(i,j) > 0.0) .and. & - (CS%kappa_itides**2 * (GV%Z_to_m**2)*CS%h2(i,j) * CS%Nb(i,j)**3 > 1.0e-14) ) then + (CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 > 1.0e-14) ) then z0_polzin(i) = GV%m_to_Z * CS%Polzin_decay_scale_factor * CS%Nu_Polzin * & CS%Nbotref_Polzin**2 * CS%tideamp(i,j) / & - ( CS%kappa_itides**2 * GV%Z_to_m**2*CS%h2(i,j) * CS%Nb(i,j)**3 ) + ( CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 ) if (z0_polzin(i) < CS%Polzin_min_decay_scale) & z0_polzin(i) = CS%Polzin_min_decay_scale - if (N2_meanz(i) > 1.0e-14 ) then + if (N2_meanz(i) > 1.0e-14 ) then !### Here 1.0e-14 has dimensions of s-2. z0_polzin_scaled(i) = z0_polzin(i)*CS%Nb(i,j)**2 / N2_meanz(i) else z0_polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * htot(i) @@ -1077,9 +1076,9 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, endif if (associated(dd%Polzin_decay_scale)) & - dd%Polzin_decay_scale(i,j) = GV%Z_to_m * z0_polzin(i) + dd%Polzin_decay_scale(i,j) = z0_polzin(i) if (associated(dd%Polzin_decay_scale_scaled)) & - dd%Polzin_decay_scale_scaled(i,j) = GV%Z_to_m * z0_polzin_scaled(i) + dd%Polzin_decay_scale_scaled(i,j) = z0_polzin_scaled(i) if (associated(dd%N2_bot)) dd%N2_bot(i,j) = CS%Nb(i,j)*CS%Nb(i,j) if ( CS%Int_tide_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then @@ -1180,12 +1179,12 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, ! Convert power to diffusivity Kd_add = TKE_to_Kd(i,k) * (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) - if (Kd_max >= 0.0) Kd_add = min(Kd_add, GV%Z_to_m**2*Kd_max) - Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*Kd_add + if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + Kd_add if (present(Kd_int)) then - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*GV%m_to_Z**2*Kd_add - Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*GV%m_to_Z**2*Kd_add + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*Kd_add + Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*Kd_add endif ! diagnostics @@ -1193,7 +1192,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, ! If at layers, dd%Kd_itidal is just TKE_to_Kd(i,k) * TKE_itide_lay ! The following sets the interface diagnostics. Kd_add = TKE_to_Kd(i,k) * TKE_itide_lay - if (Kd_max >= 0.0) Kd_add = min(Kd_add, GV%Z_to_m**2*Kd_max) + if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) if (k>1) dd%Kd_itidal(i,j,K) = dd%Kd_itidal(i,j,K) + 0.5*Kd_add if (k= 0.0) Kd_add = min(Kd_add, GV%Z_to_m**2*Kd_max) + if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) if (k>1) dd%Kd_Niku(i,j,K) = dd%Kd_Niku(i,j,K) + 0.5*Kd_add if (k= 0.0) Kd_add = min(Kd_add, GV%Z_to_m**2*Kd_max) + if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) if (k>1) dd%Kd_lowmode(i,j,K) = dd%Kd_lowmode(i,j,K) + 0.5*Kd_add if (k= 0.0) Kd_add = min(Kd_add, GV%Z_to_m**2*Kd_max) - Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*Kd_add + if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + Kd_add if (present(Kd_int)) then - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*GV%m_to_Z**2*Kd_add - Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*GV%m_to_Z**2*Kd_add + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*Kd_add + Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*Kd_add endif ! diagnostics @@ -1280,7 +1279,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, ! If at layers, this is just dd%Kd_itidal(i,j,K) = TKE_to_Kd(i,k) * TKE_itide_lay ! The following sets the interface diagnostics. Kd_add = TKE_to_Kd(i,k) * TKE_itide_lay - if (Kd_max >= 0.0) Kd_add = min(Kd_add, GV%Z_to_m**2*Kd_max) + if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) if (k>1) dd%Kd_itidal(i,j,K) = dd%Kd_itidal(i,j,K) + 0.5*Kd_add if (k= 0.0) Kd_add = min(Kd_add, GV%Z_to_m**2*Kd_max) + if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) if (k>1) dd%Kd_Niku(i,j,K) = dd%Kd_Niku(i,j,K) + 0.5*Kd_add if (k= 0.0) Kd_add = min(Kd_add, GV%Z_to_m**2*Kd_max) + if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) if (k>1) dd%Kd_lowmode(i,j,K) = dd%Kd_lowmode(i,j,K) + 0.5*Kd_add if (k Date: Fri, 5 Oct 2018 09:13:13 -0400 Subject: [PATCH 150/174] Removed trailing white space --- src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index b9325733e5..4f7126b4bd 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -804,7 +804,7 @@ subroutine VarMix_init(Time, G, param_file, diag, CS) CS%calculate_cg1 = CS%calculate_cg1 .or. use_FGNV_streamfn call get_param(param_file, mdl, "USE_MEKE", use_MEKE, & default=.false., do_not_log=.true.) - CS%calculate_Rd_dx = CS%calculate_Rd_dx .or. use_MEKE + CS%calculate_Rd_dx = CS%calculate_Rd_dx .or. use_MEKE CS%calculate_Eady_growth_rate = CS%calculate_Eady_growth_rate .or. use_MEKE call get_param(param_file, mdl, "KHTR_PASSIVITY_COEFF", KhTr_passivity_coeff, & default=0., do_not_log=.true.) From 21473df7835871d5e5422892356d9ee394e86601 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 5 Oct 2018 10:37:39 -0400 Subject: [PATCH 151/174] Rescaled MOM_set_diffusivity calculations into Z Rescaled numerous internal calculations and internal variables in MOM_set_diffusivity to work in units of Z in place of m to permit dimensional consistency testing. All answers are bitwise identical, including rescaling Z over a large range. --- .../vertical/MOM_set_diffusivity.F90 | 145 +++++++++--------- 1 file changed, 73 insertions(+), 72 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 237b0aeb12..9917f49f90 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -68,7 +68,7 @@ module MOM_set_diffusivity !! by bottom drag drives BBL diffusion (nondim) real :: cdrag !< quadratic drag coefficient (nondim) real :: IMax_decay !< inverse of a maximum decay scale for - !! bottom-drag driven turbulence, (1/m) + !! bottom-drag driven turbulence, (1/Z) real :: Kv !< The interior vertical viscosity (Z2/s) real :: Kd !< interior diapycnal diffusivity (Z2/s) real :: Kd_min !< minimum diapycnal diffusivity (Z2/s) @@ -521,8 +521,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (associated(dd%Kd_work)) then do k=1,nz ; do i=is,ie - dd%Kd_Work(i,j,k) = GV%Rho0 * GV%Z_to_m**2*Kd_lay(i,j,k) * N2_lay(i,k) * & - GV%H_to_m*h(i,j,k) ! Watt m-2 s or kg s-3 + dd%Kd_Work(i,j,k) = GV%Rho0 * GV%Z_to_m**3*Kd_lay(i,j,k) * N2_lay(i,k) * & + GV%H_to_Z*h(i,j,k) ! Watt m-2 s or kg s-3 enddo ; enddo endif enddo ! j-loop @@ -693,19 +693,19 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & maxEnt ! maxEnt is the maximum value of entrainment from below (with ! compensating entrainment from above to keep the layer ! density from changing) that will not deplete all of the - ! layers above or below a layer within a timestep (meter) + ! layers above or below a layer within a timestep (Z) real, dimension(SZI_(G)) :: & htot, & ! total thickness above or below a layer, or the - ! integrated thickness in the BBL (meter) + ! integrated thickness in the BBL (Z) mFkb, & ! total thickness in the mixed and buffer layers - ! times ds_dsp1 (meter) + ! times ds_dsp1 (Z) p_ref, & ! array of tv%P_Ref pressures Rcv_kmb, & ! coordinate density in the lowest buffer layer p_0 ! An array of 0 pressures real :: dh_max ! maximum amount of entrainment a layer could ! undergo before entraining all fluid in the layers - ! above or below (meter) + ! above or below (Z) real :: dRho_lay ! density change across a layer (kg/m3) real :: Omega2 ! rotation rate squared (1/s2) real :: G_Rho0 ! gravitation accel divided by Bouss ref density (m4 s-2 kg-1) @@ -727,7 +727,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & ! Simple but coordinate-independent estimate of Kd/TKE if (CS%simple_TKE_to_Kd) then do k=1,nz ; do i=is,ie - hN2pO2 = GV%Z_to_m**2*( GV%H_to_m * h(i,j,k) ) * ( N2_lay(i,k) + Omega2 ) ! Units of m3 Z-2 s-2. + hN2pO2 = GV%Z_to_m**3 * ( GV%H_to_Z * h(i,j,k) ) * ( N2_lay(i,k) + Omega2 ) ! Units of m3 Z-2 s-2. if (hN2pO2>0.) then TKE_to_Kd(i,k) = 1.0 / hN2pO2 ! Units of Z2 s2 m-3. else; TKE_to_Kd(i,k) = 0.; endif @@ -782,32 +782,32 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & if (CS%bulkmixedlayer) then kmb = GV%nk_rho_varies do i=is,ie - htot(i) = GV%H_to_m*h(i,j,kmb) + htot(i) = GV%H_to_Z*h(i,j,kmb) mFkb(i) = 0.0 if (kb(i) < nz) & - mFkb(i) = ds_dsp1(i,kb(i)) * (GV%H_to_m*(h(i,j,kmb) - GV%Angstrom_H)) + mFkb(i) = ds_dsp1(i,kb(i)) * (GV%H_to_Z*(h(i,j,kmb) - GV%Angstrom_H)) enddo do k=1,kmb-1 ; do i=is,ie - htot(i) = htot(i) + GV%H_to_m*h(i,j,k) - mFkb(i) = mFkb(i) + ds_dsp1(i,k+1)*(GV%H_to_m*(h(i,j,k) - GV%Angstrom_H)) + htot(i) = htot(i) + GV%H_to_Z*h(i,j,k) + mFkb(i) = mFkb(i) + ds_dsp1(i,k+1)*(GV%H_to_Z*(h(i,j,k) - GV%Angstrom_H)) enddo ; enddo else do i=is,i - maxEnt(i,1) = 0.0 ; htot(i) = GV%H_to_m*(h(i,j,1) - GV%Angstrom_H) + maxEnt(i,1) = 0.0 ; htot(i) = GV%H_to_Z*(h(i,j,1) - GV%Angstrom_H) enddo endif do k=kb_min,nz-1 ; do i=is,ie if (k == kb(i)) then - maxEnt(i,kb(i))= mFkb(i) + maxEnt(i,kb(i)) = mFkb(i) elseif (k > kb(i)) then maxEnt(i,k) = (1.0/dsp1_ds(i,k))*(maxEnt(i,k-1) + htot(i)) ! maxEnt(i,k) = ds_dsp1(i,k)*(maxEnt(i,k-1) + htot(i)) ! BITWISE CHG - htot(i) = htot(i) + GV%H_to_m*(h(i,j,k) - GV%Angstrom_H) + htot(i) = htot(i) + GV%H_to_Z*(h(i,j,k) - GV%Angstrom_H) endif enddo ; enddo do i=is,ie - htot(i) = GV%H_to_m*(h(i,j,nz) - GV%Angstrom_H) ; maxEnt(i,nz) = 0.0 + htot(i) = GV%H_to_Z*(h(i,j,nz) - GV%Angstrom_H) ; maxEnt(i,nz) = 0.0 do_i(i) = (G%mask2dT(i,j) > 0.5) enddo do k=nz-1,kb_min,-1 @@ -816,7 +816,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & if (k 0.0) .and. (absf > 0.5*CS%IMax_decay*ustar_h)) then @@ -1222,12 +1222,12 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & I2decay(i) = 0.5*CS%IMax_decay endif TKE(i) = ((CS%BBL_effic * cdrag_sqrt) * & - exp(-I2decay(i)*(GV%H_to_m*h(i,j,nz))) ) * & + exp(-I2decay(i)*(GV%H_to_Z*h(i,j,nz))) ) * & visc%TKE_BBL(i,j) if (associated(fluxes%TKE_tidal)) & TKE(i) = TKE(i) + fluxes%TKE_tidal(i,j) * I_Rho0 * & - (CS%BBL_effic * exp(-I2decay(i)*(GV%H_to_m*h(i,j,nz)))) + (CS%BBL_effic * exp(-I2decay(i)*(GV%H_to_Z*h(i,j,nz)))) ! Distribute the work over a BBL of depth 20^2 ustar^2 / g' following ! Killworth & Edwards (1999) and Zilitikevich & Mironov (1996). @@ -1237,16 +1237,16 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & gh_sum_top(i) = R0_g * 400.0 * ustar_h**2 do_i(i) = (G%mask2dT(i,j) > 0.5) - htot(i) = GV%H_to_m*h(i,j,nz) - rho_htot(i) = GV%Rlay(nz)*(GV%H_to_m*h(i,j,nz)) + htot(i) = GV%H_to_Z*h(i,j,nz) + rho_htot(i) = GV%Rlay(nz)*(GV%H_to_Z*h(i,j,nz)) Rho_top(i) = GV%Rlay(1) if (CS%bulkmixedlayer .and. do_i(i)) Rho_top(i) = GV%Rlay(kb(i)-1) enddo do k=nz-1,2,-1 ; domore = .false. do i=is,ie ; if (do_i(i)) then - htot(i) = htot(i) + GV%H_to_m*h(i,j,k) - rho_htot(i) = rho_htot(i) + GV%Rlay(k)*(GV%H_to_m*h(i,j,k)) + htot(i) = htot(i) + GV%H_to_Z*h(i,j,k) + rho_htot(i) = rho_htot(i) + GV%Rlay(k)*(GV%H_to_Z*h(i,j,k)) if (htot(i)*GV%Rlay(k-1) <= (rho_htot(i) - gh_sum_top(i))) then ! The top of the mixing is in the interface atop the current layer. Rho_top(i) = (rho_htot(i) - gh_sum_top(i)) / htot(i) @@ -1265,7 +1265,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & i_rem = i_rem + 1 ! Count the i-rows that are still being worked on. ! Apply vertical decay of the turbulent energy. This energy is ! simply lost. - TKE(i) = TKE(i) * exp(-I2decay(i) * (GV%H_to_m*(h(i,j,k) + h(i,j,k+1)))) + TKE(i) = TKE(i) * exp(-I2decay(i) * (GV%H_to_Z*(h(i,j,k) + h(i,j,k+1)))) ! if (maxEnt(i,k) <= 0.0) cycle if (maxTKE(i,k) <= 0.0) cycle @@ -1390,17 +1390,17 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & real :: TKE_consumed ! TKE used for mixing in this layer (m3 s-3) real :: TKE_Kd_wall ! TKE associated with unlimited law of the wall mixing (m3 s-3) real :: cdrag_sqrt ! square root of the drag coefficient (nondimensional) - real :: ustar ! value of ustar at a thickness point (m/s) + real :: ustar ! value of ustar at a thickness point (Z/s) real :: ustar2 ! square of ustar, for convenience (Z2/s2) real :: absf ! average absolute value of Coriolis parameter around a thickness point (1/sec) - real :: dh, dhm1 ! thickness of layers k and k-1, respecitvely (meter) - real :: z ! distance to interface k from bottom (meter) - real :: D_minus_z ! distance to interface k from surface (meter) - real :: total_thickness ! total thickness of water column (meter) - real :: Idecay ! inverse of decay scale used for "Joule heating" loss of TKE with height (1/m) + real :: dh, dhm1 ! thickness of layers k and k-1, respecitvely (Z) + real :: z_bot ! distance to interface k from bottom (Z) + real :: D_minus_z ! distance to interface k from surface (Z) + real :: total_thickness ! total thickness of water column (Z) + real :: Idecay ! inverse of decay scale used for "Joule heating" loss of TKE with height (1/Z) real :: Kd_wall ! Law of the wall diffusivity (Z2/s) real :: Kd_lower ! diffusivity for lower interface (Z2/sec) - real :: ustar_D ! u* x D (m2/s) + real :: ustar_D ! u* x D (Z2/s) real :: I_Rho0 ! 1 / rho0 real :: N2_min ! Minimum value of N2 to use in calculation of TKE_Kd_wall (1/s2) logical :: Rayleigh_drag ! Set to true if there are Rayleigh drag velocities defined in visc, on @@ -1429,11 +1429,11 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & (abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J-1)))) ! Non-zero on equator! ! u* at the bottom, in m s-1. - ustar = visc%ustar_BBL(i,j) - ustar2 = GV%m_to_Z**2*ustar**2 + ustar = GV%m_to_Z*visc%ustar_BBL(i,j) + ustar2 = ustar**2 ! In add_drag_diffusivity(), fluxes%ustar_tidal is added in. This might be double counting ! since ustar_BBL should already include all contributions to u*? -AJA - if (associated(fluxes%ustar_tidal)) ustar = ustar + fluxes%ustar_tidal(i,j) + if (associated(fluxes%ustar_tidal)) ustar = ustar + GV%m_to_Z*fluxes%ustar_tidal(i,j) ! The maximum decay scale should be something of order 200 m. We use the smaller of u*/f and ! (IMax_decay)^-1 as the decay scale. If ustar = 0, this is land so this value doesn't matter. @@ -1450,17 +1450,17 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & TKE_column = CS%BBL_effic * TKE_column ! Only use a fraction of the mechanical dissipation for mixing. TKE_remaining = TKE_column - total_thickness = ( sum(h(i,j,:)) + GV%H_subroundoff )* GV%H_to_m ! Total column thickness, in m. + total_thickness = ( sum(h(i,j,:)) + GV%H_subroundoff )* GV%H_to_Z ! Total column thickness, in m. ustar_D = ustar * total_thickness - z = 0. + z_bot = 0. Kd_lower = 0. ! Diffusivity on bottom boundary. ! Work upwards from the bottom, accumulating work used until it exceeds the available TKE input ! at the bottom. do k=G%ke,2,-1 - dh = GV%H_to_m * h(i,j,k) ! Thickness of this level in m. + dh = GV%H_to_Z * h(i,j,k) ! Thickness of this level in Z. km1 = max(k-1, 1) - dhm1 = GV%H_to_m * h(i,j,km1) ! Thickness of level above in m. + dhm1 = GV%H_to_Z * h(i,j,km1) ! Thickness of level above in Z. ! Add in additional energy input from bottom-drag against slopes (sides) if (Rayleigh_drag) TKE_remaining = TKE_remaining + & @@ -1474,20 +1474,21 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & ! This is energy loss in addition to work done as mixing, apparently to Joule heating. TKE_remaining = exp(-Idecay*dh) * TKE_remaining - z = z + h(i,j,k)*GV%H_to_m ! Distance between upper interface of layer and the bottom, in m. - D_minus_z = max(total_thickness - z, 0.) ! Thickness above layer, m. + z_bot = z_bot + h(i,j,k)*GV%H_to_Z ! Distance between upper interface of layer and the bottom, in Z. + D_minus_z = max(total_thickness - z_bot, 0.) ! Thickness above layer, Z. ! Diffusivity using law of the wall, limited by rotation, at height z, in m2/s. ! This calculation is at the upper interface of the layer - if ( ustar_D + absf * ( z * D_minus_z ) == 0.) then + if ( ustar_D + absf * ( z_bot * D_minus_z ) == 0.) then Kd_wall = 0. else - Kd_wall = ( ( von_karm * ustar2 ) * ( z * D_minus_z ) )/( ustar_D + absf * ( z * D_minus_z ) ) + Kd_wall = ( ( von_karm * ustar2 ) * ( z_bot * D_minus_z ) ) / & + ( ustar_D + absf * ( z_bot * D_minus_z ) ) endif ! TKE associated with Kd_wall, in m3 s-2. ! This calculation if for the volume spanning the interface. - TKE_Kd_wall = GV%Z_to_m**2*Kd_wall * 0.5 * (dh + dhm1) * max(N2_int(i,k), N2_min) + TKE_Kd_wall = GV%Z_to_m**3*Kd_wall * 0.5 * (dh + dhm1) * max(N2_int(i,k), N2_min) ! Now bound Kd such that the associated TKE is no greater than available TKE for mixing. if (TKE_Kd_wall > 0.) then @@ -1537,9 +1538,9 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_ ! This routine adds effects of mixed layer radiation to the layer diffusivities. - real, dimension(SZI_(G)) :: h_ml + real, dimension(SZI_(G)) :: h_ml ! Mixed layer thickness, in Z. real, dimension(SZI_(G)) :: TKE_ml_flux - real, dimension(SZI_(G)) :: I_decay + real, dimension(SZI_(G)) :: I_decay ! A decay rate in Z-1. real, dimension(SZI_(G)) :: Kd_mlr_ml ! Diffusivities associated with mixed layer radiation, in Z2 s-1. real :: f_sq, h_ml_sq, ustar_sq @@ -1547,10 +1548,10 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_ real :: C1_6 ! 1/6 real :: Omega2 ! rotation rate squared (1/s2) real :: z1 ! layer thickness times I_decay (nondim) - real :: dzL ! thickness converted to meter + real :: dzL ! thickness converted to Z real :: I_decay_len2_TKE ! squared inverse decay lengthscale for - ! TKE, as used in the mixed layer code (1/m2) - real :: h_neglect ! negligibly small thickness (meter) + ! TKE, as used in the mixed layer code (1/Z2) + real :: h_neglect ! negligibly small thickness (Z) logical :: do_any, do_i(SZI_(G)) integer :: i, k, is, ie, nz, kml @@ -1559,12 +1560,12 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_ Omega2 = CS%Omega**2 C1_6 = 1.0 / 6.0 kml = GV%nkml - h_neglect = GV%H_subroundoff*GV%H_to_m + h_neglect = GV%H_subroundoff*GV%H_to_Z if (.not.CS%ML_radiation) return do i=is,ie ; h_ml(i) = 0.0 ; do_i(i) = (G%mask2dT(i,j) > 0.5) ; enddo - do k=1,kml ; do i=is,ie ; h_ml(i) = h_ml(i) + GV%H_to_m*h(i,j,k) ; enddo ; enddo + do k=1,kml ; do i=is,ie ; h_ml(i) = h_ml(i) + GV%H_to_Z*h(i,j,k) ; enddo ; enddo do i=is,ie ; if (do_i(i)) then if (CS%ML_omega_frac >= 1.0) then @@ -1579,7 +1580,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_ ustar_sq = max(fluxes%ustar(i,j), CS%ustar_min)**2 TKE_ml_flux(i) = (CS%mstar*CS%ML_rad_coeff)*(ustar_sq*fluxes%ustar(i,j)) - I_decay_len2_TKE = CS%TKE_decay**2 * (f_sq / ustar_sq) + I_decay_len2_TKE = CS%TKE_decay**2 * (f_sq / (GV%m_to_Z**2*ustar_sq)) if (CS%ML_rad_TKE_decay) & TKE_ml_flux(i) = TKE_ml_flux(i) * exp(-h_ml(i) * sqrt(I_decay_len2_TKE)) @@ -1590,7 +1591,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_ ! Average the dissipation layer kml+1, using ! a more accurate Taylor series approximations for very thin layers. - z1 = (GV%H_to_m*h(i,j,kml+1)) * I_decay(i) + z1 = (GV%H_to_Z*h(i,j,kml+1)) * I_decay(i) if (z1 > 1e-5) then Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,kml+1)) * & (1.0 - exp(-z1)) @@ -1617,13 +1618,13 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_ do k=kml+2,nz-1 do_any = .false. do i=is,ie ; if (do_i(i)) then - dzL = GV%H_to_m*h(i,j,k) ; z1 = dzL*I_decay(i) + dzL = GV%H_to_Z*h(i,j,k) ; z1 = dzL*I_decay(i) if (z1 > 1e-5) then Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & - ((1.0 - exp(-z1)) / dzL) + GV%m_to_Z * ((1.0 - exp(-z1)) / dzL) else Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & - (I_decay(i) * (1.0 - z1 * (0.5 - C1_6*z1))) + GV%m_to_Z * (I_decay(i) * (1.0 - z1 * (0.5 - C1_6*z1))) endif Kd_mlr = min(Kd_mlr, CS%ML_rad_kd_max) Kd_lay(i,j,k) = Kd_lay(i,j,k) + Kd_mlr @@ -1633,7 +1634,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_ endif TKE_ml_flux(i) = TKE_ml_flux(i) * exp(-z1) - if (TKE_ml_flux(i) * I_decay(i) < 0.1*CS%Kd_min*GV%Z_to_m**2*Omega2) then + if (TKE_ml_flux(i) * I_decay(i) < 0.1*CS%Kd_min*GV%Z_to_m**3*Omega2) then do_i(i) = .false. else ; do_any = .true. ; endif endif ; enddo @@ -2035,10 +2036,10 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp "The maximum decay scale for the BBL diffusion, or 0 \n"//& "to allow the mixing to penetrate as far as \n"//& "stratification and rotation permit. The default is 0. \n"//& - "This is only used if BOTTOMDRAGLAW is true.", units="m", & - default=0.0) + "This is only used if BOTTOMDRAGLAW is true.", & + units="m", default=0.0, scale=GV%m_to_Z) - CS%IMax_decay = 1.0/200.0 + CS%IMax_decay = 1.0 / (200.0*GV%m_to_Z) !### This is inconsistent with the description above. if (decay_length > 0.0) CS%IMax_decay = 1.0/decay_length call get_param(param_file, mdl, "BBL_MIXING_AS_MAX", CS%BBL_mixing_as_max, & "If true, take the maximum of the diffusivity from the \n"//& From e6e63dbd649559f8949fda00613d4945101ad4b9 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 5 Oct 2018 14:35:52 -0400 Subject: [PATCH 152/174] Changed the units of visc%ustar_BBL to Z s-1 Rescaled the units of visc%ustar_BBL from m s-1 to Z s-1 for dimensional consistency testing. Also changed the units of 5 CS%dissip_... parameters in MOM_set_diffusivity via calls to get_param. All answers are bitwise identical, including rescaling Z over a large range. --- src/core/MOM_variables.F90 | 2 +- .../vertical/MOM_set_diffusivity.F90 | 41 ++++++++++--------- 2 files changed, 22 insertions(+), 21 deletions(-) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 91e3e48af3..8f7dc9dea1 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -196,7 +196,7 @@ module MOM_variables bbl_thick_v => NULL(), & !< The bottom boundary layer thickness at the v-points, in Z. kv_bbl_u => NULL(), & !< The bottom boundary layer viscosity at the u-points, in Z2 s-1. kv_bbl_v => NULL(), & !< The bottom boundary layer viscosity at the v-points, in Z2 s-1. - ustar_BBL => NULL() !< The turbulence velocity in the bottom boundary layer at h points, in m s-1. + ustar_BBL => NULL() !< The turbulence velocity in the bottom boundary layer at h points, in Z s-1. real, pointer, dimension(:,:) :: TKE_BBL => NULL() !< A term related to the bottom boundary layer source of turbulent kinetic !! energy, currently in units of m3 s-3, but will later be changed to W m-2. diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 9917f49f90..52df0e0f72 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -84,11 +84,11 @@ module MOM_set_diffusivity logical :: limit_dissipation !< If enabled, dissipation is limited to be larger !! than the following: - real :: dissip_min !< Minimum dissipation (W/m3) - real :: dissip_N0 !< Coefficient a in minimum dissipation = a+b*N (W/m3) - real :: dissip_N1 !< Coefficient b in minimum dissipation = a+b*N (J/m3) - real :: dissip_N2 !< Coefficient c in minimum dissipation = c*N2 (W m-3 s2) - real :: dissip_Kd_min !< Minimum Kd (m2/s) with dissipatio Rho0*Kd_min*N^2 + real :: dissip_min !< Minimum dissipation (Z2 m-2 W m-3) + real :: dissip_N0 !< Coefficient a in minimum dissipation = a+b*N (Z2 m-2 W m-3) + real :: dissip_N1 !< Coefficient b in minimum dissipation = a+b*N (Z2 m-2 W m-3 s) + real :: dissip_N2 !< Coefficient c in minimum dissipation = c*N2 (Z2 m-2 W m-3 s2) + real :: dissip_Kd_min !< Minimum Kd (Z2/s) with dissipation Rho0*Kd_min*N^2 real :: TKE_itide_max !< maximum internal tide conversion (W m-2) !! available to mix above the BBL @@ -250,7 +250,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & KS_extra !< double difusion diffusivity of salinity (Z2/sec) real :: I_Rho0 ! inverse of Boussinesq density (m3/kg) - real :: dissip ! local variable for dissipation calculations (W/m3) + real :: dissip ! local variable for dissipation calculations (Z2 W/m5) real :: Omega2 ! squared absolute rotation rate (1/s2) logical :: use_EOS ! If true, compute density from T/S using equation of state. @@ -502,7 +502,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & CS%dissip_N0 + CS%dissip_N1 * sqrt(N2_lay(i,k)), & ! Floor aka Gargett CS%dissip_N2 * N2_lay(i,k) ) ! Floor of Kd_min*rho0/F_Ri Kd_lay(i,j,k) = max( Kd_lay(i,j,k) , & ! Apply floor to Kd - GV%m_to_Z**2*dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_lay(i,k) + Omega2))) ) + dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_lay(i,k) + Omega2))) ) enddo ; enddo if (present(Kd_int)) then ; do K=2,nz ; do i=is,ie @@ -515,7 +515,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & CS%dissip_N0 + CS%dissip_N1 * sqrt(N2_int(i,K)), & ! Floor aka Gargett CS%dissip_N2 * N2_int(i,K) ) ! Floor of Kd_min*rho0/F_Ri Kd_int(i,j,K) = max( Kd_int(i,j,K) , & ! Apply floor to Kd - GV%m_to_Z**2*dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_int(i,K) + Omega2))) ) + dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_int(i,K) + Omega2))) ) enddo ; enddo ; endif endif @@ -1209,7 +1209,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & ! Any turbulence that makes it into the mixed layers is assumed ! to be relatively small and is discarded. do i=is,ie - ustar_h = GV%m_to_Z*visc%ustar_BBL(i,j) + ustar_h = visc%ustar_BBL(i,j) if (associated(fluxes%ustar_tidal)) & ustar_h = ustar_h + GV%m_to_Z*fluxes%ustar_tidal(i,j) absf = 0.25*((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & @@ -1429,7 +1429,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & (abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J-1)))) ! Non-zero on equator! ! u* at the bottom, in m s-1. - ustar = GV%m_to_Z*visc%ustar_BBL(i,j) + ustar = visc%ustar_BBL(i,j) ustar2 = ustar**2 ! In add_drag_diffusivity(), fluxes%ustar_tidal is added in. This might be double counting ! since ustar_BBL should already include all contributions to u*? -AJA @@ -1668,13 +1668,13 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, CS) real, dimension(SZIB_(G)) :: & uhtot, & ! running integral of u in the BBL (Z m/s) - ustar, & ! bottom boundary layer turbulence speed (m/s) + ustar, & ! bottom boundary layer turbulence speed (Z/s) u2_bbl ! square of the mean zonal velocity in the BBL (m2/s2) real :: vhtot(SZI_(G)) ! running integral of v in the BBL (Z m/sec) real, dimension(SZI_(G),SZJB_(G)) :: & - vstar, & ! ustar at at v-points in 2 j-rows (m/s) + vstar, & ! ustar at at v-points (Z/s) v2_bbl ! square of average meridional velocity in BBL (m2/s2) real :: cdrag_sqrt ! square root of the drag coefficient (nondim) @@ -1709,7 +1709,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, CS) ! vertical decay scale. do i=is,ie ; if ((G%mask2dCv(i,J) > 0.5) .and. (cdrag_sqrt*visc%bbl_thick_v(i,J) > 0.0)) then do_i(i) = .true. ; vhtot(i) = 0.0 ; htot(i) = 0.0 - vstar(i,J) = GV%Z_to_m*visc%kv_bbl_v(i,J)/(cdrag_sqrt*visc%bbl_thick_v(i,J)) + vstar(i,J) = visc%kv_bbl_v(i,J) / (cdrag_sqrt*visc%bbl_thick_v(i,J)) else do_i(i) = .false. ; vstar(i,J) = 0.0 ; htot(i) = 0.0 endif ; enddo @@ -1739,7 +1739,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, CS) do j=js,je do I=is-1,ie ; if ((G%mask2dCu(I,j) > 0.5) .and. (cdrag_sqrt*visc%bbl_thick_u(I,j) > 0.0)) then do_i(I) = .true. ; uhtot(I) = 0.0 ; htot(I) = 0.0 - ustar(I) = GV%Z_to_m*visc%kv_bbl_u(I,j)/(cdrag_sqrt*visc%bbl_thick_u(I,j)) + ustar(I) = visc%kv_bbl_u(I,j) / (cdrag_sqrt*visc%bbl_thick_u(I,j)) else do_i(I) = .false. ; ustar(I) = 0.0 ; htot(I) = 0.0 endif ; enddo @@ -1770,10 +1770,11 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, 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) = (((G%areaCu(I-1,j)*(ustar(I-1)*u2_bbl(I-1)) + & + visc%TKE_BBL(i,j) = GV%Z_to_m * & + (((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)) + & - G%areaCv(i,J) * (vstar(i,J)*v2_bbl(i,J))))*G%IareaT(i,j)) + G%areaCv(i,J) * (vstar(i,J)*v2_bbl(i,J))) )*G%IareaT(i,j)) enddo enddo !$OMP end parallel @@ -2125,20 +2126,20 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp call get_param(param_file, mdl, "DISSIPATION_MIN", CS%dissip_min, & "The minimum dissipation by which to determine a lower \n"//& - "bound of Kd (a floor).", units="W m-3", default=0.0) + "bound of Kd (a floor).", units="W m-3", default=0.0, scale=GV%m_to_Z**2) call get_param(param_file, mdl, "DISSIPATION_N0", CS%dissip_N0, & "The intercept when N=0 of the N-dependent expression \n"//& "used to set a minimum dissipation by which to determine \n"//& "a lower bound of Kd (a floor): A in eps_min = A + B*N.", & - units="W m-3", default=0.0) + units="W m-3", default=0.0, scale=GV%m_to_Z**2) call get_param(param_file, mdl, "DISSIPATION_N1", CS%dissip_N1, & "The coefficient multiplying N, following Gargett, used to \n"//& "set a minimum dissipation by which to determine a lower \n"//& "bound of Kd (a floor): B in eps_min = A + B*N", & - units="J m-3", default=0.0) + units="J m-3", default=0.0, scale=GV%m_to_Z**2) call get_param(param_file, mdl, "DISSIPATION_KD_MIN", CS%dissip_Kd_min, & "The minimum vertical diffusivity applied as a floor.", & - units="m2 s-1", default=0.0) + units="m2 s-1", default=0.0, scale=GV%m_to_Z**2) CS%limit_dissipation = (CS%dissip_min>0.) .or. (CS%dissip_N1>0.) .or. & (CS%dissip_N0>0.) .or. (CS%dissip_Kd_min>0.) From 7575e39e3dacb4d950b6ef9c61e2c950c3b35308 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 5 Oct 2018 14:48:41 -0400 Subject: [PATCH 153/174] Swapped argument attribute order Altered the order of the attributes of the new argument to match the other arguments. The code is syntactically equivalent. --- config_src/solo_driver/atmos_ocean_fluxes.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config_src/solo_driver/atmos_ocean_fluxes.F90 b/config_src/solo_driver/atmos_ocean_fluxes.F90 index 76c0941c18..4a4ddf6da3 100644 --- a/config_src/solo_driver/atmos_ocean_fluxes.F90 +++ b/config_src/solo_driver/atmos_ocean_fluxes.F90 @@ -22,7 +22,7 @@ function aof_set_coupler_flux(name, flux_type, implementation, atm_tr_index, integer, optional, intent(in) :: atm_tr_index !< An unused argument real, dimension(:), optional, intent(in) :: param !< An unused argument logical, dimension(:), optional, intent(in) :: flag !< An unused argument - real, intent(in), optional :: mol_wt !< An unused argument + real, optional, intent(in) :: mol_wt !< An unused argument character(len=*), optional, intent(in) :: ice_restart_file !< An unused argument character(len=*), optional, intent(in) :: ocean_restart_file !< An unused argument character(len=*), optional, intent(in) :: units !< An unused argument From 6a47a23f9db3587162cb84623483367e3ad88f4f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 6 Oct 2018 06:34:04 -0400 Subject: [PATCH 154/174] Recast diffusivity in energetic_PBL into Z2 s-1 Rescaled the internal representation of diffusivities in energetic_PBL from m2 s-1 to Z2 s-1, and related lengths from m to Z and vstar from m s-1 to Z s-1 all for greater dimensional consistency testing. All answers are bitwise identical, including rescaling Z over a large range. --- .../vertical/MOM_energetic_PBL.F90 | 51 ++++++++++--------- 1 file changed, 27 insertions(+), 24 deletions(-) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index a105bfa6e3..04cf148d16 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -52,8 +52,8 @@ module MOM_energetic_PBL !! energy is converted to a turbulent velocity, relative to !! mechanically forced turbulent kinetic energy, nondim. !! Making this larger increases the diffusivity. - real :: vstar_scale_fac !< An overall nondimensional scaling factor for vstar. - !! Making this larger increases the diffusivity. + real :: vstar_scale_fac !< An overall nondimensional scaling factor for vstar times a unit + !! conversion factor. Making this larger increases the diffusivity. real :: Ekman_scale_coef !< A nondimensional scaling factor controlling the inhibition of the !! diffusive length scale by rotation. Making this larger decreases !! the diffusivity in the planetary boundary layer. @@ -63,7 +63,7 @@ module MOM_energetic_PBL !! value of 0.1 might be better justified by observations. real :: MLD_tol !< A tolerance for determining the boundary layer thickness when !! Use_MLD_iteration is true, in m. - real :: min_mix_len !< The minimum mixing length scale that will be used by ePBL, in m. + real :: min_mix_len !< The minimum mixing length scale that will be used by ePBL, in Z. !! The default (0) does not set a minimum. real :: N2_Dissipation_Scale_Neg !< A nondimensional scaling factor controlling the loss of TKE !! due to enhanced dissipation in the presence of negative (unstable) @@ -354,7 +354,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & real :: LA ! The Langmuir number (non-dim) real :: LAmod ! A modified Langmuir number accounting for other parameters. real :: hbs_here ! The local minimum of hb_hs and MixLen_shape, times a - ! conversion factor from H to M, in m H-1. + ! conversion factor from H to Z, in Z H-1. real :: nstar_FC ! The fraction of conv_PErel that can be converted to mixing, nondim. real :: TKE_reduc ! The fraction by which TKE and other energy fields are ! reduced to support mixing, nondim. between 0 and 1. @@ -373,7 +373,11 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & real :: dPE_conv ! The convective change in column potential energy, in J m-2. real :: MKE_src ! The mean kinetic energy source of TKE due to Kddt_h(K), in J m-2. real :: dMKE_src_dK ! The partial derivative of MKE_src with Kddt_h(K), in J m-2 H-1. - real :: Kd_guess0, PE_chg_g0, dPEa_dKd_g0, Kddt_h_g0 + real :: Kd_guess0 ! A first guess of the diapycnal diffusivity, in Z2 s-1. + real :: PE_chg_g0 ! The potential energy change when Kd is Kd_guess0 + real :: dPEa_dKd_g0 + real :: Kddt_h_g0 ! The first guess diapycnal diffusivity times a timestep divided + ! by the average thicknesses around a layer, in H (m or kg m-2). real :: PE_chg_max ! The maximum PE change for very large values of Kddt_h(K). real :: dPEc_dKd_Kd0 ! The partial derivative of PE change with Kddt_h(K) ! for very small values of Kddt_h(K), in J m-2 H-1. @@ -663,7 +667,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & pres(i,1) = 0.0 do k=1,nz dMass = GV%H_to_kg_m2 * h(i,k) - dPres = (GV%g_Earth*GV%m_to_Z) * dMass + dPres = (GV%g_Earth*GV%m_to_Z) * dMass ! This is equivalent to GV%H_to_Pa * h(i,k) dT_to_dPE(i,k) = (dMass * (pres(i,K) + 0.5*dPres)) * dSV_dT(i,j,k) dS_to_dPE(i,k) = (dMass * (pres(i,K) + 0.5*dPres)) * dSV_dS(i,j,k) dT_to_dColHt(i,k) = dMass * dSV_dT(i,j,k) @@ -955,7 +959,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & dSe_t2 = Kddt_h(K-1) * ((S0(k-2) - S0(k-1)) + dSe(k-2)) endif endif - dt_h = (GV%m_to_H**2*dt) / max(0.5*(h(i,k-1)+h(i,k)), 1e-15*h_sum(i)) + dt_h = (GV%Z_to_H**2*dt) / max(0.5*(h(i,k-1)+h(i,k)), 1e-15*h_sum(i)) ! This tests whether the layers above and below this interface are in ! a convetively stable configuration, without considering any effects of @@ -1045,13 +1049,13 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & TKE_here = mech_TKE(i) + CS%wstar_ustar_coef*conv_PErel(i) if (TKE_here > 0.0) then vstar = CS%vstar_scale_fac * (I_dtrho*TKE_here)**C1_3 - hbs_here = GV%H_to_m * min(hb_hs(i,K), MixLen_shape(K)) + hbs_here = GV%H_to_Z * min(hb_hs(i,K), MixLen_shape(K)) Mixing_Length_Used(k) = MAX(CS%min_mix_len,((h_tt*hbs_here)*vstar) / & ((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar)) !Note setting Kd_guess0 to Mixing_Length_Used(K) here will ! change the answers. Therefore, skipping that. if (.not.CS%Use_MLD_Iteration) then - Kd_guess0 = vstar * vonKar * ((h_tt*hbs_here)*vstar) / & + Kd_guess0 = vstar * vonKar * ((h_tt*hbs_here)*vstar) / & ((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar) else Kd_guess0 = vstar * vonKar * Mixing_Length_Used(k) @@ -1097,16 +1101,16 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & TKE_here = mech_TKE(i) + CS%wstar_ustar_coef*(conv_PErel(i)-PE_chg_max) if (TKE_here > 0.0) then vstar = CS%vstar_scale_fac * (I_dtrho*TKE_here)**C1_3 - hbs_here = GV%H_to_m * min(hb_hs(i,K), MixLen_shape(K)) + hbs_here = GV%H_to_Z * min(hb_hs(i,K), MixLen_shape(K)) Mixing_Length_Used(k) = max(CS%min_mix_len,((h_tt*hbs_here)*vstar) / & ((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar)) if (.not.CS%Use_MLD_Iteration) then ! Note again (as prev) that using Mixing_Length_Used here ! instead of redoing the computation will change answers... - Kd(i,k) = vstar * vonKar * ((h_tt*hbs_here)*vstar) / & + Kd(i,k) = vstar * vonKar * ((h_tt*hbs_here)*vstar) / & ((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar) else - Kd(i,k) = vstar * vonKar * Mixing_Length_Used(k) + Kd(i,k) = vstar * vonKar * Mixing_Length_Used(k) endif else vstar = 0.0 ; Kd(i,k) = 0.0 @@ -1362,7 +1366,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & !This is how the iteration was original conducted do k=2,nz if (FIRST_OBL) then !Breaks when OBL found - if (Vstar_Used(k) > 1.e-10 .and. k < nz) then + if (Vstar_Used(k) > 1.e-10*GV%m_to_Z .and. k < nz) then MLD_FOUND = MLD_FOUND + h(i,k-1)*GV%H_to_m else FIRST_OBL = .false. @@ -1474,7 +1478,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & endif do K=1,nz+1 ; do i=is,ie - Kd_int(i,j,K) = GV%m_to_Z**2 * Kd(i,K) + Kd_int(i,j,K) = Kd(i,K) enddo ; enddo enddo ! j-loop @@ -1923,18 +1927,17 @@ subroutine get_LA_windsea(ustar, hbl, GV, LA) call ust_2_u10_coare3p5(ustar*sqrt(GV%Rho0/1.225),U10,GV) ! surface Stokes drift us = us_to_u10*u10 - ! - ! significant wave height from Pierson-Moskowitz - ! spectrum (Bouws, 1998) + + ! significant wave height from Pierson-Moskowitz spectrum (Bouws, 1998) hm0 = 0.0246 *u10**2 - ! + ! peak frequency (PM, Bouws, 1998) tmp = 2.0 * PI * u19p5_to_u10 * u10 fp = 0.877 * (GV%g_Earth*GV%m_to_Z) / tmp - ! + ! mean frequency fm = fm_to_fp * fp - ! + ! total Stokes transport (a factor r_loss is applied to account ! for the effect of directional spreading, multidirectional waves ! and the use of PM peak frequency and PM significant wave height @@ -2100,7 +2103,7 @@ subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, "VSTAR_SCALE_FACTOR", CS%vstar_scale_fac, & "An overall nondimensional scaling factor for v*. \n"// & "Making this larger decreases the PBL diffusivity.", & - units="nondim", default=1.0) + units="nondim", default=1.0, scale=GV%m_to_Z) call get_param(param_file, mdl, "EKMAN_SCALE_COEF", CS%Ekman_scale_coef, & "A nondimensional scaling factor controlling the inhibition \n"// & "of the diffusive length scale by rotation. Making this larger \n"//& @@ -2124,7 +2127,7 @@ subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, "EPBL_MIN_MIX_LEN", CS%min_mix_len, & "The minimum mixing length scale that will be used \n"//& "by ePBL. The default (0) does not set a minimum.", & - units="meter", default=0.0) + units="meter", default=0.0, scale=GV%m_to_Z) call get_param(param_file, mdl, "EPBL_ORIGINAL_PE_CALC", CS%orig_PE_calc, & "If true, the ePBL code uses the original form of the \n"// & "potential energy change code. Otherwise, the newer \n"// & @@ -2224,9 +2227,9 @@ subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS) CS%id_Hsfc_used = register_diag_field('ocean_model', 'ePBL_Hs_used', diag%axesT1, & Time, 'Surface region thickness that is used', 'm') CS%id_Mixing_Length = register_diag_field('ocean_model', 'Mixing_Length', diag%axesTi, & - Time, 'Mixing Length that is used', 'm') + Time, 'Mixing Length that is used', 'm', conversion=GV%Z_to_m) CS%id_Velocity_Scale = register_diag_field('ocean_model', 'Velocity_Scale', diag%axesTi, & - Time, 'Velocity Scale that is used.', 'm s-1') + Time, 'Velocity Scale that is used.', 'm s-1', conversion=GV%Z_to_m) CS%id_LT_enhancement = register_diag_field('ocean_model', 'LT_Enhancement', diag%axesT1, & Time, 'LT enhancement that is used.', 'nondim') CS%id_MSTAR_mix = register_diag_field('ocean_model', 'MSTAR', diag%axesT1, & From e69a9d861543f95235ed355cc1e33b00bd119045 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 6 Oct 2018 06:36:10 -0400 Subject: [PATCH 155/174] Added missing unit conversion factor for Kd_layer Added a missing diagnostic conversion argument in the register_diag_field call for Kd_layer. This does not alter answers, but will change a diagnostic when Z_RESCALE_POWER is not 0. --- src/parameterizations/vertical/MOM_set_diffusivity.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 52df0e0f72..3ca3d22fba 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -2148,7 +2148,7 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp CS%dissip_N2 = CS%dissip_Kd_min * GV%Rho0 / CS%FluxRi_max CS%id_Kd_layer = register_diag_field('ocean_model', 'Kd_layer', diag%axesTL, Time, & - 'Diapycnal diffusivity of layers (as set)', 'm2 s-1') + 'Diapycnal diffusivity of layers (as set)', 'm2 s-1', conversion=GV%Z_to_m**2) if (CS%tm_csp%Int_tide_dissipation .or. CS%tm_csp%Lee_wave_dissipation .or. & From a546ea079097f5f9ca68298ec0f76939a22f4b88 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 6 Oct 2018 06:39:34 -0400 Subject: [PATCH 156/174] Calculate diagnostics in Z instead of H Changed several diatnostics to be stored internally in units of Z or Z2 s-1, and then converted from Z to m via the diag manager, to avoid any conversions in the special case when Z_RESCALE_POWER=0 for efficiency in that special limit. All answers are bitwise identical. --- .../vertical/MOM_bulk_mixed_layer.F90 | 30 +++++++++---------- .../vertical/MOM_entrain_diffusive.F90 | 14 ++++----- 2 files changed, 22 insertions(+), 22 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index a851eee838..eb7dae1590 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -305,7 +305,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & integer, dimension(SZI_(G),SZK_(GV)) :: & ksort ! The sorted k-index that each original layer goes to. real, dimension(SZI_(G),SZJ_(G)) :: & - h_miss ! The summed absolute mismatch, in H. + h_miss ! The summed absolute mismatch, in Z. real, dimension(SZI_(G)) :: & TKE, & ! The turbulent kinetic energy available for mixing over a ! time step, in Z m2 s-2. @@ -374,12 +374,12 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & ! adjustment, Z m2 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, H. + ! after entrainment but before any buffer layer detrainment, in Z. Hsfc_used, & ! The thickness of the surface region after buffer layer - ! detrainment, in units of H. + ! detrainment, in units of Z. Hsfc_min, & ! The minimum thickness of the surface region based on the ! new mixed layer depth and the previous thickness of the - ! neighboring water columns, in H. + ! neighboring water columns, in Z. h_sum, & ! The total thickness of the water column, in H. hmbl_prev ! The previous thickness of the mixed and buffer layers, in H. real, dimension(SZI_(G)) :: & @@ -671,14 +671,14 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & hmbl_prev(i,j-1) - dHD*min(h_sum(i,j),h_sum(i,j-1)), & hmbl_prev(i,j+1) - dHD*min(h_sum(i,j),h_sum(i,j+1))) ) - Hsfc_min(i,j) = max(h(i,0), min(Hsfc(i), H_nbr)) + Hsfc_min(i,j) = GV%H_to_Z * max(h(i,0), min(Hsfc(i), H_nbr)) if (CS%limit_det) max_BL_det(i) = max(0.0, Hsfc(i)-H_nbr) enddo endif if (CS%id_Hsfc_max > 0) then ; do i=is,ie - Hsfc_max(i,j) = Hsfc(i) + Hsfc_max(i,j) = GV%H_to_Z * Hsfc(i) enddo ; endif endif @@ -702,9 +702,9 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & if (CS%id_Hsfc_used > 0) then - do i=is,ie ; Hsfc_used(i,j) = h(i,0) ; enddo + do i=is,ie ; Hsfc_used(i,j) = GV%H_to_Z * h(i,0) ; enddo do k=CS%nkml+1,nkmb ; do i=is,ie - Hsfc_used(i,j) = Hsfc_used(i,j) + h(i,k) + Hsfc_used(i,j) = Hsfc_used(i,j) + GV%H_to_Z * h(i,k) enddo ; enddo endif @@ -788,15 +788,15 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & if (CS%id_h_mismatch > 0) then do i=is,ie - h_miss(i,j) = abs(h_3d(i,j,1) - (h_orig(i,1) + & + h_miss(i,j) = GV%H_to_Z * abs(h_3d(i,j,1) - (h_orig(i,1) + & (eaml(i,1) + (ebml(i,1) - eaml(i,1+1))))) enddo do k=2,nz-1 ; do i=is,ie - h_miss(i,j) = h_miss(i,j) + abs(h_3d(i,j,k) - (h_orig(i,k) + & + h_miss(i,j) = h_miss(i,j) + GV%H_to_Z * abs(h_3d(i,j,k) - (h_orig(i,k) + & ((eaml(i,k) - ebml(i,k-1)) + (ebml(i,k) - eaml(i,k+1))))) enddo ; enddo do i=is,ie - h_miss(i,j) = h_miss(i,j) + abs(h_3d(i,j,nz) - (h_orig(i,nz) + & + h_miss(i,j) = h_miss(i,j) + GV%H_to_Z * abs(h_3d(i,j,nz) - (h_orig(i,nz) + & ((eaml(i,nz) - ebml(i,nz-1)) + ebml(i,nz)))) enddo endif @@ -3744,13 +3744,13 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS) Time, 'Spurious source of potential energy from mixed layer only detrainment', & 'W m-2', conversion=GV%Z_to_m) CS%id_h_mismatch = register_diag_field('ocean_model', 'h_miss_ML', diag%axesT1, & - Time, 'Summed absolute mismatch in entrainment terms', 'm', conversion=GV%H_to_m) + Time, 'Summed absolute mismatch in entrainment terms', 'm', conversion=GV%Z_to_m) CS%id_Hsfc_used = register_diag_field('ocean_model', 'Hs_used', diag%axesT1, & - Time, 'Surface region thickness that is used', 'm', conversion=GV%H_to_m) + Time, 'Surface region thickness that is used', 'm', conversion=GV%Z_to_m) CS%id_Hsfc_max = register_diag_field('ocean_model', 'Hs_max', diag%axesT1, & - Time, 'Maximum surface region thickness', 'm', conversion=GV%H_to_m) + Time, 'Maximum surface region thickness', 'm', conversion=GV%Z_to_m) CS%id_Hsfc_min = register_diag_field('ocean_model', 'Hs_min', diag%axesT1, & - Time, 'Minimum surface region thickness', 'm', conversion=GV%H_to_m) + Time, 'Minimum surface region thickness', 'm', conversion=GV%Z_to_m) !CS%lim_det_dH_sfc = 0.5 ; CS%lim_det_dH_bathy = 0.2 ! Technically these should not get used if limit_det is false? if (CS%limit_det .or. (CS%id_Hsfc_min > 0)) then call get_param(param_file, mdl, "LIMIT_BUFFER_DET_DH_SFC", CS%lim_det_dH_sfc, & diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 6bd8aa484f..4ddde1060c 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -806,23 +806,23 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & endif ! correct_density if (CS%id_Kd > 0) then - Idt = 1.0 / dt + Idt = GV%H_to_Z**2 / dt do k=2,nz-1 ; do i=is,ie if (k 0) then - g_2dt = 0.5 * (GV%H_to_Z*GV%H_to_m) * (GV%g_Earth / dt) + g_2dt = 0.5 * GV%H_to_Z**2 * (GV%g_Earth / dt) do i=is,ie ; diff_work(i,j,1) = 0.0 ; diff_work(i,j,nz+1) = 0.0 ; enddo if (associated(tv%eqn_of_state)) then if (associated(fluxes%p_surf)) then @@ -2189,9 +2189,9 @@ subroutine entrain_diffusive_init(Time, G, GV, param_file, diag, CS) units="m", default=MAX(100.0*GV%Angstrom_m,1.0e-4*sqrt(dt*Kd)), scale=GV%m_to_H) CS%id_Kd = register_diag_field('ocean_model', 'Kd_effective', diag%axesTL, Time, & - 'Diapycnal diffusivity as applied', 'm2 s-1') + 'Diapycnal diffusivity as applied', 'm2 s-1', conversion=GV%Z_to_m**2) CS%id_diff_work = register_diag_field('ocean_model', 'diff_work', diag%axesTi, Time, & - 'Work actually done by diapycnal diffusion across each interface', 'W m-2') + 'Work actually done by diapycnal diffusion across each interface', 'W m-2', conversion=GV%Z_to_m) end subroutine entrain_diffusive_init From 21a9e4ba0459d25c2fe1fca2fb594fbe66166068 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 6 Oct 2018 09:39:05 -0400 Subject: [PATCH 157/174] +Recast energetic_PBL to work in units of Z Recast the internal calculations in energetic_PBL to use units of Z for dimensional consistency testing. As a part of these chages, a new GV argument was added to energetic_PBL_get_MLD, along with an optional argument to specify the output units for MLD. All answers are bitwise identical, including rescaling Z over a large range. --- .../vertical/MOM_diabatic_driver.F90 | 4 +- .../vertical/MOM_energetic_PBL.F90 | 175 +++++++++--------- 2 files changed, 93 insertions(+), 86 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 76a64f932a..b111322df3 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -733,7 +733,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! If visc%MLD exists, copy the ePBL's MLD into it if (associated(visc%MLD)) then - call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, visc%MLD, G) + call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, visc%MLD, G, GV) call pass_var(visc%MLD, G%domain, halo=1) Hml(:,:) = visc%MLD(:,:) endif @@ -1708,7 +1708,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! If visc%MLD exists, copy the ePBL's MLD into it if (associated(visc%MLD)) then - call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, visc%MLD, G) + call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, visc%MLD, G, GV) call pass_var(visc%MLD, G%domain, halo=1) Hml(:,:) = visc%MLD(:,:) endif diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 04cf148d16..cd27295045 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -62,7 +62,7 @@ module MOM_energetic_PBL !! boundary layer thickness. The default is 0, but a !! value of 0.1 might be better justified by observations. real :: MLD_tol !< A tolerance for determining the boundary layer thickness when - !! Use_MLD_iteration is true, in m. + !! Use_MLD_iteration is true, in Z. real :: min_mix_len !< The minimum mixing length scale that will be used by ePBL, in Z. !! The default (0) does not set a minimum. real :: N2_Dissipation_Scale_Neg !< A nondimensional scaling factor controlling the loss of TKE @@ -145,8 +145,8 @@ module MOM_energetic_PBL diag_TKE_conv_decay, & !< The decay of convective TKE, in J m-2. diag_TKE_mixing,& !< The work done by TKE to deepen the mixed layer, in J m-2. ! Additional output parameters also 2d - ML_depth, & !< The mixed layer depth in m. (result after iteration step) - ML_depth2, & !< The mixed layer depth in m. (guess for iteration step) + ML_depth, & !< The mixed layer depth in Z. (result after iteration step) + ML_depth2, & !< The mixed layer depth in Z. (guess for iteration step) Enhance_M, & !< The enhancement to the turbulent velocity scale (non-dim) MSTAR_MIX, & !< Mstar used in EPBL MSTAR_LT, & !< Mstar for Langmuir turbulence @@ -335,9 +335,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & real :: dt_h ! The timestep divided by the averages of the thicknesses around ! a layer, times a thickness conversion factor, in H s m-2. real :: h_bot ! The distance from the bottom, in H. - real :: h_rsum ! The running sum of h from the top, in H. + real :: h_rsum ! The running sum of h from the top, in Z. real :: I_hs ! The inverse of h_sum, in H-1. - real :: I_mld ! The inverse of the current value of MLD, in H-1. + real :: I_MLD ! The inverse of the current value of MLD, in Z-1. real :: h_tt ! The distance from the surface or up to the next interface ! that did not exhibit turbulent mixing from this scheme plus ! a surface mixing roughness length given by h_tt_min, in H. @@ -347,7 +347,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & real :: vonKar ! The vonKarman constant. real :: I_dtrho ! 1.0 / (dt * Rho0) in m3 kg-1 s-1. This is ! used convert TKE back into ustar^3. - real :: U_star ! The surface friction velocity, in m s-1. + real :: U_star ! The surface friction velocity, in Z s-1. real :: U_Star_Mean ! The surface friction without gustiness in m s-1. real :: vstar ! An in-situ turbulent velocity, in m s-1. real :: Enhance_M ! An enhancement factor for vstar, based here on Langmuir impact. @@ -406,18 +406,17 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & real :: dt__diag ! A copy of dt_diag (if present) or dt, in s. real :: IdtdR0 ! = 1.0 / (dt__diag * Rho0), in m3 kg-1 s-1. real, dimension(SZI_(G),SZJ_(G)) :: & - Hsfc_used ! The thickness of the surface region after buffer layer + Hsfc_used ! The thickness of the surface region in Z logical :: write_diags ! If true, write out diagnostics with this step. logical :: reset_diags ! If true, zero out the accumulated diagnostics. - ! detrainment, in units of m. ! Local column copies of energy change diagnostics, all in J m-2. real :: dTKE_conv, dTKE_forcing, dTKE_mixing real :: dTKE_MKE, dTKE_mech_decay, dTKE_conv_decay !---------------------------------------------------------------------- !/BGR added Aug24,2016 for adding iteration to get boundary layer depth ! - needed to compute new mixing length. - real :: MLD_guess, MLD_found ! Mixing Layer depth guessed/found for iteration, in m. - real :: max_MLD, min_MLD ! Iteration bounds, in m, which are adjusted at each step + real :: MLD_guess, MLD_found ! Mixing Layer depth guessed/found for iteration, in Z. + real :: max_MLD, min_MLD ! Iteration bounds, in Z, which are adjusted at each step ! - These are initialized based on surface/bottom ! 1. The iteration guesses a value (possibly from ! prev step or neighbor). @@ -465,29 +464,29 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & integer, save :: NOTCONVERGED! !-End BGR iteration parameters----------------------------------------- real :: N2_dissipation - real :: Bf_STABLE ! Buoyancy flux, capped at 0 (negative only) + real :: Bf_STABLE ! Buoyancy flux, capped at 0 (negative only) real :: Bf_UNSTABLE ! Buoyancy flux, floored at 0 (positive only) - real :: STAB_SCALE ! Composite of Stabilizing length scales: - ! Ekman scale and Monin-Obukhov scale. - real :: iL_Ekman ! Inverse of Ekman length scale - real :: iL_Obukhov ! Inverse of Obukhov length scale + real :: Stab_Scale ! Composite of stabilizing Ekman scale and Monin-Obukhov length scales, in Z + real :: iL_Ekman ! Inverse of Ekman length scale, in Z-1 + real :: iL_Obukhov ! Inverse of Obukhov length scale, in Z-1 real :: MLD_o_Ekman ! > real :: MLD_o_Obukhov_stab ! Ratios of length scales where MLD is boundary layer depth real :: Ekman_o_Obukhov_stab ! > real :: MLD_o_Obukhov_un ! Ratios of length scales where MLD is boundary layer depth real :: Ekman_o_Obukhov_un ! > - real :: C_MO = 1. ! Constant in STAB_SCALE for Monin-Obukhov - real :: C_EK = 2. ! Constant in STAB_SCALE for Ekman length - real :: MLD_over_STAB ! Mixing layer depth divided by STAB_SCALE - real :: MSTAR_MIX! The value of mstar (Proportionality of TKE to drive mixing to ustar + real :: C_MO = 1. ! Constant in Stab_Scale for Monin-Obukhov + real :: C_EK = 2. ! Constant in Stab_Scale for Ekman length + real :: MLD_over_STAB ! Mixing layer depth divided by Stab_Scale + real :: MSTAR_MIX ! The value of mstar (Proportionality of TKE to drive mixing to ustar ! cubed) which is computed as a function of latitude, boundary layer depth, ! and the Monin-Obukhov depth. - real :: MSTAR_LT ! The added mstar contribution due to Langmuir turbulence + real :: MSTAR_LT ! The added mstar contribution due to Langmuir turbulence real :: MSTAR_Conv_Adj ! Adjustment made to mstar due to convection reducing mechanical mixing. real :: MSTAR_STAB, MSTAR_ROT ! Mstar in each limit, max is used. logical :: debug=.false. ! Change this hard-coded value for debugging. -! The following arrays are used only for debugging purposes. + + ! The following arrays are used only for debugging purposes. real :: dPE_debug, mixing_debug, taux2, tauy2 real, dimension(20) :: TKE_left_itt, PE_chg_itt, Kddt_h_itt, dPEa_dKd_itt, MKE_src_itt real, dimension(SZI_(G),SZK_(GV)) :: & @@ -552,7 +551,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & !!OMP TKE_forced,debug,H_neglect,dSV_dT, & !!OMP dSV_dS,I_dtrho,C1_3,h_tt_min,vonKar, & !!OMP max_itt,Kd_int) & -!!OMP private(i,j,k,h,u,v,T,S,Kd,mech_TKE_k,conv_PErel_k, & +!!OMP private(i,j,k,h,u,v,T,S,Kd,mech_TKE_k,conv_PErel_k, & !!OMP U_Star,absf,mech_TKE,conv_PErel,nstar_k, & !!OMP h_sum,I_hs,h_bot,hb_hs,T0,S0,num_itts, & !!OMP pres,dMass,dPres,dT_to_dPE,dS_to_dPE, & @@ -584,8 +583,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & Kd(i,K) = 0.0 enddo ; enddo do i=is,ie - CS%ML_depth(i,j) = h(i,1)*GV%H_to_m - !CS%ML_depth2(i,j) = h(i,1)*GV%H_to_m + CS%ML_depth(i,j) = h(i,1)*GV%H_to_Z + !CS%ML_depth2(i,j) = h(i,1)*GV%H_to_Z sfc_connected(i) = .true. enddo @@ -601,17 +600,17 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & ! interface. do i=is,ie ; if (G%mask2dT(i,j) > 0.5) then - U_Star = fluxes%ustar(i,j) + U_star = GV%m_to_Z*fluxes%ustar(i,j) U_Star_Mean = fluxes%ustar_gustless(i,j) if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then if (fluxes%frac_shelf_h(i,j) > 0.0) & - U_Star = (1.0 - fluxes%frac_shelf_h(i,j)) * U_star + & - fluxes%frac_shelf_h(i,j) * fluxes%ustar_shelf(i,j) + U_star = (1.0 - fluxes%frac_shelf_h(i,j)) * U_star + & + fluxes%frac_shelf_h(i,j) * GV%m_to_Z*fluxes%ustar_shelf(i,j) endif if (U_Star < CS%ustar_min) U_Star = CS%ustar_min ! Computing Bf w/ limiters. - Bf_Stable = max(0.0,buoy_Flux(i,j)) ! Positive for stable - Bf_Unstable = min(0.0,buoy_flux(i,j)) ! Negative for unstable + Bf_Stable = max(0.0, GV%m_to_Z**2 * buoy_Flux(i,j)) ! Positive for stable + Bf_Unstable = min(0.0, GV%m_to_Z**2 * buoy_flux(i,j)) ! Negative for unstable if (CS%omega_frac >= 1.0) then ; absf(i) = 2.0*CS%omega else absf(i) = 0.25*((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & @@ -621,13 +620,13 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & endif ! Computing stability scale which correlates with TKE for mixing, where ! TKE for mixing = TKE production minus TKE dissipation - Stab_Scale = u_star**2 / ( VonKar * ( C_MO * BF_Stable/u_star - C_EK * u_star * absf(i))) + Stab_Scale = U_star**2 / ( VonKar * ( C_MO * BF_Stable / U_star - C_EK * U_star * absf(i))) ! Inverse of Ekman and Obukhov - iL_Ekman = absf(i)/U_star - iL_Obukhov = buoy_flux(i,j)*vonkar/U_Star**3 + iL_Ekman = absf(i) / U_star + iL_Obukhov = GV%m_to_Z**2 * buoy_flux(i,j)*vonkar / (U_star**3) if (CS%Mstar_Mode == CS%CONST_MSTAR) then - mech_TKE(i) = (dt*CS%mstar*GV%Rho0)*((U_Star**3)) + mech_TKE(i) = (dt*CS%mstar*GV%Rho0) * GV%Z_to_m**3 * U_star**3 conv_PErel(i) = 0.0 if (CS%TKE_diagnostics) then @@ -689,18 +688,18 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & !/The following lines are for the iteration over MLD !{ ! max_MLD will initialized as ocean bottom depth - max_MLD = 0.0 ; do k=1,nz ; max_MLD = max_MLD + h(i,k)*GV%H_to_m ; enddo + max_MLD = 0.0 ; do k=1,nz ; max_MLD = max_MLD + h(i,k)*GV%H_to_Z ; enddo min_MLD = 0.0 !min_MLD will initialize as 0. !/BGR: May add user-input bounds for max/min MLD !/BGR: Add MLD_guess based on stored previous value. ! note that this is different from ML_Depth already ! computed by EPBL, need to figure out why. - if (CS%MLD_iteration_guess .and. CS%ML_Depth2(i,j) > 1.) then + if (CS%MLD_iteration_guess .and. (CS%ML_Depth2(i,j) > 1.0*GV%m_to_Z)) then !If prev value is present use for guess. - MLD_guess=CS%ML_Depth2(i,j) + MLD_guess = CS%ML_Depth2(i,j) else - !Otherwise guess middle of water column (or stab_scale if smaller). + !Otherwise guess middle of water column (or Stab_Scale if smaller). MLD_guess = 0.5 * (min_MLD+max_MLD) endif @@ -713,8 +712,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & do OBL_IT=1,MAX_OBL_IT ; if (.not. OBL_CONVERGED) then ! Reset ML_depth - CS%ML_depth(i,j) = h(i,1)*GV%H_to_m - !CS%ML_depth2(i,j) = h(i,1)*GV%H_to_m + CS%ML_depth(i,j) = h(i,1)*GV%H_to_Z + !CS%ML_depth2(i,j) = h(i,1)*GV%H_to_Z sfc_connected(i) = .true. @@ -746,8 +745,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & endif elseif (CS%MSTAR_MODE == CS%EKMAN_o_OBUKHOV) then !### Please refrain from using the construct A / B / C in place of A/(B*C). - mstar_STAB = CS%MSTAR_COEF*sqrt(Bf_Stable/u_star**2/(absf(i)+1.e-10)) - mstar_ROT = CS%C_EK*log(max(1.,u_star/(absf(i)+1.e-10)/mld_guess)) + mstar_STAB = CS%MSTAR_COEF*sqrt(Bf_Stable / U_star**2 / (absf(i)+1.e-10)) + mstar_ROT = CS%C_EK * log(max(1., U_star / (absf(i)+1.e-10) / MLD_guess)) if ( CS%MSTAR_CAP <= 0.0) then !No cap. MSTAR_MIX = max(mstar_STAB,& ! 1st term if balance of rotation and stabilizing ! the balance is f(L_Ekman,L_Obukhov) @@ -770,18 +769,18 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & ! Adjustment for unstable buoyancy flux. ! Convection reduces mechanical mixing because there ! is less density gradient to mix. (Statically unstable near surface) - MSTAR_Conv_Adj = 1. - CS%CNV_MST_FAC * (-BF_Unstable+1.e-10) / & - ( (-Bf_Unstable+1.e-10)+ & - 2. *MSTAR_MIX *U_STAR**3 / MLD_GUESS ) + MSTAR_Conv_Adj = 1. - CS%CNV_MST_FAC * (-BF_Unstable + 1.e-10*GV%m_to_Z**2) / & + ( (-Bf_Unstable + 1.e-10*GV%m_to_Z**2) + & + 2.0 *MSTAR_MIX * U_star**3 / MLD_guess ) if (CS%USE_LT) then - call get_Langmuir_Number( LA, G, GV, abs(MLD_guess), u_star_mean, I, J, & + call get_Langmuir_Number( LA, G, GV, abs(GV%Z_to_m*MLD_guess), u_star_mean, i, j, & H=H(i,:), U_H=U(i,:), V_H=V(i,:), WAVES=WAVES) ! 2. Get parameters for modified LA - MLD_o_Ekman = abs(MLD_guess*iL_Ekman) - MLD_o_Obukhov_stab = abs(max(0.,MLD_guess*iL_Obukhov)) - MLD_o_Obukhov_un = abs(min(0.,MLD_guess*iL_Obukhov)) - Ekman_o_Obukhov_stab = abs(max(0.,iL_Obukhov/(iL_Ekman+1.e-10))) - Ekman_o_Obukhov_un = abs(min(0.,iL_Obukhov/(iL_Ekman+1.e-10))) + MLD_o_Ekman = abs(MLD_guess * iL_Ekman) + MLD_o_Obukhov_stab = abs(max(0., MLD_guess*iL_Obukhov)) + MLD_o_Obukhov_un = abs(min(0., MLD_guess*iL_Obukhov)) + Ekman_o_Obukhov_stab = abs(max(0., iL_Obukhov / (iL_Ekman + 1.e-10*GV%Z_to_m))) + Ekman_o_Obukhov_un = abs(min(0., iL_Obukhov / (iL_Ekman + 1.e-10*GV%Z_to_m))) ! 3. Adjust LA based on various parameters. ! Assumes linear factors based on length scale ratios to adjust LA ! Note when these coefficients are set to 0 recovers simple LA. @@ -805,7 +804,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & endif endif !Reset mech_tke and conv_perel values (based on new mstar) - mech_TKE(i) = ( MSTAR_mix * MSTAR_conv_adj * ENHANCE_M + MSTAR_LT) * (dt*GV%Rho0*U_Star**3) + mech_TKE(i) = ( MSTAR_mix * MSTAR_conv_adj * ENHANCE_M + MSTAR_LT) * & + GV%Z_to_m**3 * (dt*GV%Rho0*U_star**3) conv_PErel(i) = 0.0 if (CS%TKE_diagnostics) then CS%diag_TKE_wind(i,j) = CS%diag_TKE_wind(i,j) + mech_TKE(i) * IdtdR0 @@ -856,7 +856,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & I_MLD = 1.0 / MLD_guess ; h_rsum = 0.0 MixLen_shape(1) = 1.0 do K=2,nz+1 - h_rsum = h_rsum + h(i,k-1)*GV%H_to_m + h_rsum = h_rsum + h(i,k-1)*GV%H_to_Z if (CS%MixLenExponent==2.0)then MixLen_shape(K) = CS%transLay_scale + (1.0 - CS%transLay_scale) * & (max(0.0, (MLD_guess - h_rsum)*I_MLD) )**2!CS%MixLenExponent @@ -888,7 +888,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & ! different rates. The following form is often used for mechanical ! stirring from the surface, perhaps due to breaking surface gravity ! waves and wind-driven turbulence. - Idecay_len_TKE(i) = (CS%TKE_decay * absf(i) / U_Star) * GV%H_to_m + Idecay_len_TKE(i) = (CS%TKE_decay * absf(i) / U_star) * GV%H_to_Z exp_kh = 1.0 if (Idecay_len_TKE(i) > 0.0) exp_kh = exp(-h(i,k-1)*Idecay_len_TKE(i)) if (CS%TKE_diagnostics) & @@ -1149,8 +1149,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & dTKE_MKE = dTKE_MKE + MKE_src * IdtdR0 endif if (sfc_connected(i)) then - CS%ML_depth(i,J) = CS%ML_depth(i,J) + GV%H_to_m * h(i,k) - !CS%ML_depth2(i,j) = CS%ML_depth2(i,J) + GV%H_to_m * h(i,k) + CS%ML_depth(i,J) = CS%ML_depth(i,J) + GV%H_to_Z * h(i,k) + ! CS%ML_depth2(i,j) = CS%ML_depth2(i,J) + GV%H_to_Z * h(i,k) endif Kddt_h(K) = Kd(i,k)*dt_h @@ -1174,8 +1174,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & mech_TKE(i) = TKE_reduc*(mech_TKE(i) + MKE_src) conv_PErel(i) = TKE_reduc*conv_PErel(i) if (sfc_connected(i)) then - CS%ML_depth(i,J) = CS%ML_depth(i,J) + GV%H_to_m * h(i,k) - !CS%ML_depth2(i,J) = CS%ML_depth2(i,J) + GV%H_to_m * h(i,k) + CS%ML_depth(i,J) = CS%ML_depth(i,J) + GV%H_to_Z * h(i,k) + ! CS%ML_depth2(i,J) = CS%ML_depth2(i,J) + GV%H_to_Z * h(i,k) endif elseif (tot_TKE == 0.0) then ! This can arise if nstar_FC = 0. @@ -1277,7 +1277,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & endif if (sfc_connected(i)) CS%ML_depth(i,J) = CS%ML_depth(i,J) + & - (PE_chg / PE_chg_g0) * GV%H_to_m * h(i,k) + (PE_chg / PE_chg_g0) * GV%H_to_Z * h(i,k) tot_TKE = 0.0 ; mech_TKE(i) = 0.0 ; conv_PErel(i) = 0.0 sfc_disconnect = .true. endif @@ -1361,18 +1361,18 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & ITmin(obl_it) = min_MLD ! Track min } For debug purpose ITguess(obl_it) = MLD_guess ! Track guess } !/ - MLD_FOUND=0.0 ; FIRST_OBL=.true. + MLD_found = 0.0 ; FIRST_OBL = .true. if (CS%Orig_MLD_iteration) then !This is how the iteration was original conducted do k=2,nz if (FIRST_OBL) then !Breaks when OBL found - if (Vstar_Used(k) > 1.e-10*GV%m_to_Z .and. k < nz) then - MLD_FOUND = MLD_FOUND + h(i,k-1)*GV%H_to_m + if ((Vstar_Used(k) > 1.e-10*GV%m_to_Z) .and. k < nz) then + MLD_found = MLD_found + h(i,k-1)*GV%H_to_Z else FIRST_OBL = .false. - if (MLD_FOUND-CS%MLD_tol > MLD_guess) then + if (MLD_found - CS%MLD_tol > MLD_guess) then min_MLD = MLD_guess - elseif ((MLD_guess-MLD_FOUND) < max(CS%MLD_tol,h(i,k-1)*GV%H_to_m)) then + elseif ((MLD_guess - MLD_found) < max(CS%MLD_tol,h(i,k-1)*GV%H_to_Z)) then OBL_CONVERGED = .true.!Break convergence loop if (OBL_IT_STATS) then !Compute iteration statistics MAXIT = max(MAXIT,obl_it) @@ -1390,10 +1390,10 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & enddo else !New method uses ML_DEPTH as computed in ePBL routine - MLD_FOUND=CS%ML_DEPTH(i,j) - if (MLD_FOUND-CS%MLD_tol > MLD_guess) then + MLD_found = CS%ML_Depth(i,j) + if (MLD_found - CS%MLD_tol > MLD_guess) then min_MLD = MLD_guess - elseif (abs(MLD_guess-MLD_FOUND) < (CS%MLD_tol)) then + elseif (abs(MLD_guess - MLD_found) < CS%MLD_tol) then OBL_CONVERGED = .true.!Break convergence loop if (OBL_IT_STATS) then !Compute iteration statistics MAXIT = max(MAXIT,obl_it) @@ -1408,8 +1408,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & endif endif ! For next pass, guess average of minimum and maximum values. - MLD_guess = min_MLD*0.5 + max_MLD*0.5 - ITresult(obl_it) = MLD_FOUND + MLD_guess = 0.5*(min_MLD + max_MLD) + ITresult(obl_it) = MLD_found endif ; enddo ! Iteration loop for converged boundary layer thickness. if (.not.OBL_CONVERGED) then !/Temp output, warn that EPBL didn't converge @@ -1452,9 +1452,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & if (allocated(CS%Enhance_M)) CS%Enhance_M(i,j) = Enhance_M if (allocated(CS%mstar_mix)) CS%mstar_mix(i,j) = MSTAR_MIX if (allocated(CS%mstar_lt)) CS%mstar_lt(i,j) = MSTAR_LT - if (allocated(CS%MLD_Obukhov)) CS%MLD_Obukhov(i,j) = (MLD_guess*iL_Obukhov) - if (allocated(CS%MLD_Ekman)) CS%MLD_Ekman(i,j) = (MLD_guess*iL_Ekman) - if (allocated(CS%Ekman_Obukhov)) CS%Ekman_Obukhov(i,j) = (iL_Obukhov/(iL_Ekman+1.e-10)) + if (allocated(CS%MLD_Obukhov)) CS%MLD_Obukhov(i,j) = MLD_guess * iL_Obukhov + if (allocated(CS%MLD_Ekman)) CS%MLD_Ekman(i,j) = MLD_guess * iL_Ekman + if (allocated(CS%Ekman_Obukhov)) CS%Ekman_Obukhov(i,j) = iL_Obukhov / (iL_Ekman + 1.e-10*GV%Z_to_m) if (allocated(CS%La)) CS%La(i,j) = LA if (allocated(CS%La_mod)) CS%La_mod(i,j) = LAmod else @@ -1471,9 +1471,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & endif ; enddo ; ! Close of i-loop - Note unusual loop order! if (CS%id_Hsfc_used > 0) then - do i=is,ie ; Hsfc_used(i,j) = h(i,1)*GV%H_to_m ; enddo + do i=is,ie ; Hsfc_used(i,j) = h(i,1)*GV%H_to_Z ; enddo do k=2,nz ; do i=is,ie - if (Kd(i,K) > 0.0) Hsfc_used(i,j) = Hsfc_used(i,j) + h(i,k)*GV%H_to_m + if (Kd(i,K) > 0.0) Hsfc_used(i,j) = Hsfc_used(i,j) + h(i,k)*GV%H_to_Z enddo ; enddo endif @@ -1830,15 +1830,22 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & end subroutine find_PE_chg_orig !> Copies the ePBL active mixed layer depth into MLD -subroutine energetic_PBL_get_MLD(CS, MLD, G) +subroutine energetic_PBL_get_MLD(CS, MLD, G, GV, m_to_MLD_units) type(energetic_PBL_CS), pointer :: CS !< Control structure for ePBL type(ocean_grid_type), intent(in) :: G !< Grid structure - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: MLD !< Depth of ePBL active mixing layer + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: MLD !< Depth of ePBL active mixing layer, in m + real, optional, intent(in) :: m_to_MLD_units !< A conversion factor to the desired units for MLD ! Local variables + real :: scale ! A dimensional rescaling factor integer :: i,j + + scale = GV%Z_to_m ; if (present(m_to_MLD_units)) scale = scale * m_to_MLD_units + do j = G%jsc, G%jec ; do i = G%isc, G%iec - MLD(i,j) = CS%ML_depth(i,j) + MLD(i,j) = scale*CS%ML_Depth(i,j) enddo ; enddo + end subroutine energetic_PBL_get_MLD !> Computes wind speed from ustar_air based on COARE 3.5 Cd relationship @@ -1923,8 +1930,8 @@ subroutine get_LA_windsea(ustar, hbl, GV, LA) real :: pi, u10 pi = 4.0*atan(1.0) if (ustar > 0.0) then - ! Computing u10 based on u_star and COARE 3.5 relationships - call ust_2_u10_coare3p5(ustar*sqrt(GV%Rho0/1.225),U10,GV) + ! Computing u10 based on ustar and COARE 3.5 relationships + call ust_2_u10_coare3p5(ustar * sqrt(GV%Rho0/1.225), U10, GV) ! surface Stokes drift us = us_to_u10*u10 @@ -2123,7 +2130,7 @@ subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, "EPBL_MLD_TOLERANCE", CS%MLD_tol, & "The tolerance for the iteratively determined mixed \n"// & "layer depth. This is only used with USE_MLD_ITERATION.", & - units="meter", default=1.0) + units="meter", default=1.0, scale=GV%m_to_Z) call get_param(param_file, mdl, "EPBL_MIN_MIX_LEN", CS%min_mix_len, & "The minimum mixing length scale that will be used \n"//& "by ePBL. The default (0) does not set a minimum.", & @@ -2201,13 +2208,13 @@ subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS) units="nondim", default=0.95) endif ! This gives a minimum decay scale that is typically much less than Angstrom. - CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_m + GV%H_to_m*GV%H_subroundoff) - call log_param(param_file, mdl, "EPBL_USTAR_MIN", CS%ustar_min, & + CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_Z + GV%H_to_Z*GV%H_subroundoff) + call log_param(param_file, mdl, "EPBL_USTAR_MIN", CS%ustar_min*GV%Z_to_m, & "The (tiny) minimum friction velocity used within the \n"//& "ePBL code, derived from OMEGA and ANGSTROM.", units="m s-1") CS%id_ML_depth = register_diag_field('ocean_model', 'ePBL_h_ML', diag%axesT1, & - Time, 'Surface boundary layer depth', 'm', & + Time, 'Surface boundary layer depth', 'm', conversion=GV%Z_to_m, & cmor_long_name='Ocean Mixed Layer Thickness Defined by Mixing Scheme') CS%id_TKE_wind = register_diag_field('ocean_model', 'ePBL_TKE_wind', diag%axesT1, & Time, 'Wind-stirring source of mixed layer TKE', 'm3 s-3') @@ -2225,7 +2232,7 @@ subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS) CS%id_TKE_conv_decay = register_diag_field('ocean_model', 'ePBL_TKE_conv_decay', diag%axesT1, & Time, 'Convective energy decay sink of mixed layer TKE', 'm3 s-3') CS%id_Hsfc_used = register_diag_field('ocean_model', 'ePBL_Hs_used', diag%axesT1, & - Time, 'Surface region thickness that is used', 'm') + Time, 'Surface region thickness that is used', 'm', conversion=GV%m_to_Z) CS%id_Mixing_Length = register_diag_field('ocean_model', 'Mixing_Length', diag%axesTi, & Time, 'Mixing Length that is used', 'm', conversion=GV%Z_to_m) CS%id_Velocity_Scale = register_diag_field('ocean_model', 'Velocity_Scale', diag%axesTi, & @@ -2235,7 +2242,7 @@ subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS) CS%id_MSTAR_mix = register_diag_field('ocean_model', 'MSTAR', diag%axesT1, & Time, 'MSTAR that is used.', 'nondim') CS%id_OSBL = register_diag_field('ocean_model', 'ePBL_OSBL', diag%axesT1, & - Time, 'ePBL Surface Boundary layer depth.', 'm') + Time, 'ePBL Surface Boundary layer depth.', 'm', conversion=GV%m_to_Z) ! BGR (9/21/2017) Note that ePBL_OSBL is the guess for iteration step while ePBL_h_ML is ! result from iteration step. CS%id_mld_ekman = register_diag_field('ocean_model', 'MLD_EKMAN', diag%axesT1, & From 2743a41343bfb283ef8e126f986d7cef8c6d29d1 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 6 Oct 2018 11:24:10 -0400 Subject: [PATCH 158/174] +Changed the units of SkinBuoyFlux to Z2 s-3 Changed the units of SkinBuoyFlux in diabatic and Buoy_flux in energetic_PBL from m2 s-3 to Z2 s-3 for dimensional consistency testing. All answers are bitwise identical, including rescaling Z over a large range. --- src/parameterizations/vertical/MOM_diabatic_aux.F90 | 4 ++-- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 6 ++---- src/parameterizations/vertical/MOM_energetic_PBL.F90 | 8 ++++---- 3 files changed, 8 insertions(+), 10 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 90332c1b85..119e3dbb30 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -790,7 +790,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & optional, intent(out) :: dSV_dS !< Partial derivative of specific volume with !! salinity, in m3 kg-1 / (g kg-1). real, dimension(SZI_(G),SZJ_(G)), & - optional, intent(out) :: SkinBuoyFlux !< Buoyancy flux at surface in m2 s-3 + optional, intent(out) :: SkinBuoyFlux !< Buoyancy flux at surface in Z2 s-3 ! Local variables integer, parameter :: maxGroundings = 5 @@ -1256,7 +1256,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & ! 3. Convert to a buoyancy flux, excluding penetrating SW heating ! BGR-Jul 5, 2017: The contribution of SW heating here needs investigated for ePBL. do i=is,ie - SkinBuoyFlux(i,j) = - GoRho * GV%H_to_Z * ( & + SkinBuoyFlux(i,j) = - GoRho * GV%H_to_Z * GV%m_to_Z**2 * ( & dRhodS(i) * (netSalt_rate(i) - tv%S(i,j,1)*netMassInOut_rate(i)) + & dRhodT(i) * ( netHeat_rate(i) + netPen(i,1)) ) ! m^2/s^3 enddo diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index b111322df3..a82cb12e44 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -300,13 +300,11 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & cTKE, & ! convective TKE requirements for each layer in J/m^2. u_h, & ! zonal and meridional velocities at thickness points after v_h ! entrainment (m/s) - real, dimension(SZI_(G),SZJ_(G),CS%nMode) :: & - cn ! baroclinic gravity wave speeds (formerly cg1 - BDM) - + cn ! baroclinic gravity wave speeds real, dimension(SZI_(G),SZJ_(G)) :: & Rcv_ml, & ! coordinate density of mixed layer, used for applying sponges - SkinBuoyFlux! 2d surface buoyancy flux (m2/s3), used by ePBL + SkinBuoyFlux! 2d surface buoyancy flux (Z2/s3), used by ePBL real, dimension(SZI_(G),SZJ_(G),G%ke) :: h_diag ! diagnostic array for thickness real, dimension(SZI_(G),SZJ_(G),G%ke) :: temp_diag ! diagnostic array for temp real, dimension(SZI_(G),SZJ_(G),G%ke) :: saln_diag ! diagnostic array for salinity diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index cd27295045..b82c697b8d 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -214,7 +214,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & type(energetic_PBL_CS), pointer :: CS !< The control structure returned by a previous !! call to mixedlayer_init. real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: Buoy_Flux !< The surface buoyancy flux. in m2/s3. + intent(in) :: Buoy_Flux !< The surface buoyancy flux in Z2/s3. real, optional, intent(in) :: dt_diag !< The diagnostic time step, which may be less !! than dt if there are two callse to !! mixedlayer, in s. @@ -609,8 +609,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & endif if (U_Star < CS%ustar_min) U_Star = CS%ustar_min ! Computing Bf w/ limiters. - Bf_Stable = max(0.0, GV%m_to_Z**2 * buoy_Flux(i,j)) ! Positive for stable - Bf_Unstable = min(0.0, GV%m_to_Z**2 * buoy_flux(i,j)) ! Negative for unstable + Bf_Stable = max(0.0, buoy_Flux(i,j)) ! Positive for stable + Bf_Unstable = min(0.0, buoy_flux(i,j)) ! Negative for unstable if (CS%omega_frac >= 1.0) then ; absf(i) = 2.0*CS%omega else absf(i) = 0.25*((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & @@ -623,7 +623,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & Stab_Scale = U_star**2 / ( VonKar * ( C_MO * BF_Stable / U_star - C_EK * U_star * absf(i))) ! Inverse of Ekman and Obukhov iL_Ekman = absf(i) / U_star - iL_Obukhov = GV%m_to_Z**2 * buoy_flux(i,j)*vonkar / (U_star**3) + iL_Obukhov = buoy_flux(i,j)*vonkar / (U_star**3) if (CS%Mstar_Mode == CS%CONST_MSTAR) then mech_TKE(i) = (dt*CS%mstar*GV%Rho0) * GV%Z_to_m**3 * U_star**3 From bb6ddb5a8a4f5fc8c4ce6b666af46a200394411e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 6 Oct 2018 11:31:44 -0400 Subject: [PATCH 159/174] +Recast find_N2_bottom to work in units of Z Recast the internal calculations in find_N2_bottom to use units of Z for dimensional consistency testing. All answers are bitwise identical in the MOM6 test cases, including rescaling Z over a large range. --- .../vertical/MOM_internal_tide_input.F90 | 22 +++++++++---------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index 4a59b9f610..b8e6abb4c4 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -46,7 +46,7 @@ module MOM_int_tide_input type, public :: int_tide_input_type real, allocatable, dimension(:,:) :: & TKE_itidal_input, & !< The internal tide TKE input at the bottom of the ocean, in W m-2. - h2, & !< The squared topographic roughness height, in m2. + h2, & !< The squared topographic roughness height, in Z2. tideamp, & !< The amplitude of the tidal velocities, in m s-1. Nb !< The bottom stratification, in s-1. end type int_tide_input_type @@ -128,7 +128,7 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, N2_bot) !! smooth out the values in thin layers, in degC. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_f !< Salinity after vertical filtering to !! smooth out the values in thin layers, in PSU. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h2 !< Bottom topographic roughness, in m2 + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h2 !< Bottom topographic roughness, in Z2 type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes type(int_tide_input_CS), pointer :: CS !< This module's control structure. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: N2_bot !< The squared buoyancy freqency at the @@ -141,19 +141,19 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, N2_bot) Temp_int, & ! The temperature at each interface, in degC. Salin_int, & ! The salinity at each interface, in PSU. drho_bot, & - h_amp, & - hb, & - z_from_bot, & + h_amp, & ! The amplitude of topographic roughness, in Z. + hb, & ! The depth below a layer, in Z. + z_from_bot, & ! The height of a layer center above the bottom, in Z. dRho_dT, & ! The partial derivatives of density with temperature and dRho_dS ! salinity, in kg m-3 degC-1 and kg m-3 PSU-1. - real :: dz_int ! The thickness associated with an interface, in m. + real :: dz_int ! The thickness associated with an interface, in Z. real :: G_Rho0 ! The gravitation acceleration divided by the Boussinesq - ! density, in m4 s-2 kg-1. + ! density, in Z m3 s-2 kg-1. logical :: do_i(SZI_(G)), do_any integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - G_Rho0 = (GV%g_Earth*GV%m_to_Z) / GV%Rho0 + G_Rho0 = (GV%g_Earth*GV%m_to_Z**2) / GV%Rho0 ! Find the (limited) density jump across each interface. do i=is,ie @@ -194,7 +194,7 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, N2_bot) ! Find the bottom boundary layer stratification. do i=is,ie hb(i) = 0.0 ; dRho_bot(i) = 0.0 - z_from_bot(i) = 0.5*GV%H_to_m*h(i,j,nz) + z_from_bot(i) = 0.5*GV%H_to_Z*h(i,j,nz) do_i(i) = (G%mask2dT(i,j) > 0.5) h_amp(i) = sqrt(h2(i,j)) enddo @@ -202,7 +202,7 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, N2_bot) do k=nz,2,-1 do_any = .false. do i=is,ie ; if (do_i(i)) then - dz_int = 0.5*GV%H_to_m*(h(i,j,k) + h(i,j,k-1)) + dz_int = 0.5*GV%H_to_Z*(h(i,j,k) + h(i,j,k-1)) z_from_bot(i) = z_from_bot(i) + dz_int ! middle of the layer above hb(i) = hb(i) + dz_int @@ -211,7 +211,7 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, N2_bot) if (z_from_bot(i) > h_amp(i)) then if (k>2) then ! Always include at least one full layer. - hb(i) = hb(i) + 0.5*GV%H_to_m*(h(i,j,k-1) + h(i,j,k-2)) + hb(i) = hb(i) + 0.5*GV%H_to_Z*(h(i,j,k-1) + h(i,j,k-2)) dRho_bot(i) = dRho_bot(i) + dRho_int(i,K-1) endif do_i(i) = .false. From 6197f8beee58c5e0e82edc24f52f551a4de92a69 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 6 Oct 2018 13:54:31 -0400 Subject: [PATCH 160/174] +Made GV a required argument to initialize_sponge Made GV a required argument to initialize_sponge to facilitate dimensional consistency checking and removed the internal copy of eta_Z_to_m. All answers are bitwise identical. --- src/parameterizations/vertical/MOM_sponge.F90 | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) diff --git a/src/parameterizations/vertical/MOM_sponge.F90 b/src/parameterizations/vertical/MOM_sponge.F90 index 70f7a9216d..8bb8fa3ef3 100644 --- a/src/parameterizations/vertical/MOM_sponge.F90 +++ b/src/parameterizations/vertical/MOM_sponge.F90 @@ -54,7 +54,6 @@ module MOM_sponge !! coordinate-density is being damped, in kg m-3. real, pointer :: Ref_eta(:,:) => NULL() !< The value toward which the interface !! heights are being damped, in depth units (Z). - real :: eta_Z_to_m !< The conversion factor between the units for depths (Z) and m. type(p3d) :: var(MAX_FIELDS_) !< Pointers to the fields that are being damped. type(p2d) :: Ref_val(MAX_FIELDS_) !< The values to which the fields are damped. @@ -90,8 +89,7 @@ subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, GV, & type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(sponge_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module - type(verticalGrid_type), & - optional, intent(in) :: GV !< The ocean's vertical grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZJ_(G)), & optional, intent(in) :: Iresttime_i_mean !< The inverse of the restoring time for !! the zonal mean properties, in s-1. @@ -135,8 +133,6 @@ subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, GV, & ! CS%bulkmixedlayer may be set later via a call to set_up_sponge_ML_density. CS%bulkmixedlayer = .false. - CS%eta_Z_to_m = 1.0 ; if (present(GV)) CS%eta_Z_to_m = GV%Z_to_m - CS%num_col = 0 ; CS%fldno = 0 do j=G%jsc,G%jec ; do i=G%isc,G%iec if ((Iresttime(i,j)>0.0) .and. (G%mask2dT(i,j)>0)) & @@ -385,9 +381,6 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) call MOM_error(FATAL, "Rml must be provided to apply_sponge when using "//& "a bulk mixed layer.") - if (CS%eta_Z_to_m /= GV%Z_to_m) call MOM_error(FATAL, & - "There are inconsistent depth units between calls to set_up_sponge and apply_sponge.") - if ((CS%id_w_sponge > 0) .or. CS%do_i_mean_sponge) then do k=1,nz+1 ; do j=js,je ; do i=is,ie w_int(i,j,K) = 0.0 From 7b8cb07d6f48c9f2ea8159f6a8e8c3390a2f5c07 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 8 Oct 2018 11:45:44 -0400 Subject: [PATCH 161/174] +Recast MOM_kappa_shear to work in units of Z Recast the internal calculations in MOM_kappa_shear to use units of Z and Z2 s-1 in place of m and m2 s-1 for dimensional consistency testing. All answers are bitwise identical in the MOM6 test cases, including rescaling Z over a range from Z_RESCALE_POWER=-93 to 8. For larger values of Z_RESCALE_POWER, there are subtle round-off level changes in some of the single column test cases, for which I suspect underflow in TKE may be the culprit, but this nees further investigation. --- .../vertical/MOM_kappa_shear.F90 | 321 +++++++++--------- 1 file changed, 163 insertions(+), 158 deletions(-) diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index a6613ed39b..2ee8a0bdc6 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -50,7 +50,7 @@ module MOM_kappa_shear !! the buoyancy and shear scales in the diffusivity !! equation, 0 to eliminate the shear scale. Nondim. real :: TKE_bg !< The background level of TKE, in m2 s-2. - real :: kappa_0 !< The background diapycnal diffusivity, in m2 s-1. + real :: kappa_0 !< The background diapycnal diffusivity, in Z2 s-1. real :: kappa_tol_err !< The fractional error in kappa that is tolerated. real :: Prandtl_turb !< Prandtl number used to convert Kd_shear into viscosity. integer :: nkml !< The number of layers in the mixed layer, as @@ -126,31 +126,31 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & h_2d, & ! A 2-D version of h, but converted to m. u_2d, v_2d, T_2d, S_2d, rho_2d ! 2-D versions of u_in, v_in, T, S, and rho. real, dimension(SZI_(G),SZK_(GV)+1) :: & - kappa_2d, tke_2d ! 2-D versions of various kappa_io and tke_io. + kappa_2d, tke_2d ! 2-D versions of various kappa_io and tke_io. real, dimension(SZK_(GV)) :: & u, & ! The zonal velocity after a timestep of mixing, in m s-1. v, & ! The meridional velocity after a timestep of mixing, in m s-1. - Idz, & ! The inverse of the distance between TKE points, in m. + Idz, & ! The inverse of the distance between TKE points, in Z-1. T, & ! The potential temperature after a timestep of mixing, in C. Sal, & ! The salinity after a timestep of mixing, in psu. - dz, & ! The layer thickness, in m. - u0xdz, & ! The initial zonal velocity times dz, in m2 s-1. - v0xdz, & ! The initial meridional velocity times dz, in m2 s-1. - T0xdz, & ! The initial temperature times dz, in C m. - S0xdz ! The initial salinity times dz, in PSU m. + dz, & ! The layer thickness, in Z. + u0xdz, & ! The initial zonal velocity times dz, in Z m s-1. + v0xdz, & ! The initial meridional velocity times dz, in Z m s-1. + T0xdz, & ! The initial temperature times dz, in C Z. + S0xdz ! The initial salinity times dz, in PSU Z. real, dimension(SZK_(GV)+1) :: & kappa, & ! The shear-driven diapycnal diffusivity at an interface, in - ! units of m2 s-1. + ! units of Z2 s-1. tke, & ! The Turbulent Kinetic Energy per unit mass at an interface, ! in units of m2 s-2. - kappa_avg, & ! The time-weighted average of kappa, in m2 s-1. + kappa_avg, & ! The time-weighted average of kappa, in Z2 s-1. tke_avg ! The time-weighted average of TKE, in m2 s-2. real :: f2 ! The squared Coriolis parameter of each column, in s-2. real :: surface_pres ! The top surface pressure, in Pa. - real :: dz_in_lay ! The running sum of the thickness in a layer, in m. - real :: k0dt ! The background diffusivity times the timestep, in m2. - real :: dz_massless ! A layer thickness that is considered massless, in m. + real :: dz_in_lay ! The running sum of the thickness in a layer, in Z. + real :: k0dt ! The background diffusivity times the timestep, in Z2. + real :: dz_massless ! A layer thickness that is considered massless, in Z. logical :: use_temperature ! If true, temperature and salinity have been ! allocated and are being used as state variables. logical :: new_kappa = .true. ! If true, ignore the value of kappa from the @@ -176,7 +176,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & integer :: max_debug_itt ; parameter(max_debug_itt=20) real :: wt(SZK_(GV)+1), wt_tot, I_wt_tot, wt_itt real, dimension(SZK_(GV)+1) :: & - Ri_k, tke_prev, dtke, dkappa, dtke_norm, & + Ri_k, tke_prev, dtke, dkap, dtke_norm, & ksrc_av ! The average through the iterations of k_src, in s-1. real, dimension(SZK_(GV)+1,0:max_debug_itt) :: & tke_it1, N2_it1, Sh2_it1, ksrc_it1, kappa_it1, kprev_it1 @@ -193,9 +193,6 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & use_temperature = .false. ; if (associated(tv%T)) use_temperature = .true. new_kappa = .true. ; if (present(initialize_all)) new_kappa = initialize_all -! Ri_crit = CS%Rino_crit -! gR0 = GV%Rho0*(GV%g_Earth*GV%m_to_Z) ; g_R0 = (GV%g_Earth*GV%m_to_Z)/GV%Rho0 - k0dt = dt*CS%kappa_0 dz_massless = 0.1*sqrt(k0dt) @@ -206,7 +203,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & !$OMP tv,G,GV,CS,kappa_io,dz_massless,k0dt,p_surf,dt,tke_io,kv_io) do j=js,je do k=1,nz ; do i=is,ie - h_2d(i,k) = h(i,j,k)*GV%H_to_m + h_2d(i,k) = h(i,j,k)*GV%H_to_Z 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 @@ -215,7 +212,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & rho_2d(i,k) = GV%Rlay(k) ! Could be tv%Rho(i,j,k) ? enddo ; enddo ; endif if (.not.new_kappa) then ; do K=1,nz+1 ; do i=is,ie - kappa_2d(i,K) = GV%Z_to_m**2*kappa_io(i,j,K) + kappa_2d(i,K) = kappa_io(i,j,K) enddo ; enddo ; endif !--------------------------------------- @@ -294,7 +291,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & ! Set the initial guess for kappa, here defined at interfaces. ! ---------------------------------------------------- if (new_kappa) then - do K=1,nzc+1 ; kappa(K) = 1.0 ; enddo + do K=1,nzc+1 ; kappa(K) = GV%m_to_Z**2*1.0 ; enddo else do K=1,nzc+1 ; kappa(K) = kappa_2d(i,K) ; enddo endif @@ -327,8 +324,8 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & #ifdef ADD_DIAGNOSTICS I_Ld2_2d(i,1) = 0.0 ; dz_Int_2d(i,1) = dz_Int(1) do K=2,nzc - I_Ld2_2d(i,K) = (N2(K) / CS%lambda**2 + f2) / & - max(TKE(K),1e-30) + I_L2_bdry(K) + I_Ld2_2d(i,K) = I_L2_bdry(K) + & + (N2(K) / CS%lambda**2 + f2) * Z2_to_L2 / (max(TKE(K),1e-30)) dz_Int_2d(i,K) = dz_Int(K) enddo I_Ld2_2d(i,nzc+1) = 0.0 ; dz_Int_2d(i,nzc+1) = dz_Int(nzc+1) @@ -348,9 +345,9 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & endif ; enddo ! i-loop do K=1,nz+1 ; do i=is,ie - kappa_io(i,j,K) = GV%m_to_Z**2 * G%mask2dT(i,j) * kappa_2d(i,K) + kappa_io(i,j,K) = G%mask2dT(i,j) * kappa_2d(i,K) tke_io(i,j,K) = G%mask2dT(i,j) * tke_2d(i,K) - kv_io(i,j,K) = GV%m_to_Z**2 * ( G%mask2dT(i,j) * kappa_2d(i,K) ) * CS%Prandtl_turb + kv_io(i,j,K) = ( G%mask2dT(i,j) * kappa_2d(i,K) ) * CS%Prandtl_turb #ifdef ADD_DIAGNOSTICS I_Ld2_3d(i,j,K) = I_Ld2_2d(i,K) dz_Int_3d(i,j,K) = dz_Int_2d(i,K) @@ -419,33 +416,33 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ h_2d, & ! A 2-D version of h, but converted to m. u_2d, v_2d, T_2d, S_2d, rho_2d ! 2-D versions of u_in, v_in, T, S, and rho. real, dimension(SZIB_(G),SZK_(GV)+1,2) :: & - kappa_2d ! Quasi 2-D versions of kappa_io, in m2 s-1. + kappa_2d ! Quasi 2-D versions of kappa_io, in Z2 s-1. real, dimension(SZIB_(G),SZK_(GV)+1) :: & tke_2d ! 2-D version tke_io in m2 s-2. real, dimension(SZK_(GV)) :: & u, & ! The zonal velocity after a timestep of mixing, in m s-1. v, & ! The meridional velocity after a timestep of mixing, in m s-1. - Idz, & ! The inverse of the distance between TKE points, in m. + Idz, & ! The inverse of the distance between TKE points, in Z-1. T, & ! The potential temperature after a timestep of mixing, in C. Sal, & ! The salinity after a timestep of mixing, in psu. - dz, & ! The layer thickness, in m. - u0xdz, & ! The initial zonal velocity times dz, in m2 s-1. - v0xdz, & ! The initial meridional velocity times dz, in m2 s-1. - T0xdz, & ! The initial temperature times dz, in C m. - S0xdz ! The initial salinity times dz, in PSU m. + dz, & ! The layer thickness, in Z. + u0xdz, & ! The initial zonal velocity times dz, in m Z s-1. + v0xdz, & ! The initial meridional velocity times dz, in m Z s-1. + T0xdz, & ! The initial temperature times dz, in C Z. + S0xdz ! The initial salinity times dz, in PSU Z. real, dimension(SZK_(GV)+1) :: & kappa, & ! The shear-driven diapycnal diffusivity at an interface, in ! units of m2 s-1. tke, & ! The Turbulent Kinetic Energy per unit mass at an interface, ! in units of m2 s-2. - kappa_avg, & ! The time-weighted average of kappa, in m2 s-1. + kappa_avg, & ! The time-weighted average of kappa, in Z2 s-1. tke_avg ! The time-weighted average of TKE, in m2 s-2. real :: f2 ! The squared Coriolis parameter of each column, in s-2. real :: surface_pres ! The top surface pressure, in Pa. - real :: dz_in_lay ! The running sum of the thickness in a layer, in m. - real :: k0dt ! The background diffusivity times the timestep, in m2. - real :: dz_massless ! A layer thickness that is considered massless, in m. + real :: dz_in_lay ! The running sum of the thickness in a layer, in Z. + real :: k0dt ! The background diffusivity times the timestep, in Z2. + real :: dz_massless ! A layer thickness that is considered massless, in Z. real :: I_hwt ! The inverse of the masked thickness weights, in H-1. real :: I_Prandtl logical :: use_temperature ! If true, temperature and salinity have been @@ -491,9 +488,6 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ use_temperature = .false. ; if (associated(tv%T)) use_temperature = .true. new_kappa = .true. ; if (present(initialize_all)) new_kappa = initialize_all -! Ri_crit = CS%Rino_crit -! gR0 = GV%Rho0*(GV%g_Earth*GV%m_to_Z) ; g_R0 = (GV%g_Earth*GV%m_to_Z)/GV%Rho0 - k0dt = dt*CS%kappa_0 dz_massless = 0.1*sqrt(k0dt) I_Prandtl = 0.0 ; if (CS%Prandtl_turb > 0.0) I_Prandtl = 1.0 / CS%Prandtl_turb @@ -529,19 +523,19 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ ((G%mask2dT(i+1,j) * h(i+1,j,k)) * S_in(i+1,j,k) + & (G%mask2dT(i,j+1) * h(i,j+1,k)) * S_in(i,j+1,k)) ) * I_hwt endif - h_2d(I,k) = GV%H_to_m * ((G%mask2dT(i,j) * h(i,j,k) + G%mask2dT(i+1,j+1) * h(i+1,j+1,k)) + & + h_2d(I,k) = GV%H_to_Z * ((G%mask2dT(i,j) * h(i,j,k) + G%mask2dT(i+1,j+1) * h(i+1,j+1,k)) + & (G%mask2dT(i+1,j) * h(i+1,j,k) + G%mask2dT(i,j+1) * h(i,j+1,k)) ) / & ((G%mask2dT(i,j) + G%mask2dT(i+1,j+1)) + & (G%mask2dT(i+1,j) + G%mask2dT(i,j+1)) + 1.0e-36 ) -! h_2d(I,k) = 0.25*((h(i,j,k) + h(i+1,j+1,k)) + (h(i+1,j,k) + h(i,j+1,k)))*GV%H_to_m +! h_2d(I,k) = 0.25*((h(i,j,k) + h(i+1,j+1,k)) + (h(i+1,j,k) + h(i,j+1,k)))*GV%H_to_Z ! h_2d(I,k) = ((h(i,j,k)**2 + h(i+1,j+1,k)**2) + & -! (h(i+1,j,k)**2 + h(i,j+1,k)**2))*GV%H_to_m * I_hwt +! (h(i+1,j,k)**2 + h(i,j+1,k)**2))*GV%H_to_Z * I_hwt enddo ; enddo if (.not.use_temperature) then ; do k=1,nz ; do I=IsB,IeB rho_2d(I,k) = GV%Rlay(k) enddo ; enddo ; endif if (.not.new_kappa) then ; do K=1,nz+1 ; do I=IsB,IeB - kappa_2d(I,K,J2) = GV%Z_to_m**2 * kv_io(I,J,K) * I_Prandtl + kappa_2d(I,K,J2) = kv_io(I,J,K) * I_Prandtl enddo ; enddo ; endif !--------------------------------------- @@ -623,7 +617,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ ! Set the initial guess for kappa, here defined at interfaces. ! ---------------------------------------------------- if (new_kappa) then - do K=1,nzc+1 ; kappa(K) = 1.0 ; enddo + do K=1,nzc+1 ; kappa(K) = GV%m_to_Z**2*1.0 ; enddo else do K=1,nzc+1 ; kappa(K) = kappa_2d(I,K,J2) ; enddo endif @@ -656,8 +650,8 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ #ifdef ADD_DIAGNOSTICS I_Ld2_2d(I,1) = 0.0 ; dz_Int_2d(I,1) = dz_Int(1) do K=2,nzc - I_Ld2_2d(I,K) = (N2(K) / CS%lambda**2 + f2) / & - max(TKE(K),1e-30) + I_L2_bdry(K) + I_Ld2_2d(I,K) = I_L2_bdry(K) + & + (N2(K) / CS%lambda**2 + f2) * Z2_to_L2 / (max(TKE(K),1e-30)) dz_Int_2d(I,K) = dz_Int(K) enddo I_Ld2_2d(I,nzc+1) = 0.0 ; dz_Int_2d(I,nzc+1) = dz_Int(nzc+1) @@ -678,7 +672,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ do K=1,nz+1 ; do I=IsB,IeB tke_io(I,J,K) = G%mask2dBu(I,J) * tke_2d(I,K) - kv_io(I,J,K) = GV%m_to_Z**2 * ( G%mask2dBu(I,J) * kappa_2d(I,K,J2) ) * CS%Prandtl_turb + kv_io(I,J,K) = ( G%mask2dBu(I,J) * kappa_2d(I,K,J2) ) * CS%Prandtl_turb #ifdef ADD_DIAGNOSTICS I_Ld2_3d(I,J,K) = I_Ld2_2d(I,K) dz_Int_3d(I,J,K) = dz_Int_2d(I,K) @@ -686,7 +680,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ enddo ; enddo if (J>=G%jsc) then ; do K=1,nz+1 ; do i=G%isc,G%iec ! Set the diffusivities in tracer columns from the values at vertices. - kappa_io(i,j,K) = GV%m_to_Z**2 * G%mask2dT(i,j) * 0.25 * & + kappa_io(i,j,K) = G%mask2dT(i,j) * 0.25 * & ((kappa_2d(I-1,K,J2m1) + kappa_2d(I,K,J2)) + & (kappa_2d(I-1,K,J2) + kappa_2d(I,K,J2m1))) enddo ; enddo ; endif @@ -714,7 +708,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & tke_avg, tv, CS, GV) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZK_(GV)+1), & - intent(inout) :: kappa !< The time-weighted average of kappa, in m2 s-1. + intent(inout) :: kappa !< The time-weighted average of kappa, in Z2 s-1. real, dimension(SZK_(GV)+1), & intent(inout) :: tke !< The Turbulent Kinetic Energy per unit mass at !! an interface, in units of m2 s-2. @@ -722,17 +716,17 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & real, intent(in) :: f2 !< The square of the Coriolis parameter, in s-2. real, intent(in) :: surface_pres !< The surface pressure, in Pa. real, dimension(SZK_(GV)), & - intent(in) :: dz !< The layer thickness, in m. + intent(in) :: dz !< The layer thickness, in Z. real, dimension(SZK_(GV)), & - intent(in) :: u0xdz !< The initial zonal velocity times dz, in m2 s-1. + intent(in) :: u0xdz !< The initial zonal velocity times dz, in Z m s-1. real, dimension(SZK_(GV)), & - intent(in) :: v0xdz !< The initial meridional velocity times dz, in m2 s-1. + intent(in) :: v0xdz !< The initial meridional velocity times dz, in Z m s-1. real, dimension(SZK_(GV)), & - intent(in) :: T0xdz !< The initial temperature times dz, in C m. + intent(in) :: T0xdz !< The initial temperature times dz, in C Z. real, dimension(SZK_(GV)), & - intent(in) :: S0xdz !< The initial salinity times dz, in PSU m. + intent(in) :: S0xdz !< The initial salinity times dz, in PSU Z. real, dimension(SZK_(GV)+1), & - intent(out) :: kappa_avg !< The time-weighted average of kappa, in m2 s-1. + intent(out) :: kappa_avg !< The time-weighted average of kappa, in Z2 s-1. real, dimension(SZK_(GV)+1), & intent(out) :: tke_avg !< The time-weighted average of TKE, in m2 s-2. real, intent(in) :: dt !< Time increment, in s. @@ -745,7 +739,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & real, dimension(nzc) :: & u, & ! The zonal velocity after a timestep of mixing, in m s-1. v, & ! The meridional velocity after a timestep of mixing, in m s-1. - Idz, & ! The inverse of the distance between TKE points, in m. + Idz, & ! The inverse of the distance between TKE points, in Z-1. T, & ! The potential temperature after a timestep of mixing, in C. Sal, & ! The salinity after a timestep of mixing, in psu. u_test, v_test, T_test, S_test @@ -753,46 +747,46 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & real, dimension(nzc+1) :: & N2, & ! The squared buoyancy frequency at an interface, in s-2. dz_Int, & ! The extent of a finite-volume space surrounding an interface, - ! as used in calculating kappa and TKE, in m. + ! as used in calculating kappa and TKE, in Z. I_dz_int, & ! The inverse of the distance between velocity & density points - ! above and below an interface, in m-1. This is used to + ! above and below an interface, in Z-1. This is used to ! calculate N2, shear, and fluxes, and it might differ from ! 1/dz_Int, as they have different uses. S2, & ! The squared shear at an interface, in s-2. a1, & ! a1 is the coupling between adjacent interfaces in the TKE, - ! velocity, and density equations, in m s-1 or m. + ! velocity, and density equations, in Z s-1 or Z. c1, & ! c1 is used in the tridiagonal (and similar) solvers. k_src, & ! The shear-dependent source term in the kappa equation, in s-1. kappa_src, & ! The shear-dependent source term in the kappa equation in s-1. - kappa_out, & ! The kappa that results from the kappa equation, in m2 s-1. + kappa_out, & ! The kappa that results from the kappa equation, in Z2 s-1. kappa_mid, & ! The average of the initial and predictor estimates of kappa, - ! in units of m2 s-1. + ! in units of Z2 s-1. tke_pred, & ! The value of TKE from a predictor step, in m2 s-2. - kappa_pred, & ! The value of kappa from a predictor step, in m2 s-1. + kappa_pred, & ! The value of kappa from a predictor step, in Z2 s-1. pressure, & ! The pressure at an interface, in Pa. T_int, & ! The temperature interpolated to an interface, in C. Sal_int, & ! The salinity interpolated to an interface, in psu. dbuoy_dT, & ! The partial derivatives of buoyancy with changes in - dbuoy_dS, & ! temperature and salinity, in m s-2 K-1 and m s-2 psu-1. + dbuoy_dS, & ! temperature and salinity, in Z s-2 K-1 and Z s-2 psu-1. I_L2_bdry, & ! The inverse of the square of twice the harmonic mean - ! distance to the top and bottom boundaries, in m-2. - K_Q, & ! Diffusivity divided by TKE, in s. - K_Q_tmp, & ! Diffusivity divided by TKE, in s. + ! distance to the top and bottom boundaries, in Z-2. + K_Q, & ! Diffusivity divided by TKE, in Z2 m-2 s. + K_Q_tmp, & ! A temporary copy of diffusivity divided by TKE, in Z2 m-2 s. local_src_avg, & ! The time-integral of the local source, nondim. tol_min, & ! Minimum tolerated ksrc for the corrector step, in s-1. tol_max, & ! Maximum tolerated ksrc for the corrector step, in s-1. tol_chg, & ! The tolerated change integrated in time, nondim. - dist_from_top, & ! The distance from the top surface, in m. + dist_from_top, & ! The distance from the top surface, in Z. local_src ! The sum of all sources of kappa, including kappa_src and ! sources from the elliptic term, in s-1. - real :: dist_from_bot ! The distance from the bottom surface, in m. + real :: dist_from_bot ! The distance from the bottom surface, in Z. real :: b1 ! The inverse of the pivot in the tridiagonal equations. real :: bd1 ! A term in the denominator of b1. real :: d1 ! 1 - c1 in the tridiagonal equations. real :: gR0 ! Rho_0 times g in kg m-2 s-2. - real :: g_R0 ! g_R0 is g/Rho in m4 kg-1 s-2. - real :: Norm ! A factor that normalizes two weights to 1, in m-2. + real :: g_R0 ! g_R0 is g/Rho in Z m3 kg-1 s-2. + real :: Norm ! A factor that normalizes two weights to 1, in Z-2. real :: tol_dksrc, tol2 ! ### Tolerances that need to be set better later. real :: tol_dksrc_low ! The tolerance for the fractional decrease in ksrc ! within an iteration. 0 < tol_dksrc_low < 1. @@ -806,7 +800,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & real :: Idtt ! Idtt = 1 / dt_test, in s-1. real :: dt_inc ! An increment to dt_test that is being tested, in s. - real :: k0dt ! The background diffusivity times the timestep, in m2. + real :: k0dt ! The background diffusivity times the timestep, in Z2. logical :: valid_dt ! If true, all levels so far exhibit acceptably small ! changes in k_src. logical :: use_temperature ! If true, temperature and salinity have been @@ -821,7 +815,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & integer :: k, itt, itt_dt Ri_crit = CS%Rino_crit - gR0 = GV%Rho0*(GV%g_Earth*GV%m_to_Z) ; g_R0 = (GV%g_Earth*GV%m_to_Z)/GV%Rho0 + gR0 = GV%Rho0*(GV%g_Earth*GV%m_to_Z) ; g_R0 = (GV%g_Earth*GV%m_to_Z**2)/GV%Rho0 k0dt = dt*CS%kappa_0 ! These are hard-coded for now. Perhaps these could be made dynamic later? ! tol_dksrc = 0.5*tol_ksrc_chg ; tol_dksrc_low = 1.0 - 1.0/tol_ksrc_chg ? @@ -846,7 +840,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! layers and applying a time-step of background diffusion. if (nzc > 1) then a1(2) = k0dt*I_dz_int(2) - b1 = 1.0 / (dz(1)+a1(2)) + b1 = 1.0 / (dz(1) + a1(2)) u(1) = b1 * u0xdz(1) ; v(1) = b1 * v0xdz(1) T(1) = b1 * T0xdz(1) ; Sal(1) = b1 * S0xdz(1) c1(2) = a1(2) * b1 ; d1 = dz(1) * b1 ! = 1 - c1 @@ -904,14 +898,14 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & do K=nzc,2,-1 dist_from_bot = dist_from_bot + dz(k) I_L2_bdry(K) = (dist_from_top(K) + dist_from_bot)**2 / & - (dist_from_top(K) * dist_from_bot)**2 + (dist_from_top(K) * dist_from_bot)**2 enddo ! Calculate thermodynamic coefficients and an initial estimate of N2. if (use_temperature) then pressure(1) = surface_pres do K=2,nzc - pressure(K) = pressure(K-1) + gR0*dz(k-1) + pressure(K) = pressure(K-1) + gR0*GV%Z_to_m*dz(k-1) T_int(K) = 0.5*(T(k-1) + T(k)) Sal_int(K) = 0.5*(Sal(k-1) + Sal(k)) enddo @@ -968,7 +962,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! This call just calculates N2 and S2. call calculate_projected_state(kappa, u, v, T, Sal, 0.0, nzc, & dz, I_dz_int, dbuoy_dT, dbuoy_dS, & - u, v, T, Sal, N2=N2, S2=S2) + u, v, T, Sal, GV, N2=N2, S2=S2) ! ---------------------------------------------------- ! Iterate ! ---------------------------------------------------- @@ -999,7 +993,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! call cpu_clock_begin(id_clock_KQ) call find_kappa_tke(N2, S2, kappa, Idz, dz_Int, I_L2_bdry, f2, & - nzc, CS, K_Q, tke, kappa_out, kappa_src, local_src) + nzc, CS, GV, K_Q, tke, kappa_out, kappa_src, local_src) ! call cpu_clock_end(id_clock_KQ) ! call cpu_clock_begin(id_clock_avg) @@ -1038,7 +1032,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! enough. call calculate_projected_state(kappa_out, u, v, T, Sal, 0.5*dt_test, nzc, & dz, I_dz_int, dbuoy_dT, dbuoy_dS, & - u_test, v_test, T_test, S_test, N2, S2, & + u_test, v_test, T_test, S_test, GV, N2, S2, & ks_int = ks_kappa, ke_int = ke_kappa) valid_dt = .true. Idtt = 1.0 / dt_test @@ -1065,7 +1059,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & do itt_dt=1,dt_refinements call calculate_projected_state(kappa_out, u, v, T, Sal, & 0.5*(dt_test+dt_inc), nzc, dz, I_dz_int, dbuoy_dT, & - dbuoy_dS, u_test, v_test, T_test, S_test, N2, S2, & + dbuoy_dS, u_test, v_test, T_test, S_test, GV, N2, S2, & ks_int = ks_kappa, ke_int = ke_kappa) valid_dt = .true. Idtt = 1.0 / (dt_test+dt_inc) @@ -1119,14 +1113,14 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! call cpu_clock_begin(id_clock_project) call calculate_projected_state(kappa_out, u, v, T, Sal, dt_now, nzc, & dz, I_dz_int, dbuoy_dT, dbuoy_dS, & - u_test, v_test, T_test, S_test, N2=N2, S2=S2, & + u_test, v_test, T_test, S_test, GV, N2=N2, S2=S2, & ks_int = ks_kappa, ke_int = ke_kappa) ! call cpu_clock_end(id_clock_project) ! call cpu_clock_begin(id_clock_KQ) do K=1,nzc+1 ; K_Q_tmp(K) = K_Q(K) ; enddo call find_kappa_tke(N2, S2, kappa_out, Idz, dz_Int, I_L2_bdry, f2, & - nzc, CS, K_Q_tmp, tke_pred, kappa_pred) + nzc, CS, GV, K_Q_tmp, tke_pred, kappa_pred) ! call cpu_clock_end(id_clock_KQ) ks_kappa = GV%ke+1 ; ke_kappa = 0 @@ -1139,13 +1133,13 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! call cpu_clock_begin(id_clock_project) call calculate_projected_state(kappa_mid, u, v, T, Sal, dt_now, nzc, & dz, I_dz_int, dbuoy_dT, dbuoy_dS, & - u_test, v_test, T_test, S_test, N2=N2, S2=S2, & + u_test, v_test, T_test, S_test, GV, N2=N2, S2=S2, & ks_int = ks_kappa, ke_int = ke_kappa) ! call cpu_clock_end(id_clock_project) ! call cpu_clock_begin(id_clock_KQ) call find_kappa_tke(N2, S2, kappa_out, Idz, dz_Int, I_L2_bdry, f2, & - nzc, CS, K_Q, tke_pred, kappa_pred) + nzc, CS, GV, K_Q, tke_pred, kappa_pred) ! call cpu_clock_end(id_clock_KQ) ! call cpu_clock_begin(id_clock_avg) @@ -1164,7 +1158,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! call cpu_clock_begin(id_clock_project) call calculate_projected_state(kappa_mid, u, v, T, Sal, dt_now, nzc, & dz, I_dz_int, dbuoy_dT, dbuoy_dS, & - u, v, T, Sal, N2, S2) + u, v, T, Sal, GV, N2, S2) ! call cpu_clock_end(id_clock_project) endif @@ -1198,7 +1192,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & Ri_k(K) = 1e3 ; if (N2(K) < 1e3 * S2(K)) Ri_k(K) = N2(K) / S2(K) dtke(K) = tke_pred(K) - tke(K) dtke_norm(K) = dtke(K) / (0.5*(tke(K) + tke_pred(K))) - dkappa(K) = kappa_pred(K) - kappa_out(K) + dkap(K) = kappa_pred(K) - kappa_out(K) enddo if (itt <= max_debug_itt) then do k=1,nzc @@ -1215,7 +1209,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & if (abs(dkappa_it1(K,itt-1)) > 1e-20) & d_dkappa_it1(K,itt) = dkappa_it1(K,itt) / dkappa_it1(K,itt-1) endif - dkappa_norm(K,itt) = dkappa(K) / max(0.5*(Kappa_pred(K) + kappa_out(K)), 1e-100) + dkappa_norm(K,itt) = dkap(K) / max(0.5*(kappa_pred(K) + kappa_out(K)), GV%m_to_Z**2*1e-100) enddo endif #endif @@ -1231,27 +1225,28 @@ end subroutine kappa_shear_column !! may also calculate the projected buoyancy frequency and shear. subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & dz, I_dz_int, dbuoy_dT, dbuoy_dS, & - u, v, T, Sal, N2, S2, ks_int, ke_int) + u, v, T, Sal, GV, N2, S2, ks_int, ke_int) integer, intent(in) :: nz !< The number of layers (after eliminating massless !! layers?). real, dimension(nz+1), intent(in) :: kappa !< The diapycnal diffusivity at interfaces, - !! in m2 s-1. + !! in Z2 s-1. real, dimension(nz), intent(in) :: u0 !< The initial zonal velocity, in m s-1. real, dimension(nz), intent(in) :: v0 !< The initial meridional velocity, in m s-1. real, dimension(nz), intent(in) :: T0 !< The initial temperature, in C. real, dimension(nz), intent(in) :: S0 !< The initial salinity, in PSU. - real, dimension(nz), intent(in) :: dz !< The grid spacing of layers, in m. + real, dimension(nz), intent(in) :: dz !< The grid spacing of layers, in Z. real, dimension(nz+1), intent(in) :: I_dz_int !< The inverse of the layer's thicknesses, - !! in m-1. + !! in Z-1. real, dimension(nz+1), intent(in) :: dbuoy_dT !< The partial derivative of buoyancy with - !! temperature, in m s-2 C-1. + !! temperature, in Z s-2 C-1. real, dimension(nz+1), intent(in) :: dbuoy_dS !< The partial derivative of buoyancy with - !! salinity, in m s-2 PSU-1. + !! salinity, in Z s-2 PSU-1. real, intent(in) :: dt !< The time step in s. real, dimension(nz), intent(inout) :: u !< The zonal velocity after dt, in m s-1. real, dimension(nz), intent(inout) :: v !< The meridional velocity after dt, in m s-1. real, dimension(nz), intent(inout) :: T !< The temperature after dt, in C. real, dimension(nz), intent(inout) :: Sal !< The salinity after dt, in PSU. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(nz+1), optional, & intent(inout) :: N2 !< The buoyancy frequency squared at interfaces, !! in s-2. @@ -1263,6 +1258,8 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & ! Local variables real, dimension(nz+1) :: c1 + real :: L2_to_Z2 ! A conversion factor from horizontal length units to vertical depth + ! units squared, in Z2 m-2. real :: a_a, a_b, b1, d1, bd1, b1nz_0 integer :: k, ks, ke @@ -1325,14 +1322,15 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & endif if (present(S2)) then + L2_to_Z2 = GV%m_to_Z**2 S2(1) = 0.0 ; S2(nz+1) = 0.0 if (ks > 1) & - S2(ks) = ((u(ks)-u0(ks-1))**2 + (v(ks)-v0(ks-1))**2) * I_dz_int(ks)**2 + S2(ks) = ((u(ks)-u0(ks-1))**2 + (v(ks)-v0(ks-1))**2) * L2_to_Z2*I_dz_int(ks)**2 do K=ks+1,ke - S2(K) = ((u(k)-u(k-1))**2 + (v(k)-v(k-1))**2) * I_dz_int(K)**2 + S2(K) = ((u(k)-u(k-1))**2 + (v(k)-v(k-1))**2) * L2_to_Z2*I_dz_int(K)**2 enddo if (ke This subroutine calculates new, consistent estimates of TKE and kappa. subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & - nz, CS, K_Q, tke, kappa, kappa_src, local_src) + nz, CS, GV, K_Q, tke, kappa, kappa_src, local_src) integer, intent(in) :: nz !< The number of layers to work on. real, dimension(nz+1), intent(in) :: N2 !< The buoyancy frequency squared at interfaces, !! in s-2. real, dimension(nz+1), intent(in) :: S2 !< The squared shear at interfaces, in s-2. real, dimension(nz+1), intent(in) :: kappa_in !< The initial guess at the diffusivity, - !! in m2 s-1. - real, dimension(nz+1), intent(in) :: dz_Int !< The thicknesses associated with interfaces, - !! in m. + !! in Z2 s-1. + real, dimension(nz+1), intent(in) :: dz_Int !< The thicknesses associated with interfaces, + !! in Z-1. real, dimension(nz+1), intent(in) :: I_L2_bdry !< The inverse of the squared distance to !! boundaries, m2. - real, dimension(nz), intent(in) :: Idz !< The inverse grid spacing of layers, in m-1. + real, dimension(nz), intent(in) :: Idz !< The inverse grid spacing of layers, in Z-1. real, intent(in) :: f2 !< The squared Coriolis parameter, in s-2. type(Kappa_shear_CS), pointer :: CS !< A pointer to this module's control structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(nz+1), intent(inout) :: K_Q !< The shear-driven diapycnal diffusivity divided by !! the turbulent kinetic energy per unit mass at !! interfaces, in s. real, dimension(nz+1), intent(out) :: tke !< The turbulent kinetic energy per unit mass at !! interfaces, in units of m2 s-2. - real, dimension(nz+1), intent(out) :: kappa !< The diapycnal diffusivity at interfaces, - !! in m2 s-1. + real, dimension(nz+1), intent(out) :: kappa !< The diapycnal diffusivity at interfaces, + !! in Z2 s-1. real, dimension(nz+1), optional, & intent(out) :: kappa_src !< The source term for kappa, in s-1. real, dimension(nz+1), optional, & @@ -1387,16 +1386,16 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! equations, in m s-1. dQdz ! Half the partial derivative of TKE with depth, m s-2. real, dimension(nz+1) :: & - dK, & ! The change in kappa, in m2 s-1. - dQ, & ! The change in TKE, in m2 s-1. + dK, & ! The change in kappa, in Z2 s-1. + dQ, & ! The change in TKE, in m2 s-2. cQ, cK, & ! cQ and cK are the upward influences in the tridiagonal and ! hexadiagonal solvers for the TKE and kappa equations, ND. I_Ld2, & ! 1/Ld^2, where Ld is the effective decay length scale - ! for kappa, in units of m-2. + ! for kappa, in units of Z-2. TKE_decay, & ! The local TKE decay rate in s-1. k_src, & ! The source term in the kappa equation, in s-1. - dQmdK, & ! With Newton's method the change in dQ(k-1) due to dK(k), s. - dKdQ, & ! With Newton's method the change in dK(k) due to dQ(k), s-1. + dQmdK, & ! With Newton's method the change in dQ(k-1) due to dK(k), m2 s Z-2. + dKdQ, & ! With Newton's method the change in dK(k) due to dQ(k), Z2 m-2 s-1. e1 ! The fractional change in a layer TKE due to a change in the ! TKE of the layer above when all the kappas below are 0. ! e1 is nondimensional, and 0 < e1 < 1. @@ -1404,7 +1403,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! and stratification, in m2 s-3. (For convenience, ! a term involving the non-dissipation of q0 is also ! included here.) - real :: bQ, bK ! The inverse of the pivot in the tridiagonal equations. + real :: bQ, bK ! The inverse of the pivot in the tridiagonal equations, in Z-1. real :: bd1 ! A term in the denominator of bQ or bK. real :: cQcomp, cKcomp ! 1 - cQ or 1 - cK in the tridiagonal equations. real :: c_s2 ! The coefficient for the decay of TKE due to @@ -1417,21 +1416,26 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & real :: Ilambda2 ! 1.0 / CS%lambda**2. real :: TKE_min ! The minimum value of shear-driven TKE that can be ! solved for, in m2 s-2. - real :: kappa0 ! The background diapycnal diffusivity, in m2 s-1. + real :: kappa0 ! The background diapycnal diffusivity, in Z2 s-1. real :: max_err ! The maximum value of norm_err in a column, nondim. - real :: kappa_trunc ! Diffusivities smaller than this are rounded to 0, m2 s-1. + real :: kappa_trunc ! Diffusivities smaller than this are rounded to 0, Z2 s-1. real :: eden1, eden2, I_eden, ome ! Variables used in calculating e1. real :: diffusive_src ! The diffusive source in the kappa equation, in m s-1. real :: chg_by_k0 ! The value of k_src that leads to an increase of ! kappa_0 if only the diffusive term is a sink, in s-1. - real :: kappa_mean ! A mean value of kappa, in m2 s-1. + real :: kappa_mean ! A mean value of kappa, in Z2 s-1. real :: Newton_test ! The value of relative error that will cause the next ! iteration to use Newton's method. ! Temporary variables used in the Newton's method iterations. - real :: decay_term, I_Q, kap_src, v1, v2 - + real :: decay_term_k ! The decay term in the diffusivity equation + real :: decay_term_Q ! The decay term in the TKE equation + real :: I_Q ! The inverse of TKE, in s2 m-2 + real :: kap_src + real :: v1, v2 + real :: Z2_to_L2 ! A conversion factor from vertical depth units to horizontal length + ! units squared, in m2 Z-2. real :: tol_err ! The tolerance for max_err that determines when to ! stop iterating. real :: Newton_err ! The tolerance for max_err that determines when to @@ -1456,7 +1460,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & integer :: max_debug_itt ; parameter(max_debug_itt=20) real :: K_err_lin, Q_err_lin real, dimension(nz+1) :: & - kappa_prev, & ! The value of kappa at the start of the current iteration, in m2 s-1. + kappa_prev, & ! The value of kappa at the start of the current iteration, in Z2 s-1. TKE_prev ! The value of TKE at the start of the current iteration, in m2 s-2. real, dimension(nz+1,1:max_debug_itt) :: & tke_it1, kappa_it1, kprev_it1, & ! Various values from each iteration. @@ -1471,6 +1475,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & q0 = CS%TKE_bg ; kappa0 = CS%kappa_0 ; TKE_min = max(CS%TKE_bg,1.0E-20) Ri_crit = CS%Rino_crit Ilambda2 = 1.0 / CS%lambda**2 + Z2_to_L2 = GV%Z_to_m**2 kappa_trunc = 0.01*kappa0 ! ### CHANGE THIS HARD-WIRING LATER? do_Newton = .false. ; abort_Newton = .false. tol_err = CS%kappa_tol_err @@ -1554,13 +1559,13 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! terms. ke_tke = max(ke_kappa,ke_kappa_prev)+1 - ! aQ is the coupling between adjacent interfaces in m s-1. + ! aQ is the coupling between adjacent interfaces in Z s-1. do k=1,min(ke_tke,nz) - aQ(k) = (0.5*(kappa(K)+kappa(K+1))+kappa0) * Idz(k) + aQ(k) = (0.5*(kappa(K)+kappa(K+1)) + kappa0) * Idz(k) enddo dQ(1) = -TKE(1) if (tke_noflux_top_BC) then - tke_src = kappa0*S2(1) + q0 * TKE_decay(1) ! Uses that kappa(1) = 0 + tke_src = Z2_to_L2*kappa0*S2(1) + q0 * TKE_decay(1) ! Uses that kappa(1) = 0 bd1 = dz_Int(1) * TKE_decay(1) bQ = 1.0 / (bd1 + aQ(1)) tke(1) = bQ * (dz_Int(1)*tke_src) @@ -1570,8 +1575,8 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & endif do K=2,ke_tke-1 dQ(K) = -TKE(K) - tke_src = (kappa(K) + kappa0)*S2(K) + q0*TKE_decay(K) - bd1 = dz_Int(K)*(TKE_decay(K) + N2(K)*K_Q(K)) + cQcomp*aQ(k-1) + tke_src = Z2_to_L2*(kappa(K) + kappa0)*S2(K) + q0*TKE_decay(K) + bd1 = dz_Int(K)*(TKE_decay(K) + N2(K)*Z2_to_L2*K_Q(K)) + cQcomp*aQ(k-1) bQ = 1.0 / (bd1 + aQ(k)) tke(K) = bQ * (dz_Int(K)*tke_src + aQ(k-1)*tke(K-1)) cQ(K+1) = aQ(k) * bQ ; cQcomp = bd1 * bQ ! = 1 - cQ @@ -1581,7 +1586,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & dQ(nz+1) = 0.0 else k = ke_tke - tke_src = kappa0*S2(K) + q0*TKE_decay(K) ! Uses that kappa(ke_tke) = 0 + tke_src = Z2_to_L2*kappa0*S2(K) + q0*TKE_decay(K) ! Uses that kappa(ke_tke) = 0 if (K == nz+1) then dQ(K) = -TKE(K) bQ = 1.0 / (dz_Int(K)*TKE_decay(K) + cQcomp*aQ(k-1)) @@ -1624,12 +1629,12 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & dK(1) = 0.0 ! kappa takes boundary values of 0. cK(2) = 0.0 ; cKcomp = 1.0 if (itt == 1) then ; dO K=2,nz - I_Ld2(K) = (N2(K)*Ilambda2 + f2) / tke(K) + I_L2_bdry(K) + I_Ld2(K) = (N2(K)*Ilambda2 + f2) * Z2_to_L2 / tke(K) + I_L2_bdry(K) enddo ; endif do K=2,nz dK(K) = -kappa(K) if (itt>1) & - I_Ld2(K) = (N2(K)*Ilambda2 + f2) / tke(K) + I_L2_bdry(K) + I_Ld2(K) = (N2(K)*Ilambda2 + f2) * Z2_to_L2 / tke(K) + I_L2_bdry(K) bd1 = dz_Int(K)*I_Ld2(K) + cKcomp*Idz(k-1) bK = 1.0 / (bd1 + Idz(k)) @@ -1673,7 +1678,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & aQ(1) = (0.5*(kappa(1)+kappa(2))+kappa0) * Idz(1) dQdz(1) = 0.5*(TKE(1) - TKE(2))*Idz(1) if (tke_noflux_top_BC) then - tke_src = dz_Int(1) * (kappa0*S2(1) - (TKE(1) - q0)*TKE_decay(1)) - & + tke_src = dz_Int(1) * (Z2_to_L2*kappa0*S2(1) - (TKE(1) - q0)*TKE_decay(1)) - & aQ(1) * (TKE(1) - TKE(2)) bQ = 1.0 / (aQ(1) + dz_Int(1)*TKE_decay(1)) @@ -1686,21 +1691,21 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & endif do K=2,nz I_Q = 1.0 / TKE(K) - I_Ld2(K) = (N2(K)*Ilambda2 + f2) * I_Q + I_L2_bdry(K) + I_Ld2(K) = (N2(K)*Ilambda2 + f2) * (Z2_to_L2*I_Q) + I_L2_bdry(K) kap_src = dz_Int(K) * (k_src(K) - I_Ld2(K)*kappa(K)) + & - Idz(k-1)*(kappa(K-1)-kappa(K)) - Idz(k)*(kappa(K)-kappa(K+1)) + Idz(k-1)*(kappa(K-1)-kappa(K)) - Idz(k)*(kappa(K)-kappa(K+1)) ! Ensure that the pivot is always positive, and that 0 <= cK <= 1. ! Otherwise do not use Newton's method. - decay_term = -Idz(k-1)*dQmdK(K)*dKdQ(K-1) + dz_Int(K)*I_Ld2(K) - if (decay_term < 0.0) then ; abort_Newton = .true. ; exit ; endif - bK = 1.0 / (Idz(k) + Idz(k-1)*cKcomp + decay_term) + decay_term_k = -Idz(k-1)*dQmdK(K)*dKdQ(K-1) + dz_Int(K)*I_Ld2(K) + if (decay_term_k < 0.0) then ; abort_Newton = .true. ; exit ; endif + bK = 1.0 / (Idz(k) + Idz(k-1)*cKcomp + decay_term_k) cK(K+1) = bK * Idz(k) - cKcomp = bK * (Idz(k-1)*cKcomp + decay_term) ! = 1-cK(K+1) + cKcomp = bK * (Idz(k-1)*cKcomp + decay_term_k) ! = 1-cK(K+1) dKdQ(K) = bK * (Idz(k-1)*dKdQ(K-1)*cQ(K) + & - (N2(K)*Ilambda2 + f2)*I_Q**2*kappa(K)) + GV%Z_to_m*(N2(K)*Ilambda2 + f2) * I_Q**2 * kappa(K) ) dK(K) = bK * (kap_src + Idz(k-1)*dK(K-1) + Idz(k-1)*dKdQ(K-1)*dQ(K-1)) ! Truncate away negligibly small values of kappa. @@ -1714,21 +1719,21 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! Solve for dQ(K)... aQ(k) = (0.5*(kappa(K)+kappa(K+1))+kappa0) * Idz(k) dQdz(k) = 0.5*(TKE(K) - TKE(K+1))*Idz(k) - tke_src = dz_Int(K) * ((kappa(k) + kappa0)*S2(k) - kappa(k)*N2(k) - & - (TKE(k) - q0)*TKE_decay(k)) - & + tke_src = dz_Int(K) * (Z2_to_L2*((kappa(k) + kappa0)*S2(k) - kappa(k)*N2(k)) - & + (TKE(k) - q0)*TKE_decay(k)) - & (aQ(k) * (TKE(K) - TKE(K+1)) - aQ(k-1) * (TKE(K-1) - TKE(K))) v1 = aQ(k-1) + dQdz(k-1)*dKdQ(K-1) v2 = (v1*dQmdK(K) + dQdz(k-1)*cK(K)) + & - ((dQdz(k-1) - dQdz(k)) + dz_Int(K)*(S2(K) - N2(K))) + ((dQdz(k-1) - dQdz(k)) + Z2_to_L2*dz_Int(K)*(S2(K) - N2(K))) ! Ensure that the pivot is always positive, and that 0 <= cQ <= 1. ! Otherwise do not use Newton's method. - decay_term = dz_Int(K)*TKE_decay(K) - dQdz(k-1)*dKdQ(K-1)*cQ(K) - v2*dKdQ(K) - if (decay_term < 0.0) then ; abort_Newton = .true. ; exit ; endif - bQ = 1.0 / (aQ(k) + (cQcomp*aQ(k-1) + decay_term)) + decay_term_Q = dz_Int(K)*TKE_decay(K) - dQdz(k-1)*dKdQ(K-1)*cQ(K) - v2*dKdQ(K) + if (decay_term_Q < 0.0) then ; abort_Newton = .true. ; exit ; endif + bQ = 1.0 / (aQ(k) + (cQcomp*aQ(k-1) + decay_term_Q)) cQ(K+1) = aQ(k) * bQ - cQcomp = (cQcomp*aQ(k-1) + decay_term) * bQ + cQcomp = (cQcomp*aQ(k-1) + decay_term_Q) * bQ dQmdK(K+1) = (v2 * cK(K+1) - dQdz(k)) * bQ ! Ensure that TKE+dQ will not drop below 0.5*TKE. @@ -1746,15 +1751,15 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & dK(nz+1) = 0.0 ; dKdQ(nz+1) = 0.0 if (tke_noflux_bottom_BC) then K = nz+1 - tke_src = dz_Int(K) * (kappa0*S2(K) - (TKE(K) - q0)*TKE_decay(K)) + & + tke_src = dz_Int(K) * (Z2_to_L2*kappa0*S2(K) - (TKE(K) - q0)*TKE_decay(K)) + & aQ(k-1) * (TKE(K-1) - TKE(K)) v1 = aQ(k-1) + dQdz(k-1)*dKdQ(K-1) - decay_term = max(0.0, dz_Int(K)*TKE_decay(K) - dQdz(k-1)*dKdQ(K-1)*cQ(K)) - if (decay_term < 0.0) then + decay_term_Q = max(0.0, dz_Int(K)*TKE_decay(K) - dQdz(k-1)*dKdQ(K-1)*cQ(K)) + if (decay_term_Q < 0.0) then abort_Newton = .true. else - bQ = 1.0 / (aQ(k) + (cQcomp*aQ(k-1) + decay_term)) + bQ = 1.0 / (aQ(k) + (cQcomp*aQ(k-1) + decay_term_Q)) ! Ensure that TKE+dQ will not drop below 0.5*TKE. dQ(K) = max(bQ * ((v1 * dQ(K-1) + dQdz(k-1)*dK(K-1)) + tke_src), & -0.5*TKE(K)) @@ -1772,10 +1777,9 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & if (K < nz+1) then ! Ignore this source? aQ(k) = (0.5*(kappa(K)+kappa(K+1))+kappa0) * Idz(k) - tke_src = (dz_Int(K) * (kappa0*S2(K) - (TKE(K)-q0)*TKE_decay(K)) - & - (aQ(k) * (TKE(K) - TKE(K+1)) - & - aQ(k-1) * (TKE(K-1) - TKE(K))) ) / & - (aQ(k) + (aQ(k-1) + dz_Int(K)*TKE_decay(K))) + tke_src = (dz_Int(K) * (Z2_to_L2*kappa0*S2(K) - (TKE(K)-q0)*TKE_decay(K)) - & + (aQ(k) * (TKE(K) - TKE(K+1)) - aQ(k-1) * (TKE(K-1) - TKE(K))) ) / & + (aQ(k) + (aQ(k-1) + dz_Int(K)*TKE_decay(K))) endif #endif dK(K) = 0.0 @@ -1816,7 +1820,8 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & endif #ifdef DEBUG - ! Check these solutions for consistency. + ! Check these solutions for consistency. + ! The unit conversions here have not been carefully tested. do K=2,nz ! In these equations, K_err_lin and Q_err_lin should be at round-off levels ! compared with the dominant terms, perhaps, dz_Int*I_Ld2*kappa and @@ -1824,23 +1829,23 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! been increased to ensure a positive pivot, or 2) negative TKEs have been ! truncated, or 3) small or negative kappas have been rounded toward 0. I_Q = 1.0 / TKE(K) - I_Ld2(K) = (N2(K)*Ilambda2 + f2) * I_Q + I_L2_bdry(K) + I_Ld2(K) = (N2(K)*Ilambda2 + f2) * (Z2_to_L2*I_Q) + I_L2_bdry(K) kap_src = dz_Int(K) * (k_src(K) - I_Ld2(K)*kappa_prev(K)) + & - (Idz(k-1)*(kappa_prev(k-1)-kappa_prev(k)) - & - Idz(k)*(kappa_prev(k)-kappa_prev(k+1))) - K_err_lin = -Idz(k-1)*(dK(K-1)-dK(K)) + Idz(k)*(dK(K)-dK(K+1)) + & + (Idz(k-1)*(kappa_prev(k-1)-kappa_prev(k)) - & + Idz(k)*(kappa_prev(k)-kappa_prev(k+1))) + K_err_lin = -Idz(k-1)*(dK(K-1)-dK(K)) + Idz(k)*(dK(K)-dK(K+1)) + & dz_Int(K)*I_Ld2(K)*dK(K) - kap_src - & - (N2(K)*Ilambda2 + f2)*I_Q**2*kappa_prev(K) * dQ(K) + GV%Z_to_m*(N2(K)*Ilambda2 + f2)*I_Q**2*kappa_prev(K) * dQ(K) - tke_src = dz_Int(K) * ((kappa_prev(K) + kappa0)*S2(K) - & - kappa_prev(K)*N2(K) - (TKE_prev(K) - q0)*TKE_decay(K)) - & + tke_src = dz_Int(K) * (Z2_to_L2*(kappa_prev(K) + kappa0)*S2(K) - & + Z2_to_L2*kappa_prev(K)*N2(K) - (TKE_prev(K) - q0)*TKE_decay(K)) - & (aQ(k) * (TKE_prev(K) - TKE_prev(K+1)) - & aQ(k-1) * (TKE_prev(K-1) - TKE_prev(K))) Q_err_lin = (aQ(k-1) * (dQ(K-1)-dQ(K)) - aQ(k) * (dQ(k)-dQ(k+1))) - & 0.5*(TKE_prev(K)-TKE_prev(K+1))*Idz(k) * (dK(K) + dK(K+1)) - & 0.5*(TKE_prev(K)-TKE_prev(K-1))*Idz(k-1)* (dK(K-1) + dK(K)) + & - dz_Int(K) * (dK(K) * (S2(K) - N2(K)) - dQ(K)*TKE_decay(K)) + tke_src + dz_Int(K) * (Z2_to_L2*dK(K) * (S2(K) - N2(K)) - dQ(K)*TKE_decay(K)) + tke_src enddo #endif endif ! End of the Newton's method solver. @@ -1942,8 +1947,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & if (present(local_src)) then local_src(1) = 0.0 ; local_src(nz+1) = 0.0 do K=2,nz - diffusive_src = Idz(k-1)*(kappa(K-1)-kappa(K)) + & - Idz(k)*(kappa(K+1)-kappa(K)) + diffusive_src = Idz(k-1)*(kappa(K-1)-kappa(K)) + Idz(k)*(kappa(K+1)-kappa(K)) chg_by_k0 = kappa0 * ((Idz(k-1)+Idz(k)) / dz_Int(K) + I_Ld2(K)) if (diffusive_src <= 0.0) then local_src(K) = k_src(K) + chg_by_k0 @@ -2023,7 +2027,8 @@ function kappa_shear_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, "KD_KAPPA_SHEAR_0", CS%kappa_0, & "The background diffusivity that is used to smooth the \n"//& "density and shear profiles before solving for the \n"//& - "diffusivities. Defaults to value of KD.", units="m2 s-1", default=KD_normal) + "diffusivities. Defaults to value of KD.", & + units="m2 s-1", default=KD_normal, scale=GV%m_to_Z**2) call get_param(param_file, mdl, "FRI_CURVATURE", CS%FRi_curvature, & "The nondimensional curvature of the function of the \n"//& "Richardson number in the kappa source term in the \n"//& @@ -2103,9 +2108,9 @@ function kappa_shear_init(Time, G, GV, param_file, diag, CS) 'Shear-driven Turbulent Kinetic Energy', 'm2 s-2') #ifdef ADD_DIAGNOSTICS CS%id_ILd2 = register_diag_field('ocean_model','ILd2_shear',diag%axesTi,Time, & - 'Inverse kappa decay scale at interfaces', 'm-2') + 'Inverse kappa decay scale at interfaces', 'm-2', conversion=GV%m_to_Z**2) CS%id_dz_Int = register_diag_field('ocean_model','dz_Int_shear',diag%axesTi,Time, & - 'Finite volume thickness of interfaces', 'm') + 'Finite volume thickness of interfaces', 'm', conversion=GV%Z_to_m) #endif end function kappa_shear_init From 8dbc04601c4a934b20680e8203d4c8f393bae68b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 9 Oct 2018 14:13:22 -0400 Subject: [PATCH 162/174] Recast mixedlayer_restrat to work in units of Z Recast the internal calculations in mixedlayer_restrat to use vertical height units of Z in place of m for dimensional consistency testing. All answers are bitwise identical in the MOM6 test cases, including rescaling Z over a large range. --- .../lateral/MOM_mixed_layer_restrat.F90 | 61 ++++++++++--------- 1 file changed, 31 insertions(+), 30 deletions(-) diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 78993633b3..27a60e7a38 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -138,17 +138,17 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var MLD_slow, & ! Mixed layer depth actually used in MLE restratification parameterization (H units) htot_slow, & ! The sum of the thicknesses of layers in the mixed layer (H units) Rml_av_slow ! g_Rho0 times the average mixed layer density (m s-2) - real :: g_Rho0 ! G_Earth/Rho0 (m4 s-2 kg-1) + real :: g_Rho0 ! G_Earth/Rho0 (m5 Z-1 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 in metre (not H). + real :: h_vel ! htot interpolated onto velocity points in Z (not H). real :: absf ! absolute value of f, interpolated to velocity points (s-1) - real :: u_star ! surface friction velocity, interpolated to velocity points (m s-1) + real :: u_star ! surface friction velocity, interpolated to velocity points (Z s-1) real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer (s-1) real :: timescale ! mixing growth timescale (sec) real :: h_neglect ! tiny thickness usually lost in roundoff so can be neglected (H units) - real :: dz_neglect ! A tiny thickness (in m) that is usually lost in roundoff so can be neglected + real :: dz_neglect ! A tiny thickness (in Z) that is usually lost in roundoff so can be neglected real :: I4dt ! 1/(4 dt) (sec-1) real :: Ihtot,Ihtot_slow! total mixed layer thickness real :: a(SZK_(G)) ! A non-dimensional value relating the overall flux @@ -273,9 +273,9 @@ 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*GV%m_to_Z)/GV%Rho0 + g_Rho0 = GV%g_Earth / GV%Rho0 h_neglect = GV%H_subroundoff - dz_neglect = GV%H_subroundoff*GV%H_to_m + 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. @@ -338,7 +338,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var 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) 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) + call hchksum(Rml_av_fast,'mixed_layer_restrat: rml',G%HI,haloshift=1, scale=GV%m_to_Z) endif ! TO DO: @@ -348,7 +348,7 @@ 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 = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) + u_star = GV%m_to_Z*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 = & @@ -358,23 +358,23 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! 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. - h_vel = 0.5*((htot_fast(i,j) + htot_fast(i+1,j)) + h_neglect) * GV%H_to_m + h_vel = 0.5*((htot_fast(i,j) + htot_fast(i+1,j)) + h_neglect) * GV%H_to_Z mom_mixrate = (0.41*9.8696)*u_star**2 / & (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) 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%m_to_H) + 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_m + 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 / & (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) 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%m_to_H) + 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 @@ -424,7 +424,7 @@ 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 = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) + u_star = GV%m_to_Z*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 = & @@ -434,23 +434,23 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! 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. - h_vel = 0.5*((htot_fast(i,j) + htot_fast(i,j+1)) + h_neglect) * GV%H_to_m + h_vel = 0.5*((htot_fast(i,j) + htot_fast(i,j+1)) + h_neglect) * GV%H_to_Z mom_mixrate = (0.41*9.8696)*u_star**2 / & (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) 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%m_to_H) + 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_m + 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 / & (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) 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%m_to_H) + 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 @@ -559,17 +559,17 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, CS) real, dimension(SZI_(G),SZJ_(G)) :: & htot, & ! The sum of the thicknesses of layers in the mixed layer (H units) Rml_av ! g_Rho0 times the average mixed layer density (m s-2) - real :: g_Rho0 ! G_Earth/Rho0 (m4 s-2 kg-1) + real :: g_Rho0 ! G_Earth/Rho0 (m5 Z-1 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 (meter; not H) + real :: h_vel ! htot interpolated onto velocity points (Z; not H) real :: absf ! absolute value of f, interpolated to velocity points (s-1) - real :: u_star ! surface friction velocity, interpolated to velocity points (m s-1) + real :: u_star ! surface friction velocity, interpolated to velocity points (Z s-1) real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer (s-1) real :: timescale ! mixing growth timescale (sec) real :: h_neglect ! tiny thickness usually lost in roundoff and can be neglected (H units) - real :: dz_neglect ! tiny thickness (in m) that usually lost in roundoff and can be neglected (meter) + real :: dz_neglect ! tiny thickness (in Z) that usually lost in roundoff and can be neglected (meter) real :: I4dt ! 1/(4 dt) real :: I2htot ! Twice the total mixed layer thickness at velocity points (H units) real :: z_topx2 ! depth of the top of a layer at velocity points (H units) @@ -597,10 +597,10 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, CS) uDml(:) = 0.0 ; vDml(:) = 0.0 I4dt = 0.25 / dt - g_Rho0 = (GV%g_Earth*GV%m_to_Z)/GV%Rho0 + 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_m + dz_neglect = GV%H_subroundoff*GV%H_to_Z if (.not.use_EOS) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & "An equation of state must be used with this module.") @@ -644,9 +644,9 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, CS) do i=is,ie ; utimescale_diag(i,j) = 0.0 ; enddo do i=is,ie ; vtimescale_diag(i,j) = 0.0 ; enddo do I=is-1,ie - h_vel = 0.5*(htot(i,j) + htot(i+1,j)) * GV%H_to_m + h_vel = 0.5*(htot(i,j) + htot(i+1,j)) * GV%H_to_Z - u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) + u_star = GV%m_to_Z*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 @@ -661,7 +661,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, CS) utimescale_diag(I,j) = timescale 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%m_to_H) + 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 @@ -692,9 +692,9 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, CS) ! V- component !$OMP do do J=js-1,je ; do i=is,ie - h_vel = 0.5*(htot(i,j) + htot(i,j+1)) * GV%H_to_m + h_vel = 0.5*(htot(i,j) + htot(i,j+1)) * GV%H_to_Z - u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) + u_star = GV%m_to_Z*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 @@ -709,7 +709,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, CS) vtimescale_diag(i,J) = timescale 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%m_to_H) + 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 @@ -883,7 +883,8 @@ logical function mixedlayer_restrat_init(Time, G, GV, param_file, diag, CS, rest 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') + 'Mixed Layer Buoyancy as used in the mixed-layer restratification parameterization', & + 'm s2', conversion=GV%m_to_Z) 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') CS%id_vDml = register_diag_field('ocean_model', 'vdml_restrat', diag%axesCv1, Time, & From 8315caaff77db24e112f743eac4e7880dee3a62b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 9 Oct 2018 14:20:34 -0400 Subject: [PATCH 163/174] +Allow find_eta to specify units for eta Added a new optional argument to find_eta to specify the units to use in reporting the interface heights and eliminated the required G_Earth argument, instead obtaining this information from GV. These changes support dimensional consistency testing. All answers are bitwise identical, but some calls may need to use the new eta_to_m argument when Z_RESCALE_POWER is not 0, and the interface to find_eta has changed. --- src/ALE/MOM_ALE.F90 | 2 +- src/core/MOM.F90 | 8 +-- src/core/MOM_interface_heights.F90 | 72 ++++++++++--------- src/diagnostics/MOM_diagnostics.F90 | 6 +- src/diagnostics/MOM_sum_output.F90 | 2 +- .../MOM_state_initialization.F90 | 2 +- .../lateral/MOM_lateral_mixing_coeffs.F90 | 2 +- .../lateral/MOM_thickness_diffuse.F90 | 2 +- .../vertical/MOM_diabatic_driver.F90 | 4 +- 9 files changed, 52 insertions(+), 48 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 72acafef51..192b278a09 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -329,7 +329,7 @@ subroutine ALE_main( G, GV, h, u, v, tv, Reg, CS, dt, frac_shelf_h) if (CS%id_T_preale > 0) call post_data(CS%id_T_preale, tv%T, CS%diag) if (CS%id_S_preale > 0) call post_data(CS%id_S_preale, tv%S, CS%diag) if (CS%id_e_preale > 0) then - call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, eta_preale) + call find_eta(h, tv, G, GV, eta_preale, eta_to_m=1.0) call post_data(CS%id_e_preale, eta_preale, CS%diag) endif diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index c117aad3b1..eaacbc8493 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -750,7 +750,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & ! Determining the time-average sea surface height is part of the algorithm. ! This may be eta_av if Boussinesq, or need to be diagnosed if not. CS%time_in_cycle = CS%time_in_cycle + dt - call find_eta(h, CS%tv, (GV%g_Earth*GV%m_to_Z), G, GV, ssh, CS%eta_av_bc) + call find_eta(h, CS%tv, G, GV, ssh, CS%eta_av_bc, eta_to_m=1.0) do j=js,je ; do i=is,ie CS%ssh_rint(i,j) = CS%ssh_rint(i,j) + dt*ssh(i,j) enddo ; enddo @@ -2432,9 +2432,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (.not.query_initialized(CS%ave_ssh_ibc,"ave_ssh",restart_CSp)) then if (CS%split) then - call find_eta(CS%h, CS%tv, (GV%g_Earth*GV%m_to_Z), G, GV, CS%ave_ssh_ibc, eta) + call find_eta(CS%h, CS%tv, G, GV, CS%ave_ssh_ibc, eta, eta_to_m=1.0) else - call find_eta(CS%h, CS%tv, (GV%g_Earth*GV%m_to_Z), G, GV, CS%ave_ssh_ibc) + call find_eta(CS%h, CS%tv, G, GV, CS%ave_ssh_ibc, eta_to_m=1.0) endif endif if (CS%split) deallocate(eta) @@ -2489,7 +2489,7 @@ subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) allocate(restart_CSp_tmp) restart_CSp_tmp = restart_CSp allocate(z_interface(SZI_(G),SZJ_(G),SZK_(G)+1)) - call find_eta(CS%h, CS%tv, (GV%g_Earth*GV%m_to_Z), G, GV, z_interface) + call find_eta(CS%h, CS%tv, G, GV, z_interface, eta_to_m=1.0) call register_restart_field(z_interface, "eta", .true., restart_CSp_tmp, & "Interface heights", "meter", z_grid='i') diff --git a/src/core/MOM_interface_heights.F90 b/src/core/MOM_interface_heights.F90 index 1ae571a733..c6c283dfc2 100644 --- a/src/core/MOM_interface_heights.F90 +++ b/src/core/MOM_interface_heights.F90 @@ -27,9 +27,8 @@ module MOM_interface_heights !! form for consistency with the calculation of the pressure gradient forces. !! Additionally, these height may be dilated for consistency with the !! corresponding time-average quantity from the barotropic calculation. -subroutine find_eta_3d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid - !! structure. +subroutine find_eta_3d(h, tv, G, GV, eta, eta_bt, halo_size, eta_to_m) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical !! grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H @@ -37,16 +36,17 @@ subroutine find_eta_3d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to !! various thermodynamic !! variables. - real, intent(in) :: G_Earth !< Earth gravitational - !! acceleration (m/s2). real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: eta !< layer interface heights - !! (meter). + !! (Z or 1/eta_to_m m). real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta_bt !< optional barotropic !! variable that gives the "correct" free surface height (Boussinesq) or total water !! column mass per unit area (non-Boussinesq). This is used to dilate the layer. !! thicknesses when calculating interfaceheights, in H (m or kg m-2). integer, optional, intent(in) :: halo_size !< width of halo points on !! which to calculate eta. + real, optional, intent(in) :: eta_to_m !< The conversion factor from + !! the units of eta to m; by default this is GV%Z_to_m. + ! Local variables real :: p(SZI_(G),SZJ_(G),SZK_(G)+1) real :: dz_geo(SZI_(G),SZJ_(G),SZK_(G)) ! The change in geopotential height @@ -54,6 +54,7 @@ subroutine find_eta_3d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) real :: dilate(SZI_(G)) ! non-dimensional dilation factor real :: htot(SZI_(G)) ! total thickness H real :: I_gEarth + real :: Z_to_eta, H_to_eta, H_to_rho_eta ! Unit conversion factors with obvious names. integer i, j, k, isv, iev, jsv, jev, nz, halo halo = 0 ; if (present(halo_size)) halo = max(0,halo_size) @@ -64,18 +65,19 @@ subroutine find_eta_3d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) if ((isvG%ied) .or. (jsvG%jed)) & call MOM_error(FATAL,"find_eta called with an overly large halo_size.") - I_gEarth = 1.0 / G_Earth + Z_to_eta = 1.0 ; if (present(eta_to_m)) Z_to_eta = GV%Z_to_m / eta_to_m + H_to_eta = GV%H_to_Z * Z_to_eta + H_to_rho_eta = GV%H_to_kg_m2 * (GV%m_to_Z * Z_to_eta) + I_gEarth = Z_to_eta / GV%g_Earth -!$OMP parallel default(none) shared(isv,iev,jsv,jev,nz,eta,G,GV,h,eta_bt,tv,p, & -!$OMP G_Earth,dz_geo,halo,I_gEarth) & -!$OMP private(dilate,htot) +!$OMP parallel default(shared) private(dilate,htot) !$OMP do - do j=jsv,jev ; do i=isv,iev ; eta(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) ; enddo ; enddo + do j=jsv,jev ; do i=isv,iev ; eta(i,j,nz+1) = -Z_to_eta*G%bathyT(i,j) ; enddo ; enddo if (GV%Boussinesq) then !$OMP do do j=jsv,jev ; do k=nz,1,-1; do i=isv,iev - eta(i,j,K) = eta(i,j,K+1) + h(i,j,k)*GV%H_to_m + eta(i,j,K) = eta(i,j,K+1) + h(i,j,k)*H_to_eta enddo ; enddo ; enddo if (present(eta_bt)) then ! Dilate the water column to agree with the free surface height @@ -83,22 +85,22 @@ subroutine find_eta_3d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) !$OMP do do j=jsv,jev do i=isv,iev - dilate(i) = (eta_bt(i,j)*GV%H_to_m + G%Zd_to_m*G%bathyT(i,j)) / & - (eta(i,j,1) + G%Zd_to_m*G%bathyT(i,j)) + dilate(i) = (eta_bt(i,j)*H_to_eta + Z_to_eta*G%bathyT(i,j)) / & + (eta(i,j,1) + Z_to_eta*G%bathyT(i,j)) enddo do k=1,nz ; do i=isv,iev - eta(i,j,K) = dilate(i) * (eta(i,j,K) + G%Zd_to_m*G%bathyT(i,j)) - G%Zd_to_m*G%bathyT(i,j) + eta(i,j,K) = dilate(i) * (eta(i,j,K) + Z_to_eta*G%bathyT(i,j)) - Z_to_eta*G%bathyT(i,j) enddo ; enddo enddo endif else if (associated(tv%eqn_of_state)) then - ! ### THIS SHOULD BE P_SURF, IF AVAILABLE. !$OMP do do j=jsv,jev + ! ### THIS SHOULD BE P_SURF, IF AVAILABLE. do i=isv,iev ; p(i,j,1) = 0.0 ; enddo do k=1,nz ; do i=isv,iev - p(i,j,K+1) = p(i,j,K) + G_Earth*GV%H_to_kg_m2*h(i,j,k) + p(i,j,K+1) = p(i,j,K) + GV%H_to_Pa*h(i,j,k) enddo ; enddo enddo !$OMP do @@ -115,7 +117,7 @@ subroutine find_eta_3d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) else !$OMP do do j=jsv,jev ; do k=nz,1,-1; do i=isv,iev - eta(i,j,K) = eta(i,j,K+1) + GV%H_to_kg_m2*h(i,j,k)/GV%Rlay(k) + eta(i,j,K) = eta(i,j,K+1) + H_to_rho_eta*h(i,j,k)/GV%Rlay(k) enddo ; enddo ; enddo endif if (present(eta_bt)) then @@ -127,7 +129,7 @@ subroutine find_eta_3d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) do k=1,nz ; do i=isv,iev ; htot(i) = htot(i) + h(i,j,k) ; enddo ; enddo do i=isv,iev ; dilate(i) = eta_bt(i,j) / htot(i) ; enddo do k=1,nz ; do i=isv,iev - eta(i,j,K) = dilate(i) * (eta(i,j,K) + G%Zd_to_m*G%bathyT(i,j)) - G%Zd_to_m*G%bathyT(i,j) + eta(i,j,K) = dilate(i) * (eta(i,j,K) + Z_to_eta*G%bathyT(i,j)) - Z_to_eta*G%bathyT(i,j) enddo ; enddo enddo endif @@ -140,7 +142,7 @@ end subroutine find_eta_3d !! with the calculation of the pressure gradient forces. Additionally, the sea !! surface height may be adjusted for consistency with the corresponding !! time-average quantity from the barotropic calculation. -subroutine find_eta_2d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) +subroutine find_eta_2d(h, tv, G, GV, eta, eta_bt, halo_size, eta_to_m) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid !! structure. @@ -149,8 +151,6 @@ subroutine find_eta_2d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to !! various thermodynamic !! variables. - real, intent(in) :: G_Earth !< Earth gravitational - !! acceleration (m/s2). real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta !< free surface height !! relative to mean sea !! level (z=0) (m). @@ -159,37 +159,41 @@ subroutine find_eta_2d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) !! water column mass per unit area (non-Boussinesq), in H (m or kg m-2). integer, optional, intent(in) :: halo_size !< width of halo points on !! which to calculate eta. + real, optional, intent(in) :: eta_to_m !< The conversion factor from + !! the units of eta to m; by default this is GV%Z_to_m. ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & p ! The pressure in Pa. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & dz_geo ! The change in geopotential height across a layer, in m2 s-2. - real :: htot(SZI_(G)) ! The sum of all layers' thicknesses, in kg m-2 or m. + real :: htot(SZI_(G)) ! The sum of all layers' thicknesses, in H. real :: I_gEarth + real :: Z_to_eta, H_to_eta, H_to_rho_eta ! Unit conversion factors with obvious names. integer i, j, k, is, ie, js, je, nz, halo halo = 0 ; if (present(halo_size)) halo = max(0,halo_size) is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo nz = G%ke - I_gEarth = 1.0 / G_Earth + Z_to_eta = 1.0 ; if (present(eta_to_m)) Z_to_eta = GV%Z_to_m / eta_to_m + H_to_eta = GV%H_to_Z * Z_to_eta + H_to_rho_eta = GV%H_to_kg_m2 * (GV%m_to_Z * Z_to_eta) + I_gEarth = Z_to_eta / GV%g_Earth -!$OMP parallel default(none) shared(is,ie,js,je,nz,eta,G,GV,eta_bt,h,tv,p, & -!$OMP G_Earth,dz_geo,halo,I_gEarth) & -!$OMP private(htot) +!$OMP parallel default(shared) private(htot) !$OMP do - do j=js,je ; do i=is,ie ; eta(i,j) = -G%Zd_to_m*G%bathyT(i,j) ; enddo ; enddo + do j=js,je ; do i=is,ie ; eta(i,j) = -Z_to_eta*G%bathyT(i,j) ; enddo ; enddo if (GV%Boussinesq) then if (present(eta_bt)) then !$OMP do do j=js,je ; do i=is,ie - eta(i,j) = GV%H_to_m*eta_bt(i,j) + eta(i,j) = H_to_eta*eta_bt(i,j) enddo ; enddo else !$OMP do do j=js,je ; do k=1,nz ; do i=is,ie - eta(i,j) = eta(i,j) + h(i,j,k)*GV%H_to_m + eta(i,j) = eta(i,j) + h(i,j,k)*H_to_eta enddo ; enddo ; enddo endif else @@ -199,7 +203,7 @@ subroutine find_eta_2d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) do i=is,ie ; p(i,j,1) = 0.0 ; enddo do k=1,nz ; do i=is,ie - p(i,j,k+1) = p(i,j,k) + G_Earth*GV%H_to_kg_m2*h(i,j,k) + p(i,j,k+1) = p(i,j,k) + GV%H_to_Pa*h(i,j,k) enddo ; enddo enddo !$OMP do @@ -214,7 +218,7 @@ subroutine find_eta_2d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) else !$OMP do do j=js,je ; do k=1,nz ; do i=is,ie - eta(i,j) = eta(i,j) + GV%H_to_kg_m2*h(i,j,k)/GV%Rlay(k) + eta(i,j) = eta(i,j) + H_to_rho_eta*h(i,j,k)/GV%Rlay(k) enddo ; enddo ; enddo endif if (present(eta_bt)) then @@ -225,8 +229,8 @@ subroutine find_eta_2d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) do i=is,ie ; htot(i) = GV%H_subroundoff ; enddo do k=1,nz ; do i=is,ie ; htot(i) = htot(i) + h(i,j,k) ; enddo ; enddo do i=is,ie - eta(i,j) = (eta_bt(i,j) / htot(i)) * (eta(i,j) + G%Zd_to_m*G%bathyT(i,j)) - & - G%Zd_to_m*G%bathyT(i,j) + eta(i,j) = (eta_bt(i,j) / htot(i)) * (eta(i,j) + Z_to_eta*G%bathyT(i,j)) - & + Z_to_eta*G%bathyT(i,j) enddo enddo endif diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 60340287a3..30101c91a0 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -284,7 +284,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_h > 0) call post_data(CS%id_h, h, CS%diag) if (associated(CS%e)) then - call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, CS%e, eta_bt) + call find_eta(h, tv, G, GV, CS%e, eta_bt, eta_to_m=1.0) if (CS%id_e > 0) call post_data(CS%id_e, CS%e, CS%diag) endif @@ -294,7 +294,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & CS%e_D(i,j,k) = CS%e(i,j,k) + G%Zd_to_m*G%bathyT(i,j) enddo ; enddo ; enddo else - call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, CS%e_D, eta_bt) + call find_eta(h, tv, G, GV, CS%e_D, eta_bt, eta_to_m=1.0) do k=1,nz+1 ; do j=js,je ; do i=is,ie CS%e_D(i,j,k) = CS%e_D(i,j,k) + G%Zd_to_m*G%bathyT(i,j) enddo ; enddo ; enddo @@ -815,7 +815,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, CS) endif if (CS%id_col_ht > 0) then - call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, z_top) + call find_eta(h, tv, G, GV, z_top, eta_to_m=1.0) do j=js,je ; do i=is,ie z_bot(i,j) = z_top(i,j) + G%Zd_to_m*G%bathyT(i,j) enddo ; enddo diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index e464d565fa..91a4dd96ab 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -498,7 +498,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp, OBC, dt_forc enddo ; enddo ; enddo mass_tot = reproducing_sum(tmp1, sums=mass_lay, EFP_sum=mass_EFP) - call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, eta) + call find_eta(h, tv, G, GV, eta, eta_to_m=1.0) do k=1,nz ; do j=js,je ; do i=is,ie tmp1(i,j,k) = (eta(i,j,K)-eta(i,j,K+1)) * areaTm(i,j) enddo ; enddo ; enddo diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 02ca818dfb..b19e6fc518 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -1031,7 +1031,7 @@ subroutine depress_surface(h, G, GV, param_file, tv, just_read_params) call MOM_read_data(filename, eta_srf_var, eta_sfc, G%Domain, scale=scale_factor) ! Convert thicknesses to interface heights. - call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, eta) + call find_eta(h, tv, G, GV, eta, eta_to_m=1.0) do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.0) then ! if (eta_sfc(i,j) < eta(i,j,nz+1)) then diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 6065062b83..eace701a6c 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -393,7 +393,7 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, CS) "Module must be initialized before it is used.") if (CS%calculate_Eady_growth_rate) then - call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, e, halo_size=2) + call find_eta(h, tv, G, GV, e, halo_size=2, eta_to_m=1.0) if (CS%use_stored_slopes) then call calc_isoneutral_slopes(G, GV, h, e, tv, dt*CS%kappa_smooth, & CS%slope_x, CS%slope_y, N2_u, N2_v, 1) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 5a72723b07..b7b0fc105c 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -162,7 +162,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS enddo ; enddo ! Calculates interface heights, e, in m. - call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, e, halo_size=1) + call find_eta(h, tv, G, GV, e, halo_size=1, eta_to_m=1.0) ! Set the diffusivities. !$OMP parallel default(none) shared(is,ie,js,je,Khth_Loc_u,CS,use_VarMix,VarMix, & diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index a82cb12e44..88f28f8937 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -405,7 +405,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%id_T_predia > 0) call post_data(CS%id_T_predia, tv%T, CS%diag) if (CS%id_S_predia > 0) call post_data(CS%id_S_predia, tv%S, CS%diag) if (CS%id_e_predia > 0) then - call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, eta) + call find_eta(h, tv, G, GV, eta, eta_to_m=1.0) call post_data(CS%id_e_predia, eta, CS%diag) endif @@ -1278,7 +1278,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%id_T_predia > 0) call post_data(CS%id_T_predia, tv%T, CS%diag) if (CS%id_S_predia > 0) call post_data(CS%id_S_predia, tv%S, CS%diag) if (CS%id_e_predia > 0) then - call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, eta) + call find_eta(h, tv, G, GV, eta, eta_to_m=1.0) call post_data(CS%id_e_predia, eta, CS%diag) endif From 1d881a163bd2d97067ce74c60fea21154197cfac Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 10 Oct 2018 06:13:43 -0400 Subject: [PATCH 164/174] Recast thickness_diffuse to work in units of Z Recast the internal calculations in thickness_diffuse to use vertical height units of Z in place of m for dimensional consistency testing. All answers are bitwise identical in the MOM6 test cases, including rescaling Z over a large range. --- .../lateral/MOM_thickness_diffuse.F90 | 177 +++++++++--------- 1 file changed, 88 insertions(+), 89 deletions(-) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index b7b0fc105c..caad72b3a4 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -86,7 +86,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion ! Local variables real :: e(SZI_(G), SZJ_(G), SZK_(G)+1) ! heights of interfaces, relative to mean - ! sea level,in H units, positive up. + ! sea level, in Z, positive up. real :: uhD(SZIB_(G), SZJ_(G), SZK_(G)) ! uhD & vhD are the diffusive u*h & real :: vhD(SZI_(G), SZJB_(G), SZK_(G)) ! v*h fluxes (m2 H s-1) @@ -111,7 +111,6 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS KH_v_CFL ! The maximum stable interface height diffusivity at v grid points (m2 s-1) real :: Khth_Loc_u(SZIB_(G), SZJ_(G)) real :: Khth_Loc(SZIB_(G), SZJB_(G)) ! locally calculated thickness diffusivity (m2/s) - real :: H_to_m, m_to_H ! Local copies of unit conversion factors. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in H. real, dimension(:,:), pointer :: cg1 => null() !< Wave speed (m/s) @@ -130,7 +129,6 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke h_neglect = GV%H_subroundoff - H_to_m = GV%H_to_m ; m_to_H = GV%m_to_H if (associated(MEKE)) then if (associated(MEKE%GM_src)) then @@ -162,7 +160,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS enddo ; enddo ! Calculates interface heights, e, in m. - call find_eta(h, tv, G, GV, e, halo_size=1, eta_to_m=1.0) + call find_eta(h, tv, G, GV, e, halo_size=1) ! Set the diffusivities. !$OMP parallel default(none) shared(is,ie,js,je,Khth_Loc_u,CS,use_VarMix,VarMix, & @@ -402,15 +400,15 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV 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 - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (m or kg/m2) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface positions (m) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness in H (m or kg/m2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface positions (Z) real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: Kh_u !< Thickness diffusivity on interfaces !! at u points (m2/s) real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: Kh_v !< Thickness diffusivity on interfaces !! at v points (m2/s) type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: uhD !< Zonal mass fluxes (m3/s) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: vhD !< Meridional mass fluxes (m3/s) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: uhD !< Zonal mass fluxes (m2 H s-1) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: vhD !< Meridional mass fluxes (m2 H s-1) real, dimension(:,:), pointer :: cg1 !< Wave speed (m/s) real, intent(in) :: dt !< Time increment (s) type(MEKE_type), pointer :: MEKE !< MEKE control structue @@ -425,6 +423,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV !! density gradients. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), optional, intent(in) :: slope_x !< Isopycnal slope at u-points real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), optional, intent(in) :: slope_y !< Isopycnal slope at v-points + ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: & T, & ! The temperature (or density) in C, with the values in @@ -434,12 +433,12 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV Rho, & ! Density itself, when a nonlinear equation of state is ! not in use. h_avail, & ! The mass available for diffusion out of each face, divided - ! by dt, in m3 s-1. + ! by dt, in H m2 s-1. h_frac ! The fraction of the mass in the column above the bottom ! interface of a layer that is within a layer, ND. 0 0.0) then Slope = drdx / sqrt(mag_grad2) slope2_Ratio_u(I,K) = Slope**2 * I_slope_max2 @@ -693,13 +689,13 @@ 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) * ((e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j)) + int_slope_u(I,j,K) * GV%Z_to_m*((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 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))*Slope) + Sfn_unlim_u(I,K) = -((KH_u(I,j,K)*G%dy_Cu(I,j))*GV%m_to_Z*Slope) ! Avoid moving dense water upslope from below the level of ! the bottom on the receiving side. @@ -725,11 +721,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 = ((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) * G%mask2dCu(I,j) + Slope = GV%Z_to_m*((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))*Slope) - hN2_u(I,K) = GV%g_prime(K)*GV%m_to_Z + Sfn_unlim_u(I,K) = ((KH_u(I,j,K)*G%dy_Cu(I,j))*GV%m_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 @@ -741,9 +737,9 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (CS%use_FGNV_streamfn) then do k=1,nz ; do I=is-1,ie ; if (G%mask2dCu(I,j)>0.) then - h_harm = H_to_m * max( h_neglect, & + 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 / 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. @@ -764,9 +760,9 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (uhtot(I,j) <= 0.0) then ! The transport that must balance the transport below is positive. - Sfn_safe = uhtot(I,j) * (1.0 - h_frac(i,j,k)) * H_to_m + Sfn_safe = uhtot(I,j) * (1.0 - h_frac(i,j,k)) * GV%H_to_Z else ! (uhtot(I,j) > 0.0) - Sfn_safe = uhtot(I,j) * (1.0 - h_frac(i+1,j,k)) * H_to_m + Sfn_safe = uhtot(I,j) * (1.0 - h_frac(i+1,j,k)) * GV%H_to_Z endif ! The actual streamfunction at each interface. @@ -777,7 +773,7 @@ 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 * m_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. @@ -819,7 +815,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! A second order centered estimate is used for the density transfered ! between water columns. - Work_u(I,j) = Work_u(I,j) + ( G_scale * H_to_m ) * & + Work_u(I,j) = Work_u(I,j) + G_scale * & ( uhtot(I,j) * drdkDe_u(I,K) - & (uhD(I,j,K) * drdi_u(I,K)) * 0.25 * & ((e(i,j,K) + e(i,j,K+1)) + (e(i+1,j,K) + e(i+1,j,K+1))) ) @@ -836,7 +832,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV !$OMP int_slope_v,KH_v,vhtot,h_frac,h_avail_rsum, & !$OMP vhD,h_avail,G_scale,Work_v,CS,slope_y,cg1, & !$OMP diag_sfn_y, diag_sfn_unlim_y,N2_floor, & -!$OMP present_slope_y,m_to_H,H_to_m,G_rho0) & +!$OMP present_slope_y,G_rho0) & !$OMP private(drdjA,drdjB,drdkL,drdkR,pres_v,T_v,S_v, & !$OMP drho_dT_v,drho_dS_v,hg2A,hg2B,hg2L,hg2R,haA, & !$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz, & @@ -890,7 +886,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV haL = 0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect haR = 0.5*(h(i,j+1,k-1) + h(i,j+1,k)) + h_neglect if (GV%Boussinesq) then - dzaL = haL * H_to_m ; dzaR = haR * H_to_m + dzaL = haL * GV%H_to_Z ; dzaR = haR * GV%H_to_Z else dzaL = 0.5*(e(i,j,K-1) - e(i,j,K+1)) + dz_neglect dzaR = 0.5*(e(i,j+1,K-1) - e(i,j+1,K+1)) + dz_neglect @@ -909,8 +905,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV haB = 0.5*(h(i,j,k) + h(i,j+1,k)) + h_neglect ! hN2_v is used with the FGNV streamfunction formulation - hN2_v(i,K) = (0.5 * H_to_m * ( hg2A / haA + hg2B / haB )) * & - max(drdz*G_rho0 , N2_floor) + hN2_v(i,K) = (0.5 * GV%H_to_Z * ( hg2A / haA + hg2B / haB )) * & + max(drdz*G_rho0, N2_floor) endif if (present_slope_y) then Slope = slope_y(i,J,k) @@ -925,7 +921,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 + drdz**2 + mag_grad2 = drdy**2 + (GV%m_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 @@ -939,13 +935,13 @@ 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) * ((e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J)) + int_slope_v(i,J,K) * GV%Z_to_m*((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 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))*Slope) + Sfn_unlim_v(i,K) = -((KH_v(i,J,K)*G%dx_Cv(i,J))*GV%m_to_Z*Slope) ! Avoid moving dense water upslope from below the level of ! the bottom on the receiving side. @@ -971,11 +967,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 = ((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) * G%mask2dCv(i,J) + Slope = GV%Z_to_m*((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))*Slope) - hN2_v(i,K) = GV%g_prime(K)*GV%m_to_Z + Sfn_unlim_v(i,K) = ((KH_v(i,J,K)*G%dx_Cv(i,J))*GV%m_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 @@ -987,9 +983,9 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (CS%use_FGNV_streamfn) then do k=1,nz ; do i=is,ie ; if (G%mask2dCv(i,J)>0.) then - h_harm = H_to_m * max( h_neglect, & + 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 / 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. @@ -1010,9 +1006,9 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (vhtot(i,J) <= 0.0) then ! The transport that must balance the transport below is positive. - Sfn_safe = vhtot(i,J) * (1.0 - h_frac(i,j,k)) * H_to_m + Sfn_safe = vhtot(i,J) * (1.0 - h_frac(i,j,k)) * GV%H_to_Z else ! (vhtot(I,j) > 0.0) - Sfn_safe = vhtot(i,J) * (1.0 - h_frac(i,j+1,k)) * H_to_m + Sfn_safe = vhtot(i,J) * (1.0 - h_frac(i,j+1,k)) * GV%H_to_Z endif ! The actual streamfunction at each interface. @@ -1023,7 +1019,7 @@ 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 * m_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. @@ -1065,7 +1061,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! A second order centered estimate is used for the density transfered ! between water columns. - Work_v(i,J) = Work_v(i,J) + ( G_scale * H_to_m ) * & + Work_v(i,J) = Work_v(i,J) + G_scale * & ( vhtot(i,J) * drdkDe_v(i,K) - & (vhD(i,J,K) * drdj_v(i,K)) * 0.25 * & ((e(i,j,K) + e(i,j,K+1)) + (e(i,j+1,K) + e(i,j+1,K+1))) ) @@ -1098,7 +1094,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV drdiB = drho_dT_u(I) * (T(i+1,j,1)-T(i,j,1)) + & drho_dS_u(I) * (S(i+1,j,1)-S(i,j,1)) endif - Work_u(I,j) = Work_u(I,j) + ( G_scale * H_to_m ) * & + Work_u(I,j) = Work_u(I,j) + G_scale * & ( (uhD(I,j,1) * drdiB) * 0.25 * & ((e(i,j,1) + e(i,j,2)) + (e(i+1,j,1) + e(i+1,j,2))) ) @@ -1123,7 +1119,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV drdjB = drho_dT_v(i) * (T(i,j+1,1)-T(i,j,1)) + & drho_dS_v(i) * (S(i,j+1,1)-S(i,j,1)) endif - Work_v(i,J) = Work_v(i,J) - ( G_scale * H_to_m ) * & + Work_v(i,J) = Work_v(i,J) - G_scale * & ( (vhD(i,J,1) * drdjB) * 0.25 * & ((e(i,j,1) + e(i,j,2)) + (e(i,j+1,1) + e(i,j+1,2))) ) enddo @@ -1154,7 +1150,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 (m3 s-1) + real, dimension(nk+1), intent(inout) :: sfn !< Streamfunction (Z m2 s-1 or arbitrary units) !! On entry, equals diffusivity times slope. !! On exit, equals the streamfunction. ! Local variables @@ -1188,7 +1184,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV type(ocean_grid_type), intent(in) :: 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) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface positions (m) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface positions (Z) real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kh_u !< Thickness diffusivity on interfaces !! at u points (m2/s) real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: Kh_v !< Thickness diffusivity on interfaces @@ -1248,7 +1244,8 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV real :: sl_Kp1 ! The sign-corrected slope of the interface below, ND. real :: I_sl_K ! The (limited) inverse of sl_K, ND. real :: I_sl_Kp1 ! The (limited) inverse of sl_Kp1, ND. - real :: I_4t ! A quarter of inverse of the damping timescale, in s-1. + real :: I_4t ! A quarter of a unit conversion factor divided by + ! the damping timescale, in 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, in m2 s-1. @@ -1344,7 +1341,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! Limit the diffusivities - I_4t = Kh_scale / (4.0*dt) + I_4t = GV%Z_to_m*Kh_scale / (4.0*dt) do n=1,2 if (n==1) then ; jsh = js ; ish = is-1 @@ -1387,7 +1384,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 ; if (dH < 0) sign = -1.0 + sign = 1.0*GV%Z_to_m ; if (dH < 0) sign = -1.0*GV%Z_to_m 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) @@ -1410,7 +1407,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,j+1,k) - h(i,j,k)) / denom adH = abs(dH) - sign = 1.0 ; if (dH < 0) sign = -1.0 + sign = 1.0*GV%Z_to_m ; if (dH < 0) sign = -1.0*GV%Z_to_m 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) @@ -1821,9 +1818,11 @@ subroutine thickness_diffuse_init(Time, G, GV, param_file, diag, CDp, CS) CS%id_sfn_y = register_diag_field('ocean_model', 'GM_sfn_y', diag%axesCvi, Time, & 'Parameterized Meridional Overturning Streamfunction', 'm3 s-1') 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') + 'Parameterized Zonal Overturning Streamfunction before limiting/smoothing', & + 'm3 s-1', conversion=GV%Z_to_m) 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') + 'Parameterized Meridional Overturning Streamfunction before limiting/smoothing', & + 'm3 s-1', conversion=GV%Z_to_m) end subroutine thickness_diffuse_init From d6dc15710af8e30445787aedbf1b98ceaa840ee7 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 10 Oct 2018 07:03:24 -0400 Subject: [PATCH 165/174] Recast calc_slope_functions to work in units of Z Recast the internal calculations in calc_slope_functions to use vertical height units of Z in place of m for dimensional consistency testing. Also eliminated an unused argument, e, from calc_Visbeck_coeffs. All answers are bitwise identical in the MOM6 test cases, including rescaling Z over a large range. --- .../lateral/MOM_lateral_mixing_coeffs.F90 | 39 +++++++------------ 1 file changed, 15 insertions(+), 24 deletions(-) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index eace701a6c..583fad8c75 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -397,7 +397,7 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, CS) if (CS%use_stored_slopes) then call calc_isoneutral_slopes(G, GV, h, e, tv, dt*CS%kappa_smooth, & CS%slope_x, CS%slope_y, N2_u, N2_v, 1) - call calc_Visbeck_coeffs(h, e, 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, 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) @@ -417,11 +417,10 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, CS) end subroutine calc_slope_functions !> Calculates factors used when setting diffusivity coefficients similar to Visbeck et al. -subroutine calc_Visbeck_coeffs(h, e, 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, 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 (m or kg/m2) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface position (m) 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 (1/s2) real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: slope_y !< Meridional isoneutral slope @@ -620,20 +619,11 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) h_neglect = GV%H_subroundoff H_cutoff = real(2*nz) * (GV%Angstrom_H + h_neglect) -!$OMP parallel default(none) shared(is,ie,js,je,CS,nz,e,G,GV,h,H_cutoff,h_neglect, & -!$OMP one_meter,SN_u_local,SN_v_local,calculate_slopes) & -!$OMP private(E_x,E_y,S2,Hdn,Hup,H_geom,N2) -!$OMP do - do j=js-1,je+1 ; do i=is-1,ie+1 - CS%SN_u(i,j) = 0.0 - CS%SN_v(i,j) = 0.0 - enddo ; enddo - ! 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 ! and midlatitude deformation radii, using calc_resoln_function as a template. -!$OMP do + !$OMP parallel do default(shared) private(E_x,E_y,S2,Hdn,Hup,H_geom,N2) do k=nz,CS%VarMix_Ktop,-1 if (calculate_slopes) then @@ -669,7 +659,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) N2 = GV%g_prime(k)*GV%m_to_Z**2 / (GV%H_to_Z * max(Hdn,Hup,one_meter)) if (min(h(i,j,k-1), h(i+1,j,k-1), h(i,j,k), h(i+1,j,k)) < H_cutoff) & S2 = 0.0 - SN_u_local(I,j,k) = (H_geom * GV%H_to_m) * S2 * N2 + SN_u_local(I,j,k) = (H_geom * GV%H_to_Z) * S2 * N2 enddo ; enddo do J=js-1,je ; do i=is,ie S2 = ( E_y(i,J)**2 + 0.25*( & @@ -680,44 +670,45 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) N2 = GV%g_prime(k)*GV%m_to_Z**2 / (GV%H_to_Z * max(Hdn,Hup,one_meter)) if (min(h(i,j,k-1), h(i,j+1,k-1), h(i,j,k), h(i,j+1,k)) < H_cutoff) & S2 = 0.0 - SN_v_local(i,J,k) = (H_geom * GV%H_to_m) * S2 * N2 + SN_v_local(i,J,k) = (H_geom * GV%H_to_Z) * S2 * N2 enddo ; enddo enddo ! k -!$OMP do - do j = js,je + !$OMP parallel do default(shared) + do j=js,je + do I=is-1,ie ; CS%SN_u(I,j) = 0.0 ; enddo do k=nz,CS%VarMix_Ktop,-1 ; do I=is-1,ie CS%SN_u(I,j) = CS%SN_u(I,j) + SN_u_local(I,j,k) enddo ; enddo ! SN above contains S^2*N^2*H, convert to vertical average of S*N do I=is-1,ie - !SN_u(I,j) = sqrt( SN_u(I,j) / (G%Zd_to_m*( max(G%bathyT(I,j), G%bathyT(I+1,j)) + GV%Angstrom_Z ) )) + !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) * sqrt( CS%SN_u(I,j) / & - (G%Zd_to_m*max(G%bathyT(I,j), G%bathyT(I+1,j))) ) + (max(G%bathyT(I,j), G%bathyT(I+1,j))) ) else CS%SN_u(I,j) = 0.0 endif enddo enddo -!$OMP do + !$OMP parallel do default(shared) do J=js-1,je - do k=nz,CS%VarMix_Ktop,-1 ; do I=is,ie + do i=is,ie ; CS%SN_v(i,J) = 0.0 ; enddo + do k=nz,CS%VarMix_Ktop,-1 ; do i=is,ie CS%SN_v(i,J) = CS%SN_v(i,J) + SN_v_local(i,J,k) enddo ; enddo do i=is,ie - !SN_v(i,J) = sqrt( SN_v(i,J) / (G%Zd_to_m*( max(G%bathyT(i,J), G%bathyT(i,J+1)) + GV%Angstrom_Z ) )) + !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) * sqrt( CS%SN_v(i,J) / & - (G%Zd_to_m*max(G%bathyT(i,J), G%bathyT(i,J+1))) ) + (max(G%bathyT(i,J), G%bathyT(i,J+1))) ) else CS%SN_v(I,j) = 0.0 endif enddo enddo -!$OMP end parallel end subroutine calc_slope_functions_using_just_e From 8738e296689c3704b2503087a2ad0be5ad6cf7a7 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 11 Oct 2018 08:44:28 -0400 Subject: [PATCH 166/174] +Recast calc_isoneutral_slope to work in units of Z Recast the calc_isoneutral_slope take interface heights (the argument e) in units of Z, and internally to use vertical height units of Z in place of m for dimensional consistency testing. Also recast calc_slope_functions_using_just_e to take interface heights in units of e. All answers are bitwise identical in the MOM6 test cases, including rescaling Z over a large range. --- src/core/MOM_isopycnal_slopes.F90 | 48 ++++++++++++------- .../lateral/MOM_lateral_mixing_coeffs.F90 | 9 ++-- 2 files changed, 37 insertions(+), 20 deletions(-) diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index 119eca7b56..3e305f37b7 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -18,11 +18,12 @@ module MOM_isopycnal_slopes !> Calculate isopycnal slopes, and optionally return N2 used in calculation. subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & - slope_x, slope_y, N2_u, N2_v, halo) + slope_x, slope_y, N2_u, N2_v, halo) !, eta_to_m) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface heights (m) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface heights (in Z or units + !! given by 1/eta_to_m) type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables real, intent(in) :: dt_kappa_smooth !< A vertical diffusive smoothing @@ -36,6 +37,9 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & optional, intent(inout) :: N2_v !< Brunt-Vaisala frequency squared at !! interfaces between u-points (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 + ! (This argument has been tested but for now serves no purpose.) !! of eta to m; GV%Z_to_m by default. ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: & T, & ! The temperature (or density) in C, with the values in @@ -63,12 +67,12 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & ! interface times the grid spacing, in kg m-3. real :: drdkL, drdkR ! Vertical density differences across an interface, ! in kg m-3. - real :: hg2A, hg2B, hg2L, hg2R - real :: haA, haB, haL, haR - real :: dzaL, dzaR - real :: wtA, wtB, wtL, wtR - real :: drdx, drdy, drdz ! Zonal, meridional, and vertical density gradients, - ! in units of kg m-4. + real :: hg2A, hg2B, hg2L, hg2R ! Squares of geometric mean thicknesses, in H2. + real :: haA, haB, haL, haR ! Arithmetic mean thicknesses in H. + real :: dzaL, dzaR ! Temporary thicknesses in eta units (Z?). + real :: wtA, wtB, wtL, wtR ! Unscaled weights, with various units. + real :: drdx, drdy ! Zonal and meridional density gradients, in kg m-4. + real :: drdz ! Vertical density gradient, in units of kg m-3 Z-1. 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, in kg2 m-8. @@ -77,10 +81,15 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & ! in roundoff and can be neglected, in H. real :: h_neglect2 ! h_neglect^2, in H2. real :: dz_neglect ! A thickness in m that is so small it is usually lost - ! in roundoff and can be neglected, in m. + ! in roundoff and can be neglected, in eta units (Z?). 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. + real :: L_to_Z ! A conversion factor between from units for lateral distances + ! to the units for e. + real :: H_to_Z ! A conversion factor from thickness units to the units of e. logical :: present_N2_u, present_N2_v integer :: is, ie, js, je, nz, IsdB @@ -94,13 +103,18 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & nz = G%ke ; IsdB = G%IsdB h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect**2 - dz_neglect = GV%H_subroundoff*GV%H_to_m + Z_to_L = GV%Z_to_m ; 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 + ! endif + L_to_Z = 1.0 / Z_to_L + dz_neglect = GV%H_subroundoff * H_to_Z use_EOS = associated(tv%eqn_of_state) present_N2_u = PRESENT(N2_u) present_N2_v = PRESENT(N2_v) - G_Rho0 = (GV%g_Earth*GV%m_to_Z) / GV%Rho0 + G_Rho0 = (GV%g_Earth*L_to_Z*GV%m_to_Z) / GV%Rho0 if (present_N2_u) then do j=js,je ; do I=is-1,ie N2_u(I,j,1) = 0. @@ -187,7 +201,7 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & haL = 0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect haR = 0.5*(h(i+1,j,k-1) + h(i+1,j,k)) + h_neglect if (GV%Boussinesq) then - dzaL = haL * GV%H_to_m ; dzaR = haR * GV%H_to_m + dzaL = haL * H_to_Z ; dzaR = haR * H_to_Z else dzaL = 0.5*(e(i,j,K-1) - e(i,j,K+1)) + dz_neglect dzaR = 0.5*(e(i+1,j,K-1) - e(i+1,j,K+1)) + dz_neglect @@ -207,7 +221,7 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. - mag_grad2 = drdx**2 + drdz**2 + mag_grad2 = drdx**2 + (L_to_Z*drdz)**2 if (mag_grad2 > 0.0) then slope_x(I,j,K) = drdx / sqrt(mag_grad2) else ! Just in case mag_grad2 = 0 ever. @@ -217,7 +231,7 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & if (present_N2_u) N2_u(I,j,k) = G_Rho0 * drdz * G%mask2dCu(I,j) ! Square of Brunt-Vaisala frequency (s-2) else ! With .not.use_EOS, the layers are constant density. - slope_x(I,j,K) = ((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) + slope_x(I,j,K) = (Z_to_L*(e(i,j,K)-e(i+1,j,K))) * G%IdxCu(I,j) endif enddo ! I @@ -271,7 +285,7 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & haL = 0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect haR = 0.5*(h(i,j+1,k-1) + h(i,j+1,k)) + h_neglect if (GV%Boussinesq) then - dzaL = haL * GV%H_to_m ; dzaR = haR * GV%H_to_m + dzaL = haL * H_to_Z ; dzaR = haR * H_to_Z else dzaL = 0.5*(e(i,j,K-1) - e(i,j,K+1)) + dz_neglect dzaR = 0.5*(e(i,j+1,K-1) - e(i,j+1,K+1)) + dz_neglect @@ -291,7 +305,7 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. - mag_grad2 = drdy**2 + drdz**2 + mag_grad2 = drdy**2 + (L_to_Z*drdz)**2 if (mag_grad2 > 0.0) then slope_y(i,J,K) = drdy / sqrt(mag_grad2) else ! Just in case mag_grad2 = 0 ever. @@ -301,7 +315,7 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & if (present_N2_v) N2_v(i,J,k) = G_Rho0 * drdz * G%mask2dCv(i,J) ! Square of Brunt-Vaisala frequency (s-2) else ! With .not.use_EOS, the layers are constant density. - slope_y(i,J,K) = ((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) + slope_y(i,J,K) = (Z_to_L*(e(i,j,K)-e(i,j+1,K))) * G%IdyCv(i,J) endif enddo ! i diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 583fad8c75..a851ccf1b6 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -393,7 +393,7 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, CS) "Module must be initialized before it is used.") if (CS%calculate_Eady_growth_rate) then - call find_eta(h, tv, G, GV, e, halo_size=2, eta_to_m=1.0) + call find_eta(h, tv, G, GV, e, halo_size=2) if (CS%use_stored_slopes) then call calc_isoneutral_slopes(G, GV, h, e, tv, dt*CS%kappa_smooth, & CS%slope_x, CS%slope_y, N2_u, N2_v, 1) @@ -599,6 +599,8 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) real :: N2 ! Brunt-Vaisala frequency (1/s) real :: Hup, Hdn ! Thickness from above, below (m or kg m-2) real :: H_geom ! The geometric mean of Hup*Hdn, in 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 of m or kg m-2. integer :: is, ie, js, je, nz integer :: i, j, k, kb_max @@ -618,6 +620,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) 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 = GV%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 @@ -629,12 +632,12 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) 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) = (e(i+1,j,K)-e(i,j,K))*G%IdxCu(I,j) + E_x(I,j) = 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) = (e(i,j+1,K)-e(i,j,K))*G%IdyCv(i,J) + E_y(i,J) = 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 From 1402a86876edb0299290dabb3a27780fd942daaa Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 11 Oct 2018 11:31:41 -0400 Subject: [PATCH 167/174] +Recast vert_fill_TS to work with units of Z Recast the vert_fill_TS take the diffusivity argument in units of Z2 s-1, and for the private version in calc_isoneutral_slopes eliminated the timescale argument (which had previously been hard-coded to 1.0). Rescaling the diffusivities vert_fill_TS required added in a new GV argument to VarMix_init. All answers are bitwise identical in the MOM6 test cases, including rescaling Z over a large range. --- src/core/MOM.F90 | 2 +- src/core/MOM_isopycnal_slopes.F90 | 16 ++++++++-------- .../lateral/MOM_lateral_mixing_coeffs.F90 | 5 +++-- .../lateral/MOM_thickness_diffuse.F90 | 10 +++++----- .../vertical/MOM_internal_tide_input.F90 | 4 ++-- .../vertical/MOM_set_diffusivity.F90 | 6 +++--- 6 files changed, 22 insertions(+), 21 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index eaacbc8493..aa89ddf117 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2289,7 +2289,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & CS%useMEKE = MEKE_init(Time, G, param_file, diag, CS%MEKE_CSp, CS%MEKE, restart_CSp) - call VarMix_init(Time, G, param_file, diag, CS%VarMix) + call VarMix_init(Time, G, GV, param_file, diag, CS%VarMix) call set_visc_init(Time, G, GV, param_file, diag, CS%visc, CS%set_visc_CSp, restart_CSp, CS%OBC) if (CS%split) then allocate(eta(SZI_(G),SZJ_(G))) ; eta(:,:) = 0.0 diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index 3e305f37b7..3698c32afe 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -26,8 +26,8 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & !! given by 1/eta_to_m) type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables - real, intent(in) :: dt_kappa_smooth !< A vertical diffusive smoothing - !! timescale, in s. + real, intent(in) :: dt_kappa_smooth !< A smoothing vertical diffusivity + !! times a smoothing timescale, in Z2. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: slope_x !< Isopycnal slope in i-direction (nondim) 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), & @@ -130,9 +130,9 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & if (use_EOS) then if (present(halo)) then - call vert_fill_TS(h, tv%T, tv%S, dt_kappa_smooth, 1.0, T, S, G, GV, halo+1) + call vert_fill_TS(h, tv%T, tv%S, dt_kappa_smooth, T, S, G, GV, halo+1) else - call vert_fill_TS(h, tv%T, tv%S, dt_kappa_smooth, 1.0, T, S, G, GV, 1) + call vert_fill_TS(h, tv%T, tv%S, dt_kappa_smooth, T, S, G, GV, 1) endif endif @@ -325,14 +325,14 @@ end subroutine calc_isoneutral_slopes !> Returns tracer arrays (nominally T and S) with massless layers filled with !! sensible values, by diffusing vertically with a small but constant diffusivity. -subroutine vert_fill_TS(h, T_in, S_in, kappa, dt, T_f, S_f, G, GV, halo_here) +subroutine vert_fill_TS(h, T_in, S_in, kappa_dt, T_f, S_f, G, GV, halo_here) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_in !< Temperature (deg C) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_in !< Salinity (psu) - real, intent(in) :: kappa !< A vertical diffusivity to use for smoothing (m2 s-1) - real, intent(in) :: dt !< The time increment, in s. + real, intent(in) :: kappa_dt !< A vertical diffusivity to use for smoothing + !! times a smoothing timescale, in Z2. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T_f !< Filled temperature (deg C) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S_f !< Filed salinity (psu) integer, optional, intent(in) :: halo_here !< Halo width over which to compute @@ -352,7 +352,7 @@ subroutine vert_fill_TS(h, T_in, S_in, kappa, dt, T_f, S_f, G, GV, halo_here) is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo nz = G%ke - kap_dt_x2 = (2.0*kappa*dt)*GV%m_to_H**2 + kap_dt_x2 = (2.0*kappa_dt)*GV%Z_to_H**2 h_neglect = GV%H_subroundoff if (kap_dt_x2 <= 0.0) then diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index a851ccf1b6..fb14e8f23b 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -716,9 +716,10 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) end subroutine calc_slope_functions_using_just_e !> Initializes the variables mixing coefficients container -subroutine VarMix_init(Time, G, param_file, diag, CS) +subroutine VarMix_init(Time, G, GV, param_file, diag, CS) 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 !< The ocean's vertical grid structure type(param_file_type), intent(in) :: param_file !< Parameter file handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(VarMix_CS), pointer :: CS !< Variable mixing coefficients @@ -835,7 +836,7 @@ subroutine VarMix_init(Time, G, param_file, diag, CS) call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_smooth, & "A diapycnal diffusivity that is used to interpolate \n"//& "more sensible values of T & S into thin layers.", & - default=1.0e-6) + default=1.0e-6, scale=GV%m_to_Z**2) !### Add units argument. endif if (CS%calculate_Eady_growth_rate) then diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index caad72b3a4..982b73698f 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -1601,10 +1601,10 @@ end subroutine add_detangling_Kh subroutine vert_fill_TS(h, T_in, S_in, kappa, dt, T_f, S_f, G, GV, halo_here) type(ocean_grid_type), intent(in) :: 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 (m or kg/m2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness in H (m or kg/m2) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_in !< Input temperature (C) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_in !< Input salinity (ppt) - real, intent(in) :: kappa !< Constant diffusivity to use (m2/s) + real, intent(in) :: kappa !< Constant diffusivity to use (Z2/s) real, intent(in) :: dt !< Time increment (s) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T_f !< Filled temperature (C) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S_f !< Filled salinity (ppt) @@ -1633,8 +1633,8 @@ subroutine vert_fill_TS(h, T_in, S_in, kappa, dt, T_f, S_f, G, GV, halo_here) is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo nz = G%ke h_neglect = GV%H_subroundoff - kap_dt_x2 = (2.0*kappa*dt)*GV%m_to_H**2 - h0 = 1.0e-16*sqrt(kappa*dt)*GV%m_to_H + kap_dt_x2 = (2.0*kappa*dt)*GV%Z_to_H**2 + h0 = 1.0e-16*sqrt(kappa*dt)*GV%Z_to_H if (kap_dt_x2 <= 0.0) then !$OMP parallel do default(none) shared(is,ie,js,je,nz,T_f,T_in,S_f,S_in) @@ -1742,7 +1742,7 @@ subroutine thickness_diffuse_init(Time, G, GV, param_file, diag, CDp, CS) call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_smooth, & "A diapycnal diffusivity that is used to interpolate \n"//& "more sensible values of T & S into thin layers.", & - default=1.0e-6) + default=1.0e-6, scale=GV%m_to_Z**2) call get_param(param_file, mdl, "KHTH_USE_FGNV_STREAMFUNCTION", CS%use_FGNV_streamfn, & "If true, use the streamfunction formulation of\n"// & "Ferrari et al., 2010, which effectively emphasizes\n"//& diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index b8e6abb4c4..e41cc8cb2b 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -88,8 +88,8 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, CS) if (.not.associated(CS)) call MOM_error(FATAL,"set_diffusivity: "//& "Module must be initialized before it is used.") - kappa_fill = 1.e-3 ! m2 s-1 - dt_fill = 7200. + kappa_fill = 1.e-3*GV%m_to_Z**2 !### Dimensional constant in m2 s-1. + dt_fill = 7200. !### Dimensionalconstant in s. use_EOS = associated(tv%eqn_of_state) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 3ca3d22fba..873a61d7b8 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -276,8 +276,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & "Module must be initialized before it is used.") I_Rho0 = 1.0/GV%Rho0 - kappa_fill = 1.e-3 ! m2 s-1 - dt_fill = 7200. + kappa_fill = 1.e-3*GV%m_to_Z**2 !### Dimensional constant in m2 s-1. + dt_fill = 7200. !### Dimensionalconstant in s. Omega2 = CS%Omega*CS%Omega use_EOS = associated(tv%eqn_of_state) @@ -346,7 +346,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call cpu_clock_begin(id_clock_kappaShear) if (CS%Vertex_shear) then call full_convection(G, GV, h, tv, T_adj, S_adj, fluxes%p_surf, & - kappa_fill*dt_fill, halo=1) + GV%Z_to_H**2*kappa_fill*dt_fill, halo=1) call calc_kappa_shear_vertex(u, v, h, T_adj, S_adj, tv, fluxes%p_surf, visc%Kd_shear, & visc%TKE_turb, visc%Kv_shear_Bu, dt, G, GV, CS%kappaShear_CSp) From 4bf6386e651175460804b9231bcebb3a3f479c0c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 11 Oct 2018 12:13:49 -0400 Subject: [PATCH 168/174] Fixed rescaling of eta_av unsplit stepping code Corrected the dimensional rescaling of eta_av in step_MOM_dyn_unsplit and step_MOM_dyn_unsplit_RK2 to go to H. This only occurs with Boussinesq code, and the answers do not change if H_to_m is 1, as is often the case, and only diagnostics are impacted in ocean only cases. This code appears not to be adequately tested with the MOM6_examples test suite, which was bitwise identical with this change. --- src/core/MOM_dynamics_unsplit.F90 | 4 ++-- src/core/MOM_dynamics_unsplit_RK2.F90 | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 96d78fccde..430443de06 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -209,7 +209,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< The accumulated meridional volume or mass !! transport since the last tracer advection, in m3 or kg. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< The time-mean free surface height or - !! column mass, in m or kg m-2. + !! column mass, in H (m or kg m-2). type(MOM_dyn_unsplit_CS), pointer :: CS !< The control structure set up by !! initialize_dyn_unsplit. type(VarMix_CS), pointer :: VarMix !< A pointer to a structure with fields @@ -491,7 +491,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & endif if (GV%Boussinesq) then - do j=js,je ; do i=is,ie ; eta_av(i,j) = -G%Zd_to_m*G%bathyT(i,j) ; enddo ; enddo + do j=js,je ; do i=is,ie ; eta_av(i,j) = -GV%Z_to_H*G%bathyT(i,j) ; enddo ; enddo else do j=js,je ; do i=is,ie ; eta_av(i,j) = 0.0 ; enddo ; enddo endif diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index aef20292f8..3a5db102f2 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -221,7 +221,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, !! or mass transport since the last !! tracer advection, in m3 or kg. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< The time-mean free surface height - !! or column mass, in m or kg m-2. + !! or column mass, in H (m or kg m-2). type(MOM_dyn_unsplit_RK2_CS), pointer :: CS !< The control structure set up by !! initialize_dyn_unsplit_RK2. type(VarMix_CS), pointer :: VarMix !< A pointer to a structure with @@ -431,7 +431,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, endif if (GV%Boussinesq) then - do j=js,je ; do i=is,ie ; eta_av(i,j) = -G%Zd_to_m*G%bathyT(i,j) ; enddo ; enddo + do j=js,je ; do i=is,ie ; eta_av(i,j) = -GV%Z_to_H*G%bathyT(i,j) ; enddo ; enddo else do j=js,je ; do i=is,ie ; eta_av(i,j) = 0.0 ; enddo ; enddo endif From a2ab18d7e51984b6fd4fe572a77f2b4bba7387ec Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 13 Oct 2018 14:49:49 -0400 Subject: [PATCH 169/174] Recast MOM_wave_speed to work in units of Z Recast the internal calculations in MOM_wave_speed to use vertical height units of Z in place of m for dimensional consistency testing. Several probable bugs were highlighted in comments but not corrected. All answers are bitwise identical in the MOM6 test cases, including rescaling Z over a large range. --- src/diagnostics/MOM_wave_speed.F90 | 151 ++++++++++++----------------- 1 file changed, 62 insertions(+), 89 deletions(-) diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index ea2212a4ab..e8d58e502b 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -29,7 +29,7 @@ module MOM_wave_speed !! wave speed. This parameter controls the default behavior of !! wave_speed() which can be overridden by optional arguments. real :: mono_N2_depth = -1. !< The depth below which N2 is limited as monotonic for the purposes of - !! calculating the equivalent barotropic wave speed. (m) + !! calculating the equivalent barotropic wave speed. (Z) !! This parameter controls the default behavior of wave_speed() which !! can be overridden by optional arguments. type(remapping_CS) :: remapping_CS !< Used for vertical remapping when calculating equivalent barotropic @@ -58,7 +58,7 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & !! for the purposes of calculating vertical modal structure. real, optional, intent(in) :: mono_N2_depth !< A depth below which N2 is limited as !! monotonic for the purposes of calculating vertical - !! modal structure. + !! modal structure, in m. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: modal_structure !< Normalized model structure (non-dim) @@ -66,7 +66,7 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & real, dimension(SZK_(G)+1) :: & dRho_dT, dRho_dS, & pres, T_int, S_int, & - gprime ! The reduced gravity across each interface, in m s-2. + gprime ! The reduced gravity across each interface, in m2 Z-1 s-2. real, dimension(SZK_(G)) :: & Igl, Igu ! The inverse of the reduced gravity across an interface times ! the thickness of the layer below (Igl) or above (Igu) it, @@ -78,13 +78,13 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & real det, ddet, detKm1, detKm2, ddetKm1, ddetKm2 real :: lam, dlam, lam0 real :: min_h_frac - real :: H_to_pres - real :: H_to_m ! Local copy of a unit conversion factor. + real :: H_to_pres ! A conversion factor from thickesses (in Z) to pressure (in Pa) real, dimension(SZI_(G)) :: & htot, hmin, & ! Thicknesses in m. H_here, HxT_here, HxS_here, HxR_here real :: speed2_tot real :: I_Hnew, drxh_sum + real :: L2_to_Z2 ! A scaling factor squared from units of lateral distances to depths, in Z2 m-2. real, parameter :: tol1 = 0.0001, tol2 = 0.001 real, pointer, dimension(:,:,:) :: T => NULL(), S => NULL() real :: g_Rho0 ! G_Earth/Rho0 in m4 s-2 kg-1. @@ -109,12 +109,14 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & is = G%isd ; ie = G%ied ; js = G%jsd ; je = G%jed endif ; endif + L2_to_Z2 = GV%m_to_Z**2 + l_use_ebt_mode = CS%use_ebt_mode if (present(use_ebt_mode)) l_use_ebt_mode = use_ebt_mode l_mono_N2_column_fraction = CS%mono_N2_column_fraction if (present(mono_N2_column_fraction)) l_mono_N2_column_fraction = mono_N2_column_fraction - l_mono_N2_depth = CS%mono_N2_depth - if (present(mono_N2_depth)) l_mono_N2_depth = mono_N2_depth + l_mono_N2_depth = GV%m_to_Z*CS%mono_N2_depth + if (present(mono_N2_depth)) l_mono_N2_depth = GV%m_to_Z*mono_N2_depth calc_modal_structure = l_use_ebt_mode if (present(modal_structure)) calc_modal_structure = .true. if (calc_modal_structure) then @@ -124,18 +126,17 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & endif S => tv%S ; T => tv%T - g_Rho0 = (GV%g_Earth*GV%m_to_Z)/GV%Rho0 + g_Rho0 = GV%g_Earth / GV%Rho0 use_EOS = associated(tv%eqn_of_state) - H_to_pres = (GV%g_Earth*GV%m_to_Z) * GV%Rho0 - H_to_m = GV%H_to_m + H_to_pres = GV%g_Earth * GV%Rho0 rescale = 1024.0**4 ; I_rescale = 1.0/rescale min_h_frac = tol1 / real(nz) !$OMP parallel do default(none) shared(is,ie,js,je,nz,h,G,GV,min_h_frac,use_EOS,T,S,tv,& !$OMP calc_modal_structure,l_use_ebt_mode,modal_structure, & !$OMP l_mono_N2_column_fraction,l_mono_N2_depth,CS, & -!$OMP H_to_pres,H_to_m,cg1,g_Rho0,rescale,I_rescale) & +!$OMP H_to_pres,cg1,g_Rho0,rescale,I_rescale,L2_to_Z2) & !$OMP private(htot,hmin,kf,H_here,HxT_here,HxS_here,HxR_here, & !$OMP Hf,Tf,Sf,Rf,pres,T_int,S_int,drho_dT, & !$OMP drho_dS,drxh_sum,kc,Hc,Tc,Sc,I_Hnew,gprime, & @@ -148,7 +149,7 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & ! at the top). This also transposes the row order so that columns can ! be worked upon one at a time. do i=is,ie ; htot(i) = 0.0 ; enddo - do k=1,nz ; do i=is,ie ; htot(i) = htot(i) + h(i,j,k)*H_to_m ; enddo ; enddo + do k=1,nz ; do i=is,ie ; htot(i) = htot(i) + h(i,j,k)*GV%H_to_Z ; enddo ; enddo do i=is,ie hmin(i) = htot(i)*min_h_frac ; kf(i) = 1 ; H_here(i) = 0.0 @@ -156,20 +157,20 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & enddo if (use_EOS) then do k=1,nz ; do i=is,ie - if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*H_to_m > hmin(i))) then + if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*GV%H_to_Z > hmin(i))) then Hf(kf(i),i) = H_here(i) Tf(kf(i),i) = HxT_here(i) / H_here(i) Sf(kf(i),i) = HxS_here(i) / H_here(i) kf(i) = kf(i) + 1 ! Start a new layer - H_here(i) = h(i,j,k)*H_to_m - HxT_here(i) = (h(i,j,k)*H_to_m)*T(i,j,k) - HxS_here(i) = (h(i,j,k)*H_to_m)*S(i,j,k) + H_here(i) = h(i,j,k)*GV%H_to_Z + HxT_here(i) = (h(i,j,k)*GV%H_to_Z)*T(i,j,k) + HxS_here(i) = (h(i,j,k)*GV%H_to_Z)*S(i,j,k) else - H_here(i) = H_here(i) + h(i,j,k)*H_to_m - HxT_here(i) = HxT_here(i) + (h(i,j,k)*H_to_m)*T(i,j,k) - HxS_here(i) = HxS_here(i) + (h(i,j,k)*H_to_m)*S(i,j,k) + H_here(i) = H_here(i) + h(i,j,k)*GV%H_to_Z + HxT_here(i) = HxT_here(i) + (h(i,j,k)*GV%H_to_Z)*T(i,j,k) + HxS_here(i) = HxS_here(i) + (h(i,j,k)*GV%H_to_Z)*S(i,j,k) endif enddo ; enddo do i=is,ie ; if (H_here(i) > 0.0) then @@ -179,16 +180,16 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & endif ; enddo else do k=1,nz ; do i=is,ie - if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*H_to_m > hmin(i))) then + if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*GV%H_to_Z > hmin(i))) then Hf(kf(i),i) = H_here(i) ; Rf(kf(i),i) = HxR_here(i) / H_here(i) kf(i) = kf(i) + 1 ! Start a new layer - H_here(i) = h(i,j,k)*H_to_m - HxR_here(i) = (h(i,j,k)*H_to_m)*GV%Rlay(k) + H_here(i) = h(i,j,k)*GV%H_to_Z + HxR_here(i) = (h(i,j,k)*GV%H_to_Z)*GV%Rlay(k) else - H_here(i) = H_here(i) + h(i,j,k)*H_to_m - HxR_here(i) = HxR_here(i) + (h(i,j,k)*H_to_m)*GV%Rlay(k) + H_here(i) = H_here(i) + h(i,j,k)*GV%H_to_Z + HxR_here(i) = HxR_here(i) + (h(i,j,k)*GV%H_to_Z)*GV%Rlay(k) endif enddo ; enddo do i=is,ie ; if (H_here(i) > 0.0) then @@ -312,27 +313,29 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & speed2_tot = 0.0 if (l_use_ebt_mode) then Igu(1) = 0. ! Neumann condition for pressure modes - sum_hc = Hc(1)*GV%H_to_m - N2min = gprime(2)/Hc(1) + sum_hc = Hc(1)*GV%H_to_m !### I believe this conversion factor to be wrong. -RWH + N2min = L2_to_Z2*gprime(2)/Hc(1) do k=2,kc hw = 0.5*(Hc(k-1)+Hc(k)) gp = gprime(K) if (l_mono_N2_column_fraction>0. .or. l_mono_N2_depth>=0.) then - if (G%Zd_to_m*G%bathyT(i,j)-sum_hc < l_mono_N2_column_fraction*G%Zd_to_m*G%bathyT(i,j) .and. & - gp>N2min*hw) then + if (G%bathyT(i,j)-sum_hc < l_mono_N2_column_fraction*G%bathyT(i,j) .and. & + L2_to_Z2*gp > N2min*hw) then ! Filters out regions where N2 increases with depth but only in a lower fraction of water column - gp = N2min/hw - elseif (l_mono_N2_depth>=0. .and. sum_hc>l_mono_N2_depth .and. gp>N2min*hw) then + gp = N2min/hw !### THIS IS DIMENSIONALLY INCONSISTENT! -RWH + !### This should be gp = GV%Z_to_m**2* (N2min*hw) + elseif (l_mono_N2_depth>=0. .and. sum_hc>l_mono_N2_depth .and. L2_to_Z2*gp>N2min*hw) then ! Filters out regions where N2 increases with depth but only below a certain depth - gp = N2min/hw + gp = N2min/hw !### THIS IS DIMENSIONALLY INCONSISTENT! -RWH + !### This should be gp = GV%Z_to_m**2* (N2min*hw) else - N2min = gp/hw + N2min = L2_to_Z2 * gp/hw endif endif Igu(k) = 1.0/(gp*Hc(k)) Igl(k-1) = 1.0/(gp*Hc(k-1)) speed2_tot = speed2_tot + gprime(k)*(Hc(k-1)+Hc(k))*0.707 - sum_hc = sum_hc + Hc(k)*GV%H_to_m + sum_hc = sum_hc + Hc(k)*GV%H_to_m !### I believe this conversion factor to be wrong. -RWH enddo !Igl(kc) = 0. ! Neumann condition for pressure modes Igl(kc) = 2.*Igu(kc) ! Dirichlet condition for pressure modes @@ -449,9 +452,9 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & mode_struct(1:kc)=0. endif ! Note that remapping_core_h requires that the same units be used - ! for both the source and target grid thicknesses. - call remapping_core_h(CS%remapping_CS, kc, Hc, mode_struct, & - nz, GV%H_to_m*h(i,j,:), modal_structure(i,j,:)) + ! for both the source and target grid thicknesses, here in H. + call remapping_core_h(CS%remapping_CS, kc, GV%Z_to_H*Hc(:), mode_struct, & + nz, h(i,j,:), modal_structure(i,j,:), 1.0e-30*GV%m_to_H, 1.0e-10*GV%m_to_H) endif else cg1(i,j) = 0.0 @@ -506,7 +509,7 @@ subroutine tdma6(n, a, b, c, lam, y) do k = n-1, 1, -1 y(k) = ( yy(k) - c(k) * y(k+1) ) * beta(k) enddo -end subroutine +end subroutine tdma6 !> Calculates the wave speeds for the first few barolinic modes. subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) @@ -556,7 +559,7 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) integer :: numint ! number of widows (intervals) in root searching range integer :: nrootsfound ! number of extra roots found (not including 1st root) real :: min_h_frac - real :: H_to_pres + real :: H_to_pres ! A conversion factor from thickesses (in Z) to pressure (in Pa) real :: H_to_m ! Local copy of a unit conversion factor. real, dimension(SZI_(G)) :: & htot, hmin, & ! Thicknesses in m. @@ -596,10 +599,10 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) endif ; endif S => tv%S ; T => tv%T - g_Rho0 = (GV%g_Earth*GV%m_to_Z)/GV%Rho0 + g_Rho0 = GV%g_Earth / GV%Rho0 use_EOS = associated(tv%eqn_of_state) - H_to_pres = (GV%g_Earth*GV%m_to_Z) * GV%Rho0 + H_to_pres = GV%g_Earth * GV%Rho0 H_to_m = GV%H_to_m min_h_frac = tol1 / real(nz) @@ -620,7 +623,7 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) ! at the top). This also transposes the row order so that columns can ! be worked upon one at a time. do i=is,ie ; htot(i) = 0.0 ; enddo - do k=1,nz ; do i=is,ie ; htot(i) = htot(i) + h(i,j,k)*H_to_m ; enddo ; enddo + do k=1,nz ; do i=is,ie ; htot(i) = htot(i) + h(i,j,k)*GV%H_to_Z ; enddo ; enddo do i=is,ie hmin(i) = htot(i)*min_h_frac ; kf(i) = 1 ; H_here(i) = 0.0 @@ -628,20 +631,20 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) enddo if (use_EOS) then do k=1,nz ; do i=is,ie - if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*H_to_m > hmin(i))) then + if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*GV%H_to_Z > hmin(i))) then Hf(kf(i),i) = H_here(i) Tf(kf(i),i) = HxT_here(i) / H_here(i) Sf(kf(i),i) = HxS_here(i) / H_here(i) kf(i) = kf(i) + 1 ! Start a new layer - H_here(i) = h(i,j,k)*H_to_m - HxT_here(i) = (h(i,j,k)*H_to_m)*T(i,j,k) - HxS_here(i) = (h(i,j,k)*H_to_m)*S(i,j,k) + H_here(i) = h(i,j,k)*GV%H_to_Z + HxT_here(i) = (h(i,j,k)*GV%H_to_Z)*T(i,j,k) + HxS_here(i) = (h(i,j,k)*GV%H_to_Z)*S(i,j,k) else - H_here(i) = H_here(i) + h(i,j,k)*H_to_m - HxT_here(i) = HxT_here(i) + (h(i,j,k)*H_to_m)*T(i,j,k) - HxS_here(i) = HxS_here(i) + (h(i,j,k)*H_to_m)*S(i,j,k) + H_here(i) = H_here(i) + h(i,j,k)*GV%H_to_Z + HxT_here(i) = HxT_here(i) + (h(i,j,k)*GV%H_to_Z)*T(i,j,k) + HxS_here(i) = HxS_here(i) + (h(i,j,k)*GV%H_to_Z)*S(i,j,k) endif enddo ; enddo do i=is,ie ; if (H_here(i) > 0.0) then @@ -651,16 +654,16 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) endif ; enddo else do k=1,nz ; do i=is,ie - if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*H_to_m > hmin(i))) then + if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*GV%H_to_Z > hmin(i))) then Hf(kf(i),i) = H_here(i) ; Rf(kf(i),i) = HxR_here(i) / H_here(i) kf(i) = kf(i) + 1 ! Start a new layer - H_here(i) = h(i,j,k)*H_to_m - HxR_here(i) = (h(i,j,k)*H_to_m)*GV%Rlay(k) + H_here(i) = h(i,j,k)*GV%H_to_Z + HxR_here(i) = (h(i,j,k)*GV%H_to_Z)*GV%Rlay(k) else - H_here(i) = H_here(i) + h(i,j,k)*H_to_m - HxR_here(i) = HxR_here(i) + (h(i,j,k)*H_to_m)*GV%Rlay(k) + H_here(i) = H_here(i) + h(i,j,k)*GV%H_to_Z + HxR_here(i) = HxR_here(i) + (h(i,j,k)*GV%H_to_Z)*GV%Rlay(k) endif enddo ; enddo do i=is,ie ; if (H_here(i) > 0.0) then @@ -787,7 +790,7 @@ subroutine wave_speeds(h, tv, G, GV, 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) = gprime(K)/(0.5*(Hc(k)+Hc(k-1))) + N2(K) = GV%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) @@ -795,11 +798,8 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) ! Calcualte 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-10) then - call MOM_error(WARNING, "wave_structure: mismatch in total depths") - print *, "kc=", kc - print *, "z_int(kc+1)=", z_int(kc+1) - print *, "htot(i)=", htot(i) + if (abs(z_int(kc+1)-htot(i)) > 1.e-12*htot(i)) then + call MOM_error(FATAL, "wave_structure: mismatch in total depths") endif ! Define the diagonals of the tridiagonal matrix @@ -955,19 +955,6 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) call MOM_error(WARNING, "wave_speed: root not found "// & " after sub_it_max subdivisions of original"// & " interval.") - !if (ig == 144 .and. jg == 5) then - !print *, "xbl=",xbl - !print *, "xbr=",xbr - !print *, "Wave_speed: kc=",kc - !print *, 'Wave_speed: z_int(ig,jg)=', z_int(1:kc+1) - !print *, 'Wave_speed: N2(ig,jg)=', N2(1:kc+1) - !print *, 'Wave_speed: gprime=', gprime(1:kc+1) - !print *, 'Wave_speed: htot=', htot(i) - !print *, 'Wave_speed: cn1=', cn(i,j,1) - !print *, 'Wave_speed: numint=', numint - !print *, 'Wave_speed: nrootsfound=', nrootsfound - !stop - !endif endif ! sub_it == sub_it_max enddo ! sub_it-loop------------------------------------------------- endif ! det_l*ddet_l < 0.0 @@ -980,20 +967,6 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) ! oops, lamMax not large enough - could add code to increase (BDM) ! set unfound modes to zero for now (BDM) cn(i,j,nrootsfound+2:nmodes) = 0.0 - !if (ig == 83 .and. jg == 2) then - ! call MOM_error(WARNING, "wave_speed: not all modes found "// & - ! " within search range: increase numint.") - ! print *, "Increase lamMax at ig=",ig," jg=",jg - ! print *, "where lamMax=", lamMax - ! print *, 'numint=', numint - ! print *, "nrootsfound=", nrootsfound - ! print *, "xbl=",xbl - ! print *, "xbr=",xbr - !print *, "kc=",kc - !print *, 'z_int(ig,jg)=', z_int(1:kc+1) - !print *, 'N2(ig,jg)=', N2(1:kc+1) - !stop - !endif else ! else shift interval and keep looking until nmodes or numint is reached det_l = det_r @@ -1133,9 +1106,9 @@ subroutine wave_speed_set_param(CS, use_ebt_mode, mono_N2_column_fraction, mono_ if (.not.associated(CS)) call MOM_error(FATAL, & "wave_speed_set_param called with an associated control structure.") - if (present(use_ebt_mode)) CS%use_ebt_mode=use_ebt_mode - if (present(mono_N2_column_fraction)) CS%mono_N2_column_fraction=mono_N2_column_fraction - if (present(mono_N2_depth)) CS%mono_N2_depth=mono_N2_depth + if (present(use_ebt_mode)) CS%use_ebt_mode = use_ebt_mode + if (present(mono_N2_column_fraction)) CS%mono_N2_column_fraction = mono_N2_column_fraction + if (present(mono_N2_depth)) CS%mono_N2_depth = mono_N2_depth end subroutine wave_speed_set_param From b806a3416ae6e9662f902a075cba5c6c8271a05d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 13 Oct 2018 15:44:55 -0400 Subject: [PATCH 170/174] Recast MOM_structure to work in units of Z Recast the internal calculations in MOM_structure to use vertical height units of Z in place of m for dimensional consistency testing. At one point the code goes into a complicated iterative tridiagonal solver, and this part of the algorithm reverts to working in m (for now). All answers are bitwise identical in the MOM6 test cases, including rescaling Z over a large range. --- src/diagnostics/MOM_wave_structure.F90 | 148 ++++++++++--------------- 1 file changed, 60 insertions(+), 88 deletions(-) diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index 45e71e70ba..735690eb81 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -44,7 +44,7 @@ module MOM_wave_structure real, allocatable, dimension(:,:,:) :: z_depths !< Depths of layer interfaces, in m. real, allocatable, dimension(:,:,:) :: N2 - !< Squared buoyancy frequency at each interface + !< Squared buoyancy frequency at each interface, in S-2. integer, allocatable, dimension(:,:):: num_intfaces !< Number of layer interfaces (including surface and bottom) real :: int_tide_source_x !< X Location of generation site @@ -108,7 +108,7 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) real, dimension(SZK_(G)+1) :: & dRho_dT, dRho_dS, & pres, T_int, S_int, & - gprime ! The reduced gravity across each interface, in m s-2. + gprime ! The reduced gravity across each interface, in m2 Z-1 s-2. real, dimension(SZK_(G)) :: & Igl, Igu ! The inverse of the reduced gravity across an interface times ! the thickness of the layer below (Igl) or above (Igu) it, @@ -123,15 +123,14 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) real :: lam real :: min_h_frac real :: H_to_pres - real :: H_to_m ! Local copy of a unit conversion factor. real, dimension(SZI_(G)) :: & - hmin, & ! Thicknesses in m. + hmin, & ! Thicknesses in Z. H_here, HxT_here, HxS_here, HxR_here real :: speed2_tot 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 m4 s-2 kg-1. + real :: g_Rho0 ! G_Earth/Rho0 in m5 Z-1 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 @@ -152,6 +151,7 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) real :: w2avg ! average of squared vertical velocity structure funtion real :: int_dwdz2, int_w2, int_N2w2, KE_term, PE_term, W0 ! terms in vertically averaged energy equation + real :: gp_unscaled ! A version of gprime rescaled to units of m s-2. real, dimension(SZK_(G)-1) :: lam_z ! product of eigen value and gprime(k); one value for each ! interface (excluding surface and bottom) real, dimension(SZK_(G)-1) :: a_diag, b_diag, c_diag @@ -178,11 +178,10 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) Pi = (4.0*atan(1.0)) S => tv%S ; T => tv%T - g_Rho0 = (GV%g_Earth*GV%m_to_Z)/GV%Rho0 + g_Rho0 = GV%g_Earth /GV%Rho0 use_EOS = associated(tv%eqn_of_state) - H_to_pres = (GV%g_Earth*GV%m_to_Z) * GV%Rho0 - H_to_m = GV%H_to_m + H_to_pres = GV%g_Earth * GV%Rho0 rescale = 1024.0**4 ; I_rescale = 1.0/rescale min_h_frac = tol1 / real(nz) @@ -192,7 +191,7 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) ! at the top). This also transposes the row order so that columns can ! be worked upon one at a time. do i=is,ie ; htot(i,j) = 0.0 ; enddo - do k=1,nz ; do i=is,ie ; htot(i,j) = htot(i,j) + h(i,j,k)*H_to_m ; enddo ; enddo + do k=1,nz ; do i=is,ie ; htot(i,j) = htot(i,j) + h(i,j,k)*GV%H_to_Z ; enddo ; enddo do i=is,ie hmin(i) = htot(i,j)*min_h_frac ; kf(i) = 1 ; H_here(i) = 0.0 @@ -200,20 +199,20 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) enddo if (use_EOS) then do k=1,nz ; do i=is,ie - if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*H_to_m > hmin(i))) then + if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*GV%H_to_Z > hmin(i))) then Hf(kf(i),i) = H_here(i) Tf(kf(i),i) = HxT_here(i) / H_here(i) Sf(kf(i),i) = HxS_here(i) / H_here(i) kf(i) = kf(i) + 1 ! Start a new layer - H_here(i) = h(i,j,k)*H_to_m - HxT_here(i) = (h(i,j,k)*H_to_m)*T(i,j,k) - HxS_here(i) = (h(i,j,k)*H_to_m)*S(i,j,k) + H_here(i) = h(i,j,k)*GV%H_to_Z + HxT_here(i) = (h(i,j,k)*GV%H_to_Z)*T(i,j,k) + HxS_here(i) = (h(i,j,k)*GV%H_to_Z)*S(i,j,k) else - H_here(i) = H_here(i) + h(i,j,k)*H_to_m - HxT_here(i) = HxT_here(i) + (h(i,j,k)*H_to_m)*T(i,j,k) - HxS_here(i) = HxS_here(i) + (h(i,j,k)*H_to_m)*S(i,j,k) + H_here(i) = H_here(i) + h(i,j,k)*GV%H_to_Z + HxT_here(i) = HxT_here(i) + (h(i,j,k)*GV%H_to_Z)*T(i,j,k) + HxS_here(i) = HxS_here(i) + (h(i,j,k)*GV%H_to_Z)*S(i,j,k) endif enddo ; enddo do i=is,ie ; if (H_here(i) > 0.0) then @@ -223,16 +222,16 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) endif ; enddo else do k=1,nz ; do i=is,ie - if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*H_to_m > hmin(i))) then + if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*GV%H_to_Z > hmin(i))) then Hf(kf(i),i) = H_here(i) ; Rf(kf(i),i) = HxR_here(i) / H_here(i) kf(i) = kf(i) + 1 ! Start a new layer - H_here(i) = h(i,j,k)*H_to_m - HxR_here(i) = (h(i,j,k)*H_to_m)*GV%Rlay(k) + H_here(i) = h(i,j,k)*GV%H_to_Z + HxR_here(i) = (h(i,j,k)*GV%H_to_Z)*GV%Rlay(k) else - H_here(i) = H_here(i) + h(i,j,k)*H_to_m - HxR_here(i) = HxR_here(i) + (h(i,j,k)*H_to_m)*GV%Rlay(k) + H_here(i) = H_here(i) + h(i,j,k)*GV%H_to_Z + HxR_here(i) = HxR_here(i) + (h(i,j,k)*GV%H_to_Z)*GV%Rlay(k) endif enddo ; enddo do i=is,ie ; if (H_here(i) > 0.0) then @@ -368,20 +367,20 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, 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) = gprime(K)/(0.5*(Hc(k)+Hc(k-1))) + N2(K) = GV%m_to_Z**2*gprime(K)/(0.5*(Hc(k)+Hc(k-1))) 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 z_int(kc+1) = z_int(kc)+Hc(kc) ! check that thicknesses sum to total depth - if (abs(z_int(kc+1)-htot(i,j)) > 1.e-10) then - call MOM_error(WARNING, "wave_structure: mismatch in total depths") - print *, "kc=", kc - print *, "z_int(kc+1)=", z_int(kc+1) - print *, "htot(i,j)=", htot(i,j) + if (abs(z_int(kc+1)-htot(i,j)) > 1.e-14*htot(i,j)) then + call MOM_error(FATAL, "wave_structure: mismatch in total depths") endif + ! Note that many of the calcluation from here on revert to using vertical + ! distances in m, not Z. + ! Populate interior rows of tridiagonal matrix; must multiply through by ! gprime to get tridiagonal matrix to the symmetrical form: ! [-1/H(k-1)]e(k-1) + [1/H(k-1)+1/H(k)-lam_z]e(k) + [-1/H(k)]e(k+1) = 0, @@ -389,30 +388,33 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) ! Frist, populate interior rows do K=3,kc-1 row = K-1 ! indexing for TD matrix rows - lam_z(row) = lam*gprime(K) - a_diag(row) = gprime(K)*(-Igu(K)) - b_diag(row) = gprime(K)*(Igu(K)+Igl(K)) - lam_z(row) - c_diag(row) = gprime(K)*(-Igl(K)) + gp_unscaled = GV%m_to_Z*gprime(K) + lam_z(row) = lam*gp_unscaled + a_diag(row) = gp_unscaled*(-Igu(K)) + b_diag(row) = gp_unscaled*(Igu(K)+Igl(K)) - lam_z(row) + c_diag(row) = gp_unscaled*(-Igl(K)) if (isnan(lam_z(row)))then ; print *, "Wave_structure: lam_z(row) is NAN" ; endif if (isnan(a_diag(row)))then ; print *, "Wave_structure: a(k) is NAN" ; endif if (isnan(b_diag(row)))then ; print *, "Wave_structure: b(k) is NAN" ; endif if (isnan(c_diag(row)))then ; print *, "Wave_structure: c(k) is NAN" ; endif enddo ! Populate top row of tridiagonal matrix - K=2 ; row = K-1 - lam_z(row) = lam*gprime(K) + K=2 ; row = K-1 ; + gp_unscaled = GV%m_to_Z*gprime(K) + lam_z(row) = lam*gp_unscaled a_diag(row) = 0.0 - b_diag(row) = gprime(K)*(Igu(K)+Igl(K)) - lam_z(row) - c_diag(row) = gprime(K)*(-Igl(K)) + b_diag(row) = gp_unscaled*(Igu(K)+Igl(K)) - lam_z(row) + c_diag(row) = gp_unscaled*(-Igl(K)) ! Populate bottom row of tridiagonal matrix K=kc ; row = K-1 - lam_z(row) = lam*gprime(K) - a_diag(row) = gprime(K)*(-Igu(K)) - b_diag(row) = gprime(K)*(Igu(K)+Igl(K)) - lam_z(row) + gp_unscaled = GV%m_to_Z*gprime(K) + lam_z(row) = lam*gp_unscaled + a_diag(row) = gp_unscaled*(-Igu(K)) + b_diag(row) = gp_unscaled*(Igu(K)+Igl(K)) - lam_z(row) c_diag(row) = 0.0 ! Guess a vector shape to start with (excludes surface and bottom) - e_guess(1:kc-1) = sin(z_int(2:kc)/htot(i,j)*Pi) + e_guess(1:kc-1) = sin((z_int(2:kc)/htot(i,j)) *Pi) e_guess(1:kc-1) = e_guess(1:kc-1)/sqrt(sum(e_guess(1:kc-1)**2)) ! Perform inverse iteration with tri-diag solver @@ -441,11 +443,12 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) !(including surface and bottom) w2avg = 0.0 do k=1,nzm-1 - dz(k) = Hc(k) + dz(k) = GV%Z_to_m*Hc(k) w2avg = w2avg + 0.5*(w_strct(K)**2+w_strct(K+1)**2)*dz(k) enddo - w2avg = w2avg/htot(i,j) - w_strct = w_strct/sqrt(htot(i,j)*w2avg*I_a_int) + !### 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) ! Calculate vertical structure function of u (i.e. dw/dz) do K=2,nzm-1 @@ -495,45 +498,13 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) endif ! Store values in control structure - CS%w_strct(i,j,1:nzm) = w_strct - CS%u_strct(i,j,1:nzm) = u_strct - CS%W_profile(i,j,1:nzm) = W_profile - CS%Uavg_profile(i,j,1:nzm)= Uavg_profile - CS%z_depths(i,j,1:nzm) = z_int - CS%N2(i,j,1:nzm) = N2 + CS%w_strct(i,j,1:nzm) = w_strct(:) + CS%u_strct(i,j,1:nzm) = u_strct(:) + CS%W_profile(i,j,1:nzm) = W_profile(:) + CS%Uavg_profile(i,j,1:nzm)= Uavg_profile(:) + CS%z_depths(i,j,1:nzm) = GV%Z_to_m*z_int(:) + CS%N2(i,j,1:nzm) = N2(:) CS%num_intfaces(i,j) = nzm - - !----for debugging; delete later---- - !if (ig == ig_stop .and. jg == jg_stop) then - !print *, 'cn(ig,jg)=', cn(i,j) - !print *, "e_guess=", e_guess(1:kc-1) - !print *, "|e_guess|=", sqrt(sum(e_guess(1:kc-1)**2)) - !print *, 'f0=', sqrt(f2) - !print *, 'freq=', freq - !print *, 'Kh=', sqrt(Kmag2) - !print *, 'Wave_structure: z_int(ig,jg)=', z_int(1:nzm) - !print *, 'Wave_structure: N2(ig,jg)=', N2(1:nzm) - !print *, 'gprime=', gprime(1:nzm) - !print *, '1/Hc=', 1/Hc - !print *, 'Wave_structure: a_diag(ig,jg)=', a_diag(1:kc-1) - !print *, 'Wave_structure: b_diag(ig,jg)=', b_diag(1:kc-1) - !print *, 'Wave_structure: c_diag(ig,jg)=', c_diag(1:kc-1) - !print *, 'Wave_structure: lam_z(ig,jg)=', lam_z(1:kc-1) - !print *, 'Wave_structure: w_strct(ig,jg)=', w_strct(1:nzm) - !print *, 'En(i,j)=', En(i,j) - !print *, 'Wave_structure: W_profile(ig,jg)=', W_profile(1:nzm) - !print *,'int_dwdz2 =',int_dwdz2 - !print *,'int_w2 =',int_w2 - !print *,'int_N2w2 =',int_N2w2 - !print *,'KEterm=',KE_term - !print *,'PEterm=',PE_term - !print *, 'W0=',W0 - !print *,'Uavg_profile=',Uavg_profile(1:nzm) - !open(unit=1,file='out_N2',form='formatted') ; write(1,*) N2 ; close(1) - !open(unit=2,file='out_z',form='formatted') ; write(2,*) z_int ; close(2) - !endif - !----------------------------------- - else ! If not enough layers, default to zero nzm = kc+1 @@ -584,8 +555,8 @@ subroutine tridiag_solver(a, b, c, h, y, method, x) real, dimension(:), intent(out) :: x !< vector of unknown values to solve for. ! Local variables integer :: nrow ! number of rows in A matrix - real, allocatable, dimension(:,:) :: A_check ! for solution checking - real, allocatable, dimension(:) :: y_check ! for solution checking +! real, allocatable, dimension(:,:) :: A_check ! for solution checking +! real, allocatable, dimension(:) :: y_check ! for solution checking real, allocatable, dimension(:) :: c_prime, y_prime, q, alpha ! intermediate values for solvers real :: Q_prime, beta ! intermediate values for solver @@ -597,8 +568,8 @@ subroutine tridiag_solver(a, b, c, h, y, method, x) allocate(y_prime(nrow)) allocate(q(nrow)) allocate(alpha(nrow)) - allocate(A_check(nrow,nrow)) - allocate(y_check(nrow)) +! allocate(A_check(nrow,nrow)) +! allocate(y_check(nrow)) if (method == 'TDMA_T') then ! Standard Thomas algoritim (4th variant). @@ -648,7 +619,7 @@ subroutine tridiag_solver(a, b, c, h, y, method, x) ! symmetric, diagonally dominant matrix, with h>0. ! Need to add a check for these conditions. do k=1,nrow-1 - if (abs(a(k+1)-c(k)) > 1.e-10) then + if (abs(a(k+1)-c(k)) > 1.e-10*(abs(a(k+1))+abs(c(k)))) then call MOM_error(WARNING, "tridiag_solver: matrix not symmetric; need symmetry when invoking TDMA_H") endif enddo @@ -671,8 +642,8 @@ subroutine tridiag_solver(a, b, c, h, y, method, x) Q_prime = beta*(h(k)+alpha(k-1)*Q_prime) enddo if ((h(nrow)+alpha(nrow-1)*Q_prime+alpha(nrow)) == 0.0)then - call MOM_error(WARNING, "Tridiag_solver: this system is not stable; overriding beta(nrow).") - beta = 1/(1e-15) ! place holder for unstable systems - delete later + call MOM_error(FATAL, "Tridiag_solver: this system is not stable.") ! ; overriding beta(nrow) + ! This has hard-coded dimensions: beta = 1/(1e-15) ! place holder for unstable systems - delete later else beta = 1/(h(nrow)+alpha(nrow-1)*Q_prime+alpha(nrow)) endif @@ -686,7 +657,8 @@ subroutine tridiag_solver(a, b, c, h, y, method, x) !print *, 'x=',x(1:nrow) endif - deallocate(c_prime,y_prime,q,alpha,A_check,y_check) + deallocate(c_prime,y_prime,q,alpha) +! deallocate(A_check,y_check) end subroutine tridiag_solver From 204a767f9ad96e28268011390203d5e6b0627401 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Tue, 23 Oct 2018 17:44:16 +0000 Subject: [PATCH 171/174] Corrected intent of some variables - ice_shelf_advect_temp_*() has G intent(inout) but should be intent(in) - KPP_compute_BLD() and KPP_smooth_BLD() had G intent(in), now intent(inout) - set_visc_init() had G intent(in), now intent(inout) - Thanks to @jiandewang for reporting issue when evaluating PR #862 --- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 4 ++-- src/parameterizations/vertical/MOM_CVMix_KPP.F90 | 4 ++-- src/parameterizations/vertical/MOM_set_viscosity.F90 | 2 +- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 23ec85d8c5..eea9ee322a 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -3609,7 +3609,7 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. real, intent(in) :: time_step !< The time step for this update, in s. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: hmask !< A mask indicating which tracer points are + intent(in) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: h0 !< The initial ice shelf thicknesses in m. @@ -3850,7 +3850,7 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_aft type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, intent(in) :: time_step !< The time step for this update, in s. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: hmask !< A mask indicating which tracer points are + intent(in) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: h_after_uflux !< The ice shelf thicknesses after diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index e03d217414..dec3187a99 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -864,7 +864,7 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux, ! Arguments type(KPP_CS), pointer :: CS !< Control structure - type(ocean_grid_type), intent(in) :: G !< Ocean grid + type(ocean_grid_type), intent(inout) :: G !< Ocean grid type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid type(wave_parameters_CS), optional, pointer :: Waves !< Wave CS real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) @@ -1308,7 +1308,7 @@ end subroutine KPP_compute_BLD subroutine KPP_smooth_BLD(CS,G,GV,h) ! Arguments type(KPP_CS), pointer :: CS !< Control structure - type(ocean_grid_type), intent(in) :: G !< Ocean grid + type(ocean_grid_type), intent(inout) :: G !< Ocean grid type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 4e75bcacc2..af2dce00d6 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -1806,7 +1806,7 @@ end subroutine set_visc_register_restarts !> Initializes the MOM_set_visc control structure subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, restart_CS, OBC) type(time_type), target, intent(in) :: Time !< The current model time. - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + 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(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters. From 6c98b8e16908b2f838bfdfb9de5a789e12e974c0 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 23 Oct 2018 19:22:54 -0400 Subject: [PATCH 172/174] Corrected openMP directive errors in recent commit Corrected a number of openMP directives that had been broken by a recent set of commits. The code would not compile with openMP enabled without these changes. All answers are bitwise identical, and answers have been verified to reproduce with 1 and 2 threads for the SIS2_cgrid_bergs test case. --- src/core/MOM_PressureForce_Montgomery.F90 | 2 +- src/core/MOM_PressureForce_blocked_AFV.F90 | 2 +- src/core/MOM_isopycnal_slopes.F90 | 38 ++++++++-------- .../lateral/MOM_lateral_mixing_coeffs.F90 | 18 ++------ .../vertical/MOM_set_diffusivity.F90 | 4 +- .../vertical/MOM_set_viscosity.F90 | 45 +++++-------------- .../vertical/MOM_vert_friction.F90 | 4 +- 7 files changed, 39 insertions(+), 74 deletions(-) diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index f8657fca2d..4f295600cd 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -679,7 +679,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, Rho0, GFS_scale, pbce, rho_star) enddo ! end of j loop endif else ! not use_EOS - !$OMP parallel do default(share) private(Ihtot) + !$OMP parallel do default(shared) private(Ihtot) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 Ihtot(i) = 1.0 / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect) diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index 7cd449f86f..cd5961c23d 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -618,7 +618,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at endif !$OMP parallel do default(none) shared(use_p_atm,rho_ref,G,GV,e,p_atm,nz,use_EOS,& -!$OMP use_ALE,T_t,T_b,S_t,S_b,CS,tv,tv_tmp, & +!$OMP use_ALE,T_t,T_b,S_t,S_b,CS,tv,tv_tmp,g_Earth_z, & !$OMP h,PFu,I_Rho0,h_neglect,dz_neglect,PFv,dM)& !$OMP private(is_bk,ie_bk,js_bk,je_bk,Isq_bk,Ieq_bk,Jsq_bk, & !$OMP Jeq_bk,ioff_bk,joff_bk,pa_bk, & diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index 3698c32afe..41b9bef817 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -137,27 +137,25 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & endif ! Find the maximum and minimum permitted streamfunction. -!$OMP parallel default(none) shared(is,ie,js,je,pres,GV,h,nz) -!$OMP do + !$OMP parallel do default(shared) do j=js-1,je+1 ; do i=is-1,ie+1 pres(i,j,1) = 0.0 ! ### This should be atmospheric pressure. pres(i,j,2) = pres(i,j,1) + GV%H_to_Pa*h(i,j,1) enddo ; enddo -!$OMP do + !$OMP parallel do default(shared) do j=js-1,je+1 do k=2,nz ; do i=is-1,ie+1 pres(i,j,K+1) = pres(i,j,K) + GV%H_to_Pa*h(i,j,k) enddo ; enddo enddo -!$OMP end parallel - -!$OMP parallel do default(none) shared(nz,is,ie,js,je,use_EOS,G,GV,pres,T,S, & -!$OMP IsdB,tv,h,h_neglect,e,dz_neglect, & -!$OMP h_neglect2,present_N2_u,G_Rho0,N2_u,slope_x) & -!$OMP private(drdiA,drdiB,drdkL,drdkR,pres_u,T_u,S_u, & -!$OMP drho_dT_u,drho_dS_u,hg2A,hg2B,hg2L,hg2R,haA, & -!$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz, & -!$OMP drdx,mag_grad2,Slope,slope2_Ratio) + + !$OMP parallel do default(none) shared(nz,is,ie,js,je,IsdB,use_EOS,G,GV,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, & + !$OMP drho_dT_u,drho_dS_u,hg2A,hg2B,hg2L,hg2R,haA, & + !$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz, & + !$OMP drdx,mag_grad2,Slope,slope2_Ratio) do j=js,je ; do K=nz,2,-1 if (.not.(use_EOS)) then drdiA = 0.0 ; drdiB = 0.0 @@ -237,14 +235,14 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & enddo ! I enddo ; enddo ! end of j-loop - ! Calculate the meridional isopycnal slope. -!$OMP parallel do default(none) shared(nz,is,ie,js,je,use_EOS,G,GV,pres,T,S, & -!$OMP IsdB,tv,h,h_neglect,e,dz_neglect, & -!$OMP h_neglect2,present_N2_v,G_Rho0,N2_v,slope_y) & -!$OMP private(drdjA,drdjB,drdkL,drdkR,pres_v,T_v,S_v, & -!$OMP drho_dT_v,drho_dS_v,hg2A,hg2B,hg2L,hg2R,haA, & -!$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz, & -!$OMP drdy,mag_grad2,Slope,slope2_Ratio) + ! Calculate the meridional isopycnal slope. + !$OMP parallel do default(none) shared(nz,is,ie,js,je,IsdB,use_EOS,G,GV,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_v,G_Rho0,N2_v,slope_y) & + !$OMP private(drdjA,drdjB,drdkL,drdkR,pres_v,T_v,S_v, & + !$OMP drho_dT_v,drho_dS_v,hg2A,hg2B,hg2L,hg2R,haA, & + !$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz, & + !$OMP drdy,mag_grad2,Slope,slope2_Ratio) do j=js-1,je ; do K=nz,2,-1 if (.not.(use_EOS)) then drdjA = 0.0 ; drdjB = 0.0 diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index b4da411aac..7f33140fb7 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -426,9 +426,8 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) 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 (1/s2) type(VarMix_CS), pointer :: CS !< Variable mixing coefficients + ! Local variables - real :: E_x(SZIB_(G), SZJ_(G)) ! X-slope of interface at u points (for diagnostics) - real :: E_y(SZI_(G), SZJB_(G)) ! Y-slope of interface at u points (for diagnostics) real :: Khth_Loc ! Locally calculated thickness mixing coefficient (m2/s) real :: S2 ! Interface slope squared (non-dim) real :: N2 ! Brunt-Vaisala frequency (1/s) @@ -437,8 +436,6 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) integer :: is, ie, js, je, nz integer :: i, j, k, kb_max real :: S2max, wNE, wSE, wSW, wNW - real :: SN_u_local(SZIB_(G), SZJ_(G),SZK_(G)) - real :: SN_v_local(SZI_(G), SZJB_(G),SZK_(G)) real :: H_u(SZIB_(G)), H_v(SZI_(G)) real :: S2_u(SZIB_(G), SZJ_(G)) real :: S2_v(SZI_(G), SZJB_(G)) @@ -455,12 +452,7 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) S2max = CS%Visbeck_S_max**2 -!$OMP parallel default(none) shared(is,ie,js,je,CS,nz,e,G,GV,h, & -!$OMP S2_u,S2_v,slope_x,slope_y, & -!$OMP SN_u_local,SN_v_local,N2_u,N2_v, S2max) & -!$OMP private(E_x,E_y,S2,H_u,H_v,Hdn,Hup,H_geom,N2, & -!$OMP wNE, wSE, wSW, wNW) -!$OMP do + !$OMP parallel do default(shared) do j=js-1,je+1 ; do i=is-1,ie+1 CS%SN_u(i,j) = 0.0 CS%SN_v(i,j) = 0.0 @@ -470,7 +462,7 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) ! calculate the first-mode gravity wave speed and then blend the equatorial ! and midlatitude deformation radii, using calc_resoln_function as a template. -!$OMP do + !$OMP parallel do default(shared) private(S2,H_u,Hdn,Hup,H_geom,N2,wNE,wSE,wSW,wNW) do j = js,je do I=is-1,ie CS%SN_u(I,j) = 0. ; H_u(I) = 0. ; S2_u(I,j) = 0. @@ -516,7 +508,7 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) enddo enddo -!$OMP do + !$OMP parallel do default(shared) private(S2,H_v,Hdn,Hup,H_geom,N2,wNE,wSE,wSW,wNW) do J = js-1,je do i=is,ie CS%SN_v(i,J) = 0. ; H_v(i) = 0. ; S2_v(i,J) = 0. @@ -562,8 +554,6 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) enddo enddo -!$OMP end parallel - ! Offer diagnostic fields for averaging. if (query_averaging_enabled(CS%diag)) then if (CS%id_S2_u > 0) call post_data(CS%id_S2_u, S2_u, CS%diag) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 873a61d7b8..e5e55ec590 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -555,13 +555,13 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%Kd_add > 0.0) then if (present(Kd_int)) then -!$OMP parallel do default(none) shared(is,ie,js,je,nz,Kd_int,CS,Kd) + !$OMP parallel do default(shared) do k=1,nz ; do j=js,je ; do i=is,ie Kd_int(i,j,K) = Kd_int(i,j,K) + CS%Kd_add Kd_lay(i,j,k) = Kd_lay(i,j,k) + CS%Kd_add enddo ; enddo ; enddo else -!$OMP parallel do default(none) shared(is,ie,js,je,nz,CS,Kd) + !$OMP parallel do default(shared) do k=1,nz ; do j=js,je ; do i=is,ie Kd_lay(i,j,k) = Kd_lay(i,j,k) + CS%Kd_add enddo ; enddo ; enddo diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index af2dce00d6..d4261b6523 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -375,20 +375,10 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) if (.not.use_BBL_EOS) Rml_vel(:,:) = 0.0 -!$OMP parallel do default(none) shared(u, v, h, tv, visc, G, GV, CS, Rml, is, ie, js, je, & -!$OMP nz, Isq, Ieq, Jsq, Jeq, nkmb, h_neglect, Rho0x400_G,& -!$OMP C2pi_3, U_bg_sq, cdrag_sqrt,K2,use_BBL_EOS,OBC, & -!$OMP maxitt,nkml,Vol_quit,D_u,D_v,mask_u,mask_v) & -!$OMP private(do_i,h_at_vel,htot_vel,hwtot,hutot,Thtot,Shtot, & -!$OMP hweight,v_at_u,u_at_v,ustar,T_EOS,S_EOS,press, & -!$OMP dR_dT, dR_dS,ustarsq,htot,T_vel,S_vel,Rml_vel, & -!$OMP oldfn,Dfn,Dh,Rhtot,C2f,ustH,root,bbl_thick, & -!$OMP D_vel,tmp,Dp,Dm,a_3,a,a_12,slope,Vol_open,Vol_2_reg,& -!$OMP C24_a,apb_4a,Iapb,a2x48_apb3,ax2_3apb,Vol_direct, & -!$OMP L_direct,Ibma_2,L,vol,vol_below,Vol_err,h_vel_pos, & -!$OMP BBL_visc_frac,h_vel,L0,Vol_0,dV_dL2,dVol,L_max, & -!$OMP L_min,Vol_err_min,Vol_err_max,BBL_frac,Cell_width, & -!$OMP gam,Rayleigh, Vol_tol, tmp_val_m1_to_p1) + !$OMP parallel do default(private) shared(u,v,h,tv,visc,G,GV,CS,Rml,is,ie,js,je,nz,nkmb, & + !$OMP nkml,Isq,Ieq,Jsq,Jeq,h_neglect,Rho0x400_G,C2pi_3, & + !$OMP U_bg_sq,cdrag_sqrt_Z,cdrag_sqrt,K2,use_BBL_EOS, & + !$OMP OBC,maxitt,Vol_quit,D_u,D_v,mask_u,mask_v) do j=Jsq,Jeq ; do m=1,2 if (m==1) then @@ -1211,16 +1201,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) endif enddo ; endif -!$OMP parallel do default(none) shared(u, v, h, tv, forces, visc, dt, G, GV, CS, use_EOS, & -!$OMP dt_Rho0, h_neglect, h_tiny, g_H_Rho0,js,je,OBC, & -!$OMP Isq, Ieq, nz, U_bg_sq,mask_v, & -!$OMP cdrag_sqrt,Rho0x400_G,nkml) & -!$OMP private(do_any,htot,do_i,k_massive,Thtot,uhtot,vhtot,U_star, & -!$OMP Idecay_len_TKE,press,k2,I_2hlay,T_EOS,S_EOS,dR_dT, & -!$OMP dR_dS,hlay,v_at_u,Uh2,T_lay,S_lay,gHprime, & -!$OMP RiBulk,Shtot,Rhtot,absf,do_any_shelf, & -!$OMP h_at_vel,ustar,htot_vel,hwtot,hutot,hweight,ustarsq, & -!$OMP oldfn,Dfn,Dh,Rlay,Rlb,h2f2,ustar1) + !$OMP parallel do default(private) shared(u,v,h,tv,forces,visc,dt,G,GV,CS,use_EOS,dt_Rho0, & + !$OMP h_neglect,h_tiny,g_H_Rho0,js,je,OBC,Isq,Ieq,nz, & + !$OMP U_bg_sq,mask_v,cdrag_sqrt,cdrag_sqrt_Z,Rho0x400_G,nkml) do j=js,je ! u-point loop if (CS%dynamic_viscous_ML) then do_any = .false. @@ -1453,17 +1436,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) enddo ! j-loop at u-points -!$OMP parallel do default(none) shared(u, v, h, tv, forces, visc, dt, G, GV, CS, use_EOS,& -!$OMP dt_Rho0, h_neglect, h_tiny, g_H_Rho0,is,ie,OBC, & -!$OMP Jsq,Jeq,nz,U_bg_sq,cdrag_sqrt,Rho0x400_G,nkml, & -!$OMP mask_u) & -!$OMP private(do_any,htot,do_i,k_massive,Thtot,vhtot,uhtot,absf,& -!$OMP U_star,Idecay_len_TKE,press,k2,I_2hlay,T_EOS, & -!$OMP S_EOS,dR_dT, dR_dS,hlay,u_at_v,Uh2, & -!$OMP T_lay,S_lay,gHprime,RiBulk,do_any_shelf, & -!$OMP Shtot,Rhtot,ustar,h_at_vel,htot_vel,hwtot, & -!$OMP hutot,hweight,ustarsq,oldfn,Dh,Rlay,Rlb,Dfn, & -!$OMP h2f2,ustar1) + !$OMP parallel do default(private) shared(u,v,h,tv,forces,visc,dt,G,GV,CS,use_EOS,dt_Rho0, & + !$OMP h_neglect,h_tiny,g_H_Rho0,is,ie,OBC,Jsq,Jeq,nz, & + !$OMP U_bg_sq,cdrag_sqrt,cdrag_sqrt_Z,Rho0x400_G,nkml,mask_u) do J=Jsq,Jeq ! v-point loop if (CS%dynamic_viscous_ML) then do_any = .false. diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 9014243e56..57bf5a3ab6 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -671,7 +671,9 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) allocate(CS%a1_shelf_v(G%isd:G%ied,G%JsdB:G%JedB)) ; CS%a1_shelf_v(:,:)=0.0 endif - !$OMP parallel do default(shared) firstprivate(i_hbbl) + !$OMP parallel do default(private) shared(G,GV,CS,visc,Isq,Ieq,nz,u,h,forces,hML_u, & + !$OMP OBC,h_neglect,dt,I_valBL,Kv_u) & + !$OMP firstprivate(i_hbbl) do j=G%Jsc,G%Jec do I=Isq,Ieq ; do_i(I) = (G%mask2dCu(I,j) > 0) ; enddo From 0b48ab43e08a74b36529fb45d08ed031a74cc358 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Thu, 25 Oct 2018 17:15:14 -0600 Subject: [PATCH 173/174] fix mech_forcing_diags args --- config_src/mct_driver/MOM_ocean_model.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/config_src/mct_driver/MOM_ocean_model.F90 b/config_src/mct_driver/MOM_ocean_model.F90 index 3eac851778..4714194f40 100644 --- a/config_src/mct_driver/MOM_ocean_model.F90 +++ b/config_src/mct_driver/MOM_ocean_model.F90 @@ -559,8 +559,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & OS%nstep = OS%nstep + 1 call enable_averaging(time_step, OS%Time, OS%diag) - call mech_forcing_diags(OS%forces, OS%fluxes, time_step, OS%grid, & - OS%diag, OS%forcing_CSp%handles) + call mech_forcing_diags(OS%forces, time_step, OS%grid, OS%diag, OS%forcing_CSp%handles) call disable_averaging(OS%diag) if (OS%fluxes%fluxes_used) then From a3b8f510e41e0794a89a7e34facef0f4db6901a4 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 26 Oct 2018 13:23:41 +0000 Subject: [PATCH 174/174] Fix intent for geothermal_init() - @jiandewang reported that the argument G should be intent(inout). --- src/parameterizations/vertical/MOM_geothermal.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 3880f9fd54..c09d85f5b5 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -315,7 +315,7 @@ end subroutine geothermal !> Initialize parameters and allocate memory associated with the geothermal heating module. subroutine geothermal_init(Time, G, param_file, diag, CS) type(time_type), target, intent(in) :: Time !< Current model time. - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters. type(diag_ctrl), target, intent(inout) :: diag !< Structure used to regulate diagnostic output.