From f1041d1f90c2380c5543b75a65ea53c4b57a5060 Mon Sep 17 00:00:00 2001 From: Olga Sergienko Date: Tue, 15 Dec 2020 20:32:06 -0500 Subject: [PATCH 01/51] Fixed bugs in CG_action, matrix_diagonal and calc_shelf_visc in MOM_ice_shelf_dynamics.F90 modified initialize_ice_shelf_boundary_channel in MOM_ice_shelf_initialze.F90 --- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 212 ++++++++++++++++----- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 125 ++++++++++++ 2 files changed, 286 insertions(+), 51 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index f038190753..8480906de8 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -23,6 +23,7 @@ module MOM_ice_shelf_dynamics use MOM_ice_shelf_state, only : ice_shelf_state use MOM_coms, only : reproducing_sum, sum_across_PEs, max_across_PEs, min_across_PEs use MOM_checksums, only : hchksum, qchksum +use MOM_ice_shelf_initialize, only : initialize_ice_shelf_boundary_channel !OVS intializing b.c.s implicit none ; private @@ -366,20 +367,23 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ call get_param(param_file, mdl, "A_GLEN_ISOTHERM", CS%A_glen_isothermal, & "Ice viscosity parameter in Glen's Law", & - units="Pa-3 yr-1", default=9.461e-18, scale=1.0/(365.0*86400.0)) + units="Pa-3 s-1", default=2.2261e-25, scale=1.0) !OVS change units to Pa-3 s-1 +! units="Pa-3 yr-1", default=9.461e-18, scale=1.0/(365.0*86400.0)) ! This default is equivalent to 3.0001e-25 Pa-3 s-1, appropriate at about -10 C. call get_param(param_file, mdl, "GLEN_EXPONENT", CS%n_glen, & "nonlinearity exponent in Glen's Law", & units="none", default=3.) call get_param(param_file, mdl, "MIN_STRAIN_RATE_GLEN", CS%eps_glen_min, & "min. strain rate to avoid infinite Glen's law viscosity", & - units="a-1", default=1.e-12, scale=US%T_to_s/(365.0*86400.0)) + units="s-1", default=1.e-19, scale=US%T_to_s) !OVS change units to s-1 + !units="a-1", default=1.e-12, scale=US%T_to_s/(365.0*86400.0)) call get_param(param_file, mdl, "BASAL_FRICTION_EXP", CS%n_basal_fric, & "Exponent in sliding law \tau_b = C u^(n_basal_fric)", & units="none", fail_if_missing=.true.) call get_param(param_file, mdl, "BASAL_FRICTION_COEFF", CS%C_basal_friction, & "Coefficient in sliding law \tau_b = C u^(n_basal_fric)", & - units="Pa (m yr-1)-(n_basal_fric)", scale=US%kg_m2s_to_RZ_T*((365.0*86400.0)**CS%n_basal_fric), & + units="Pa (m s-1)^(n_basal_fric)", scale=US%kg_m2s_to_RZ_T**CS%n_basal_fric, & ! OVS change units to s-1 + !units="Pa (m yr-1)-(n_basal_fric)", scale=US%kg_m2s_to_RZ_T*((365.0*86400.0)**CS%n_basal_fric), & fail_if_missing=.true.) call get_param(param_file, mdl, "DENSITY_ICE", CS%density_ice, & "A typical density of ice.", units="kg m-3", default=917.0, scale=US%kg_m3_to_R) @@ -399,10 +403,11 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ call get_param(param_file, mdl, "SHELF_MOVING_FRONT", CS%moving_shelf_front, & "Specify whether to advance shelf front (and calve).", & - default=.true.) + default=.false.) call get_param(param_file, mdl, "CALVE_TO_MASK", CS%calve_to_mask, & "If true, do not allow an ice shelf where prohibited by a mask.", & default=.false.) + endif call get_param(param_file, mdl, "MIN_THICKNESS_SIMPLE_CALVE", CS%min_thickness_simple_calve, & "Min thickness rule for the VERY simple calving law",& @@ -515,8 +520,13 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ call pass_var(CS%calve_mask,G%domain) endif + call initialize_ice_shelf_boundary_channel(CS%u_face_mask_bdry, CS%v_face_mask_bdry, & + CS%u_flux_bdry_val, CS%v_flux_bdry_val, CS%u_bdry_val, CS%v_bdry_val, CS%h_bdry_val, & + CS%thickness_bdry_val, ISS%hmask, ISS%h_shelf, G, & +! CS%flux_bdry, & + US, param_file ) !OVS initialize b.c.s ! call init_boundary_values(CS, G, time, ISS%hmask, CS%input_flux, CS%input_thickness, new_sim) - + call update_velocity_masks(CS, G, ISS%hmask, CS%umask, CS%vmask, CS%u_face_mask, CS%v_face_mask) if (new_sim) then call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: initialize ice velocity.") call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf(:,:)) @@ -823,8 +833,18 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, iters, time) ! need to make these conditional on GL interpolation float_cond(:,:) = 0.0 ; H_node(:,:) = 0.0 + CS%ground_frac(:,:) = 0.0 allocate(Phisub(nsub,nsub,2,2,2,2)) ; Phisub(:,:,:,:,:,:) = 0.0 + do j=G%jsc,G%jec + do i=G%isc,G%iec + if (rhoi_rhow * ISS%h_shelf(i,j) - G%bathyT(i,j) > 0) then + float_cond(i,j) = 1.0 + CS%ground_frac(i,j) = 1.0 + endif + enddo + enddo + call calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, CS%OD_av) ! This is to determine which cells contain the grounding line, the criterion being that the cell @@ -867,8 +887,9 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, iters, time) enddo ; enddo call calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) - call pass_var(CS%ice_visc, G%domain) + + call calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf) call pass_var(CS%basal_traction, G%domain) ! This makes sure basal stress is only applied when it is supposed to be @@ -884,7 +905,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, iters, time) call CG_action(Au, Av, u_shlf, v_shlf, Phi, Phisub, CS%umask, CS%vmask, ISS%hmask, H_node, & CS%ice_visc, float_cond, G%bathyT, CS%basal_traction, & G, US, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi_rhow) - + call pass_vector(Au,Av,G%domain) !OVS pass Au and Av if (CS%nonlin_solve_err_mode == 1) then err_init = 0 ; err_tempu = 0 ; err_tempv = 0 do J=G%IscB,G%JecB ; do I=G%IscB,G%IecB @@ -920,6 +941,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, iters, time) call calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) call pass_var(CS%ice_visc, G%domain) + call calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf) call pass_var(CS%basal_traction, G%domain) ! makes sure basal stress is only applied when it is supposed to be @@ -986,8 +1008,11 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, iters, time) call MOM_mesg(mesg, 5) if (err_max <= CS%nonlinear_tolerance * err_init) then + write(mesg,*) "ice_shelf_solve_outer: nonlinear fractional residual = ", err_max/err_init + call MOM_mesg(mesg) write(mesg,*) "ice_shelf_solve_outer: exiting nonlinear solve after ",iter," iterations" - call MOM_mesg(mesg, 5) +! call MOM_mesg(mesg, 5) + call MOM_mesg(mesg) exit endif @@ -1073,7 +1098,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H rhoi_rhow = CS%density_ice / CS%density_ocean_avg Zu(:,:) = 0 ; Zv(:,:) = 0 ; DIAGu(:,:) = 0 ; DIAGv(:,:) = 0 - Ru(:,:) = 0 ; Rv(:,:) = 0 ; Au(:,:) = 0 ; Av(:,:) = 0 + Ru(:,:) = 0 ; Rv(:,:) = 0 ; Au(:,:) = 0 ; Av(:,:) = 0 ; RHSu(:,:) = 0 ; RHSv(:,:) = 0 Du(:,:) = 0 ; Dv(:,:) = 0 ; ubd(:,:) = 0 ; vbd(:,:) = 0 dot_p1 = 0 @@ -1125,8 +1150,8 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H do j=jsdq,jedq do i=isdq,iedq - if (CS%umask(I,J) == 1) Zu(I,J) = Ru(I,J) / DIAGu(I,J) - if (CS%vmask(I,J) == 1) Zv(I,J) = Rv(I,J) / DIAGv(I,J) + if (CS%umask(I,J) == 1 .AND.(DIAGu(I,J)/=0)) Zu(I,J) = Ru(I,J) / DIAGu(I,J) + if (CS%vmask(I,J) == 1 .AND.(DIAGv(I,J)/=0)) Zv(I,J) = Rv(I,J) / DIAGv(I,J) enddo enddo @@ -1161,7 +1186,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H ! Au, Av valid region moves in by 1 - + call pass_vector(Au,Av,G%domain, TO_ALL, BGRID_NE) sum_vec(:,:) = 0.0 ; sum_vec_2(:,:) = 0.0 do j=jscq,jecq ; do i=iscq,iecq @@ -1205,10 +1230,10 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H do j=jsdq,jedq do i=isdq,iedq - if (CS%umask(I,J) == 1) then + if (CS%umask(I,J) == 1 .AND.(DIAGu(I,J)/=0)) then Zu(I,J) = Ru(I,J) / DIAGu(I,J) endif - if (CS%vmask(I,J) == 1) then + if (CS%vmask(I,J) == 1 .AND.(DIAGv(I,J)/=0)) then Zv(I,J) = Rv(I,J) / DIAGv(I,J) endif enddo @@ -1732,7 +1757,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) BASE ! basal elevation of shelf/stream [Z ~> m]. - real :: rho, rhow ! Ice and ocean densities [R ~> kg m-3] + real :: rho, rhow, rhoi_rhow ! Ice and ocean densities [R ~> kg m-3] real :: sx, sy ! Ice shelf top slopes [Z L-1 ~> m s-1] real :: neumann_val ! [R Z L2 T-2 ~> kg s-2] real :: dxh, dyh ! Local grid spacing [L ~> m] @@ -1754,13 +1779,26 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) rho = CS%density_ice rhow = CS%density_ocean_avg grav = CS%g_Earth - + rhoi_rhow = rho/rhow ! prelim - go through and calculate S ! or is this faster? BASE(:,:) = -G%bathyT(:,:) + OD(:,:) S(:,:) = BASE(:,:) + ISS%h_shelf(:,:) + ! check whether the ice is floating or grounded + do j=jsc-1,jec+1 + do i=isc-1,iec+1 +! do i=isc-G%domain%nihalo,iec+G%domain%nihalo + +! if (ISS%h_shelf(i,j) < rhow/rho * G%bathyT(i,j)) then + if (rhoi_rhow * ISS%h_shelf(i,j) - G%bathyT(i,j) <= 0) then + S(i,j)=(1 - rhoi_rhow)*ISS%h_shelf(i,j) + endif + + + enddo + enddo do j=jsc-1,jec+1 do i=isc-1,iec+1 cnt = 0 @@ -1840,23 +1878,34 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) endif ! SW vertex - taudx(I-1,J-1) = taudx(I-1,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j) - taudy(I-1,J-1) = taudy(I-1,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) - + if (ISS%hmask(I-1,J-1) == 1) then + if (CS%u_face_mask(I-1,J-1) /= 3) then + taudx(I-1,J-1) = taudx(I-1,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j) + taudy(I-1,J-1) = taudy(I-1,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) + endif + endif ! SE vertex - taudx(I,J-1) = taudx(I,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j) - taudy(I,J-1) = taudy(I,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) - + if (ISS%hmask(I,J-1) == 1) then + if (CS%u_face_mask(I,J-1) /= 3) then + taudx(I,J-1) = taudx(I,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j) + taudy(I,J-1) = taudy(I,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) + endif + endif ! NW vertex - taudx(I-1,J) = taudx(I-1,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j) - taudy(I-1,J) = taudy(I-1,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) - + if (CS%u_face_mask(I-1,J) /= 3) then + taudx(I-1,J) = taudx(I-1,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j) + taudy(I-1,J) = taudy(I-1,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) + endif ! NE vertex - taudx(I,J) = taudx(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j) - taudy(I,J) = taudy(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) - - if (CS%ground_frac(i,j) == 1) then - neumann_val = .5 * grav * (rho * ISS%h_shelf(i,j)**2 - rhow * G%bathyT(i,j)**2) + if (ISS%hmask(I,J) == 1) then + if (CS%u_face_mask(I,J) /= 3) then + taudx(I,J) = taudx(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j) + taudy(I,J) = taudy(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) + endif + endif + if (CS%ground_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 * (1-rho/rhow) * rho * ISS%h_shelf(i,j)**2 else neumann_val = .5 * grav * (1-rho/rhow) * rho * ISS%h_shelf(i,j)**2 endif @@ -1976,7 +2025,7 @@ subroutine CG_action(uret, vret, u_shlf, v_shlf, Phi, Phisub, umask, vmask, hmas intent(inout) :: uret !< The retarding stresses working at u-points [R L3 Z T-2 ~> kg m s-2]. real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & intent(inout) :: vret !< The retarding stresses working at v-points [R L3 Z T-2 ~> kg m s-2]. - real, dimension(SZDI_(G),SZDJ_(G),8,4), & + real, dimension(8,4,SZDI_(G),SZDJ_(G)), & intent(in) :: Phi !< The gradients of bilinear basis elements at Gaussian !! quadrature points surrounding the cell vertices [L-1 ~> m-1]. real, dimension(:,:,:,:,:,:), & @@ -2080,7 +2129,7 @@ subroutine CG_action(uret, vret, u_shlf, v_shlf, Phi, Phisub, umask, vmask, hmas v_shlf(I-1,J) * Phi(6,2*(jq-1)+iq,i,j) + & v_shlf(I,J) * Phi(8,2*(jq-1)+iq,i,j) - do iphi=1,2 ; do jphi=1,2 ; Itgt = I-2+iphi ; Jtgt = J-2-jphi + do iphi=1,2 ; do jphi=1,2 ; Itgt = I-2+iphi ; ;Jtgt = J-2+jphi !Jtgt = J-2-jphi !OVS fix index if (umask(Itgt,Jtgt) == 1) uret(Itgt,Jtgt) = uret(Itgt,Jtgt) + 0.25 * ice_visc(i,j) * & ((4*ux+2*vy) * Phi(2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq,i,j) + & (uy+vx) * Phi(2*(2*(jphi-1)+iphi),2*(jq-1)+iq,i,j)) @@ -2214,7 +2263,7 @@ subroutine matrix_diagonal(CS, G, US, float_cond, H_node, ice_visc, basal_trac, ! Phi(2*i-1,j) gives d(Phi_i)/dx at quadrature point j ! Phi(2*i,j) gives d(Phi_i)/dy at quadrature point j - do iq=1,2 ; do jq=1,2 ; do iphi=1,2 ; do jphi=1,2 ; Itgt = I-2+iphi ; Jtgt = J-2-jphi + do iq=1,2 ; do jq=1,2 ; do iphi=1,2 ; do jphi=1,2 ; Itgt = I-2+iphi ; Jtgt = J-2+jphi !Jtgt = J-2-jphi !OVS fix index ilq = 1 ; if (iq == iphi) ilq = 2 jlq = 1 ; if (jq == jphi) jlq = 2 @@ -2258,7 +2307,7 @@ subroutine matrix_diagonal(CS, G, US, float_cond, H_node, ice_visc, basal_trac, if (float_cond(i,j) == 1) then Hcell(:,:) = H_node(i-1:i,j-1:j) call CG_diagonal_subgrid_basal(Phisub, Hcell, G%bathyT(i,j), dens_ratio, sub_ground) - do iphi=1,2 ; do jphi=1,2 ; Itgt = I-2+iphi ; Jtgt = J-2-jphi + do iphi=1,2 ; do jphi=1,2 ; Itgt = I-2+iphi ; Jtgt = J-2+jphi !Jtgt = J-2-jphi !OVS fix index if (CS%umask(Itgt,Jtgt) == 1) then u_diagonal(Itgt,Jtgt) = u_diagonal(Itgt,Jtgt) + sub_ground(iphi,jphi) * basal_trac(i,j) v_diagonal(Itgt,Jtgt) = v_diagonal(Itgt,Jtgt) + sub_ground(iphi,jphi) * basal_trac(i,j) @@ -2399,7 +2448,7 @@ subroutine apply_boundary_values(CS, ISS, G, US, time, Phisub, H_node, ice_visc, CS%v_bdry_val(I-1,J) * Phi(6,2*(jq-1)+iq) + & CS%v_bdry_val(I,J) * Phi(8,2*(jq-1)+iq) - do iphi=1,2 ; do jphi=1,2 ; Itgt = I-2+iphi ; Jtgt = J-2-jphi + do iphi=1,2 ; do jphi=1,2 ; Itgt = I-2+iphi ; Jtgt = J-2+jphi !Jtgt = J-2-jphi !OVS fix index ilq = 1 ; if (iq == iphi) ilq = 2 jlq = 1 ; if (jq == jphi) jlq = 2 @@ -2472,7 +2521,7 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) integer :: giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec, is, js real :: Visc_coef, n_g real :: ux, uy, vx, vy, eps_min ! Velocity shears [T-1 ~> s-1] - real :: umid, vmid, unorm ! Velocities [L T-1 ~> m s-1] +! real :: umid, vmid, unorm ! Velocities [L T-1 ~> m s-1] isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec iscq = G%iscB ; iecq = G%iecB ; jscq = G%jscB ; jecq = G%jecB @@ -2484,7 +2533,7 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) n_g = CS%n_glen; eps_min = CS%eps_glen_min - Visc_coef = US%kg_m2s_to_RZ_T*US%m_to_L*US%Z_to_L*(CS%A_glen_isothermal)**(1./CS%n_glen) + Visc_coef = US%kg_m2s_to_RZ_T*US%m_to_L*US%Z_to_L*(CS%A_glen_isothermal)**(-1./CS%n_glen) !OVS '-' in the exponent do j=jsd+1,jed-1 do i=isd+1,ied-1 @@ -2497,6 +2546,50 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) CS%ice_visc(i,j) = 0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) +! umid = ((u_shlf(I,J) + u_shlf(I-1,J-1)) + (u_shlf(I,J-1) + u_shlf(I-1,J))) * 0.25 +! vmid = ((v_shlf(I,J) + v_shlf(I-1,J-1)) + (v_shlf(I,J-1) + v_shlf(I-1,J))) * 0.25 +! unorm = sqrt(umid**2 + vmid**2 + eps_min**2*(G%dxT(i,j)**2 + G%dyT(i,j)**2)) +! CS%basal_traction(i,j) = G%areaT(i,j) * CS%C_basal_friction * (US%L_T_to_m_s*unorm)**(CS%n_basal_fric-1) + endif + enddo + enddo + +end subroutine calc_shelf_visc + +subroutine calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf) + type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe + !! the ice-shelf state + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. + type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors + real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & + intent(inout) :: u_shlf !< The zonal ice shelf velocity [L T-1 ~> m s-1]. + real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & + intent(inout) :: v_shlf !< The meridional ice shelf velocity [L T-1 ~> m s-1]. + +! also this subroutine updates the nonlinear part of the basal traction + +! this may be subject to change later... to make it "hybrid" + + integer :: i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq + integer :: giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec, is, js + real :: umid, vmid, unorm, eps_min ! Velocities [L T-1 ~> m s-1] + + isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec + iscq = G%iscB ; iecq = G%iecB ; jscq = G%jscB ; jecq = G%jecB + isd = G%isd ; jsd = G%jsd ; ied = G%ied ; jed = G%jed + iegq = G%iegB ; jegq = G%jegB + gisc = G%domain%nihalo+1 ; gjsc = G%domain%njhalo+1 + giec = G%domain%niglobal+gisc ; gjec = G%domain%njglobal+gjsc + is = iscq - 1; js = jscq - 1 + + eps_min = CS%eps_glen_min + + + do j=jsd+1,jed-1 + do i=isd+1,ied-1 + + if (ISS%hmask(i,j) == 1) then umid = ((u_shlf(I,J) + u_shlf(I-1,J-1)) + (u_shlf(I,J-1) + u_shlf(I-1,J))) * 0.25 vmid = ((v_shlf(I,J) + v_shlf(I-1,J-1)) + (v_shlf(I,J-1) + v_shlf(I-1,J))) * 0.25 unorm = sqrt(umid**2 + vmid**2 + eps_min**2*(G%dxT(i,j)**2 + G%dyT(i,j)**2)) @@ -2505,7 +2598,7 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) enddo enddo -end subroutine calc_shelf_visc +end subroutine calc_shelf_taub subroutine update_OD_ffrac(CS, G, US, ocean_mass, find_avg) type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure @@ -2673,8 +2766,18 @@ subroutine bilinear_shape_fn_grid(G, i, j, Phi) xquad(2:4:2) = .5 * (1+sqrt(1./3)) ; yquad(3:4) = .5 * (1+sqrt(1./3)) do qpoint=1,4 - a = G%dxCv(i,J-1) * (1-yquad(qpoint)) + G%dxCv(i,J) * yquad(qpoint) ! d(x)/d(x*) - d = G%dyCu(I-1,j) * (1-xquad(qpoint)) + G%dyCu(I,j) * xquad(qpoint) ! d(y)/d(y*) + if (J>1) then + a = G%dxCv(i,J-1) * (1-yquad(qpoint)) + G%dxCv(i,J) * yquad(qpoint) ! d(x)/d(x*) + else + a= G%dxCv(i,J) !* yquad(qpoint) ! d(x)/d(x*) + endif + if (I>1) then + d = G%dyCu(I-1,j) * (1-xquad(qpoint)) + G%dyCu(I,j) * xquad(qpoint) ! d(y)/d(y*) + else + d = G%dyCu(I,j) !* xquad(qpoint) + endif +! a = G%dxCv(i,J-1) * (1-yquad(qpoint)) + G%dxCv(i,J) * yquad(qpoint) ! d(x)/d(x*) +! d = G%dyCu(I-1,j) * (1-xquad(qpoint)) + G%dyCu(I,j) * xquad(qpoint) ! d(y)/d(y*) do node=1,4 xnode = 2-mod(node,2) ; ynode = ceiling(REAL(node)/2) @@ -2793,21 +2896,28 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face is = isd+1 ; js = jsd+1 endif - do j=js,G%jed +! do j=js,G%jed + do j=js-1,G%jed !OVS change index do i=is,G%ied if (hmask(i,j) == 1) then - umask(I-1:I,j-1:j) = 1. - vmask(I-1:I,j-1:j) = 1. + umask(I,j) = 1. + vmask(I,j) = 1. do k=0,1 select case (int(CS%u_face_mask_bdry(I-1+k,j))) case (3) - umask(I-1+k,J-1:J)=3. - vmask(I-1+k,J-1:J)=0. + ! vmask(I-1+k,J-1)=0. u_face_mask(I-1+k,j)=3. + umask(I-1+k,J)=3. + !vmask(I-1+k,J)=0. + vmask(I-1+k,J)=3. + !u_face_mask(I-1+k,j-1)=3. +! umask(I-1+k,J-1:J)=3. +! vmask(I-1+k,J-1:J)=0. +! u_face_mask(I-1+k,j)=3. case (2) u_face_mask(I-1+k,j)=2. case (4) @@ -2815,9 +2925,9 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face vmask(I-1+k,J-1:J)=0. u_face_mask(I-1+k,j)=4. case (0) - umask(I-1+k,J-1:J)=0. - vmask(I-1+k,J-1:J)=0. - u_face_mask(I-1+k,j)=0. +! umask(I-1+k,J-1:J)=0. +! vmask(I-1+k,J-1:J)=0. +! u_face_mask(I-1+k,j)=0. case (1) ! stress free x-boundary umask(I-1+k,J-1:J)=0. case default @@ -2838,9 +2948,9 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face vmask(I-1:I,J-1+k)=0. v_face_mask(i,J-1+k)=4. case (0) - umask(I-1:I,J-1+k)=0. - vmask(I-1:I,J-1+k)=0. - v_face_mask(i,J-1+k)=0. +! umask(I-1:I,J-1+k)=0. +! vmask(I-1:I,J-1+k)=0. +! v_face_mask(i,J-1+k)=0. case (1) ! stress free y-boundary vmask(I-1:I,J-1+k)=0. case default diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index 90c98fa487..367f8d7dce 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -18,6 +18,7 @@ module MOM_ice_shelf_initialize !MJHpublic initialize_ice_shelf_boundary, initialize_ice_thickness public initialize_ice_thickness +public initialize_ice_shelf_boundary_channel ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with @@ -263,6 +264,130 @@ subroutine initialize_ice_thickness_channel(h_shelf, area_shelf_h, hmask, G, US, endif ; enddo end subroutine initialize_ice_thickness_channel +subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_bdry, & + u_flux_bdry_val, v_flux_bdry_val, u_bdry_val, v_bdry_val, h_bdry_val, & + thickness_bdry_val, hmask, h_shelf, G,& ! OVS h_shelf 11/10/20 +! flux_bdry, & + US, PF ) + + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + real, dimension(SZIB_(G),SZJ_(G)), & + intent(inout) :: u_face_mask_bdry !< A boundary-type mask at C-grid u faces + real, dimension(SZIB_(G),SZJ_(G)), & + intent(inout) :: u_flux_bdry_val !< The boundary thickness flux through + !! C-grid u faces [L Z T-1 ~> m2 s-1]. + real, dimension(SZI_(G),SZJB_(G)), & + intent(inout) :: v_face_mask_bdry !< A boundary-type mask at C-grid v faces + real, dimension(SZI_(G),SZJB_(G)), & + intent(inout) :: v_flux_bdry_val !< The boundary thickness flux through + !! C-grid v faces [L Z T-1 ~> m2 s-1]. + real, dimension(SZIB_(G),SZJB_(G)), & + intent(inout) :: u_bdry_val !< The zonal ice shelf velocity at open + !! boundary vertices [L T-1 ~> m s-1]. + real, dimension(SZIB_(G),SZJB_(G)), & + intent(inout) :: v_bdry_val !< The meridional ice shelf velocity at open + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: thickness_bdry_val !< The ice shelf thickness at open boundaries [Z ~> m] + !! boundary vertices [L T-1 ~> m s-1]. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: h_bdry_val !< The ice shelf thickness at open boundaries [Z ~> m] + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: hmask !< A mask indicating which tracer points are + !! partly or fully covered by an ice-shelf + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: h_shelf !< Ice-shelf thickness OVS 11/10/20 +! logical, intent(in) :: flux_bdry !< If true, use mass fluxes as the boundary value. + type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors + type(param_file_type), intent(in) :: PF !< A structure to parse for run-time parameters + + character(len=40) :: mdl = "initialize_ice_shelf_boundary_channel" ! This subroutine's name. + integer :: i, j, isd, jsd, is, js, iegq, jegq, giec, gjec, gisc, gjsc,gisd,gjsd, isc, jsc, iec, jec, ied, jed + real :: input_thick ! The input ice shelf thickness [Z ~> m] +! real :: input_flux ! The input ice flux per unit length [L Z T-1 ~> m2 s-1] + real :: input_vel ! The input ice velocity per [L Z T-1 ~> m s-1] + real :: lenlat, len_stress, westlon, lenlon, southlat + + + call get_param(PF, mdl, "LENLAT", lenlat, fail_if_missing=.true.) + + call get_param(PF, mdl, "LENLON", lenlon, fail_if_missing=.true.) + + call get_param(PF, mdl, "WESTLON", westlon, fail_if_missing=.true.) + + call get_param(PF, mdl, "SOUTHLAT", southlat, fail_if_missing=.true.) + + call get_param(PF, mdl, "INPUT_VEL_ICE_SHELF", input_vel, & + "inflow ice velocity at upstream boundary", & + units="m s-1", default=0., scale=US%m_s_to_L_T*US%m_to_Z) + call get_param(PF, mdl, "INPUT_THICK_ICE_SHELF", input_thick, & + "flux thickness at upstream boundary", & + units="m", default=1000., scale=US%m_to_Z) + call get_param(PF, mdl, "LEN_SIDE_STRESS", len_stress, & + "maximum position of no-flow condition in along-flow direction", & + units="km", default=0.) + + call MOM_mesg(mdl//": setting boundary") + + isd = G%isd ; ied = G%ied + jsd = G%jsd ; jed = G%jed + isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec + gjsd = G%Domain%njglobal ; gisd = G%Domain%niglobal + gisc = G%Domain%nihalo ; gjsc = G%Domain%njhalo + giec = G%Domain%niglobal+gisc ; gjec = G%Domain%njglobal+gjsc + +!-----------b.c.s based on geopositions ----------------- + do j=jsc-1,jec+1 + do i=isc-1,iec+1 + ! upstream boundary - set either dirichlet or flux condition + + if (G%geoLonBu(i,j) == westlon) then + ! if (flux_bdry) then + ! u_face_mask_bdry(i-1,j) = 4.0 + ! u_flux_bdry_val(i-1,j) = input_flux + ! else + hmask(i+1,j) = 3.0 + h_bdry_val(i+1,j) = h_shelf(i+1,j) !OVS 11/10/20 !input_thick + thickness_bdry_val(i+1,j) = h_bdry_val(i+1,j) + u_face_mask_bdry(i+1,j) = 3.0 + u_bdry_val(i+1,j) = input_vel*(1-16.0*((G%geoLatBu(i-1,j)/lenlat-0.5))**4) !OVS 11/09/20 U b.c. + ! u_bdry_val(i+1,j) = (1 - ((G%geoLatBu(i,j) - 0.5*lenlat)*2./lenlat)**2) * & + ! 1.5 * input_flux / input_thick + ! endif + endif + + + ! side boundaries: no flow + if (G%geoLatBu(i,j-1) == southlat) then !bot boundary + if (len_stress == 0. .OR. G%geoLonCv(i,j) <= len_stress) then + v_face_mask_bdry(i,j+1) = 0. + u_face_mask_bdry(i,j-1) = 3. !OVS 11/25/20 + else + v_face_mask_bdry(i,j+1) = 1. + u_face_mask_bdry(i,j-1) = 3. !OVS 11/25/20 + u_bdry_val(i,j) = 0. + !hmask(i,j) = 0.0 !OVS 11/25/20 + endif + elseif (G%geoLatBu(i,j-1) == southlat+lenlat) then !top boundary + if (len_stress == 0. .OR. G%geoLonCv(i,j) <= len_stress) then + v_face_mask_bdry(i,j-1) = 0. + u_face_mask_bdry(i,j-1) = 3. !OVS 11/25/20 + else + v_face_mask_bdry(i,j-1) = 1. + u_face_mask_bdry(i,j-1) = 3. !OVS 11/25/20 + !u_bdry_val(i,j) = 0. !OVS 11/25/20 + !hmask(i,j) = 0.0 !OVS 11/25/20 + endif + endif + + ! downstream boundary - CFBC + if (G%geoLonBu(i,j) == westlon+lenlon) then + u_face_mask_bdry(i-1,j) = 2.0 + endif + + enddo + enddo + +end subroutine initialize_ice_shelf_boundary_channel !BEGIN MJH ! subroutine initialize_ice_shelf_boundary(u_face_mask_bdry, v_face_mask_bdry, & From 39dd3e3221bb19ef90d191f3c69f77cd50de03cb Mon Sep 17 00:00:00 2001 From: Olga Sergienko Date: Tue, 15 Dec 2020 21:05:04 -0500 Subject: [PATCH 02/51] Modified MOM_ice_shelf_dynamics.F90 --- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 8480906de8..174891582a 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -672,6 +672,7 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf(:,:)) endif + if (update_ice_vel) then call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf, iters, Time) endif From 170b4beedd5b2e421bba8889e88eecfc9cd007f0 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 23 Dec 2020 07:42:20 -0700 Subject: [PATCH 03/51] Fixes inconsistency in the calculation of tendency * Also reducing line lenghts > 120 --- src/tracer/MOM_lateral_boundary_diffusion.F90 | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/src/tracer/MOM_lateral_boundary_diffusion.F90 b/src/tracer/MOM_lateral_boundary_diffusion.F90 index 570b4b9ad8..ccb42ddecf 100644 --- a/src/tracer/MOM_lateral_boundary_diffusion.F90 +++ b/src/tracer/MOM_lateral_boundary_diffusion.F90 @@ -222,8 +222,9 @@ subroutine lateral_boundary_diffusion(G, GV, US, h, Coef_x, Coef_y, dt, Reg, CS) if (G%mask2dT(i,j)>0.) then tracer%t(i,j,k) = tracer%t(i,j,k) + (( (uFlx(I-1,j,k)-uFlx(I,j,k)) ) + ( (vFlx(i,J-1,k)-vFlx(i,J,k) ) ))* & G%IareaT(i,j) / ( h(i,j,k) + GV%H_subroundoff ) + if (tracer%id_lbdxy_conc > 0 .or. tracer%id_lbdxy_cont > 0 .or. tracer%id_lbdxy_cont_2d > 0 ) then - tendency(i,j,k) = (tracer%t(i,j,k)-tracer_old(i,j,k)) * Idt + tendency(i,j,k) = (tracer%t(i,j,k)-tracer_old(i,j,k)) * (h(i,j,k) + GV%H_subroundoff) * Idt endif endif enddo ; enddo ; enddo @@ -579,13 +580,14 @@ subroutine fluxes_layer_method(boundary, ke, hbl_L, hbl_R, h_L, h_R, phi_L, phi_ type(lbd_CS), pointer :: CS !< Lateral diffusion control structure !! the boundary layer ! Local variables - real, dimension(:), allocatable :: dz_top !< The LBD z grid to be created [L ~ m] - real, dimension(:), allocatable :: phi_L_z !< Tracer values in the ztop grid (left) [conc] - real, dimension(:), allocatable :: phi_R_z !< Tracer values in the ztop grid (right) [conc] - real, dimension(:), allocatable :: F_layer_z !< Diffusive flux at U- or V-point in the ztop grid [H L2 conc ~> m3 conc] + real, dimension(:), allocatable :: dz_top !< The LBD z grid to be created [L ~ m] + real, dimension(:), allocatable :: phi_L_z !< Tracer values in the ztop grid (left) [conc] + real, dimension(:), allocatable :: phi_R_z !< Tracer values in the ztop grid (right) [conc] + real, dimension(:), allocatable :: F_layer_z !< Diffusive flux at U- or V-point in the ztop grid + !! [H L2 conc ~> m3 conc] real, dimension(ke) :: h_vel !< Thicknesses at u- and v-points in the native grid - !! The harmonic mean is used to avoid zero values [H ~> m or kg m-2] - real :: khtr_avg !< Thickness-weighted diffusivity at the u-point [m^2 s^-1] + !! The harmonic mean is used to avoid zero values [H ~> m or kg m-2] + real :: khtr_avg !< Thickness-weighted diffusivity at the u-point [m^2 s^-1] !! This is just to remind developers that khtr_avg should be !! computed once khtr is 3D. real :: htot !< Total column thickness [H ~> m or kg m-2] From 99dcfbb1d691c2f644b127c49252bc7f8307e14b Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 28 Dec 2020 12:19:40 -0700 Subject: [PATCH 04/51] Calculate tendency using fluxes --- src/tracer/MOM_lateral_boundary_diffusion.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/tracer/MOM_lateral_boundary_diffusion.F90 b/src/tracer/MOM_lateral_boundary_diffusion.F90 index ccb42ddecf..e7ece53c0a 100644 --- a/src/tracer/MOM_lateral_boundary_diffusion.F90 +++ b/src/tracer/MOM_lateral_boundary_diffusion.F90 @@ -224,7 +224,8 @@ subroutine lateral_boundary_diffusion(G, GV, US, h, Coef_x, Coef_y, dt, Reg, CS) G%IareaT(i,j) / ( h(i,j,k) + GV%H_subroundoff ) if (tracer%id_lbdxy_conc > 0 .or. tracer%id_lbdxy_cont > 0 .or. tracer%id_lbdxy_cont_2d > 0 ) then - tendency(i,j,k) = (tracer%t(i,j,k)-tracer_old(i,j,k)) * (h(i,j,k) + GV%H_subroundoff) * Idt + tendency(i,j,k) = ((uFlx(I-1,j,k)-uFlx(I,j,k)) + (vFlx(i,J-1,k)-vFlx(i,J,k))) * & + G%IareaT(i,j) * Idt endif endif enddo ; enddo ; enddo From ebac0adb8524b450882d679f5c74af71e50d50b7 Mon Sep 17 00:00:00 2001 From: Olga Sergienko Date: Tue, 29 Dec 2020 10:38:55 -0500 Subject: [PATCH 05/51] Modifications to register_diag_field in MOM_ice_shelf_dynamics to make ice-shelf_fields consistent with diag_table Modifications to MOM_ice_shelf.F90 to apply melting to the case of a dynamic ice shelf. --- src/ice_shelf/MOM_ice_shelf.F90 | 11 ++++++++++ src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 28 ++++++++++++++++++------ 2 files changed, 32 insertions(+), 7 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 56461dbc3d..5663b326b7 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -710,6 +710,17 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step, CS) endif endif + ! Melting has been computed, now is time to update thickness and mass with dynamic ice shelf + if (CS%active_shelf_dynamics) then !OVS 12/10/20 + call change_thickness_using_melt(ISS, G, US, US%s_to_T*time_step, fluxes, CS%density_ice, CS%debug) !OVS 12/10/20 + + if (CS%debug) then + call hchksum(ISS%h_shelf, "h_shelf after change thickness using melt", G%HI, haloshift=0, scale=US%Z_to_m) + call hchksum(ISS%mass_shelf, "mass_shelf after change thickness using melt", G%HI, haloshift=0, & + scale=US%RZ_to_kg_m2) + endif + endif !OVS 12/10/20 + if (CS%debug) call MOM_forcing_chksum("Before add shelf flux", fluxes, G, CS%US, haloshift=0) call add_shelf_flux(G, US, CS, sfc_state, fluxes) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 174891582a..ead882dd75 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -537,21 +537,35 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ endif ! Register diagnostics. - CS%id_u_shelf = register_diag_field('ocean_model','u_shelf',CS%diag%axesCu1, Time, & +! CS%id_u_shelf = register_diag_field('ocean_model','u_shelf',CS%diag%axesCu1, Time, & +! 'x-velocity of ice', 'm yr-1', conversion=365.0*86400.0*US%L_T_to_m_s) + CS%id_u_shelf = register_diag_field('ice_shelf_model','u_shelf',CS%diag%axesCu1, Time, & 'x-velocity of ice', 'm yr-1', conversion=365.0*86400.0*US%L_T_to_m_s) - CS%id_v_shelf = register_diag_field('ocean_model','v_shelf',CS%diag%axesCv1, Time, & +! CS%id_v_shelf = register_diag_field('ocean_model','v_shelf',CS%diag%axesCv1, Time, & +! 'y-velocity of ice', 'm yr-1', conversion=365.0*86400.0*US%L_T_to_m_s) + CS%id_v_shelf = register_diag_field('ice_shelf_model','v_shelf',CS%diag%axesCv1, Time, & 'y-velocity of ice', 'm yr-1', conversion=365.0*86400.0*US%L_T_to_m_s) - CS%id_u_mask = register_diag_field('ocean_model','u_mask',CS%diag%axesCu1, Time, & +! CS%id_u_mask = register_diag_field('ocean_model','u_mask',CS%diag%axesCu1, Time, & +! 'mask for u-nodes', 'none') + CS%id_u_mask = register_diag_field('ice_shelf_model','u_mask',CS%diag%axesCu1, Time, & 'mask for u-nodes', 'none') - CS%id_v_mask = register_diag_field('ocean_model','v_mask',CS%diag%axesCv1, Time, & +! CS%id_v_mask = register_diag_field('ocean_model','v_mask',CS%diag%axesCv1, Time, & +! 'mask for v-nodes', 'none') + CS%id_v_mask = register_diag_field('ice_shelf_model','v_mask',CS%diag%axesCv1, Time, & 'mask for v-nodes', 'none') ! CS%id_surf_elev = register_diag_field('ocean_model','ice_surf',CS%diag%axesT1, Time, & ! 'ice surf elev', 'm') - CS%id_ground_frac = register_diag_field('ocean_model','ice_ground_frac',CS%diag%axesT1, Time, & +! CS%id_ground_frac = register_diag_field('ocean_model','ice_ground_frac',CS%diag%axesT1, Time, & +! 'fraction of cell that is grounded', 'none') + CS%id_ground_frac = register_diag_field('ice_shelf_model','ice_ground_frac',CS%diag%axesT1, Time, & 'fraction of cell that is grounded', 'none') - CS%id_col_thick = register_diag_field('ocean_model','col_thick',CS%diag%axesT1, Time, & +! CS%id_col_thick = register_diag_field('ocean_model','col_thick',CS%diag%axesT1, Time, & +! 'ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) + CS%id_col_thick = register_diag_field('ice_shelf_model','col_thick',CS%diag%axesT1, Time, & 'ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) - CS%id_OD_av = register_diag_field('ocean_model','OD_av',CS%diag%axesT1, Time, & +! CS%id_OD_av = register_diag_field('ocean_model','OD_av',CS%diag%axesT1, Time, & +! 'intermediate ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) + CS%id_OD_av = register_diag_field('ice_shelf_model','OD_av',CS%diag%axesT1, Time, & 'intermediate ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) !CS%id_h_after_uflux = register_diag_field('ocean_model','h_after_uflux',CS%diag%axesh1, Time, & ! 'thickness after u flux ', 'none') From 280e98b7a970b233b7a6bdebc84bbed75ca1451a Mon Sep 17 00:00:00 2001 From: Ian Grooms Date: Mon, 4 Jan 2021 12:27:27 -0700 Subject: [PATCH 06/51] Added a counter-based PRNG to MOM_random See https://arxiv.org/abs/2004.06278. Not an exact reproduction of "squares" because Fortran doesn't have a uint64 type, and not all compilers provide integers with > 64 bits... --- src/framework/MOM_random.F90 | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/src/framework/MOM_random.F90 b/src/framework/MOM_random.F90 index 161236572c..97e4a1ace8 100644 --- a/src/framework/MOM_random.F90 +++ b/src/framework/MOM_random.F90 @@ -17,6 +17,7 @@ module MOM_random public :: random_0d_constructor public :: random_01 +public :: random_01_CB public :: random_norm public :: random_2d_constructor public :: random_2d_01 @@ -46,6 +47,28 @@ real function random_01(CS) end function random_01 +!> Returns a random number between 0 and 1 +!! See https://arxiv.org/abs/2004.06278. Not an exact reproduction of "squares" because Fortran +!! doesn't have a uint64 type, and not all compilers provide integers with > 64 bits... +real function random_01_CB(ctr, key) + integer, parameter :: int64 = selected_int_kind(10) ! Integer with >= 64 bits + integer, intent(in) :: ctr, key ! counter & key inputs, standard integer kind + integer(kind=int64) :: x, y, z ! Follows "Squares" naming convention + + x = (ctr + 1) * (key + 65536) ! 65536 added because keys below that don't work. + y = (ctr + 1) * (key + 65536) + z = y + (key + 65536) + x = x*x + y + x = ior(ishft(x,32),ishft(x,-32)) + x = x*x + z + x = ior(ishft(x,32),ishft(x,-32)) + x = x*x + y + x = ior(ishft(x,32),ishft(x,-32)) + x = x*x + z + random_01_CB = .5*(1. + .5*real(int(ishft(x,-32)))/real(2**30)) + +end function + !> Returns an approximately normally distributed random number with mean 0 and variance 1 real function random_norm(CS) type(PRNG), intent(inout) :: CS !< Container for pseudo-random number generators From 62138bebf91c0df1ad535af7dedc3be1e3f56210 Mon Sep 17 00:00:00 2001 From: Ian Grooms Date: Tue, 5 Jan 2021 16:03:26 -0700 Subject: [PATCH 07/51] Used int64 from F2003 and added doc strings --- src/framework/MOM_random.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/framework/MOM_random.F90 b/src/framework/MOM_random.F90 index 97e4a1ace8..95775f9050 100644 --- a/src/framework/MOM_random.F90 +++ b/src/framework/MOM_random.F90 @@ -51,8 +51,9 @@ end function random_01 !! See https://arxiv.org/abs/2004.06278. Not an exact reproduction of "squares" because Fortran !! doesn't have a uint64 type, and not all compilers provide integers with > 64 bits... real function random_01_CB(ctr, key) - integer, parameter :: int64 = selected_int_kind(10) ! Integer with >= 64 bits - integer, intent(in) :: ctr, key ! counter & key inputs, standard integer kind + use iso_fortran_env, only : int64 + integer, intent(in) :: ctr !< ctr should be incremented each time you call the function + integer, intent(in) :: key !< key is like a seed: use a different key for each random stream integer(kind=int64) :: x, y, z ! Follows "Squares" naming convention x = (ctr + 1) * (key + 65536) ! 65536 added because keys below that don't work. From dde80bafcb9e097fbf64fdba859c007d8c5162f6 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 6 Jan 2021 18:16:39 -0700 Subject: [PATCH 08/51] Avoids calling boundary_k_range at land pts --- src/tracer/MOM_neutral_diffusion.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index e995ca1972..0a413e866b 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -320,7 +320,9 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS, p_surf) call pass_var(hbl,G%Domain) ! get k-indices and zeta do j=G%jsc-1, G%jec+1 ; do i=G%isc-1,G%iec+1 - call boundary_k_range(SURFACE, G%ke, h(i,j,:), hbl(i,j), k_top(i,j), zeta_top(i,j), k_bot(i,j), zeta_bot(i,j)) + if (G%mask2dT(i,j) > 0.) then + call boundary_k_range(SURFACE, G%ke, h(i,j,:), hbl(i,j), k_top(i,j), zeta_top(i,j), k_bot(i,j), zeta_bot(i,j)) + endif enddo; enddo ! TODO: add similar code for BOTTOM boundary layer endif From 0262e930a005ec45ba7938d1b44a54185b6a3563 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Thu, 7 Jan 2021 21:10:34 -0700 Subject: [PATCH 09/51] remove omp parallel do directive for a do loop including cpu_clock calls --- src/parameterizations/vertical/MOM_set_diffusivity.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index b81cf62631..d24bc890f5 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -391,8 +391,6 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! set surface diffusivities (CS%bkgnd_mixing_csp%Kd_sfc) call sfc_bkgnd_mixing(G, US, 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) do j=js,je ! Set up variables related to the stratification. From c3ea9d0c3ee1ff982ef75396145020d7d303c6f6 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 21 Jan 2021 09:47:44 -0700 Subject: [PATCH 10/51] Fixes latent heat from fprec and frunoff This patch fixes a sign bug, in both MCT and NUOPC, when accounting for the latent heat from fprec and frunnoff. Following MOM6's definition, both fprec and frunoff are > 0 into the ocean. Therefore, the latent heat associated with these terms should be negative. --- config_src/mct_driver/mom_surface_forcing_mct.F90 | 12 ++++++------ .../nuopc_driver/mom_surface_forcing_nuopc.F90 | 10 ++++++---- 2 files changed, 12 insertions(+), 10 deletions(-) diff --git a/config_src/mct_driver/mom_surface_forcing_mct.F90 b/config_src/mct_driver/mom_surface_forcing_mct.F90 index 82105e040e..ef0527dd1c 100644 --- a/config_src/mct_driver/mom_surface_forcing_mct.F90 +++ b/config_src/mct_driver/mom_surface_forcing_mct.F90 @@ -486,17 +486,17 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, ! latent heat flux (W/m^2) fluxes%latent(i,j) = 0.0 - ! contribution from frozen ppt + ! contribution from frozen ppt (notice minus sign since fprec is positive into the ocean) if (associated(IOB%fprec)) then - fluxes%latent(i,j) = fluxes%latent(i,j) + & + fluxes%latent(i,j) = fluxes%latent(i,j) - & IOB%fprec(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion - fluxes%latent_fprec_diag(i,j) = G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion + fluxes%latent_fprec_diag(i,j) = - G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion endif - ! contribution from frozen runoff + ! contribution from frozen runoff (notice minus sign since rofi_flux is positive into the ocean) if (associated(fluxes%frunoff)) then - fluxes%latent(i,j) = fluxes%latent(i,j) + & + fluxes%latent(i,j) = fluxes%latent(i,j) - & IOB%rofi_flux(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion - fluxes%latent_frunoff_diag(i,j) = G%mask2dT(i,j) * IOB%rofi_flux(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion + fluxes%latent_frunoff_diag(i,j) = - G%mask2dT(i,j) * IOB%rofi_flux(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion endif ! contribution from evaporation if (associated(IOB%q_flux)) then diff --git a/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 b/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 index 9ecf8bb01a..b219e12971 100644 --- a/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 +++ b/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 @@ -485,15 +485,17 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, fluxes%seaice_melt(i,j) = kg_m2_s_conversion * G%mask2dT(i,j) * IOB%seaice_melt(i-i0,j-j0) fluxes%latent(i,j) = 0.0 + ! notice minus sign since fprec is positive into the ocean if (associated(IOB%fprec)) then - fluxes%latent(i,j) = fluxes%latent(i,j) + & + fluxes%latent(i,j) = fluxes%latent(i,j) - & IOB%fprec(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion - fluxes%latent_fprec_diag(i,j) = G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion + fluxes%latent_fprec_diag(i,j) = - G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion endif + ! notice minus sign since frunoff is positive into the ocean if (associated(IOB%frunoff)) then - fluxes%latent(i,j) = fluxes%latent(i,j) + & + fluxes%latent(i,j) = fluxes%latent(i,j) - & IOB%frunoff(i-i0,j-j0) * US%W_m2_to_QRZ_T * CS%latent_heat_fusion - fluxes%latent_frunoff_diag(i,j) = G%mask2dT(i,j) * & + fluxes%latent_frunoff_diag(i,j) = - G%mask2dT(i,j) * & IOB%frunoff(i-i0,j-j0) * US%W_m2_to_QRZ_T * CS%latent_heat_fusion endif if (associated(IOB%q_flux)) then From e209c0ed60ef6a0f7cf00de4d4b94c35632ca3f0 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 27 Jan 2021 12:32:20 -0700 Subject: [PATCH 11/51] incorporated flux correction factors --- config_src/nuopc_driver/mom_cap.F90 | 79 +++++++++++++++--- config_src/nuopc_driver/mom_cap_methods.F90 | 91 ++++++++++++--------- 2 files changed, 119 insertions(+), 51 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index fc6bb5035e..ca44833341 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -35,7 +35,7 @@ module MOM_cap_mod use MOM_ocean_model_nuopc, only: ocean_model_init, update_ocean_model, ocean_model_end use MOM_ocean_model_nuopc, only: get_ocean_grid, get_eps_omesh use MOM_cap_time, only: AlarmInit -use MOM_cap_methods, only: mom_import, mom_export, mom_set_geomtype +use MOM_cap_methods, only: mom_import, mom_export, mom_set_geomtype, mod2med_areacor, med2mod_areacor #ifdef CESMCOUPLED use shr_file_mod, only: shr_file_setLogUnit, shr_file_getLogUnit #endif @@ -68,6 +68,7 @@ module MOM_cap_mod use ESMF, only: ESMF_COORDSYS_SPH_DEG, ESMF_GridCreate, ESMF_INDEX_DELOCAL use ESMF, only: ESMF_MESHLOC_ELEMENT, ESMF_RC_VAL_OUTOFRANGE, ESMF_StateGet use ESMF, only: ESMF_TimePrint, ESMF_AlarmSet, ESMF_FieldGet, ESMF_Array +use ESMF, only: ESMF_FieldRegridGetArea use ESMF, only: ESMF_ArrayCreate use ESMF, only: ESMF_RC_FILE_OPEN, ESMF_RC_FILE_READ, ESMF_RC_FILE_WRITE use ESMF, only: ESMF_VMBroadcast @@ -888,16 +889,21 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) character(len=256) :: cvalue character(len=256) :: frmt ! format specifier for several error msgs character(len=512) :: err_msg ! error messages + integer :: spatialDim + integer :: numOwnedElements + type(ESMF_Array) :: elemMaskArray + real(ESMF_KIND_R8) , pointer :: ownedElemCoords(:) + real(ESMF_KIND_R8) , pointer :: lat(:), latMesh(:) + real(ESMF_KIND_R8) , pointer :: lon(:), lonMesh(:) + integer(ESMF_KIND_I4) , pointer :: mask(:), maskMesh(:) + real(ESMF_KIND_R8) :: diff_lon, diff_lat + real :: eps_omesh + real(ESMF_KIND_R8) :: L2_to_rad2 + type(ESMF_Field) :: lfield + real(ESMF_KIND_R8), allocatable :: mesh_areas(:) + real(ESMF_KIND_R8), allocatable :: model_areas(:) + real(ESMF_KIND_R8), pointer :: dataPtr_mesh_areas(:) character(len=*), parameter :: subname='(MOM_cap:InitializeRealize)' - integer :: spatialDim - integer :: numOwnedElements - type(ESMF_Array) :: elemMaskArray - real(ESMF_KIND_R8) , pointer :: ownedElemCoords(:) - real(ESMF_KIND_R8) , pointer :: lat(:), latMesh(:) - real(ESMF_KIND_R8) , pointer :: lon(:), lonMesh(:) - integer(ESMF_KIND_I4) , pointer :: mask(:), maskMesh(:) - real(ESMF_KIND_R8) :: diff_lon, diff_lat - real :: eps_omesh !-------------------------------- rc = ESMF_SUCCESS @@ -1426,7 +1432,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return - endif !--------------------------------- @@ -1450,6 +1455,58 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) endif + !--------------------------------- + ! determine flux area correction factors - module variables in mom_cap_methods + !--------------------------------- + + ! Area correction factors are ONLY valid for meshes that are read in - so do not need them for + ! grids that are calculated internally + + if (geomtype == ESMF_GEOMTYPE_MESH) then + + ! Determine mesh areas for regridding + call ESMF_MeshGet(Emesh, numOwnedElements=numOwnedElements, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_StateGet(exportState, itemName=trim(fldsFrOcn(2)%stdname), field=lfield, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_FieldRegridGetArea(lfield, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_FieldGet(lfield, farrayPtr=dataPtr_mesh_areas, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + allocate(mesh_areas(numOwnedElements)) + mesh_areas(:) = dataPtr_mesh_areas(:) + + ! Determine model areas + allocate(model_areas(numOwnedElements)) + k = 0 + L2_to_rad2 = ocean_grid%US%L_to_m**2 / ocean_grid%Rad_Earth**2 + do j = ocean_grid%jsc, ocean_grid%jec + do i = ocean_grid%isc, ocean_grid%iec + k = k + 1 ! Increment position within gindex + model_areas(k) = ocean_grid%AreaT(i,j) * L2_to_rad2 + enddo + enddo + + ! Determine flux correction factors (module variables in mom_) + allocate (mod2med_areacor(numOwnedElements)) + allocate (med2mod_areacor(numOwnedElements)) + do n = 1,numOwnedElements + if (model_areas(n) == mesh_areas(n)) then + mod2med_areacor(n) = 1._ESMF_KIND_R8 + med2mod_areacor(n) = 1._ESMF_KIND_R8 + else + mod2med_areacor(n) = model_areas(n) / mesh_areas(n) + med2mod_areacor(n) = mesh_areas(n) / model_areas(n) + if (abs(mod2med_areacor(n) - 1._ESMF_KIND_R8) > 1.e-13) then + write(6,'(a,i8,2x,d21.14,2x)')' AREACOR mom6: n, abs(mod2med_areacor(n)-1)', & + n, abs(mod2med_areacor(n) - 1._ESMF_KIND_R8) + end if + end if + end do + deallocate(model_areas) + deallocate(mesh_areas) + end if + !--------------------------------- ! Set module variable geomtype in MOM_cap_methods !--------------------------------- diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 70915d0e95..d365268c0c 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -43,6 +43,13 @@ module MOM_cap_methods type(ESMF_GeomType_Flag) :: geomtype !< SMF type describing type of !! geometry (mesh or grid) +! area correction factors for fluxes send and received from mediator +! these actors are ONLY valid for meshes that are read in - so do not need them for +! grids that are calculated internally + +real(ESMF_KIND_R8), public, allocatable :: mod2med_areacor(:) ! ratios of model areas to input mesh areas +real(ESMF_KIND_R8), public, allocatable :: med2mod_areacor(:) ! ratios of input mesh areas to model areas + contains !> Sets module variable geometry type @@ -95,7 +102,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! near-IR, direct shortwave (W/m2) !---- call state_getimport(importState, 'mean_net_sw_ir_dir_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dir, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dir, areacor=med2mod_areacor, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -147,12 +154,14 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, allocate (taux(isc:iec,jsc:jec)) allocate (tauy(isc:iec,jsc:jec)) - call state_getimport(importState, 'mean_zonal_moment_flx', isc, iec, jsc, jec, taux, rc=rc) + call state_getimport(importState, 'mean_zonal_moment_flx', isc, iec, jsc, jec, taux, & + areacor=med2mod_areacor, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call state_getimport(importState, 'mean_merid_moment_flx', isc, iec, jsc, jec, tauy, rc=rc) + call state_getimport(importState, 'mean_merid_moment_flx', isc, iec, jsc, jec, tauy, & + areacor=med2mod_areacor, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -177,7 +186,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! sensible heat flux (W/m2) !---- call state_getimport(importState, 'mean_sensi_heat_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%t_flux, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%t_flux, areacor=mod2med_areacor, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -187,7 +196,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! evaporation flux (W/m2) !---- call state_getimport(importState, 'mean_evap_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%q_flux, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%q_flux, areacor=mod2med_areacor, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -197,7 +206,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! liquid precipitation (rain) !---- call state_getimport(importState, 'mean_prec_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%lprec, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%lprec, areacor=mod2med_areacor, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -207,7 +216,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! frozen precipitation (snow) !---- call state_getimport(importState, 'mean_fprec_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%fprec, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%fprec, areacor=mod2med_areacor, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -222,7 +231,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! liquid runoff ice_ocean_boundary%lrunoff (:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'Foxx_rofl', & - isc, iec, jsc, jec, ice_ocean_boundary%lrunoff,rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%lrunoff, areacor=mod2med_areacor, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -231,7 +240,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! ice runoff ice_ocean_boundary%frunoff (:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'Foxx_rofi', & - isc, iec, jsc, jec, ice_ocean_boundary%frunoff,rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%frunoff, areacor=mod2med_areacor, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -240,7 +249,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! heat content of lrunoff ice_ocean_boundary%lrunoff_hflx(:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'mean_runoff_heat_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%lrunoff_hflx, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%lrunoff_hflx, areacor=mod2med_areacor, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -249,7 +258,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! heat content of frunoff ice_ocean_boundary%frunoff_hflx(:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'mean_calving_heat_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%frunoff_hflx, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%frunoff_hflx, areacor=mod2med_areacor, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -260,29 +269,29 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- ice_ocean_boundary%salt_flux(:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'mean_salt_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%salt_flux,rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%salt_flux, areacor=mod2med_areacor, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - ! !---- - ! ! snow&ice melt heat flux (W/m^2) - ! !---- + !---- + ! snow&ice melt heat flux (W/m^2) + !---- ice_ocean_boundary%seaice_melt_heat(:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'net_heat_flx_to_ocn', & - isc, iec, jsc, jec, ice_ocean_boundary%seaice_melt_heat,rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%seaice_melt_heat, areacor=mod2med_areacor, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - ! !---- - ! ! snow&ice melt water flux (W/m^2) - ! !---- + !---- + ! snow&ice melt water flux (W/m^2) + !---- ice_ocean_boundary%seaice_melt(:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'mean_fresh_water_to_ocean_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%seaice_melt,rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%seaice_melt, areacor=mod2med_areacor, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -296,7 +305,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ice_ocean_boundary%mi(:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'mass_of_overlying_ice', & - isc, iec, jsc, jec, ice_ocean_boundary%mi, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%mi,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -477,7 +486,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, enddo call State_SetExport(exportState, 'freezing_melting_potential', & - isc, iec, jsc, jec, melt_potential, ocean_grid, rc=rc) + isc, iec, jsc, jec, melt_potential, ocean_grid, areacor=mod2med_areacor, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -669,7 +678,7 @@ subroutine State_GetFldPtr_2d(State, fldname, fldptr, rc) end subroutine State_GetFldPtr_2d !> Map import state field to output array -subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, rc) +subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, areacor, rc) type(ESMF_State) , intent(in) :: state !< ESMF state character(len=*) , intent(in) :: fldname !< Field name integer , intent(in) :: isc !< The start i-index of cell centers within @@ -682,6 +691,8 @@ subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, r !! the computational domain real (ESMF_KIND_R8) , intent(inout) :: output(isc:iec,jsc:jec)!< Output 2D array logical, optional , intent(in) :: do_sum !< If true, sums the data + real (ESMF_KIND_R8), optional, intent(in) :: areacor(:) !< flux area correction factors + !! applicable to meshes integer , intent(out) :: rc !< Return code ! local variables @@ -702,10 +713,7 @@ subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, r ! get field pointer call state_getfldptr(state, trim(fldname), dataptr1d, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out ! determine output array n = 0 @@ -719,14 +727,16 @@ subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, r endif enddo enddo + if (present(areacor)) then + do n = 1,size(dataPtr1d) + dataPtr1d(n) = dataPtr1d(n) * areacor(n) + end do + end if else if (geomtype == ESMF_GEOMTYPE_GRID) then call state_getfldptr(state, trim(fldname), dataptr2d, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out lbnd1 = lbound(dataPtr2d,1) lbnd2 = lbound(dataPtr2d,2) @@ -750,7 +760,7 @@ subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, r end subroutine State_GetImport !> Map input array to export state -subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid, rc) +subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid, areacor, rc) type(ESMF_State) , intent(inout) :: state !< ESMF state character(len=*) , intent(in) :: fldname !< Field name integer , intent(in) :: isc !< The start i-index of cell centers within @@ -763,6 +773,8 @@ subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid !! the computational domain real (ESMF_KIND_R8) , intent(in) :: input(isc:iec,jsc:jec)!< Input 2D array type(ocean_grid_type) , intent(in) :: ocean_grid !< Ocean horizontal grid + real (ESMF_KIND_R8), optional, intent(in) :: areacor(:) !< flux area correction factors + !! applicable to meshes integer , intent(out) :: rc !< Return code ! local variables @@ -786,10 +798,7 @@ subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid if (geomtype == ESMF_GEOMTYPE_MESH) then call state_getfldptr(state, trim(fldname), dataptr1d, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out n = 0 do j = jsc, jec @@ -800,14 +809,16 @@ subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid dataPtr1d(n) = input(i,j) * ocean_grid%mask2dT(ig,jg) enddo enddo + if (present(areacor)) then + do n = 1,(size(dataPtr1d)) + dataPtr1d(n) = dataPtr1d(n) * areacor(n) + enddo + end if else if (geomtype == ESMF_GEOMTYPE_GRID) then call state_getfldptr(state, trim(fldname), dataptr2d, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out lbnd1 = lbound(dataPtr2d,1) lbnd2 = lbound(dataPtr2d,2) From f30f636b2d65853180b125bd1f935c6d956c816b Mon Sep 17 00:00:00 2001 From: Olga Sergienko Date: Mon, 8 Feb 2021 19:35:38 -0500 Subject: [PATCH 12/51] corrected indecises in computation of driving stresses --- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 114 ++++++++++++++------- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 38 ++++++- 2 files changed, 110 insertions(+), 42 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index ead882dd75..ef884dc434 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -44,7 +44,10 @@ module MOM_ice_shelf_dynamics !! on q-points (B grid) [L T-1 ~> m s-1] real, pointer, dimension(:,:) :: v_shelf => NULL() !< the meridional velocity of the ice shelf/sheet !! on q-points (B grid) [L T-1 ~> m s-1] - + real, pointer, dimension(:,:) :: taudx_shelf => NULL() !< the driving stress of the ice shelf/sheet + !! on q-points (C grid) [Pa ~> Pa] + real, pointer, dimension(:,:) :: taudy_shelf => NULL() !< the meridional stress of the ice shelf/sheet + !! on q-points (C grid) [Pa ~> Pa] real, pointer, dimension(:,:) :: u_face_mask => NULL() !< mask for velocity boundary conditions on the C-grid !! u-face - this is because the FEM cares about FACES THAT GET INTEGRATED OVER, !! not vertices. Will represent boundary conditions on computational boundary @@ -152,6 +155,7 @@ module MOM_ice_shelf_dynamics !>@{ Diagnostic handles integer :: id_u_shelf = -1, id_v_shelf = -1, id_t_shelf = -1, & + id_taudx_shelf = -1, id_taudy_shelf = -1, & id_ground_frac = -1, id_col_thick = -1, id_OD_av = -1, & id_u_mask = -1, id_v_mask = -1, id_t_mask = -1 !>@} @@ -250,7 +254,8 @@ subroutine register_ice_shelf_dyn_restarts(G, param_file, CS, restart_CS) allocate( CS%basal_traction(isd:ied,jsd:jed) ) ; CS%basal_traction(:,:) = 0.0 allocate( CS%OD_av(isd:ied,jsd:jed) ) ; CS%OD_av(:,:) = 0.0 allocate( CS%ground_frac(isd:ied,jsd:jed) ) ; CS%ground_frac(:,:) = 0.0 - + allocate( CS%taudx_shelf(Isd:Ied,Jsd:Jed) ) ; CS%taudx_shelf(:,:) = 0.0 + allocate( CS%taudy_shelf(Isd:Ied,Jsd:Jed) ) ; CS%taudy_shelf(:,:) = 0.0 ! additional restarts for ice shelf state call register_restart_field(CS%u_shelf, "u_shelf", .false., restart_CS, & "ice sheet/shelf u-velocity", "m s-1", hor_grid='Bu') @@ -258,6 +263,10 @@ subroutine register_ice_shelf_dyn_restarts(G, param_file, CS, restart_CS) "ice sheet/shelf v-velocity", "m s-1", hor_grid='Bu') call register_restart_field(CS%t_shelf, "t_shelf", .true., restart_CS, & "ice sheet/shelf vertically averaged temperature", "deg C") + call register_restart_field(CS%taudx_shelf, "taudx_shelf", .true., restart_CS, & !OVS 02/8/21 + "ice sheet/shelf taudx-driving stress", "kPa") + call register_restart_field(CS%taudy_shelf, "taudy_shelf", .true., restart_CS, & !OVS 02/08/21 + "ice sheet/shelf taudy-driving stress", "kPa") call register_restart_field(CS%OD_av, "OD_av", .true., restart_CS, & "Average open ocean depth in a cell","m") call register_restart_field(CS%ground_frac, "ground_frac", .true., restart_CS, & @@ -521,7 +530,8 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ endif call initialize_ice_shelf_boundary_channel(CS%u_face_mask_bdry, CS%v_face_mask_bdry, & - CS%u_flux_bdry_val, CS%v_flux_bdry_val, CS%u_bdry_val, CS%v_bdry_val, CS%h_bdry_val, & + CS%u_flux_bdry_val, CS%v_flux_bdry_val, CS%u_bdry_val, CS%v_bdry_val, CS%u_shelf, CS%v_shelf,& + CS%h_bdry_val, & CS%thickness_bdry_val, ISS%hmask, ISS%h_shelf, G, & ! CS%flux_bdry, & US, param_file ) !OVS initialize b.c.s @@ -530,10 +540,12 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ if (new_sim) then call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: initialize ice velocity.") call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf(:,:)) - call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf, iters, Time) - +! call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf, iters, Time) + call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) !OVS 02/08/21 if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf, CS%u_shelf, CS%diag) if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf, CS%v_shelf,CS%diag) + if (CS%id_taudx_shelf > 0) call post_data(CS%id_taudx_shelf, CS%taudx_shelf,CS%diag) + if (CS%id_taudy_shelf > 0) call post_data(CS%id_taudy_shelf, CS%taudy_shelf,CS%diag) endif ! Register diagnostics. @@ -545,6 +557,10 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ ! 'y-velocity of ice', 'm yr-1', conversion=365.0*86400.0*US%L_T_to_m_s) CS%id_v_shelf = register_diag_field('ice_shelf_model','v_shelf',CS%diag%axesCv1, Time, & 'y-velocity of ice', 'm yr-1', conversion=365.0*86400.0*US%L_T_to_m_s) + CS%id_taudx_shelf = register_diag_field('ice_shelf_model','taudx_shelf',CS%diag%axesT1, Time, & + 'x-driving stress of ice', 'kPa', conversion=1.e-3*US%L_T_to_m_s) + CS%id_taudy_shelf = register_diag_field('ice_shelf_model','taudy_shelf',CS%diag%axesT1, Time, & + 'x-driving stress of ice', 'kPa', conversion=1.e-3*US%L_T_to_m_s) ! CS%id_u_mask = register_diag_field('ocean_model','u_mask',CS%diag%axesCu1, Time, & ! 'mask for u-nodes', 'none') CS%id_u_mask = register_diag_field('ice_shelf_model','u_mask',CS%diag%axesCu1, Time, & @@ -559,6 +575,7 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ ! 'fraction of cell that is grounded', 'none') CS%id_ground_frac = register_diag_field('ice_shelf_model','ice_ground_frac',CS%diag%axesT1, Time, & 'fraction of cell that is grounded', 'none') + ! CS%id_col_thick = register_diag_field('ocean_model','col_thick',CS%diag%axesT1, Time, & ! 'ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) CS%id_col_thick = register_diag_field('ice_shelf_model','col_thick',CS%diag%axesT1, Time, & @@ -575,10 +592,10 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ ! 'thickness after front adv ', 'none') !!! OVS vertically integrated temperature - CS%id_t_shelf = register_diag_field('ocean_model','t_shelf',CS%diag%axesT1, Time, & - 'T of ice', 'oC') - CS%id_t_mask = register_diag_field('ocean_model','tmask',CS%diag%axesT1, Time, & - 'mask for T-nodes', 'none') +! CS%id_t_shelf = register_diag_field('ocean_model','t_shelf',CS%diag%axesT1, Time, & +! 'T of ice', 'oC') +! CS%id_t_mask = register_diag_field('ocean_model','tmask',CS%diag%axesT1, Time, & +! 'mask for T-nodes', 'none') endif end subroutine initialize_ice_shelf_dyn @@ -615,8 +632,8 @@ subroutine initialize_diagnostic_fields(CS, ISS, G, US, Time) enddo enddo - call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf, iters, dummy_time) - +! call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf, iters, dummy_time) + call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) !OVS 02/08/21 end subroutine initialize_diagnostic_fields !> This function returns the global maximum advective timestep that can be taken based on the current @@ -676,7 +693,7 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled coupled_GL = .false. if (present(ocean_mass) .and. present(coupled_grounding)) coupled_GL = coupled_grounding - call ice_shelf_advect(CS, ISS, G, time_step, Time) +! call ice_shelf_advect(CS, ISS, G, time_step, Time) !OVS 02/08/21 CS%elapsed_velocity_time = CS%elapsed_velocity_time + time_step if (CS%elapsed_velocity_time >= CS%velocity_update_time_step) update_ice_vel = .true. @@ -688,7 +705,8 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled if (update_ice_vel) then - call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf, iters, Time) +! call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf, iters, Time) + call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) !OVS 02/08/21 endif call ice_shelf_temp(CS, ISS, G, US, time_step, ISS%water_flux, Time) @@ -699,6 +717,8 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf, CS%u_shelf, CS%diag) if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf, CS%v_shelf, CS%diag) if (CS%id_t_shelf > 0) call post_data(CS%id_t_shelf,CS%t_shelf,CS%diag) + if (CS%id_taudx_shelf > 0) call post_data(CS%id_taudx_shelf, CS%taudx_shelf, CS%diag) + if (CS%id_taudy_shelf > 0) call post_data(CS%id_taudy_shelf, CS%taudy_shelf, CS%diag) if (CS%id_ground_frac > 0) call post_data(CS%id_ground_frac, CS%ground_frac,CS%diag) if (CS%id_OD_av >0) call post_data(CS%id_OD_av, CS%OD_av,CS%diag) @@ -801,7 +821,8 @@ subroutine ice_shelf_advect(CS, ISS, G, time_step, Time) end subroutine ice_shelf_advect -subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, iters, time) +!subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, iters, time) + subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, iters, Time) !OVS 02/08/21 type(ice_shelf_dyn_CS), intent(inout) :: CS !< The ice shelf dynamics control structure type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe !! the ice-shelf state @@ -861,7 +882,9 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, iters, time) enddo call calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, CS%OD_av) - + call pass_vector(taudx, taudy, G%domain, TO_ALL, BGRID_NE) !OVS 02/01/21 +! call pass_var(taudx, G%Domain) !OVS 01/21/21 +! call pass_var(taudy, G%Domain) !OVS 01/21/21 ! This is to determine which cells contain the grounding line, the criterion being that the cell ! is ice-covered, with some nodes floating and some grounded flotation condition is estimated by ! assuming topography is cellwise constant and H is bilinear in a cell; floating where @@ -1303,7 +1326,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H cg_halo = cg_halo - 1 if (cg_halo == 0) then - ! pass vectors + ! pass vectors call pass_vector(Du, Dv, G%domain, TO_ALL, BGRID_NE) call pass_vector(u_shlf, v_shlf, G%domain, TO_ALL, BGRID_NE) call pass_vector(Ru, Rv, G%domain, TO_ALL, BGRID_NE) @@ -1786,8 +1809,10 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) iscq = G%iscB ; iecq = G%iecB ; jscq = G%jscB ; jecq = G%jecB isd = G%isd ; jsd = G%jsd iegq = G%iegB ; jegq = G%jegB - gisc = G%domain%nihalo+1 ; gjsc = G%domain%njhalo+1 - giec = G%domain%niglobal+G%domain%nihalo ; gjec = G%domain%njglobal+G%domain%njhalo +! gisc = G%domain%nihalo+1 ; gjsc = G%domain%njhalo+1 + gisc = 0*G%domain%nihalo+1 ; gjsc = 0*G%domain%njhalo+1 +! giec = G%domain%niglobal+G%domain%nihalo ; gjec = G%domain%njglobal+G%domain%njhalo + giec = G%domain%niglobal+0*G%domain%nihalo ; gjec = G%domain%njglobal+0*G%domain%njhalo is = iscq - 1; js = jscq - 1 i_off = G%idg_offset ; j_off = G%jdg_offset @@ -1802,9 +1827,10 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) S(:,:) = BASE(:,:) + ISS%h_shelf(:,:) ! check whether the ice is floating or grounded - do j=jsc-1,jec+1 - do i=isc-1,iec+1 -! do i=isc-G%domain%nihalo,iec+G%domain%nihalo +! do j=jsc-1,jec+1 !OVS 02/02/21 +! do i=isc-1,iec+1 !OVS 02/02/21 + do j=jsc-G%domain%njhalo,jec+G%domain%njhalo !OVS 02/02/21 + do i=isc-G%domain%nihalo,iec+G%domain%nihalo !OVS 02/02/21 ! if (ISS%h_shelf(i,j) < rhow/rho * G%bathyT(i,j)) then if (rhoi_rhow * ISS%h_shelf(i,j) - G%bathyT(i,j) <= 0) then @@ -1816,6 +1842,8 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) enddo do j=jsc-1,jec+1 do i=isc-1,iec+1 +! do j=jsc-G%domain%njhalo+1,jec+G%domain%njhalo-1 !OVS 02/02/21 +! do i=isc-G%domain%nihalo+1,iec+G%domain%nihalo-1 !OVS 02/02/21 cnt = 0 sx = 0 sy = 0 @@ -1826,12 +1854,14 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) ! calculate sx if ((i+i_off) == gisc) then ! at left computational bdry - if (ISS%hmask(i+1,j) == 1) then +! if ((i-i_off) == gisc) then ! at left computational bdry !OVS 02/02/21 + if (ISS%hmask(i+1,j) == 1) then sx = (S(i+1,j)-S(i,j))/dxh else sx = 0 endif elseif ((i+i_off) == giec) then ! at east computational bdry +! elseif ((i-i_off) == giec) then ! at east computational bdry !OVS 02/02/21 if (ISS%hmask(i-1,j) == 1) then sx = (S(i,j)-S(i-1,j))/dxh else @@ -1861,12 +1891,14 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) ! calculate sy, similarly if ((j+j_off) == gjsc) then ! at south computational bdry +! if ((j-j_off) == gjsc) then ! at south computational bdry !OVS 02/02/21 if (ISS%hmask(i,j+1) == 1) then sy = (S(i,j+1)-S(i,j))/dyh else sy = 0 endif elseif ((j+j_off) == gjec) then ! at nprth computational bdry +! elseif ((j-j_off) == gjec) then ! at nprth computational bdry !OVS 02/02/21 if (ISS%hmask(i,j-1) == 1) then sy = (S(i,j)-S(i,j-1))/dyh else @@ -1894,29 +1926,31 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) ! SW vertex if (ISS%hmask(I-1,J-1) == 1) then - if (CS%u_face_mask(I-1,J-1) /= 3) then +! if (CS%u_face_mask(I-1,J-1) /= 3) then taudx(I-1,J-1) = taudx(I-1,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j) taudy(I-1,J-1) = taudy(I-1,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) - endif +! endif endif ! SE vertex if (ISS%hmask(I,J-1) == 1) then - if (CS%u_face_mask(I,J-1) /= 3) then +! if (CS%u_face_mask(I,J-1) /= 3) then taudx(I,J-1) = taudx(I,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j) taudy(I,J-1) = taudy(I,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) - endif +! endif endif ! NW vertex - if (CS%u_face_mask(I-1,J) /= 3) then + if (ISS%hmask(I-1,J) == 1) then +! if (CS%u_face_mask(I-1,J) /= 3) then taudx(I-1,J) = taudx(I-1,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j) taudy(I-1,J) = taudy(I-1,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) - endif +! endif + endif ! NE vertex if (ISS%hmask(I,J) == 1) then - if (CS%u_face_mask(I,J) /= 3) then +! if (CS%u_face_mask(I,J) /= 3) then taudx(I,J) = taudx(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j) taudy(I,J) = taudy(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) - endif +! endif endif if (CS%ground_frac(i,j) == 1) then ! neumann_val = .5 * grav * (rho * ISS%h_shelf(i,j)**2 - rhow * G%bathyT(i,j)**2) @@ -2550,8 +2584,8 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) Visc_coef = US%kg_m2s_to_RZ_T*US%m_to_L*US%Z_to_L*(CS%A_glen_isothermal)**(-1./CS%n_glen) !OVS '-' in the exponent - do j=jsd+1,jed-1 - do i=isd+1,ied-1 + do j=jsd+1,jed!-1 OVS 02/01/21 + do i=isd+1,ied!-1 OVS 02/01/21 if (ISS%hmask(i,j) == 1) then ux = ((u_shlf(I,J) + u_shlf(I,J-1)) - (u_shlf(I-1,J) + u_shlf(I-1,J-1))) / (2*G%dxT(i,j)) @@ -2601,8 +2635,8 @@ subroutine calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf) eps_min = CS%eps_glen_min - do j=jsd+1,jed-1 - do i=isd+1,ied-1 + do j=jsd+1,jed!-1 OVS 02/01/21 + do i=isd+1,ied!-1 OVS 02/01/21 if (ISS%hmask(i,j) == 1) then umid = ((u_shlf(I,J) + u_shlf(I-1,J-1)) + (u_shlf(I,J-1) + u_shlf(I-1,J))) * 0.25 @@ -2911,8 +2945,8 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face is = isd+1 ; js = jsd+1 endif -! do j=js,G%jed - do j=js-1,G%jed !OVS change index + do j=js,G%jed +! do j=js-1,G%jed !OVS change index do i=is,G%ied if (hmask(i,j) == 1) then @@ -2953,8 +2987,12 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face select case (int(CS%v_face_mask_bdry(i,J-1+k))) case (3) - vmask(I-1:I,J-1+k)=3. - umask(I-1:I,J-1+k)=0. +! vmask(I-1:I,J-1+k)=3. +! umask(I-1:I,J-1+k)=0. + vmask(I-1,J-1+k)=3. + umask(I-1,J-1+k)=0. + vmask(I,J-1+k)=3. + umask(I,J-1+k)=0. v_face_mask(i,J-1+k)=3. case (2) v_face_mask(i,J-1+k)=2. diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index 367f8d7dce..7025e53981 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -266,7 +266,7 @@ subroutine initialize_ice_thickness_channel(h_shelf, area_shelf_h, hmask, G, US, end subroutine initialize_ice_thickness_channel subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_bdry, & u_flux_bdry_val, v_flux_bdry_val, u_bdry_val, v_bdry_val, h_bdry_val, & - thickness_bdry_val, hmask, h_shelf, G,& ! OVS h_shelf 11/10/20 + thickness_bdry_val, hmask, h_shelf, u_shelf, v_shelf, G,& ! OVS h_shelf 11/10/20 ! flux_bdry, & US, PF ) @@ -286,6 +286,10 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b !! boundary vertices [L T-1 ~> m s-1]. real, dimension(SZIB_(G),SZJB_(G)), & intent(inout) :: v_bdry_val !< The meridional ice shelf velocity at open + real, dimension(SZIB_(G),SZJB_(G)), & + intent(inout) :: u_shelf !< The zonal ice shelf velocity [L T-1 ~> m s-1]. + real, dimension(SZIB_(G),SZJB_(G)), & + intent(inout) :: v_shelf !< The meridional ice shelf velocity [L T-1 ~> m s-1]. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: thickness_bdry_val !< The ice shelf thickness at open boundaries [Z ~> m] !! boundary vertices [L T-1 ~> m s-1]. @@ -362,9 +366,11 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b v_face_mask_bdry(i,j+1) = 0. u_face_mask_bdry(i,j-1) = 3. !OVS 11/25/20 else - v_face_mask_bdry(i,j+1) = 1. +! v_face_mask_bdry(i,j+1) = 1. + v_face_mask_bdry(i,j-1) = 3. !OVS 01/20/21 u_face_mask_bdry(i,j-1) = 3. !OVS 11/25/20 - u_bdry_val(i,j) = 0. +! u_bdry_val(i,j) = 0. +! v_bdry_val(i,j) = 0. !OVS 01/20/21 !hmask(i,j) = 0.0 !OVS 11/25/20 endif elseif (G%geoLatBu(i,j-1) == southlat+lenlat) then !top boundary @@ -372,7 +378,8 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b v_face_mask_bdry(i,j-1) = 0. u_face_mask_bdry(i,j-1) = 3. !OVS 11/25/20 else - v_face_mask_bdry(i,j-1) = 1. +! v_face_mask_bdry(i,j-1) = 1. + v_face_mask_bdry(i,j-1) = 3. !OVS 01/20/21 u_face_mask_bdry(i,j-1) = 3. !OVS 11/25/20 !u_bdry_val(i,j) = 0. !OVS 11/25/20 !hmask(i,j) = 0.0 !OVS 11/25/20 @@ -387,6 +394,29 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b enddo enddo + +! if (.not. G%symmetric) then +!! do j=G%jsd,G%jed +!! do i=G%isd,G%ied +! do j=jsc-1,jec+1 +! do i=isc-1,iec+1 +!! if (((i+G%idg_offset) == (G%domain%nihalo+1)).and.(u_face_mask_bdry(I-1,j) == 3)) then +! if (u_face_mask_bdry(I-1,j) == 3) then +! u_shelf(I-1,J-1) = u_bdry_val(I-1,J-1) +! u_shelf(I-1,J) = u_bdry_val(I-1,J) +! v_shelf(I-1,J-1) = v_bdry_val(I-1,J-1) +! v_shelf(I-1,J) = v_bdry_val(I-1,J) +! endif +!! if (((j+G%jdg_offset) == (G%domain%njhalo+1)).and.(v_face_mask_bdry(i,J-1) == 3)) then +! if (v_face_mask_bdry(I,j-1) == 3) then +! u_shelf(I-1,J-1) = u_bdry_val(I-1,J-1) +! u_shelf(I,J-1) = u_bdry_val(I,J-1) +! v_shelf(I-1,J-1) = v_bdry_val(I-1,J-1) +! v_shelf(I,J-1) = v_bdry_val(I,J-1) +! endif +! enddo +! enddo +! endif end subroutine initialize_ice_shelf_boundary_channel !BEGIN MJH From 775205208d4df98879e42ea66cd0e3b520f9a646 Mon Sep 17 00:00:00 2001 From: Olga Sergienko Date: Wed, 10 Feb 2021 12:39:08 -0500 Subject: [PATCH 13/51] fixed ice-shelf advection --- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 16 +++++++++------- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 12 +++++++----- 2 files changed, 16 insertions(+), 12 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index ef884dc434..89c91172e1 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -558,9 +558,9 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ CS%id_v_shelf = register_diag_field('ice_shelf_model','v_shelf',CS%diag%axesCv1, Time, & 'y-velocity of ice', 'm yr-1', conversion=365.0*86400.0*US%L_T_to_m_s) CS%id_taudx_shelf = register_diag_field('ice_shelf_model','taudx_shelf',CS%diag%axesT1, Time, & - 'x-driving stress of ice', 'kPa', conversion=1.e-3*US%L_T_to_m_s) + 'x-driving stress of ice', 'kPa', conversion=1.e-9*US%L_T_to_m_s) CS%id_taudy_shelf = register_diag_field('ice_shelf_model','taudy_shelf',CS%diag%axesT1, Time, & - 'x-driving stress of ice', 'kPa', conversion=1.e-3*US%L_T_to_m_s) + 'x-driving stress of ice', 'kPa', conversion=1.e-9*US%L_T_to_m_s) ! CS%id_u_mask = register_diag_field('ocean_model','u_mask',CS%diag%axesCu1, Time, & ! 'mask for u-nodes', 'none') CS%id_u_mask = register_diag_field('ice_shelf_model','u_mask',CS%diag%axesCu1, Time, & @@ -693,7 +693,7 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled coupled_GL = .false. if (present(ocean_mass) .and. present(coupled_grounding)) coupled_GL = coupled_grounding -! call ice_shelf_advect(CS, ISS, G, time_step, Time) !OVS 02/08/21 + call ice_shelf_advect(CS, ISS, G, time_step, Time) !OVS 02/08/21 CS%elapsed_velocity_time = CS%elapsed_velocity_time + time_step if (CS%elapsed_velocity_time >= CS%velocity_update_time_step) update_ice_vel = .true. @@ -782,7 +782,7 @@ subroutine ice_shelf_advect(CS, ISS, G, time_step, Time) call ice_shelf_advect_thickness_x(CS, G, LB, time_step, ISS%hmask, ISS%h_shelf, h_after_uflux, uh_ice) ! call enable_averages(time_step, Time, CS%diag) -! call pass_var(h_after_uflux, G%domain) + call pass_var(h_after_uflux, G%domain) ! if (CS%id_h_after_uflux > 0) call post_data(CS%id_h_after_uflux, h_after_uflux, CS%diag) ! call disable_averaging(CS%diag) @@ -790,7 +790,7 @@ subroutine ice_shelf_advect(CS, ISS, G, time_step, Time) call ice_shelf_advect_thickness_y(CS, G, LB, time_step, ISS%hmask, h_after_uflux, h_after_vflux, vh_ice) ! call enable_averages(time_step, Time, CS%diag) -! call pass_var(h_after_vflux, G%domain) + call pass_var(h_after_vflux, G%domain) ! if (CS%id_h_after_vflux > 0) call post_data(CS%id_h_after_vflux, h_after_vflux, CS%diag) ! call disable_averaging(CS%diag) @@ -882,7 +882,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite enddo call calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, CS%OD_av) - call pass_vector(taudx, taudy, G%domain, TO_ALL, BGRID_NE) !OVS 02/01/21 +! call pass_vector(taudx, taudy, G%domain, TO_ALL, BGRID_NE) !OVS 02/01/21 ! call pass_var(taudx, G%Domain) !OVS 01/21/21 ! call pass_var(taudy, G%Domain) !OVS 01/21/21 ! This is to determine which cells contain the grounding line, the criterion being that the cell @@ -1842,6 +1842,8 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) enddo do j=jsc-1,jec+1 do i=isc-1,iec+1 +! do j=G%jsd+1,G%jed-1 !OVS 02/08/21 +! do i=G%isd+1,G%ied-1 !OVS 02/08/21 ! do j=jsc-G%domain%njhalo+1,jec+G%domain%njhalo-1 !OVS 02/02/21 ! do i=isc-G%domain%nihalo+1,iec+G%domain%nihalo-1 !OVS 02/02/21 cnt = 0 @@ -2594,7 +2596,7 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) vy = ((v_shlf(I,J) + v_shlf(I-1,J)) - (v_shlf(I,J-1) + v_shlf(I-1,J-1))) / (2*G%dyT(i,j)) CS%ice_visc(i,j) = 0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) - +! CS%ice_visc(i,j) =1e15*(G%areaT(i,j) * ISS%h_shelf(i,j)) !OVS 02/09/21 constvisc ! umid = ((u_shlf(I,J) + u_shlf(I-1,J-1)) + (u_shlf(I,J-1) + u_shlf(I-1,J))) * 0.25 ! vmid = ((v_shlf(I,J) + v_shlf(I-1,J-1)) + (v_shlf(I,J-1) + v_shlf(I-1,J))) * 0.25 ! unorm = sqrt(umid**2 + vmid**2 + eps_min**2*(G%dxT(i,j)**2 + G%dyT(i,j)**2)) diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index 7025e53981..2bfe64677c 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -349,11 +349,13 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b ! u_face_mask_bdry(i-1,j) = 4.0 ! u_flux_bdry_val(i-1,j) = input_flux ! else - hmask(i+1,j) = 3.0 - h_bdry_val(i+1,j) = h_shelf(i+1,j) !OVS 11/10/20 !input_thick - thickness_bdry_val(i+1,j) = h_bdry_val(i+1,j) - u_face_mask_bdry(i+1,j) = 3.0 - u_bdry_val(i+1,j) = input_vel*(1-16.0*((G%geoLatBu(i-1,j)/lenlat-0.5))**4) !OVS 11/09/20 U b.c. +! hmask(i+1,j) = 3.0 + hmask(i,j) = 3.0 +! h_bdry_val(i+1,j) = h_shelf(i+1,j) !OVS 11/10/20 !input_thick + h_bdry_val(i,j) = h_shelf(i,j) + thickness_bdry_val(i+0*1,j) = h_bdry_val(i+0*1,j) + u_face_mask_bdry(i+0*1,j) = 3.0 + u_bdry_val(i+0*1,j) = input_vel*(1-16.0*((G%geoLatBu(i-1,j)/lenlat-0.5))**4) !OVS 11/09/20 U b.c. ! u_bdry_val(i+1,j) = (1 - ((G%geoLatBu(i,j) - 0.5*lenlat)*2./lenlat)**2) * & ! 1.5 * input_flux / input_thick ! endif From f0ae41c0caf262607b0c28b9e5e54bb313c7809a Mon Sep 17 00:00:00 2001 From: Olga Sergienko Date: Thu, 11 Feb 2021 17:33:02 -0500 Subject: [PATCH 14/51] modified viscosity computations --- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 204 +++++++++++++++++++---- 1 file changed, 168 insertions(+), 36 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 89c91172e1..db3a49cfe9 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -925,10 +925,11 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite enddo ; enddo call calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) - call pass_var(CS%ice_visc, G%domain) - +! call pass_var(CS%ice_visc, G%domain) +! call pass_vector(CS%ice_visc, G%domain, TO_ALL, BGRID_NE) !OVS 02/11/21 call calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf) call pass_var(CS%basal_traction, G%domain) +! call pass_vector(CS%ice_visc,CS%basal_traction, G%domain, TO_ALL, BGRID_NE) !OVS 02/11/21 ! This makes sure basal stress is only applied when it is supposed to be do j=G%jsd,G%jed ; do i=G%isd,G%ied @@ -1842,10 +1843,6 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) enddo do j=jsc-1,jec+1 do i=isc-1,iec+1 -! do j=G%jsd+1,G%jed-1 !OVS 02/08/21 -! do i=G%isd+1,G%ied-1 !OVS 02/08/21 -! do j=jsc-G%domain%njhalo+1,jec+G%domain%njhalo-1 !OVS 02/02/21 -! do i=isc-G%domain%nihalo+1,iec+G%domain%nihalo-1 !OVS 02/02/21 cnt = 0 sx = 0 sy = 0 @@ -1856,14 +1853,12 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) ! calculate sx if ((i+i_off) == gisc) then ! at left computational bdry -! if ((i-i_off) == gisc) then ! at left computational bdry !OVS 02/02/21 if (ISS%hmask(i+1,j) == 1) then sx = (S(i+1,j)-S(i,j))/dxh else sx = 0 endif elseif ((i+i_off) == giec) then ! at east computational bdry -! elseif ((i-i_off) == giec) then ! at east computational bdry !OVS 02/02/21 if (ISS%hmask(i-1,j) == 1) then sx = (S(i,j)-S(i-1,j))/dxh else @@ -1893,14 +1888,12 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) ! calculate sy, similarly if ((j+j_off) == gjsc) then ! at south computational bdry -! if ((j-j_off) == gjsc) then ! at south computational bdry !OVS 02/02/21 if (ISS%hmask(i,j+1) == 1) then sy = (S(i,j+1)-S(i,j))/dyh else sy = 0 endif elseif ((j+j_off) == gjec) then ! at nprth computational bdry -! elseif ((j-j_off) == gjec) then ! at nprth computational bdry !OVS 02/02/21 if (ISS%hmask(i,j-1) == 1) then sy = (S(i,j)-S(i,j-1))/dyh else @@ -1928,31 +1921,23 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) ! SW vertex if (ISS%hmask(I-1,J-1) == 1) then -! if (CS%u_face_mask(I-1,J-1) /= 3) then taudx(I-1,J-1) = taudx(I-1,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j) taudy(I-1,J-1) = taudy(I-1,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) -! endif endif ! SE vertex if (ISS%hmask(I,J-1) == 1) then -! if (CS%u_face_mask(I,J-1) /= 3) then taudx(I,J-1) = taudx(I,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j) taudy(I,J-1) = taudy(I,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) -! endif endif ! NW vertex if (ISS%hmask(I-1,J) == 1) then -! if (CS%u_face_mask(I-1,J) /= 3) then taudx(I-1,J) = taudx(I-1,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j) taudy(I-1,J) = taudy(I-1,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) -! endif endif ! NE vertex if (ISS%hmask(I,J) == 1) then -! if (CS%u_face_mask(I,J) /= 3) then taudx(I,J) = taudx(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j) taudy(I,J) = taudy(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) -! endif endif if (CS%ground_frac(i,j) == 1) then ! neumann_val = .5 * grav * (rho * ISS%h_shelf(i,j)**2 - rhow * G%bathyT(i,j)**2) @@ -2567,11 +2552,11 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) ! also this subroutine updates the nonlinear part of the basal traction ! this may be subject to change later... to make it "hybrid" - + real, dimension(SZDIB_(G),SZDJB_(G)) :: eII integer :: i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq - integer :: giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec, is, js + integer :: giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec, is, js, i_off, j_off real :: Visc_coef, n_g - real :: ux, uy, vx, vy, eps_min ! Velocity shears [T-1 ~> s-1] + real :: ux, uy, vx, vy, eps_min, dxh, dyh ! Velocity shears [T-1 ~> s-1] ! real :: umid, vmid, unorm ! Velocities [L T-1 ~> m s-1] isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec @@ -2581,30 +2566,177 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) gisc = G%domain%nihalo+1 ; gjsc = G%domain%njhalo+1 giec = G%domain%niglobal+gisc ; gjec = G%domain%njglobal+gjsc is = iscq - 1; js = jscq - 1 + i_off = G%idg_offset ; j_off = G%jdg_offset n_g = CS%n_glen; eps_min = CS%eps_glen_min + CS%ice_visc(:,:) = 0.0 + eII(:,:) = (US%s_to_T**2 * (eps_min**2)) Visc_coef = US%kg_m2s_to_RZ_T*US%m_to_L*US%Z_to_L*(CS%A_glen_isothermal)**(-1./CS%n_glen) !OVS '-' in the exponent - - do j=jsd+1,jed!-1 OVS 02/01/21 - do i=isd+1,ied!-1 OVS 02/01/21 - - if (ISS%hmask(i,j) == 1) then - ux = ((u_shlf(I,J) + u_shlf(I,J-1)) - (u_shlf(I-1,J) + u_shlf(I-1,J-1))) / (2*G%dxT(i,j)) - vx = ((v_shlf(I,J) + v_shlf(I,J-1)) - (v_shlf(I-1,J) + v_shlf(I-1,J-1))) / (2*G%dxT(i,j)) - uy = ((u_shlf(I,J) + u_shlf(I-1,J)) - (u_shlf(I,J-1) + u_shlf(I-1,J-1))) / (2*G%dyT(i,j)) - vy = ((v_shlf(I,J) + v_shlf(I-1,J)) - (v_shlf(I,J-1) + v_shlf(I-1,J-1))) / (2*G%dyT(i,j)) - CS%ice_visc(i,j) = 0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & - (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) -! CS%ice_visc(i,j) =1e15*(G%areaT(i,j) * ISS%h_shelf(i,j)) !OVS 02/09/21 constvisc + call pass_vector(u_shlf, v_shlf, G%domain, TO_ALL, BGRID_NE) +! do j=jsc-1,jec+1 +! do i=isc-1,iec+1 +!! do j=jsd+1,jed!-1 OVS 02/01/21 +!! do i=isd+1,ied!-1 OVS 02/01/21 + +! if (ISS%hmask(i,j) == 1) then +! ux = ((u_shlf(I,J) + 0*u_shlf(I,J-1)) - (u_shlf(I-1,J) + 0*u_shlf(I-1,J-1))) / (G%dxT(i,j)) +! vx = ((v_shlf(I,J) + v_shlf(I,J-1)) - (v_shlf(I-1,J) + v_shlf(I-1,J-1))) / (2*G%dxT(i,j)) +! uy = ((u_shlf(I,J) + u_shlf(I-1,J)) - (u_shlf(I,J-1) + u_shlf(I-1,J-1))) / (2*G%dyT(i,j)) +! vy = ((v_shlf(I,J) + v_shlf(I-1,J)) - (v_shlf(I,J-1) + v_shlf(I-1,J-1))) / (2*G%dyT(i,j)) +!! ux = ((u_shlf(I,J) + u_shlf(I,J-1)) - (u_shlf(I-1,J) + u_shlf(I-1,J-1))) / (2*G%dxT(i,j)) +!! vx = ((v_shlf(I,J) + v_shlf(I,J-1)) - (v_shlf(I-1,J) + v_shlf(I-1,J-1))) / (2*G%dxT(i,j)) +!! uy = ((u_shlf(I,J) + u_shlf(I-1,J)) - (u_shlf(I,J-1) + u_shlf(I-1,J-1))) / (2*G%dyT(i,j)) +!! vy = ((v_shlf(I,J) + v_shlf(I-1,J)) - (v_shlf(I,J-1) + v_shlf(I-1,J-1))) / (2*G%dyT(i,j)) +! CS%ice_visc(i,j) = 0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & +! (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) +! CS%ice_visc(i,j) =1e15*(G%areaT(i,j) * ISS%h_shelf(i,j)) ! constant viscocity for debugging ! umid = ((u_shlf(I,J) + u_shlf(I-1,J-1)) + (u_shlf(I,J-1) + u_shlf(I-1,J))) * 0.25 ! vmid = ((v_shlf(I,J) + v_shlf(I-1,J-1)) + (v_shlf(I,J-1) + v_shlf(I-1,J))) * 0.25 ! unorm = sqrt(umid**2 + vmid**2 + eps_min**2*(G%dxT(i,j)**2 + G%dyT(i,j)**2)) ! CS%basal_traction(i,j) = G%areaT(i,j) * CS%C_basal_friction * (US%L_T_to_m_s*unorm)**(CS%n_basal_fric-1) - endif - enddo - enddo +! endif +! enddo +! enddo + + + do j=jsc-1,jec+1 + do i=isc-1,iec+1 + cnt = 0 + ux = 0 + uy = 0 + vx = 0 + vy = 0 + dxh = G%dxT(i,j) + dyh = G%dyT(i,j) + + if (ISS%hmask(i,j) == 1) then ! we are inside the global computational bdry, at an ice-filled cell + ! calculate sx +! if ((i+i_off) == gisc) then ! at left computational bdry +! if (ISS%hmask(i+1,j) == 1) then +! ux = (u_shlf(i+1,j)-u_shlf(i,j))/dxh +! vx = (v_shlf(i+1,j)-v_shlf(i,j))/dxh +! else +! ux = 0 +! vx = 0 +! endif +! elseif ((i+i_off) == giec) then ! at east computational bdry +! if (ISS%hmask(i-1,j) == 1) then +! ux = (u_shlf(i,j)-u_shlf(i-1,j))/dxh +! vx = (v_shlf(i,j)-v_shlf(i-1,j))/dxh +! else +! ux = 0 +! vx = 0 +! endif +! else ! interior + if (ISS%hmask(i+1,j) == 1) then + cnt = cnt+1 + ux = u_shlf(i+1,j) + vx = v_shlf(i+1,j) + else + ux = u_shlf(i,j) + vx = v_shlf(i,j) + endif + if (ISS%hmask(i-1,j) == 1) then + cnt = cnt+1 + ux = ux - u_shlf(i-1,j) + vx = vx - v_shlf(i-1,j) + else + ux = ux - u_shlf(i,j) + vx = vx - v_shlf(i,j) + endif + if (cnt == 0) then + ux = 0 + vx = 0 + else + ux = ux / (cnt * dxh) + vx = vx / (cnt * dxh) + endif +! endif + cnt = 0 + + ! calculate sy, similarly +! if ((j+j_off) == gjsc) then ! at south computational bdry +! if (ISS%hmask(i,j+1) == 1) then +! uy = (u_shlf(i,j+1)-u_shlf(i,j))/dyh +! vy = (v_shlf(i,j+1)-v_shlf(i,j))/dyh +! else +! vy = 0 +! endif +! elseif ((j+j_off) == gjec) then ! at nprth computational bdry +! if (ISS%hmask(i,j-1) == 1) then +! uy = (u_shlf(i,j)-u_shlf(i,j-1))/dyh +! vy = (v_shlf(i,j)-v_shlf(i,j-1))/dyh +! else +! uy = 0 +! vy = 0 +! endif +! else ! interior + if (ISS%hmask(i,j+1) == 1) then + cnt = cnt+1 + uy = u_shlf(i,j+1) + vy = v_shlf(i,j+1) + else + uy = u_shlf(i,j) + vy = v_shlf(i,j) + endif + if (ISS%hmask(i,j-1) == 1) then + cnt = cnt+1 + uy = uy - u_shlf(i,j-1) + vy = vy - v_shlf(i,j-1) + else + uy = uy - u_shlf(i,j) + vy = vy - v_shlf(i,j) + endif + if (cnt == 0) then + uy = 0 + vy = 0 + else + uy = uy / (cnt * dyh) + vy = vy / (cnt * dyh) + endif +! endif + + ! SW vertex + if (ISS%hmask(I-1,J-1) == 1) then + eII(i-1,j-1) = eII(i-1,j-1)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) + endif + ! SE vertex + if (ISS%hmask(I,J-1) == 1) then + eII(i,j-1) = eII(i,j-1)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) + +! CS%ice_visc(i,j-1) = CS%ice_visc(i,j-1)+.25*0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & +! (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) + endif + ! NW vertex + if (ISS%hmask(I-1,J) == 1) then + eII(i-1,j) = eII(i-1,j)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) + +! CS%ice_visc(i-1,j) = CS%ice_visc(i-1,j)+.25*0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & +! (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) + endif + ! NE vertex + if (ISS%hmask(I,J) == 1) then + eII(i,j) = eII(i,j)+.25*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) + +! CS%ice_visc(i,j) = CS%ice_visc(i,j)+.25*0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & +! (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) + endif + if (ISS%hmask(I+1,J+1) == 1) then + eII(i+1,j+1) = eII(i+1,j+1)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) + endif + if (ISS%hmask(I,J+1) == 1) then + eII(i,j+1) = eII(i,j+1)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) + endif + if (ISS%hmask(I+1,J) == 1) then + eII(i+1,j) = eII(i+1,j)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) + endif + endif + CS%ice_visc(i,j) =0.5 * Visc_coef*(G%areaT(i,j) * ISS%h_shelf(i,j))*eII(i,j)**((1.-n_g)/(2.*n_g)) +! CS%ice_visc(i,j) =1e15*(G%areaT(i,j) * ISS%h_shelf(i,j)) !constant viscosity for debugging + enddo + enddo end subroutine calc_shelf_visc subroutine calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf) From 89f4386eb153c63e55b942c4ec0fc8187d1ae8d5 Mon Sep 17 00:00:00 2001 From: Olga Sergienko Date: Thu, 18 Feb 2021 17:16:00 -0500 Subject: [PATCH 15/51] corrected initialize_boundary_channel call --- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 28 ++++++++++++---------- 1 file changed, 16 insertions(+), 12 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index 2bfe64677c..532729c58c 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -265,9 +265,8 @@ subroutine initialize_ice_thickness_channel(h_shelf, area_shelf_h, hmask, G, US, end subroutine initialize_ice_thickness_channel subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_bdry, & - u_flux_bdry_val, v_flux_bdry_val, u_bdry_val, v_bdry_val, h_bdry_val, & - thickness_bdry_val, hmask, h_shelf, u_shelf, v_shelf, G,& ! OVS h_shelf 11/10/20 -! flux_bdry, & + u_flux_bdry_val, v_flux_bdry_val, u_bdry_val, v_bdry_val, u_shelf, v_shelf, h_bdry_val, & + thickness_bdry_val, hmask, h_shelf, G,& US, PF ) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure @@ -340,7 +339,8 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b giec = G%Domain%niglobal+gisc ; gjec = G%Domain%njglobal+gjsc !-----------b.c.s based on geopositions ----------------- - do j=jsc-1,jec+1 +! do j=jsc-1,jec+1 + do j=jsc-0*1,jec+1 do i=isc-1,iec+1 ! upstream boundary - set either dirichlet or flux condition @@ -349,13 +349,13 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b ! u_face_mask_bdry(i-1,j) = 4.0 ! u_flux_bdry_val(i-1,j) = input_flux ! else -! hmask(i+1,j) = 3.0 - hmask(i,j) = 3.0 -! h_bdry_val(i+1,j) = h_shelf(i+1,j) !OVS 11/10/20 !input_thick - h_bdry_val(i,j) = h_shelf(i,j) - thickness_bdry_val(i+0*1,j) = h_bdry_val(i+0*1,j) - u_face_mask_bdry(i+0*1,j) = 3.0 - u_bdry_val(i+0*1,j) = input_vel*(1-16.0*((G%geoLatBu(i-1,j)/lenlat-0.5))**4) !OVS 11/09/20 U b.c. + hmask(i+1,j) = 3.0 +! hmask(i,j) = 3.0 + h_bdry_val(i+1,j) = h_shelf(i+1,j) !OVS 11/10/20 !input_thick +! h_bdry_val(i,j) = h_shelf(i,j) + thickness_bdry_val(i+1,j) = h_bdry_val(i+0*1,j) + u_face_mask_bdry(i+1,j) = 3.0 + u_bdry_val(i+1,j) = input_vel*(1-16.0*((G%geoLatBu(i-1,j)/lenlat-0.5))**4) !OVS 11/09/20 U b.c. ! u_bdry_val(i+1,j) = (1 - ((G%geoLatBu(i,j) - 0.5*lenlat)*2./lenlat)**2) * & ! 1.5 * input_flux / input_thick ! endif @@ -396,7 +396,11 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b enddo enddo - +! call pass_var(hmask, G%domain) +! call pass_var(h_bdry_val, G%domain) +! call pass_var(thickness_bdry_val, G%domain) + + ! if (.not. G%symmetric) then !! do j=G%jsd,G%jed !! do i=G%isd,G%ied From 271bfce9402728937542e296e986c6aa4c172337 Mon Sep 17 00:00:00 2001 From: Olga Sergienko Date: Mon, 22 Feb 2021 15:10:32 -0500 Subject: [PATCH 16/51] corrected boundary mask in init_boundary_channel and updated u_ and v_bdry_val through halo --- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 342 +++++++++++++-------- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 15 +- 2 files changed, 219 insertions(+), 138 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index db3a49cfe9..84605e3092 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -160,7 +160,7 @@ module MOM_ice_shelf_dynamics id_u_mask = -1, id_v_mask = -1, id_t_mask = -1 !>@} ! ids for outputting intermediate thickness in advection subroutine (debugging) - !integer :: id_h_after_uflux = -1, id_h_after_vflux = -1, id_h_after_adv = -1 + integer :: id_h_after_uflux = -1, id_h_after_vflux = -1, id_h_after_adv = -1, id_visc_shelf = -1 type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to control diagnostic output. @@ -535,18 +535,27 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ CS%thickness_bdry_val, ISS%hmask, ISS%h_shelf, G, & ! CS%flux_bdry, & US, param_file ) !OVS initialize b.c.s + + call pass_var(ISS%hmask, G%domain) + call pass_var(CS%h_bdry_val, G%domain) + call pass_var(CS%thickness_bdry_val, G%domain) + call pass_var(CS%u_bdry_val, G%domain) + call pass_var(CS%v_bdry_val, G%domain) + call pass_var(CS%u_face_mask_bdry, G%domain) + call pass_var(CS%v_face_mask_bdry, G%domain) ! call init_boundary_values(CS, G, time, ISS%hmask, CS%input_flux, CS%input_thickness, new_sim) call update_velocity_masks(CS, G, ISS%hmask, CS%umask, CS%vmask, CS%u_face_mask, CS%v_face_mask) - if (new_sim) then - call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: initialize ice velocity.") - call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf(:,:)) -! call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf, iters, Time) - call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) !OVS 02/08/21 - if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf, CS%u_shelf, CS%diag) - if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf, CS%v_shelf,CS%diag) - if (CS%id_taudx_shelf > 0) call post_data(CS%id_taudx_shelf, CS%taudx_shelf,CS%diag) - if (CS%id_taudy_shelf > 0) call post_data(CS%id_taudy_shelf, CS%taudy_shelf,CS%diag) - endif +! if (new_sim) then +! call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: initialize ice velocity.") +! call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf(:,:)) +!! call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf, iters, Time) +! call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) !OVS 02/08/21 +! if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf, CS%u_shelf, CS%diag) +! if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf, CS%v_shelf,CS%diag) +! if (CS%id_taudx_shelf > 0) call post_data(CS%id_taudx_shelf, CS%taudx_shelf,CS%diag) +! if (CS%id_taudy_shelf > 0) call post_data(CS%id_taudy_shelf, CS%taudy_shelf,CS%diag) +! if (CS%id_visc_shelf > 0) call post_data(CS%id_visc_shelf, CS%ice_visc,CS%diag) +! endif ! Register diagnostics. ! CS%id_u_shelf = register_diag_field('ocean_model','u_shelf',CS%diag%axesCu1, Time, & @@ -580,17 +589,29 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ ! 'ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) CS%id_col_thick = register_diag_field('ice_shelf_model','col_thick',CS%diag%axesT1, Time, & 'ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) + CS%id_visc_shelf = register_diag_field('ice_shelf_model','ice_visc',CS%diag%axesT1, Time, & + 'viscosity', 'm', conversion=1e-6*US%Z_to_m) ! CS%id_OD_av = register_diag_field('ocean_model','OD_av',CS%diag%axesT1, Time, & ! 'intermediate ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) CS%id_OD_av = register_diag_field('ice_shelf_model','OD_av',CS%diag%axesT1, Time, & 'intermediate ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) - !CS%id_h_after_uflux = register_diag_field('ocean_model','h_after_uflux',CS%diag%axesh1, Time, & - ! 'thickness after u flux ', 'none') - !CS%id_h_after_vflux = register_diag_field('ocean_model','h_after_vflux',CS%diag%axesh1, Time, & - ! 'thickness after v flux ', 'none') - !CS%id_h_after_adv = register_diag_field('ocean_model','h_after_adv',CS%diag%axesh1, Time, & - ! 'thickness after front adv ', 'none') - + CS%id_h_after_uflux = register_diag_field('ice_shelf_model','h_after_uflux',CS%diag%axesT1, Time, & + 'thickness after u flux ', 'none') + CS%id_h_after_vflux = register_diag_field('ice_shelf_model','h_after_vflux',CS%diag%axesT1, Time, & + 'thickness after v flux ', 'none') + CS%id_h_after_adv = register_diag_field('ice_shelf_model','h_after_adv',CS%diag%axesT1, Time, & + 'thickness after front adv ', 'none') + if (new_sim) then + call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: initialize ice velocity.") + call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf(:,:)) +! call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf, iters, Time) + call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) !OVS 02/08/21 + if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf, CS%u_shelf, CS%diag) + if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf, CS%v_shelf,CS%diag) + if (CS%id_taudx_shelf > 0) call post_data(CS%id_taudx_shelf, CS%taudx_shelf,CS%diag) + if (CS%id_taudy_shelf > 0) call post_data(CS%id_taudy_shelf, CS%taudy_shelf,CS%diag) + if (CS%id_visc_shelf > 0) call post_data(CS%id_visc_shelf, CS%ice_visc,CS%diag) + endif !!! OVS vertically integrated temperature ! CS%id_t_shelf = register_diag_field('ocean_model','t_shelf',CS%diag%axesT1, Time, & ! 'T of ice', 'oC') @@ -693,7 +714,7 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled coupled_GL = .false. if (present(ocean_mass) .and. present(coupled_grounding)) coupled_GL = coupled_grounding - call ice_shelf_advect(CS, ISS, G, time_step, Time) !OVS 02/08/21 +! call ice_shelf_advect(CS, ISS, G, time_step, Time) !OVS 02/08/21 CS%elapsed_velocity_time = CS%elapsed_velocity_time + time_step if (CS%elapsed_velocity_time >= CS%velocity_update_time_step) update_ice_vel = .true. @@ -721,6 +742,7 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled if (CS%id_taudy_shelf > 0) call post_data(CS%id_taudy_shelf, CS%taudy_shelf, CS%diag) if (CS%id_ground_frac > 0) call post_data(CS%id_ground_frac, CS%ground_frac,CS%diag) if (CS%id_OD_av >0) call post_data(CS%id_OD_av, CS%OD_av,CS%diag) + if (CS%id_visc_shelf > 0) call post_data(CS%id_visc_shelf, CS%ice_visc,CS%diag) if (CS%id_u_mask > 0) call post_data(CS%id_u_mask,CS%umask,CS%diag) if (CS%id_v_mask > 0) call post_data(CS%id_v_mask,CS%vmask,CS%diag) @@ -783,7 +805,7 @@ subroutine ice_shelf_advect(CS, ISS, G, time_step, Time) ! call enable_averages(time_step, Time, CS%diag) call pass_var(h_after_uflux, G%domain) -! if (CS%id_h_after_uflux > 0) call post_data(CS%id_h_after_uflux, h_after_uflux, CS%diag) + if (CS%id_h_after_uflux > 0) call post_data(CS%id_h_after_uflux, h_after_uflux, CS%diag) ! call disable_averaging(CS%diag) LB%ish = G%isc ; LB%ieh = G%iec ; LB%jsh = G%jsc ; LB%jeh = G%jec @@ -791,7 +813,7 @@ subroutine ice_shelf_advect(CS, ISS, G, time_step, Time) ! call enable_averages(time_step, Time, CS%diag) call pass_var(h_after_vflux, G%domain) -! if (CS%id_h_after_vflux > 0) call post_data(CS%id_h_after_vflux, h_after_vflux, CS%diag) + if (CS%id_h_after_vflux > 0) call post_data(CS%id_h_after_vflux, h_after_vflux, CS%diag) ! call disable_averaging(CS%diag) do j=jsd,jed @@ -882,7 +904,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite enddo call calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, CS%OD_av) -! call pass_vector(taudx, taudy, G%domain, TO_ALL, BGRID_NE) !OVS 02/01/21 + call pass_vector(taudx, taudy, G%domain, TO_ALL, BGRID_NE) !OVS 02/01/21 ! call pass_var(taudx, G%Domain) !OVS 01/21/21 ! call pass_var(taudy, G%Domain) !OVS 01/21/21 ! This is to determine which cells contain the grounding line, the criterion being that the cell @@ -925,7 +947,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite enddo ; enddo call calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) -! call pass_var(CS%ice_visc, G%domain) + call pass_var(CS%ice_visc, G%domain) ! call pass_vector(CS%ice_visc, G%domain, TO_ALL, BGRID_NE) !OVS 02/11/21 call calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf) call pass_var(CS%basal_traction, G%domain) @@ -1329,7 +1351,9 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H if (cg_halo == 0) then ! pass vectors call pass_vector(Du, Dv, G%domain, TO_ALL, BGRID_NE) - call pass_vector(u_shlf, v_shlf, G%domain, TO_ALL, BGRID_NE) +! call pass_vector(u_shlf, v_shlf, G%domain, TO_ALL, BGRID_NE) + call pass_var(u_shlf, G%domain) + call pass_var(v_shlf, G%domain) call pass_vector(Ru, Rv, G%domain, TO_ALL, BGRID_NE) cg_halo = 3 endif @@ -2531,6 +2555,8 @@ subroutine apply_boundary_values(CS, ISS, G, US, time, Phisub, H_node, ice_visc, endif endif ; enddo ; enddo + call pass_vector(u_bdry_contr, v_bdry_contr, G%domain, TO_ALL, BGRID_NE) !OVS 02/19/21 + end subroutine apply_boundary_values !> Update depth integrated viscosity, based on horizontal strain rates, and also update the @@ -2552,11 +2578,14 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) ! also this subroutine updates the nonlinear part of the basal traction ! this may be subject to change later... to make it "hybrid" - real, dimension(SZDIB_(G),SZDJB_(G)) :: eII - integer :: i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq +! real, dimension(SZDIB_(G),SZDJB_(G)) :: eII, ux, uy, vx, vy + integer :: i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq, iq, jq integer :: giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec, is, js, i_off, j_off real :: Visc_coef, n_g - real :: ux, uy, vx, vy, eps_min, dxh, dyh ! Velocity shears [T-1 ~> s-1] + real :: ux, uy, vx, vy + real :: eps_min, dxh, dyh ! Velocity shears [T-1 ~> s-1] + real, dimension(8,4) :: Phi + real, dimension(2) :: xquad ! real :: umid, vmid, unorm ! Velocities [L T-1 ~> m s-1] isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec @@ -2570,48 +2599,95 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) n_g = CS%n_glen; eps_min = CS%eps_glen_min - CS%ice_visc(:,:) = 0.0 - eII(:,:) = (US%s_to_T**2 * (eps_min**2)) +! CS%ice_visc(:,:) = 0.0 +! ux(:,:) = 0.0; uy(:,:) = 0.0; vx(:,:) =0.0; vy(:,:) =0.0 +! eII(:,:) = (US%s_to_T**2 * (eps_min**2)) Visc_coef = US%kg_m2s_to_RZ_T*US%m_to_L*US%Z_to_L*(CS%A_glen_isothermal)**(-1./CS%n_glen) !OVS '-' in the exponent - call pass_vector(u_shlf, v_shlf, G%domain, TO_ALL, BGRID_NE) +! call pass_vector(u_shlf, v_shlf, G%domain, TO_ALL, BGRID_NE) ! do j=jsc-1,jec+1 ! do i=isc-1,iec+1 -!! do j=jsd+1,jed!-1 OVS 02/01/21 -!! do i=isd+1,ied!-1 OVS 02/01/21 - -! if (ISS%hmask(i,j) == 1) then + do j=jsd+1,jed-1 !OVS 02/01/21 + do i=isd+1,ied-1 !OVS 02/01/21 + + if ((ISS%hmask(i,j) == 1) .OR. (ISS%hmask(i,j) == 3)) then +! ux(i,j) = ((u_shlf(I,J) + u_shlf(I,J-1)) - (u_shlf(I-1,J) + u_shlf(I-1,J-1))) / (2*G%dxT(i,j)) +! vx(i,j) = ((v_shlf(I,J) + v_shlf(I,J-1)) - (v_shlf(I-1,J) + v_shlf(I-1,J-1))) / (2*G%dxT(i,j)) +! uy(i,j) = ((u_shlf(I,J) + u_shlf(I-1,J)) - (u_shlf(I,J-1) + u_shlf(I-1,J-1))) / (2*G%dyT(i,j)) +! vy(i,j) = ((v_shlf(I,J) + v_shlf(I-1,J)) - (v_shlf(I,J-1) + v_shlf(I-1,J-1))) / (2*G%dyT(i,j)) +! endif +! enddo +! enddo +! call pass_vector(ux, uy, G%domain, TO_ALL, BGRID_NE) +! call pass_vector(vx, vy, G%domain, TO_ALL, BGRID_NE) ! ux = ((u_shlf(I,J) + 0*u_shlf(I,J-1)) - (u_shlf(I-1,J) + 0*u_shlf(I-1,J-1))) / (G%dxT(i,j)) ! vx = ((v_shlf(I,J) + v_shlf(I,J-1)) - (v_shlf(I-1,J) + v_shlf(I-1,J-1))) / (2*G%dxT(i,j)) ! uy = ((u_shlf(I,J) + u_shlf(I-1,J)) - (u_shlf(I,J-1) + u_shlf(I-1,J-1))) / (2*G%dyT(i,j)) ! vy = ((v_shlf(I,J) + v_shlf(I-1,J)) - (v_shlf(I,J-1) + v_shlf(I-1,J-1))) / (2*G%dyT(i,j)) -!! ux = ((u_shlf(I,J) + u_shlf(I,J-1)) - (u_shlf(I-1,J) + u_shlf(I-1,J-1))) / (2*G%dxT(i,j)) -!! vx = ((v_shlf(I,J) + v_shlf(I,J-1)) - (v_shlf(I-1,J) + v_shlf(I-1,J-1))) / (2*G%dxT(i,j)) -!! uy = ((u_shlf(I,J) + u_shlf(I-1,J)) - (u_shlf(I,J-1) + u_shlf(I-1,J-1))) / (2*G%dyT(i,j)) -!! vy = ((v_shlf(I,J) + v_shlf(I-1,J)) - (v_shlf(I,J-1) + v_shlf(I-1,J-1))) / (2*G%dyT(i,j)) -! CS%ice_visc(i,j) = 0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & -! (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) + ux = ((u_shlf(I,J) + u_shlf(I,J-1)) - (u_shlf(I-1,J) + u_shlf(I-1,J-1))) / (2*G%dxT(i,j)) + vx = ((v_shlf(I,J) + v_shlf(I,J-1)) - (v_shlf(I-1,J) + v_shlf(I-1,J-1))) / (2*G%dxT(i,j)) + uy = ((u_shlf(I,J) + u_shlf(I-1,J)) - (u_shlf(I,J-1) + u_shlf(I-1,J-1))) / (2*G%dyT(i,j)) + vy = ((v_shlf(I,J) + v_shlf(I-1,J)) - (v_shlf(I,J-1) + v_shlf(I-1,J-1))) / (2*G%dyT(i,j)) + CS%ice_visc(i,j) = 0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & + (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) ! CS%ice_visc(i,j) =1e15*(G%areaT(i,j) * ISS%h_shelf(i,j)) ! constant viscocity for debugging ! umid = ((u_shlf(I,J) + u_shlf(I-1,J-1)) + (u_shlf(I,J-1) + u_shlf(I-1,J))) * 0.25 ! vmid = ((v_shlf(I,J) + v_shlf(I-1,J-1)) + (v_shlf(I,J-1) + v_shlf(I-1,J))) * 0.25 ! unorm = sqrt(umid**2 + vmid**2 + eps_min**2*(G%dxT(i,j)**2 + G%dyT(i,j)**2)) ! CS%basal_traction(i,j) = G%areaT(i,j) * CS%C_basal_friction * (US%L_T_to_m_s*unorm)**(CS%n_basal_fric-1) -! endif -! enddo -! enddo + endif + enddo + enddo - - do j=jsc-1,jec+1 - do i=isc-1,iec+1 - cnt = 0 - ux = 0 - uy = 0 - vx = 0 - vy = 0 - dxh = G%dxT(i,j) - dyh = G%dyT(i,j) +! do j=jsc-1,jec+1 +! do i=isc-1,iec+1 +!! do j=jsd+1,jed!-1 OVS 02/01/21 +!! do i=isd+1,ied!-1 OVS 02/01/21 - if (ISS%hmask(i,j) == 1) then ! we are inside the global computational bdry, at an ice-filled cell +! if (ISS%hmask(i,j) == 1) then +! CS%ice_visc(i,j) = 0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & +! (US%s_to_T**2 * (ux(i,j)**2 + vy(i,j)**2 + ux(i,j)*vy(i,j) + 0.25*(uy(i,j)+vx(i,j))**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) +! endif +! enddo +! enddo +! xquad(1) = .5 * (1-sqrt(1./3)) ; xquad(2) = .5 * (1+sqrt(1./3)) +! do j=jsc-1,jec+1 +! do i=isc-1,iec+1 +! cnt = 0 +! ux = 0 +! uy = 0 +! vx = 0 +! vy = 0 +! dxh = G%dxT(i,j) +! dyh = G%dyT(i,j) + +! if (ISS%hmask(i,j) == 1) then ! we are inside the global computational bdry, at an ice-filled cell + +! call bilinear_shape_fn_grid(G, i, j, Phi) +! do jq = 1,2 +! do iq = 1,2 + +! ux = u_shlf(I-1,J-1) * Phi(1,2*(jq-1)+iq) + & +! u_shlf(I,J-1) * Phi(3,2*(jq-1)+iq) + & +! u_shlf(I-1,J) * Phi(5,2*(jq-1)+iq) + & +! u_shlf(I,J) * Phi(7,2*(jq-1)+iq) + +! vx = v_shlf(I-1,J-1) * Phi(1,2*(jq-1)+iq) + & +! v_shlf(I,J-1) * Phi(3,2*(jq-1)+iq) + & +! v_shlf(I-1,J) * Phi(5,2*(jq-1)+iq) + & +! v_shlf(I,J) * Phi(7,2*(jq-1)+iq) + +! uy = u_shlf(I-1,J-1) * Phi(2,2*(jq-1)+iq) + & +! u_shlf(I,J-1) * Phi(4,2*(jq-1)+iq) + & +! u_shlf(I-1,J) * Phi(6,2*(jq-1)+iq) + & +! u_shlf(I,J) * Phi(8,2*(jq-1)+iq) + +! vy = v_shlf(I-1,J-1) * Phi(2,2*(jq-1)+iq) + & +! v_shlf(I,J-1) * Phi(4,2*(jq-1)+iq) + & +! v_shlf(I-1,J) * Phi(6,2*(jq-1)+iq) + & +! v_shlf(I,J) * Phi(8,2*(jq-1)+iq) +! enddo +! enddo ! calculate sx ! if ((i+i_off) == gisc) then ! at left computational bdry ! if (ISS%hmask(i+1,j) == 1) then @@ -2630,31 +2706,31 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) ! vx = 0 ! endif ! else ! interior - if (ISS%hmask(i+1,j) == 1) then - cnt = cnt+1 - ux = u_shlf(i+1,j) - vx = v_shlf(i+1,j) - else - ux = u_shlf(i,j) - vx = v_shlf(i,j) - endif - if (ISS%hmask(i-1,j) == 1) then - cnt = cnt+1 - ux = ux - u_shlf(i-1,j) - vx = vx - v_shlf(i-1,j) - else - ux = ux - u_shlf(i,j) - vx = vx - v_shlf(i,j) - endif - if (cnt == 0) then - ux = 0 - vx = 0 - else - ux = ux / (cnt * dxh) - vx = vx / (cnt * dxh) - endif -! endif - cnt = 0 +! if (ISS%hmask(i+1,j) == 1) then +! cnt = cnt+1 +! ux = u_shlf(i+1,j) +! vx = v_shlf(i+1,j) +! else +! ux = u_shlf(i,j) +! vx = v_shlf(i,j) +! endif +! if (ISS%hmask(i-1,j) == 1) then +! cnt = cnt+1 +! ux = ux - u_shlf(i-1,j) +! vx = vx - v_shlf(i-1,j) +! else +! ux = ux - u_shlf(i,j) +! vx = vx - v_shlf(i,j) +! endif +! if (cnt == 0) then +! ux = 0 +! vx = 0 +! else +! ux = ux / (cnt * dxh) +! vx = vx / (cnt * dxh) +! endif +!! endif +! cnt = 0 ! calculate sy, similarly ! if ((j+j_off) == gjsc) then ! at south computational bdry @@ -2673,70 +2749,72 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) ! vy = 0 ! endif ! else ! interior - if (ISS%hmask(i,j+1) == 1) then - cnt = cnt+1 - uy = u_shlf(i,j+1) - vy = v_shlf(i,j+1) - else - uy = u_shlf(i,j) - vy = v_shlf(i,j) - endif - if (ISS%hmask(i,j-1) == 1) then - cnt = cnt+1 - uy = uy - u_shlf(i,j-1) - vy = vy - v_shlf(i,j-1) - else - uy = uy - u_shlf(i,j) - vy = vy - v_shlf(i,j) - endif - if (cnt == 0) then - uy = 0 - vy = 0 - else - uy = uy / (cnt * dyh) - vy = vy / (cnt * dyh) - endif -! endif +! if (ISS%hmask(i,j+1) == 1) then +! cnt = cnt+1 +! uy = u_shlf(i,j+1) +! vy = v_shlf(i,j+1) +! else +! uy = u_shlf(i,j) +! vy = v_shlf(i,j) +! endif +! if (ISS%hmask(i,j-1) == 1) then +! cnt = cnt+1 +! uy = uy - u_shlf(i,j-1) +! vy = vy - v_shlf(i,j-1) +! else +! uy = uy - u_shlf(i,j) +! vy = vy - v_shlf(i,j) +! endif +! if (cnt == 0) then +! uy = 0 +! vy = 0 +! else +! uy = uy / (cnt * dyh) +! vy = vy / (cnt * dyh) +! endif +!! endif - ! SW vertex - if (ISS%hmask(I-1,J-1) == 1) then - eII(i-1,j-1) = eII(i-1,j-1)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) - endif +! ! SW vertex +! if (ISS%hmask(I-1,J-1) == 1) then +! eII(i-1,j-1) = eII(i-1,j-1)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) +! endif ! SE vertex - if (ISS%hmask(I,J-1) == 1) then - eII(i,j-1) = eII(i,j-1)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) +! if (ISS%hmask(I,J-1) == 1) then +! eII(i,j-1) = eII(i,j-1)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) ! CS%ice_visc(i,j-1) = CS%ice_visc(i,j-1)+.25*0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & ! (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) - endif +! endif ! NW vertex - if (ISS%hmask(I-1,J) == 1) then - eII(i-1,j) = eII(i-1,j)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) +! if (ISS%hmask(I-1,J) == 1) then +! eII(i-1,j) = eII(i-1,j)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) ! CS%ice_visc(i-1,j) = CS%ice_visc(i-1,j)+.25*0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & ! (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) - endif +! endif ! NE vertex - if (ISS%hmask(I,J) == 1) then - eII(i,j) = eII(i,j)+.25*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) - +! if (ISS%hmask(I,J) == 1) then +! eII(i,j) = eII(i,j)+.25*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) +! eII(i,j) = (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) + ! CS%ice_visc(i,j) = CS%ice_visc(i,j)+.25*0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & ! (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) - endif - if (ISS%hmask(I+1,J+1) == 1) then - eII(i+1,j+1) = eII(i+1,j+1)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) - endif - if (ISS%hmask(I,J+1) == 1) then - eII(i,j+1) = eII(i,j+1)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) - endif - if (ISS%hmask(I+1,J) == 1) then - eII(i+1,j) = eII(i+1,j)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) - endif - endif - CS%ice_visc(i,j) =0.5 * Visc_coef*(G%areaT(i,j) * ISS%h_shelf(i,j))*eII(i,j)**((1.-n_g)/(2.*n_g)) -! CS%ice_visc(i,j) =1e15*(G%areaT(i,j) * ISS%h_shelf(i,j)) !constant viscosity for debugging - enddo - enddo +! endif +! if (ISS%hmask(I+1,J+1) == 1) then +! eII(i+1,j+1) = eII(i+1,j+1)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) +! endif +! if (ISS%hmask(I,J+1) == 1) then +! eII(i,j+1) = eII(i,j+1)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) +! endif +! if (ISS%hmask(I+1,J) == 1) then +! eII(i+1,j) = eII(i+1,j)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) +! endif +! CS%ice_visc(i,j) =0.5 * Visc_coef*(G%areaT(i,j) * ISS%h_shelf(i,j))*eII(i,j)**((1.-n_g)/(2.*n_g)) +! endif +! CS%ice_visc(i,j) =0.5 * Visc_coef*(G%areaT(i,j) * ISS%h_shelf(i,j))*eII(i,j)**((1.-n_g)/(2.*n_g)) + ! CS%ice_visc(i,j) =1e15*(G%areaT(i,j) * ISS%h_shelf(i,j)) !constant viscosity for debugging +! enddo +! enddo end subroutine calc_shelf_visc subroutine calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf) @@ -2772,7 +2850,7 @@ subroutine calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf) do j=jsd+1,jed!-1 OVS 02/01/21 do i=isd+1,ied!-1 OVS 02/01/21 - if (ISS%hmask(i,j) == 1) then + if ((ISS%hmask(i,j) == 1) .OR. (ISS%hmask(i,j) == 3)) then umid = ((u_shlf(I,J) + u_shlf(I-1,J-1)) + (u_shlf(I,J-1) + u_shlf(I-1,J))) * 0.25 vmid = ((v_shlf(I,J) + v_shlf(I-1,J-1)) + (v_shlf(I,J-1) + v_shlf(I-1,J))) * 0.25 unorm = sqrt(umid**2 + vmid**2 + eps_min**2*(G%dxT(i,j)**2 + G%dyT(i,j)**2)) diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index 532729c58c..3b6926e58f 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -366,13 +366,16 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b if (G%geoLatBu(i,j-1) == southlat) then !bot boundary if (len_stress == 0. .OR. G%geoLonCv(i,j) <= len_stress) then v_face_mask_bdry(i,j+1) = 0. - u_face_mask_bdry(i,j-1) = 3. !OVS 11/25/20 +! u_face_mask_bdry(i,j-1) = 3. !OVS 11/25/20 + u_face_mask_bdry(i,j) = 3. !OVS 11/25/20 + u_bdry_val(i,j) = 0. + v_bdry_val(i,j) = 0. else -! v_face_mask_bdry(i,j+1) = 1. - v_face_mask_bdry(i,j-1) = 3. !OVS 01/20/21 - u_face_mask_bdry(i,j-1) = 3. !OVS 11/25/20 -! u_bdry_val(i,j) = 0. -! v_bdry_val(i,j) = 0. !OVS 01/20/21 + v_face_mask_bdry(i,j+1) = 1. +! v_face_mask_bdry(i,j) = 3. !OVS 01/20/21 + u_face_mask_bdry(i,j) = 3. !OVS 11/25/20 + u_bdry_val(i,j) = 0. + v_bdry_val(i,j) = 0. !OVS 01/20/21 !hmask(i,j) = 0.0 !OVS 11/25/20 endif elseif (G%geoLatBu(i,j-1) == southlat+lenlat) then !top boundary From fdd83e6583415d6355d4bc9dfb3de421ddb66f9e Mon Sep 17 00:00:00 2001 From: Olga Sergienko Date: Mon, 22 Feb 2021 17:15:13 -0500 Subject: [PATCH 17/51] dynamic ice shelf with non-linear viscosity and evolving ice thickness due to sub-ice-shelf melting --- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 84605e3092..c63a42beaf 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -714,7 +714,7 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled coupled_GL = .false. if (present(ocean_mass) .and. present(coupled_grounding)) coupled_GL = coupled_grounding -! call ice_shelf_advect(CS, ISS, G, time_step, Time) !OVS 02/08/21 + call ice_shelf_advect(CS, ISS, G, time_step, Time) !OVS 02/08/21 CS%elapsed_velocity_time = CS%elapsed_velocity_time + time_step if (CS%elapsed_velocity_time >= CS%velocity_update_time_step) update_ice_vel = .true. From 32cfe35a44a40fd2947c089946b525d795b670b5 Mon Sep 17 00:00:00 2001 From: Olga Sergienko Date: Wed, 24 Feb 2021 15:41:54 -0500 Subject: [PATCH 18/51] modified MOM_ice_shelf_initialize for testing with viscosity from a file --- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 38 ++++++----- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 77 ++++++++++++++++++++++ 2 files changed, 99 insertions(+), 16 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index c63a42beaf..5e6ba60a1a 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -23,7 +23,7 @@ module MOM_ice_shelf_dynamics use MOM_ice_shelf_state, only : ice_shelf_state use MOM_coms, only : reproducing_sum, sum_across_PEs, max_across_PEs, min_across_PEs use MOM_checksums, only : hchksum, qchksum -use MOM_ice_shelf_initialize, only : initialize_ice_shelf_boundary_channel !OVS intializing b.c.s +use MOM_ice_shelf_initialize, only : initialize_ice_shelf_boundary_channel,initialize_ice_flow_from_file !OVS intializing b.c.s implicit none ; private @@ -535,7 +535,6 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ CS%thickness_bdry_val, ISS%hmask, ISS%h_shelf, G, & ! CS%flux_bdry, & US, param_file ) !OVS initialize b.c.s - call pass_var(ISS%hmask, G%domain) call pass_var(CS%h_bdry_val, G%domain) call pass_var(CS%thickness_bdry_val, G%domain) @@ -545,6 +544,9 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ call pass_var(CS%v_face_mask_bdry, G%domain) ! call init_boundary_values(CS, G, time, ISS%hmask, CS%input_flux, CS%input_thickness, new_sim) call update_velocity_masks(CS, G, ISS%hmask, CS%umask, CS%vmask, CS%u_face_mask, CS%v_face_mask) +! call initialize_ice_flow_from_file(CS%u_shelf, CS%v_shelf,CS%ice_visc,CS%ground_frac, ISS%hmask,ISS%h_shelf, & +! G, US, param_file) !spacially variable viscosity from a file for debugging +! call pass_var(CS%ice_visc, G%domain) ! if (new_sim) then ! call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: initialize ice velocity.") ! call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf(:,:)) @@ -713,7 +715,7 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled coupled_GL = .false. if (present(ocean_mass) .and. present(coupled_grounding)) coupled_GL = coupled_grounding - +! call ice_shelf_advect(CS, ISS, G, time_step, Time) !OVS 02/08/21 CS%elapsed_velocity_time = CS%elapsed_velocity_time + time_step if (CS%elapsed_velocity_time >= CS%velocity_update_time_step) update_ice_vel = .true. @@ -946,7 +948,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite call bilinear_shape_fn_grid(G, i, j, Phi(:,:,i,j)) enddo ; enddo - call calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) + call calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) !OVS 02/24/21 call pass_var(CS%ice_visc, G%domain) ! call pass_vector(CS%ice_visc, G%domain, TO_ALL, BGRID_NE) !OVS 02/11/21 call calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf) @@ -1000,7 +1002,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite write(mesg,*) "ice_shelf_solve_outer: linear solve done in ",iters," iterations" call MOM_mesg(mesg, 5) - call calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) + call calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) !OVS 02/24/21 call pass_var(CS%ice_visc, G%domain) call calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf) call pass_var(CS%basal_traction, G%domain) @@ -1351,7 +1353,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H if (cg_halo == 0) then ! pass vectors call pass_vector(Du, Dv, G%domain, TO_ALL, BGRID_NE) -! call pass_vector(u_shlf, v_shlf, G%domain, TO_ALL, BGRID_NE) + call pass_vector(u_shlf, v_shlf, G%domain, TO_ALL, BGRID_NE) call pass_var(u_shlf, G%domain) call pass_var(v_shlf, G%domain) call pass_vector(Ru, Rv, G%domain, TO_ALL, BGRID_NE) @@ -2604,10 +2606,10 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) ! eII(:,:) = (US%s_to_T**2 * (eps_min**2)) Visc_coef = US%kg_m2s_to_RZ_T*US%m_to_L*US%Z_to_L*(CS%A_glen_isothermal)**(-1./CS%n_glen) !OVS '-' in the exponent ! call pass_vector(u_shlf, v_shlf, G%domain, TO_ALL, BGRID_NE) -! do j=jsc-1,jec+1 -! do i=isc-1,iec+1 - do j=jsd+1,jed-1 !OVS 02/01/21 - do i=isd+1,ied-1 !OVS 02/01/21 + do j=jsc-0*1,jec+0*1 + do i=isc-0*1,iec+0*1 +! do j=jsd+1,jed-1 !OVS 02/01/21 +! do i=isd+1,ied-1 !OVS 02/01/21 if ((ISS%hmask(i,j) == 1) .OR. (ISS%hmask(i,j) == 3)) then ! ux(i,j) = ((u_shlf(I,J) + u_shlf(I,J-1)) - (u_shlf(I-1,J) + u_shlf(I-1,J-1))) / (2*G%dxT(i,j)) @@ -2619,14 +2621,18 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) ! enddo ! call pass_vector(ux, uy, G%domain, TO_ALL, BGRID_NE) ! call pass_vector(vx, vy, G%domain, TO_ALL, BGRID_NE) -! ux = ((u_shlf(I,J) + 0*u_shlf(I,J-1)) - (u_shlf(I-1,J) + 0*u_shlf(I-1,J-1))) / (G%dxT(i,j)) + ux = ((u_shlf(I,J) + u_shlf(I,J-1) + u_shlf(I,J+1)) - & + (u_shlf(I-1,J) + u_shlf(I-1,J-1) + u_shlf(I-1,J+1))) / (3*G%dxT(i,j)) + vx = ((v_shlf(I,J) + v_shlf(I,J-1) + v_shlf(I,J+1)) - & + (v_shlf(I-1,J) + v_shlf(I-1,J-1) + v_shlf(I-1,J+1))) / (3*G%dxT(i,j)) + uy = ((u_shlf(I,J) + u_shlf(I-1,J) + u_shlf(I+1,J)) - & + (u_shlf(I,J-1) + u_shlf(I-1,J-1) + u_shlf(I+1,J-1))) / (3*G%dyT(i,j)) + vy = ((v_shlf(I,J) + v_shlf(I-1,J)+ v_shlf(I+1,J)) - & + (v_shlf(I,J-1) + v_shlf(I-1,J-1)+ v_shlf(I+1,J-1))) / (3*G%dyT(i,j)) +! ux = ((u_shlf(I,J) + u_shlf(I,J-1)) - (u_shlf(I-1,J) + u_shlf(I-1,J-1))) / (2*G%dxT(i,j)) ! vx = ((v_shlf(I,J) + v_shlf(I,J-1)) - (v_shlf(I-1,J) + v_shlf(I-1,J-1))) / (2*G%dxT(i,j)) ! uy = ((u_shlf(I,J) + u_shlf(I-1,J)) - (u_shlf(I,J-1) + u_shlf(I-1,J-1))) / (2*G%dyT(i,j)) -! vy = ((v_shlf(I,J) + v_shlf(I-1,J)) - (v_shlf(I,J-1) + v_shlf(I-1,J-1))) / (2*G%dyT(i,j)) - ux = ((u_shlf(I,J) + u_shlf(I,J-1)) - (u_shlf(I-1,J) + u_shlf(I-1,J-1))) / (2*G%dxT(i,j)) - vx = ((v_shlf(I,J) + v_shlf(I,J-1)) - (v_shlf(I-1,J) + v_shlf(I-1,J-1))) / (2*G%dxT(i,j)) - uy = ((u_shlf(I,J) + u_shlf(I-1,J)) - (u_shlf(I,J-1) + u_shlf(I-1,J-1))) / (2*G%dyT(i,j)) - vy = ((v_shlf(I,J) + v_shlf(I-1,J)) - (v_shlf(I,J-1) + v_shlf(I-1,J-1))) / (2*G%dyT(i,j)) +! vy = ((v_shlf(I,J) + v_shlf(I-1,J)) - (v_shlf(I,J-1) + v_shlf(I-1,J-1))) / (2*G%dyT(i,j)) CS%ice_visc(i,j) = 0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) ! CS%ice_visc(i,j) =1e15*(G%areaT(i,j) * ISS%h_shelf(i,j)) ! constant viscocity for debugging diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index 3b6926e58f..f2e01c461b 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -19,6 +19,7 @@ module MOM_ice_shelf_initialize !MJHpublic initialize_ice_shelf_boundary, initialize_ice_thickness public initialize_ice_thickness public initialize_ice_shelf_boundary_channel +public initialize_ice_flow_from_file ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with @@ -589,4 +590,80 @@ end subroutine initialize_ice_shelf_boundary_channel !END MJH end subroutine initialize_ice_shelf_boundary_channel +subroutine initialize_ice_flow_from_file(u_shelf, v_shelf,ice_visc,float_cond, hmask,h_shelf, G, US, PF) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: u_shelf !< The ice shelf u velocity [Z ~> m T ~>s]. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: v_shelf !< The ice shelf v velocity [Z ~> m T ~> s]. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: ice_visc !< The ice shelf viscosity [Pa ~> m T ~> s]. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: float_cond !< An array indicating where the ice + !! shelf is floating: 0 if floating, 1 if not. + real, dimension(SZDI_(G),SZDJ_(G)), & + 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_shelf !< A mask indicating which tracer points are + !! partly or fully covered by an ice-shelf + type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors + type(param_file_type), intent(in) :: PF !< A structure to parse for run-time parameters + + ! This subroutine reads ice thickness and area from a file and puts it into + ! h_shelf [Z ~> m] and area_shelf_h [L2 ~> m2] (and dimensionless) and updates hmask + character(len=200) :: filename,vel_file,inputdir ! Strings for file/path + character(len=200) :: ushelf_varname, vshelf_varname, ice_visc_varname, floatfr_varname ! Variable name in file + character(len=40) :: mdl = "initialize_ice_velocity_from_file" ! This subroutine's name. + integer :: i, j, isc, jsc, iec, jec + real :: len_sidestress, mask, udh + + call MOM_mesg(" MOM_ice_shelf_init_profile.F90, initialize_velocity_from_file: reading velocity") + + call get_param(PF, mdl, "INPUTDIR", inputdir, default=".") + inputdir = slasher(inputdir) + call get_param(PF, mdl, "ICE_VELOCITY_FILE", vel_file, & + "The file from which the velocity is read.", & + default="ice_shelf_vel.nc") + call get_param(PF, mdl, "LEN_SIDE_STRESS", len_sidestress, & + "position past which shelf sides are stress free.", & + default=0.0, units="axis_units") + + filename = trim(inputdir)//trim(vel_file) + call log_param(PF, mdl, "INPUTDIR/THICKNESS_FILE", filename) + call get_param(PF, mdl, "ICE_U_VEL_VARNAME", ushelf_varname, & + "The name of the thickness variable in ICE_VELOCITY_FILE.", & + default="u_shelf") + call get_param(PF, mdl, "ICE_V_VEL_VARNAME", vshelf_varname, & + "The name of the thickness variable in ICE_VELOCITY_FILE.", & + default="v_shelf") + call get_param(PF, mdl, "ICE_VISC_VARNAME", ice_visc_varname, & + "The name of the thickness variable in ICE_VELOCITY_FILE.", & + default="viscosity") + + if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & + " initialize_ice_shelf_velocity_from_file: Unable to open "//trim(filename)) + + !hmask_varname = "hmask" + floatfr_varname = "float_frac" + +! call MOM_read_data(filename, trim(ushelf_varname), u_shelf, G%Domain, scale=1.0) !/(365.0*86400.0)) +! call MOM_read_data(filename,trim(vshelf_varname), v_shelf, G%Domain, scale=1.0) !/(365.0*86400.0)) + call MOM_read_data(filename,trim(ice_visc_varname), ice_visc, G%Domain, scale=1.0) !*(365.0*86400.0)) + call MOM_read_data(filename,trim(floatfr_varname), float_cond, G%Domain, scale=1.) +! call get_param(PF, mdl, "ICE_BOUNDARY_CONFIG", config, & +! "This specifies how the ice domain boundary is specified", & +! fail_if_missing=.true.) + + isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec + + do j=jsc,jec + do i=isc,iec + if (hmask(i,j) == 1.) then + ice_visc(i,j) = ice_visc(i,j) * (G%areaT(i,j) * h_shelf(i,j)) + endif + enddo + enddo + +end subroutine initialize_ice_flow_from_file end module MOM_ice_shelf_initialize From 387166bced542edb2710e6b0ba3e39ff5470bece Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Wed, 24 Feb 2021 16:26:27 -0700 Subject: [PATCH 19/51] reduce the line length in mom_surface_forcing_mct --- config_src/mct_driver/mom_surface_forcing_mct.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/config_src/mct_driver/mom_surface_forcing_mct.F90 b/config_src/mct_driver/mom_surface_forcing_mct.F90 index ef0527dd1c..e5e1309a91 100644 --- a/config_src/mct_driver/mom_surface_forcing_mct.F90 +++ b/config_src/mct_driver/mom_surface_forcing_mct.F90 @@ -496,7 +496,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, if (associated(fluxes%frunoff)) then fluxes%latent(i,j) = fluxes%latent(i,j) - & IOB%rofi_flux(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion - fluxes%latent_frunoff_diag(i,j) = - G%mask2dT(i,j) * IOB%rofi_flux(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion + fluxes%latent_frunoff_diag(i,j) = - G%mask2dT(i,j) * & + IOB%rofi_flux(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion endif ! contribution from evaporation if (associated(IOB%q_flux)) then From 1e2fbf463bfbcbc12ef9f404d6ac9bb5a4c12646 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 25 Feb 2021 08:04:26 -0700 Subject: [PATCH 20/51] Add missing areacor --- config_src/nuopc_driver/mom_cap_methods.F90 | 22 ++++++++++++--------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index d365268c0c..e706aefa6f 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -19,6 +19,7 @@ module MOM_cap_methods use MOM_surface_forcing_nuopc, only: ice_ocean_boundary_type use MOM_grid, only: ocean_grid_type use MOM_domains, only: pass_var +use MOM_error_handler, only: MOM_error, FATAL, is_root_pe use mpp_domains_mod, only: mpp_get_compute_domain ! By default make data private @@ -101,6 +102,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- ! near-IR, direct shortwave (W/m2) !---- + call state_getimport(importState, 'mean_net_sw_ir_dir_flx', & isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dir, areacor=med2mod_areacor, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -112,7 +114,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! near-IR, diffuse shortwave (W/m2) !---- call state_getimport(importState, 'mean_net_sw_ir_dif_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dif, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dif, areacor=med2mod_areacor, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -122,7 +124,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! visible, direct shortwave (W/m2) !---- call state_getimport(importState, 'mean_net_sw_vis_dir_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dir, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dir, areacor=med2mod_areacor, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -132,7 +134,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! visible, diffuse shortwave (W/m2) !---- call state_getimport(importState, 'mean_net_sw_vis_dif_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dif, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dif, areacor=med2mod_areacor, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -142,7 +144,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! Net longwave radiation (W/m2) ! ------- call state_getimport(importState, 'mean_net_lw_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%lw_flux, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%lw_flux, areacor=med2mod_areacor, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -715,6 +717,13 @@ subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, a call state_getfldptr(state, trim(fldname), dataptr1d, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + ! option to apply area correction + if (present(areacor)) then + do n = 1,size(dataPtr1d) + dataPtr1d(n) = dataPtr1d(n) * areacor(n) + end do + end if + ! determine output array n = 0 do j = jsc,jec @@ -727,11 +736,6 @@ subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, a endif enddo enddo - if (present(areacor)) then - do n = 1,size(dataPtr1d) - dataPtr1d(n) = dataPtr1d(n) * areacor(n) - end do - end if else if (geomtype == ESMF_GEOMTYPE_GRID) then From 87298d770f5367794a1603dc33255ed9fe1cea5f Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 25 Feb 2021 10:19:49 -0700 Subject: [PATCH 21/51] Fix LBD module after merging main_candidate_2021-02-19 --- src/tracer/MOM_lateral_boundary_diffusion.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/tracer/MOM_lateral_boundary_diffusion.F90 b/src/tracer/MOM_lateral_boundary_diffusion.F90 index 0d6dc14bd7..8f022821ea 100644 --- a/src/tracer/MOM_lateral_boundary_diffusion.F90 +++ b/src/tracer/MOM_lateral_boundary_diffusion.F90 @@ -274,7 +274,6 @@ subroutine lateral_boundary_diffusion(G, GV, US, h, Coef_x, Coef_y, dt, Reg, CS) endif ! post tendency of tracer content - !### This seems to be dimensionally inconsistent with the calculation of tendency above. if (tracer%id_lbdxy_cont > 0) then call post_data(tracer%id_lbdxy_cont, tendency, CS%diag) endif @@ -293,7 +292,6 @@ subroutine lateral_boundary_diffusion(G, GV, US, h, Coef_x, Coef_y, dt, Reg, CS) ! post tendency of tracer concentration; this step must be ! done after posting tracer content tendency, since we alter ! the tendency array and its units. - !### This seems to be dimensionally inconsistent with the calculation of tendency above. if (tracer%id_lbdxy_conc > 0) then do k=1,GV%ke ; do j=G%jsc,G%jec ; do i=G%isc,G%iec tendency(i,j,k) = tendency(i,j,k) / ( h(i,j,k) + CS%H_subroundoff ) From 5667b70f3623a2d9f62ef58449d4da7528d830b8 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 26 Feb 2021 14:00:45 -0700 Subject: [PATCH 22/51] Remove unused imports and delete blank line --- config_src/nuopc_driver/mom_cap_methods.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index e706aefa6f..625bde4cfe 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -19,7 +19,6 @@ module MOM_cap_methods use MOM_surface_forcing_nuopc, only: ice_ocean_boundary_type use MOM_grid, only: ocean_grid_type use MOM_domains, only: pass_var -use MOM_error_handler, only: MOM_error, FATAL, is_root_pe use mpp_domains_mod, only: mpp_get_compute_domain ! By default make data private @@ -102,7 +101,6 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- ! near-IR, direct shortwave (W/m2) !---- - call state_getimport(importState, 'mean_net_sw_ir_dir_flx', & isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dir, areacor=med2mod_areacor, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & From 28b1ac9224da9fa5c81275ecb4132ed0c80121fb Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Tue, 2 Mar 2021 14:09:56 -0500 Subject: [PATCH 23/51] Update CVMix to v0.93-beta (no API change) - Tag v0.93-beta of CVMix is the last tag on their "master" branch before an API change within CVMix. - Answers reproduce with the three-year prior commit being used, as tested in MOM6-examples single_column cases. These do not cover all CVMix code. --- pkg/CVMix-src | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pkg/CVMix-src b/pkg/CVMix-src index 534fc38e75..919a3a24ac 160000 --- a/pkg/CVMix-src +++ b/pkg/CVMix-src @@ -1 +1 @@ -Subproject commit 534fc38e759fcb8a2563fa0dc4c0bbf81f758db9 +Subproject commit 919a3a24acd67454df3ef8ad9854b734a472fea7 From 34dc0c848916075614eb7ec0a5b32a6f9fb6ebec Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Tue, 2 Mar 2021 14:16:39 -0500 Subject: [PATCH 24/51] Update CVMix to v0.94b-beta with API change - This tag involves an API change that requires changes to MOM_tidal_mixing.F90. - Changes are dropped arguments so presumably that data is not needed. - Answers reproduce in so far as they are covered by MOM6-examples. Not all of CVMix is covered in these tests and this code in particular is not. --- pkg/CVMix-src | 2 +- src/parameterizations/vertical/MOM_tidal_mixing.F90 | 2 -- 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/pkg/CVMix-src b/pkg/CVMix-src index 919a3a24ac..fee4701ac6 160000 --- a/pkg/CVMix-src +++ b/pkg/CVMix-src @@ -1 +1 @@ -Subproject commit 919a3a24acd67454df3ef8ad9854b734a472fea7 +Subproject commit fee4701ac61b69964850db5a4c3ebea41fb9346f diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index b870dff1af..512179445b 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -882,7 +882,6 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kd_int, Kv ! summing q_i*TidalConstituent_i over the number of constituents. call CVMix_compute_SchmittnerCoeff( nlev = GV%ke, & energy_flux = tidal_qe_md(:), & - rho = rho_fw, & SchmittnerCoeff = Schmittner_coeff, & exp_hab_zetar = exp_hab_zetar, & CVmix_tidal_params_user = CS%CVMix_tidal_params) @@ -896,7 +895,6 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kd_int, Kv Tdiff_out = Kd_tidal, & Nsqr = N2_int_i, & OceanDepth = -iFaceHeight(GV%ke+1), & - vert_dep = vert_dep, & nlev = GV%ke, & max_nlev = GV%ke, & SchmittnerCoeff = Schmittner_coeff, & From e56d4533587fdaac26f3f7faee54ab391cd6ad61 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Tue, 2 Mar 2021 14:22:54 -0500 Subject: [PATCH 25/51] Update CVMix to v0.98-beta - v0.98-beta is the latest tag of CVMix that is available a.t.t. - There were no API changes since the v0.94b-beta that affected MOM6. - No answer changes for MOM6-examples, but these do not exercise much of CVMix. --- pkg/CVMix-src | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pkg/CVMix-src b/pkg/CVMix-src index fee4701ac6..9423197f89 160000 --- a/pkg/CVMix-src +++ b/pkg/CVMix-src @@ -1 +1 @@ -Subproject commit fee4701ac61b69964850db5a4c3ebea41fb9346f +Subproject commit 9423197f894112edfcb1502245f7d7b873d551f9 From 5483bfed1243fd765b34059f96a68f4a0dc2b5ed Mon Sep 17 00:00:00 2001 From: Olga Sergienko Date: Wed, 3 Mar 2021 10:46:48 -0500 Subject: [PATCH 26/51] Cleaned initialize_ice_shelf_boundary_channel --- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 33 ++++++++++------------ 1 file changed, 15 insertions(+), 18 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index f2e01c461b..7ba1ab7076 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -265,6 +265,8 @@ subroutine initialize_ice_thickness_channel(h_shelf, area_shelf_h, hmask, G, US, endif ; enddo end subroutine initialize_ice_thickness_channel + +!> Initialize ice shelf boundary conditions for a channel configuration subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_bdry, & u_flux_bdry_val, v_flux_bdry_val, u_bdry_val, v_bdry_val, u_shelf, v_shelf, h_bdry_val, & thickness_bdry_val, hmask, h_shelf, G,& @@ -309,7 +311,7 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b real :: input_thick ! The input ice shelf thickness [Z ~> m] ! real :: input_flux ! The input ice flux per unit length [L Z T-1 ~> m2 s-1] real :: input_vel ! The input ice velocity per [L Z T-1 ~> m s-1] - real :: lenlat, len_stress, westlon, lenlon, southlat + real :: lenlat, len_stress, westlon, lenlon, southlat ! The input positions of the channel boundarises call get_param(PF, mdl, "LENLAT", lenlat, fail_if_missing=.true.) @@ -352,11 +354,11 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b ! else hmask(i+1,j) = 3.0 ! hmask(i,j) = 3.0 - h_bdry_val(i+1,j) = h_shelf(i+1,j) !OVS 11/10/20 !input_thick + h_bdry_val(i+1,j) = h_shelf(i+1,j) ! h_bdry_val(i,j) = h_shelf(i,j) thickness_bdry_val(i+1,j) = h_bdry_val(i+0*1,j) u_face_mask_bdry(i+1,j) = 3.0 - u_bdry_val(i+1,j) = input_vel*(1-16.0*((G%geoLatBu(i-1,j)/lenlat-0.5))**4) !OVS 11/09/20 U b.c. + u_bdry_val(i+1,j) = input_vel*(1-16.0*((G%geoLatBu(i-1,j)/lenlat-0.5))**4) !velocity distribution ! u_bdry_val(i+1,j) = (1 - ((G%geoLatBu(i,j) - 0.5*lenlat)*2./lenlat)**2) * & ! 1.5 * input_flux / input_thick ! endif @@ -367,28 +369,26 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b if (G%geoLatBu(i,j-1) == southlat) then !bot boundary if (len_stress == 0. .OR. G%geoLonCv(i,j) <= len_stress) then v_face_mask_bdry(i,j+1) = 0. -! u_face_mask_bdry(i,j-1) = 3. !OVS 11/25/20 - u_face_mask_bdry(i,j) = 3. !OVS 11/25/20 +! u_face_mask_bdry(i,j-1) = 3. + u_face_mask_bdry(i,j) = 3. u_bdry_val(i,j) = 0. v_bdry_val(i,j) = 0. else v_face_mask_bdry(i,j+1) = 1. -! v_face_mask_bdry(i,j) = 3. !OVS 01/20/21 - u_face_mask_bdry(i,j) = 3. !OVS 11/25/20 + u_face_mask_bdry(i,j) = 3. u_bdry_val(i,j) = 0. - v_bdry_val(i,j) = 0. !OVS 01/20/21 - !hmask(i,j) = 0.0 !OVS 11/25/20 + v_bdry_val(i,j) = 0. endif elseif (G%geoLatBu(i,j-1) == southlat+lenlat) then !top boundary if (len_stress == 0. .OR. G%geoLonCv(i,j) <= len_stress) then v_face_mask_bdry(i,j-1) = 0. - u_face_mask_bdry(i,j-1) = 3. !OVS 11/25/20 + u_face_mask_bdry(i,j-1) = 3. else ! v_face_mask_bdry(i,j-1) = 1. - v_face_mask_bdry(i,j-1) = 3. !OVS 01/20/21 - u_face_mask_bdry(i,j-1) = 3. !OVS 11/25/20 - !u_bdry_val(i,j) = 0. !OVS 11/25/20 - !hmask(i,j) = 0.0 !OVS 11/25/20 + v_face_mask_bdry(i,j-1) = 3. + u_face_mask_bdry(i,j-1) = 3. + !u_bdry_val(i,j) = 0. + !hmask(i,j) = 0.0 endif endif @@ -400,9 +400,6 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b enddo enddo -! call pass_var(hmask, G%domain) -! call pass_var(h_bdry_val, G%domain) -! call pass_var(thickness_bdry_val, G%domain) ! if (.not. G%symmetric) then @@ -590,6 +587,7 @@ end subroutine initialize_ice_shelf_boundary_channel !END MJH end subroutine initialize_ice_shelf_boundary_channel +!> Initialize ice shelf flow from file subroutine initialize_ice_flow_from_file(u_shelf, v_shelf,ice_visc,float_cond, hmask,h_shelf, G, US, PF) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZDI_(G),SZDJ_(G)), & @@ -644,7 +642,6 @@ subroutine initialize_ice_flow_from_file(u_shelf, v_shelf,ice_visc,float_cond, h if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & " initialize_ice_shelf_velocity_from_file: Unable to open "//trim(filename)) - !hmask_varname = "hmask" floatfr_varname = "float_frac" ! call MOM_read_data(filename, trim(ushelf_varname), u_shelf, G%Domain, scale=1.0) !/(365.0*86400.0)) From 9aa75c8691c8c4e321a5894875d04a519bc4f0a1 Mon Sep 17 00:00:00 2001 From: Olga Sergienko Date: Wed, 3 Mar 2021 11:16:53 -0500 Subject: [PATCH 27/51] Modified MOM_ice_shelf_initialize.F90 --- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 43 ++++++++++------------ 1 file changed, 19 insertions(+), 24 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index 7ba1ab7076..f9f31a373e 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -302,14 +302,12 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b !! partly or fully covered by an ice-shelf real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: h_shelf !< Ice-shelf thickness OVS 11/10/20 -! logical, intent(in) :: flux_bdry !< If true, use mass fluxes as the boundary value. type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors type(param_file_type), intent(in) :: PF !< A structure to parse for run-time parameters character(len=40) :: mdl = "initialize_ice_shelf_boundary_channel" ! This subroutine's name. integer :: i, j, isd, jsd, is, js, iegq, jegq, giec, gjec, gisc, gjsc,gisd,gjsd, isc, jsc, iec, jec, ied, jed - real :: input_thick ! The input ice shelf thickness [Z ~> m] -! real :: input_flux ! The input ice flux per unit length [L Z T-1 ~> m2 s-1] + real :: input_thick ! The input ice shelf thickness [Z ~> m] real :: input_vel ! The input ice velocity per [L Z T-1 ~> m s-1] real :: lenlat, len_stress, westlon, lenlon, southlat ! The input positions of the channel boundarises @@ -341,27 +339,27 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b gisc = G%Domain%nihalo ; gjsc = G%Domain%njhalo giec = G%Domain%niglobal+gisc ; gjec = G%Domain%njglobal+gjsc -!-----------b.c.s based on geopositions ----------------- -! do j=jsc-1,jec+1 + !---------b.c.s based on geopositions ----------------- + ! do j=jsc-1,jec+1 do j=jsc-0*1,jec+1 do i=isc-1,iec+1 ! upstream boundary - set either dirichlet or flux condition if (G%geoLonBu(i,j) == westlon) then - ! if (flux_bdry) then - ! u_face_mask_bdry(i-1,j) = 4.0 - ! u_flux_bdry_val(i-1,j) = input_flux - ! else + ! if (flux_bdry) then + ! u_face_mask_bdry(i-1,j) = 4.0 + ! u_flux_bdry_val(i-1,j) = input_flux + ! else hmask(i+1,j) = 3.0 -! hmask(i,j) = 3.0 + ! hmask(i,j) = 3.0 h_bdry_val(i+1,j) = h_shelf(i+1,j) -! h_bdry_val(i,j) = h_shelf(i,j) + ! h_bdry_val(i,j) = h_shelf(i,j) thickness_bdry_val(i+1,j) = h_bdry_val(i+0*1,j) u_face_mask_bdry(i+1,j) = 3.0 u_bdry_val(i+1,j) = input_vel*(1-16.0*((G%geoLatBu(i-1,j)/lenlat-0.5))**4) !velocity distribution - ! u_bdry_val(i+1,j) = (1 - ((G%geoLatBu(i,j) - 0.5*lenlat)*2./lenlat)**2) * & - ! 1.5 * input_flux / input_thick - ! endif + ! u_bdry_val(i+1,j) = (1 - ((G%geoLatBu(i,j) - 0.5*lenlat)*2./lenlat)**2) * & + ! 1.5 * input_flux / input_thick + ! endif endif @@ -369,7 +367,7 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b if (G%geoLatBu(i,j-1) == southlat) then !bot boundary if (len_stress == 0. .OR. G%geoLonCv(i,j) <= len_stress) then v_face_mask_bdry(i,j+1) = 0. -! u_face_mask_bdry(i,j-1) = 3. + ! u_face_mask_bdry(i,j-1) = 3. u_face_mask_bdry(i,j) = 3. u_bdry_val(i,j) = 0. v_bdry_val(i,j) = 0. @@ -384,7 +382,7 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b v_face_mask_bdry(i,j-1) = 0. u_face_mask_bdry(i,j-1) = 3. else -! v_face_mask_bdry(i,j-1) = 1. + !v_face_mask_bdry(i,j-1) = 1. v_face_mask_bdry(i,j-1) = 3. u_face_mask_bdry(i,j-1) = 3. !u_bdry_val(i,j) = 0. @@ -398,10 +396,7 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b endif enddo - enddo - - - + enddo ! if (.not. G%symmetric) then !! do j=G%jsd,G%jed !! do i=G%isd,G%ied @@ -623,7 +618,7 @@ subroutine initialize_ice_flow_from_file(u_shelf, v_shelf,ice_visc,float_cond, h call get_param(PF, mdl, "ICE_VELOCITY_FILE", vel_file, & "The file from which the velocity is read.", & default="ice_shelf_vel.nc") - call get_param(PF, mdl, "LEN_SIDE_STRESS", len_sidestress, & + call get_param(PF, mdl, "LEN_SIDE_STRESS", len_sidestress, & "position past which shelf sides are stress free.", & default=0.0, units="axis_units") @@ -642,12 +637,12 @@ subroutine initialize_ice_flow_from_file(u_shelf, v_shelf,ice_visc,float_cond, h if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & " initialize_ice_shelf_velocity_from_file: Unable to open "//trim(filename)) - floatfr_varname = "float_frac" + floatfr_varname = "float_frac" ! call MOM_read_data(filename, trim(ushelf_varname), u_shelf, G%Domain, scale=1.0) !/(365.0*86400.0)) ! call MOM_read_data(filename,trim(vshelf_varname), v_shelf, G%Domain, scale=1.0) !/(365.0*86400.0)) - call MOM_read_data(filename,trim(ice_visc_varname), ice_visc, G%Domain, scale=1.0) !*(365.0*86400.0)) - call MOM_read_data(filename,trim(floatfr_varname), float_cond, G%Domain, scale=1.) + call MOM_read_data(filename,trim(ice_visc_varname), ice_visc, G%Domain, scale=1.0) !*(365.0*86400.0)) + call MOM_read_data(filename,trim(floatfr_varname), float_cond, G%Domain, scale=1.) ! call get_param(PF, mdl, "ICE_BOUNDARY_CONFIG", config, & ! "This specifies how the ice domain boundary is specified", & ! fail_if_missing=.true.) From 2232fa2882806f8ebabb324d93cc580c107bb17a Mon Sep 17 00:00:00 2001 From: Olga Sergienko Date: Wed, 3 Mar 2021 15:51:11 -0500 Subject: [PATCH 28/51] corrected style errors in MOM_ice_shelf.F90; MOM_ice_shelf_dynamics.F90; MOM_ice_shelf_initialize.F90 --- src/ice_shelf/MOM_ice_shelf.F90 | 2 +- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 295 +++------------------ src/ice_shelf/MOM_ice_shelf_initialize.F90 | 41 +-- 3 files changed, 63 insertions(+), 275 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 5663b326b7..5d2bc88b4c 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -719,7 +719,7 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step, CS) call hchksum(ISS%mass_shelf, "mass_shelf after change thickness using melt", G%HI, haloshift=0, & scale=US%RZ_to_kg_m2) endif - endif !OVS 12/10/20 + endif !OVS 12/10/20 if (CS%debug) call MOM_forcing_chksum("Before add shelf flux", fluxes, G, CS%US, haloshift=0) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 5e6ba60a1a..8640902989 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -23,7 +23,7 @@ module MOM_ice_shelf_dynamics use MOM_ice_shelf_state, only : ice_shelf_state use MOM_coms, only : reproducing_sum, sum_across_PEs, max_across_PEs, min_across_PEs use MOM_checksums, only : hchksum, qchksum -use MOM_ice_shelf_initialize, only : initialize_ice_shelf_boundary_channel,initialize_ice_flow_from_file !OVS intializing b.c.s +use MOM_ice_shelf_initialize, only : initialize_ice_shelf_boundary_channel,initialize_ice_flow_from_file implicit none ; private @@ -47,7 +47,7 @@ module MOM_ice_shelf_dynamics real, pointer, dimension(:,:) :: taudx_shelf => NULL() !< the driving stress of the ice shelf/sheet !! on q-points (C grid) [Pa ~> Pa] real, pointer, dimension(:,:) :: taudy_shelf => NULL() !< the meridional stress of the ice shelf/sheet - !! on q-points (C grid) [Pa ~> Pa] + !! on q-points (C grid) [Pa ~> Pa] real, pointer, dimension(:,:) :: u_face_mask => NULL() !< mask for velocity boundary conditions on the C-grid !! u-face - this is because the FEM cares about FACES THAT GET INTEGRATED OVER, !! not vertices. Will represent boundary conditions on computational boundary @@ -263,10 +263,10 @@ subroutine register_ice_shelf_dyn_restarts(G, param_file, CS, restart_CS) "ice sheet/shelf v-velocity", "m s-1", hor_grid='Bu') call register_restart_field(CS%t_shelf, "t_shelf", .true., restart_CS, & "ice sheet/shelf vertically averaged temperature", "deg C") - call register_restart_field(CS%taudx_shelf, "taudx_shelf", .true., restart_CS, & !OVS 02/8/21 + call register_restart_field(CS%taudx_shelf, "taudx_shelf", .true., restart_CS, & "ice sheet/shelf taudx-driving stress", "kPa") - call register_restart_field(CS%taudy_shelf, "taudy_shelf", .true., restart_CS, & !OVS 02/08/21 - "ice sheet/shelf taudy-driving stress", "kPa") + call register_restart_field(CS%taudy_shelf, "taudy_shelf", .true., restart_CS, & + "ice sheet/shelf taudy-driving stress", "kPa") call register_restart_field(CS%OD_av, "OD_av", .true., restart_CS, & "Average open ocean depth in a cell","m") call register_restart_field(CS%ground_frac, "ground_frac", .true., restart_CS, & @@ -376,23 +376,20 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ call get_param(param_file, mdl, "A_GLEN_ISOTHERM", CS%A_glen_isothermal, & "Ice viscosity parameter in Glen's Law", & - units="Pa-3 s-1", default=2.2261e-25, scale=1.0) !OVS change units to Pa-3 s-1 -! units="Pa-3 yr-1", default=9.461e-18, scale=1.0/(365.0*86400.0)) + units="Pa-3 s-1", default=2.2261e-25, scale=1.0) ! This default is equivalent to 3.0001e-25 Pa-3 s-1, appropriate at about -10 C. call get_param(param_file, mdl, "GLEN_EXPONENT", CS%n_glen, & "nonlinearity exponent in Glen's Law", & units="none", default=3.) call get_param(param_file, mdl, "MIN_STRAIN_RATE_GLEN", CS%eps_glen_min, & "min. strain rate to avoid infinite Glen's law viscosity", & - units="s-1", default=1.e-19, scale=US%T_to_s) !OVS change units to s-1 - !units="a-1", default=1.e-12, scale=US%T_to_s/(365.0*86400.0)) + units="s-1", default=1.e-19, scale=US%T_to_s) call get_param(param_file, mdl, "BASAL_FRICTION_EXP", CS%n_basal_fric, & "Exponent in sliding law \tau_b = C u^(n_basal_fric)", & units="none", fail_if_missing=.true.) call get_param(param_file, mdl, "BASAL_FRICTION_COEFF", CS%C_basal_friction, & "Coefficient in sliding law \tau_b = C u^(n_basal_fric)", & - units="Pa (m s-1)^(n_basal_fric)", scale=US%kg_m2s_to_RZ_T**CS%n_basal_fric, & ! OVS change units to s-1 - !units="Pa (m yr-1)-(n_basal_fric)", scale=US%kg_m2s_to_RZ_T*((365.0*86400.0)**CS%n_basal_fric), & + units="Pa (m s-1)^(n_basal_fric)", scale=US%kg_m2s_to_RZ_T**CS%n_basal_fric, & fail_if_missing=.true.) call get_param(param_file, mdl, "DENSITY_ICE", CS%density_ice, & "A typical density of ice.", units="kg m-3", default=917.0, scale=US%kg_m3_to_R) @@ -416,7 +413,7 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ call get_param(param_file, mdl, "CALVE_TO_MASK", CS%calve_to_mask, & "If true, do not allow an ice shelf where prohibited by a mask.", & default=.false.) - + endif call get_param(param_file, mdl, "MIN_THICKNESS_SIMPLE_CALVE", CS%min_thickness_simple_calve, & "Min thickness rule for the VERY simple calving law",& @@ -424,7 +421,6 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ ! Allocate memory in the ice shelf dynamics control structure that was not ! previously allocated for registration for restarts. - ! OVS vertically integrated Temperature if (active_shelf_dynamics) then ! DNG @@ -533,68 +529,37 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ CS%u_flux_bdry_val, CS%v_flux_bdry_val, CS%u_bdry_val, CS%v_bdry_val, CS%u_shelf, CS%v_shelf,& CS%h_bdry_val, & CS%thickness_bdry_val, ISS%hmask, ISS%h_shelf, G, & -! CS%flux_bdry, & - US, param_file ) !OVS initialize b.c.s + US, param_file ) call pass_var(ISS%hmask, G%domain) call pass_var(CS%h_bdry_val, G%domain) - call pass_var(CS%thickness_bdry_val, G%domain) - call pass_var(CS%u_bdry_val, G%domain) - call pass_var(CS%v_bdry_val, G%domain) - call pass_var(CS%u_face_mask_bdry, G%domain) - call pass_var(CS%v_face_mask_bdry, G%domain) -! call init_boundary_values(CS, G, time, ISS%hmask, CS%input_flux, CS%input_thickness, new_sim) + call pass_var(CS%thickness_bdry_val, G%domain) + call pass_var(CS%u_bdry_val, G%domain) + call pass_var(CS%v_bdry_val, G%domain) + call pass_var(CS%u_face_mask_bdry, G%domain) + call pass_var(CS%v_face_mask_bdry, G%domain) + !call init_boundary_values(CS, G, time, ISS%hmask, CS%input_flux, CS%input_thickness, new_sim) call update_velocity_masks(CS, G, ISS%hmask, CS%umask, CS%vmask, CS%u_face_mask, CS%v_face_mask) -! call initialize_ice_flow_from_file(CS%u_shelf, CS%v_shelf,CS%ice_visc,CS%ground_frac, ISS%hmask,ISS%h_shelf, & -! G, US, param_file) !spacially variable viscosity from a file for debugging -! call pass_var(CS%ice_visc, G%domain) -! if (new_sim) then -! call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: initialize ice velocity.") -! call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf(:,:)) -!! call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf, iters, Time) -! call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) !OVS 02/08/21 -! if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf, CS%u_shelf, CS%diag) -! if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf, CS%v_shelf,CS%diag) -! if (CS%id_taudx_shelf > 0) call post_data(CS%id_taudx_shelf, CS%taudx_shelf,CS%diag) -! if (CS%id_taudy_shelf > 0) call post_data(CS%id_taudy_shelf, CS%taudy_shelf,CS%diag) -! if (CS%id_visc_shelf > 0) call post_data(CS%id_visc_shelf, CS%ice_visc,CS%diag) -! endif ! Register diagnostics. -! CS%id_u_shelf = register_diag_field('ocean_model','u_shelf',CS%diag%axesCu1, Time, & -! 'x-velocity of ice', 'm yr-1', conversion=365.0*86400.0*US%L_T_to_m_s) CS%id_u_shelf = register_diag_field('ice_shelf_model','u_shelf',CS%diag%axesCu1, Time, & 'x-velocity of ice', 'm yr-1', conversion=365.0*86400.0*US%L_T_to_m_s) -! CS%id_v_shelf = register_diag_field('ocean_model','v_shelf',CS%diag%axesCv1, Time, & -! 'y-velocity of ice', 'm yr-1', conversion=365.0*86400.0*US%L_T_to_m_s) CS%id_v_shelf = register_diag_field('ice_shelf_model','v_shelf',CS%diag%axesCv1, Time, & 'y-velocity of ice', 'm yr-1', conversion=365.0*86400.0*US%L_T_to_m_s) CS%id_taudx_shelf = register_diag_field('ice_shelf_model','taudx_shelf',CS%diag%axesT1, Time, & 'x-driving stress of ice', 'kPa', conversion=1.e-9*US%L_T_to_m_s) CS%id_taudy_shelf = register_diag_field('ice_shelf_model','taudy_shelf',CS%diag%axesT1, Time, & 'x-driving stress of ice', 'kPa', conversion=1.e-9*US%L_T_to_m_s) -! CS%id_u_mask = register_diag_field('ocean_model','u_mask',CS%diag%axesCu1, Time, & -! 'mask for u-nodes', 'none') CS%id_u_mask = register_diag_field('ice_shelf_model','u_mask',CS%diag%axesCu1, Time, & 'mask for u-nodes', 'none') -! CS%id_v_mask = register_diag_field('ocean_model','v_mask',CS%diag%axesCv1, Time, & -! 'mask for v-nodes', 'none') CS%id_v_mask = register_diag_field('ice_shelf_model','v_mask',CS%diag%axesCv1, Time, & 'mask for v-nodes', 'none') -! CS%id_surf_elev = register_diag_field('ocean_model','ice_surf',CS%diag%axesT1, Time, & -! 'ice surf elev', 'm') -! CS%id_ground_frac = register_diag_field('ocean_model','ice_ground_frac',CS%diag%axesT1, Time, & -! 'fraction of cell that is grounded', 'none') CS%id_ground_frac = register_diag_field('ice_shelf_model','ice_ground_frac',CS%diag%axesT1, Time, & 'fraction of cell that is grounded', 'none') -! CS%id_col_thick = register_diag_field('ocean_model','col_thick',CS%diag%axesT1, Time, & -! 'ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) CS%id_col_thick = register_diag_field('ice_shelf_model','col_thick',CS%diag%axesT1, Time, & 'ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) CS%id_visc_shelf = register_diag_field('ice_shelf_model','ice_visc',CS%diag%axesT1, Time, & 'viscosity', 'm', conversion=1e-6*US%Z_to_m) -! CS%id_OD_av = register_diag_field('ocean_model','OD_av',CS%diag%axesT1, Time, & -! 'intermediate ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) CS%id_OD_av = register_diag_field('ice_shelf_model','OD_av',CS%diag%axesT1, Time, & 'intermediate ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) CS%id_h_after_uflux = register_diag_field('ice_shelf_model','h_after_uflux',CS%diag%axesT1, Time, & @@ -606,8 +571,8 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ if (new_sim) then call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: initialize ice velocity.") call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf(:,:)) -! call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf, iters, Time) - call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) !OVS 02/08/21 + !call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf, iters, Time) + call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf, CS%u_shelf, CS%diag) if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf, CS%v_shelf,CS%diag) if (CS%id_taudx_shelf > 0) call post_data(CS%id_taudx_shelf, CS%taudx_shelf,CS%diag) @@ -655,8 +620,7 @@ subroutine initialize_diagnostic_fields(CS, ISS, G, US, Time) enddo enddo -! call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf, iters, dummy_time) - call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) !OVS 02/08/21 + call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) end subroutine initialize_diagnostic_fields !> This function returns the global maximum advective timestep that can be taken based on the current @@ -716,7 +680,7 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled coupled_GL = .false. if (present(ocean_mass) .and. present(coupled_grounding)) coupled_GL = coupled_grounding ! - call ice_shelf_advect(CS, ISS, G, time_step, Time) !OVS 02/08/21 + call ice_shelf_advect(CS, ISS, G, time_step, Time) CS%elapsed_velocity_time = CS%elapsed_velocity_time + time_step if (CS%elapsed_velocity_time >= CS%velocity_update_time_step) update_ice_vel = .true. @@ -729,7 +693,7 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled if (update_ice_vel) then ! call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf, iters, Time) - call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) !OVS 02/08/21 + call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) endif call ice_shelf_temp(CS, ISS, G, US, time_step, ISS%water_flux, Time) @@ -741,10 +705,10 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf, CS%v_shelf, CS%diag) if (CS%id_t_shelf > 0) call post_data(CS%id_t_shelf,CS%t_shelf,CS%diag) if (CS%id_taudx_shelf > 0) call post_data(CS%id_taudx_shelf, CS%taudx_shelf, CS%diag) - if (CS%id_taudy_shelf > 0) call post_data(CS%id_taudy_shelf, CS%taudy_shelf, CS%diag) + if (CS%id_taudy_shelf > 0) call post_data(CS%id_taudy_shelf, CS%taudy_shelf, CS%diag) if (CS%id_ground_frac > 0) call post_data(CS%id_ground_frac, CS%ground_frac,CS%diag) if (CS%id_OD_av >0) call post_data(CS%id_OD_av, CS%OD_av,CS%diag) - if (CS%id_visc_shelf > 0) call post_data(CS%id_visc_shelf, CS%ice_visc,CS%diag) + if (CS%id_visc_shelf > 0) call post_data(CS%id_visc_shelf, CS%ice_visc,CS%diag) if (CS%id_u_mask > 0) call post_data(CS%id_u_mask,CS%umask,CS%diag) if (CS%id_v_mask > 0) call post_data(CS%id_v_mask,CS%vmask,CS%diag) @@ -908,7 +872,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite call calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, CS%OD_av) call pass_vector(taudx, taudy, G%domain, TO_ALL, BGRID_NE) !OVS 02/01/21 ! call pass_var(taudx, G%Domain) !OVS 01/21/21 -! call pass_var(taudy, G%Domain) !OVS 01/21/21 +! call pass_var(taudy, G%Domain) !OVS 01/21/21 ! This is to determine which cells contain the grounding line, the criterion being that the cell ! is ice-covered, with some nodes floating and some grounded flotation condition is estimated by ! assuming topography is cellwise constant and H is bilinear in a cell; floating where @@ -1072,7 +1036,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite if (err_max <= CS%nonlinear_tolerance * err_init) then write(mesg,*) "ice_shelf_solve_outer: nonlinear fractional residual = ", err_max/err_init - call MOM_mesg(mesg) + call MOM_mesg(mesg) write(mesg,*) "ice_shelf_solve_outer: exiting nonlinear solve after ",iter," iterations" ! call MOM_mesg(mesg, 5) call MOM_mesg(mesg) @@ -1354,8 +1318,8 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H ! pass vectors call pass_vector(Du, Dv, G%domain, TO_ALL, BGRID_NE) call pass_vector(u_shlf, v_shlf, G%domain, TO_ALL, BGRID_NE) - call pass_var(u_shlf, G%domain) - call pass_var(v_shlf, G%domain) + call pass_var(u_shlf, G%domain) + call pass_var(v_shlf, G%domain) call pass_vector(Ru, Rv, G%domain, TO_ALL, BGRID_NE) cg_halo = 3 endif @@ -1856,7 +1820,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) ! check whether the ice is floating or grounded ! do j=jsc-1,jec+1 !OVS 02/02/21 ! do i=isc-1,iec+1 !OVS 02/02/21 - do j=jsc-G%domain%njhalo,jec+G%domain%njhalo !OVS 02/02/21 + do j=jsc-G%domain%njhalo,jec+G%domain%njhalo !OVS 02/02/21 do i=isc-G%domain%nihalo,iec+G%domain%nihalo !OVS 02/02/21 ! if (ISS%h_shelf(i,j) < rhow/rho * G%bathyT(i,j)) then @@ -1866,7 +1830,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) enddo - enddo + enddo do j=jsc-1,jec+1 do i=isc-1,iec+1 cnt = 0 @@ -1956,16 +1920,16 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) taudy(I,J-1) = taudy(I,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) endif ! NW vertex - if (ISS%hmask(I-1,J) == 1) then + if (ISS%hmask(I-1,J) == 1) then taudx(I-1,J) = taudx(I-1,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j) taudy(I-1,J) = taudy(I-1,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) - endif + endif ! NE vertex if (ISS%hmask(I,J) == 1) then taudx(I,J) = taudx(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j) taudy(I,J) = taudy(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) endif - if (CS%ground_frac(i,j) == 1) then + if (CS%ground_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 * (1-rho/rhow) * rho * ISS%h_shelf(i,j)**2 else @@ -2325,7 +2289,7 @@ subroutine matrix_diagonal(CS, G, US, float_cond, H_node, ice_visc, basal_trac, ! Phi(2*i-1,j) gives d(Phi_i)/dx at quadrature point j ! Phi(2*i,j) gives d(Phi_i)/dy at quadrature point j - do iq=1,2 ; do jq=1,2 ; do iphi=1,2 ; do jphi=1,2 ; Itgt = I-2+iphi ; Jtgt = J-2+jphi !Jtgt = J-2-jphi !OVS fix index + do iq=1,2 ; do jq=1,2 ; do iphi=1,2 ; do jphi=1,2 ; Itgt = I-2+iphi ; Jtgt = J-2+jphi ilq = 1 ; if (iq == iphi) ilq = 2 jlq = 1 ; if (jq == jphi) jlq = 2 @@ -2584,7 +2548,7 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) integer :: i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq, iq, jq integer :: giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec, is, js, i_off, j_off real :: Visc_coef, n_g - real :: ux, uy, vx, vy + real :: ux, uy, vx, vy real :: eps_min, dxh, dyh ! Velocity shears [T-1 ~> s-1] real, dimension(8,4) :: Phi real, dimension(2) :: xquad @@ -2602,7 +2566,7 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) n_g = CS%n_glen; eps_min = CS%eps_glen_min ! CS%ice_visc(:,:) = 0.0 -! ux(:,:) = 0.0; uy(:,:) = 0.0; vx(:,:) =0.0; vy(:,:) =0.0 +! ux(:,:) = 0.0; uy(:,:) = 0.0; vx(:,:) =0.0; vy(:,:) =0.0 ! eII(:,:) = (US%s_to_T**2 * (eps_min**2)) Visc_coef = US%kg_m2s_to_RZ_T*US%m_to_L*US%Z_to_L*(CS%A_glen_isothermal)**(-1./CS%n_glen) !OVS '-' in the exponent ! call pass_vector(u_shlf, v_shlf, G%domain, TO_ALL, BGRID_NE) @@ -2616,11 +2580,11 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) ! vx(i,j) = ((v_shlf(I,J) + v_shlf(I,J-1)) - (v_shlf(I-1,J) + v_shlf(I-1,J-1))) / (2*G%dxT(i,j)) ! uy(i,j) = ((u_shlf(I,J) + u_shlf(I-1,J)) - (u_shlf(I,J-1) + u_shlf(I-1,J-1))) / (2*G%dyT(i,j)) ! vy(i,j) = ((v_shlf(I,J) + v_shlf(I-1,J)) - (v_shlf(I,J-1) + v_shlf(I-1,J-1))) / (2*G%dyT(i,j)) -! endif +! endif +! enddo ! enddo -! enddo ! call pass_vector(ux, uy, G%domain, TO_ALL, BGRID_NE) -! call pass_vector(vx, vy, G%domain, TO_ALL, BGRID_NE) +! call pass_vector(vx, vy, G%domain, TO_ALL, BGRID_NE) ux = ((u_shlf(I,J) + u_shlf(I,J-1) + u_shlf(I,J+1)) - & (u_shlf(I-1,J) + u_shlf(I-1,J-1) + u_shlf(I-1,J+1))) / (3*G%dxT(i,j)) vx = ((v_shlf(I,J) + v_shlf(I,J-1) + v_shlf(I,J+1)) - & @@ -2628,14 +2592,14 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) uy = ((u_shlf(I,J) + u_shlf(I-1,J) + u_shlf(I+1,J)) - & (u_shlf(I,J-1) + u_shlf(I-1,J-1) + u_shlf(I+1,J-1))) / (3*G%dyT(i,j)) vy = ((v_shlf(I,J) + v_shlf(I-1,J)+ v_shlf(I+1,J)) - & - (v_shlf(I,J-1) + v_shlf(I-1,J-1)+ v_shlf(I+1,J-1))) / (3*G%dyT(i,j)) + (v_shlf(I,J-1) + v_shlf(I-1,J-1)+ v_shlf(I+1,J-1))) / (3*G%dyT(i,j)) ! ux = ((u_shlf(I,J) + u_shlf(I,J-1)) - (u_shlf(I-1,J) + u_shlf(I-1,J-1))) / (2*G%dxT(i,j)) ! vx = ((v_shlf(I,J) + v_shlf(I,J-1)) - (v_shlf(I-1,J) + v_shlf(I-1,J-1))) / (2*G%dxT(i,j)) ! uy = ((u_shlf(I,J) + u_shlf(I-1,J)) - (u_shlf(I,J-1) + u_shlf(I-1,J-1))) / (2*G%dyT(i,j)) ! vy = ((v_shlf(I,J) + v_shlf(I-1,J)) - (v_shlf(I,J-1) + v_shlf(I-1,J-1))) / (2*G%dyT(i,j)) CS%ice_visc(i,j) = 0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) -! CS%ice_visc(i,j) =1e15*(G%areaT(i,j) * ISS%h_shelf(i,j)) ! constant viscocity for debugging + CS%ice_visc(i,j) =1e14*(G%areaT(i,j) * ISS%h_shelf(i,j)) ! constant viscocity for debugging ! umid = ((u_shlf(I,J) + u_shlf(I-1,J-1)) + (u_shlf(I,J-1) + u_shlf(I-1,J))) * 0.25 ! vmid = ((v_shlf(I,J) + v_shlf(I-1,J-1)) + (v_shlf(I,J-1) + v_shlf(I-1,J))) * 0.25 ! unorm = sqrt(umid**2 + vmid**2 + eps_min**2*(G%dxT(i,j)**2 + G%dyT(i,j)**2)) @@ -2644,183 +2608,6 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) enddo enddo -! do j=jsc-1,jec+1 -! do i=isc-1,iec+1 -!! do j=jsd+1,jed!-1 OVS 02/01/21 -!! do i=isd+1,ied!-1 OVS 02/01/21 - -! if (ISS%hmask(i,j) == 1) then -! CS%ice_visc(i,j) = 0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & -! (US%s_to_T**2 * (ux(i,j)**2 + vy(i,j)**2 + ux(i,j)*vy(i,j) + 0.25*(uy(i,j)+vx(i,j))**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) -! endif -! enddo -! enddo - -! xquad(1) = .5 * (1-sqrt(1./3)) ; xquad(2) = .5 * (1+sqrt(1./3)) -! do j=jsc-1,jec+1 -! do i=isc-1,iec+1 -! cnt = 0 -! ux = 0 -! uy = 0 -! vx = 0 -! vy = 0 -! dxh = G%dxT(i,j) -! dyh = G%dyT(i,j) - -! if (ISS%hmask(i,j) == 1) then ! we are inside the global computational bdry, at an ice-filled cell - -! call bilinear_shape_fn_grid(G, i, j, Phi) -! do jq = 1,2 -! do iq = 1,2 - -! ux = u_shlf(I-1,J-1) * Phi(1,2*(jq-1)+iq) + & -! u_shlf(I,J-1) * Phi(3,2*(jq-1)+iq) + & -! u_shlf(I-1,J) * Phi(5,2*(jq-1)+iq) + & -! u_shlf(I,J) * Phi(7,2*(jq-1)+iq) - -! vx = v_shlf(I-1,J-1) * Phi(1,2*(jq-1)+iq) + & -! v_shlf(I,J-1) * Phi(3,2*(jq-1)+iq) + & -! v_shlf(I-1,J) * Phi(5,2*(jq-1)+iq) + & -! v_shlf(I,J) * Phi(7,2*(jq-1)+iq) - -! uy = u_shlf(I-1,J-1) * Phi(2,2*(jq-1)+iq) + & -! u_shlf(I,J-1) * Phi(4,2*(jq-1)+iq) + & -! u_shlf(I-1,J) * Phi(6,2*(jq-1)+iq) + & -! u_shlf(I,J) * Phi(8,2*(jq-1)+iq) - -! vy = v_shlf(I-1,J-1) * Phi(2,2*(jq-1)+iq) + & -! v_shlf(I,J-1) * Phi(4,2*(jq-1)+iq) + & -! v_shlf(I-1,J) * Phi(6,2*(jq-1)+iq) + & -! v_shlf(I,J) * Phi(8,2*(jq-1)+iq) -! enddo -! enddo - ! calculate sx -! if ((i+i_off) == gisc) then ! at left computational bdry -! if (ISS%hmask(i+1,j) == 1) then -! ux = (u_shlf(i+1,j)-u_shlf(i,j))/dxh -! vx = (v_shlf(i+1,j)-v_shlf(i,j))/dxh -! else -! ux = 0 -! vx = 0 -! endif -! elseif ((i+i_off) == giec) then ! at east computational bdry -! if (ISS%hmask(i-1,j) == 1) then -! ux = (u_shlf(i,j)-u_shlf(i-1,j))/dxh -! vx = (v_shlf(i,j)-v_shlf(i-1,j))/dxh -! else -! ux = 0 -! vx = 0 -! endif -! else ! interior -! if (ISS%hmask(i+1,j) == 1) then -! cnt = cnt+1 -! ux = u_shlf(i+1,j) -! vx = v_shlf(i+1,j) -! else -! ux = u_shlf(i,j) -! vx = v_shlf(i,j) -! endif -! if (ISS%hmask(i-1,j) == 1) then -! cnt = cnt+1 -! ux = ux - u_shlf(i-1,j) -! vx = vx - v_shlf(i-1,j) -! else -! ux = ux - u_shlf(i,j) -! vx = vx - v_shlf(i,j) -! endif -! if (cnt == 0) then -! ux = 0 -! vx = 0 -! else -! ux = ux / (cnt * dxh) -! vx = vx / (cnt * dxh) -! endif -!! endif -! cnt = 0 - - ! calculate sy, similarly -! if ((j+j_off) == gjsc) then ! at south computational bdry -! if (ISS%hmask(i,j+1) == 1) then -! uy = (u_shlf(i,j+1)-u_shlf(i,j))/dyh -! vy = (v_shlf(i,j+1)-v_shlf(i,j))/dyh -! else -! vy = 0 -! endif -! elseif ((j+j_off) == gjec) then ! at nprth computational bdry -! if (ISS%hmask(i,j-1) == 1) then -! uy = (u_shlf(i,j)-u_shlf(i,j-1))/dyh -! vy = (v_shlf(i,j)-v_shlf(i,j-1))/dyh -! else -! uy = 0 -! vy = 0 -! endif -! else ! interior -! if (ISS%hmask(i,j+1) == 1) then -! cnt = cnt+1 -! uy = u_shlf(i,j+1) -! vy = v_shlf(i,j+1) -! else -! uy = u_shlf(i,j) -! vy = v_shlf(i,j) -! endif -! if (ISS%hmask(i,j-1) == 1) then -! cnt = cnt+1 -! uy = uy - u_shlf(i,j-1) -! vy = vy - v_shlf(i,j-1) -! else -! uy = uy - u_shlf(i,j) -! vy = vy - v_shlf(i,j) -! endif -! if (cnt == 0) then -! uy = 0 -! vy = 0 -! else -! uy = uy / (cnt * dyh) -! vy = vy / (cnt * dyh) -! endif -!! endif - -! ! SW vertex -! if (ISS%hmask(I-1,J-1) == 1) then -! eII(i-1,j-1) = eII(i-1,j-1)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) -! endif - ! SE vertex -! if (ISS%hmask(I,J-1) == 1) then -! eII(i,j-1) = eII(i,j-1)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) - -! CS%ice_visc(i,j-1) = CS%ice_visc(i,j-1)+.25*0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & -! (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) -! endif - ! NW vertex -! if (ISS%hmask(I-1,J) == 1) then -! eII(i-1,j) = eII(i-1,j)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) - -! CS%ice_visc(i-1,j) = CS%ice_visc(i-1,j)+.25*0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & -! (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) -! endif - ! NE vertex -! if (ISS%hmask(I,J) == 1) then -! eII(i,j) = eII(i,j)+.25*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) -! eII(i,j) = (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) - -! CS%ice_visc(i,j) = CS%ice_visc(i,j)+.25*0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & -! (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) -! endif -! if (ISS%hmask(I+1,J+1) == 1) then -! eII(i+1,j+1) = eII(i+1,j+1)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) -! endif -! if (ISS%hmask(I,J+1) == 1) then -! eII(i,j+1) = eII(i,j+1)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) -! endif -! if (ISS%hmask(I+1,J) == 1) then -! eII(i+1,j) = eII(i+1,j)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) -! endif -! CS%ice_visc(i,j) =0.5 * Visc_coef*(G%areaT(i,j) * ISS%h_shelf(i,j))*eII(i,j)**((1.-n_g)/(2.*n_g)) -! endif -! CS%ice_visc(i,j) =0.5 * Visc_coef*(G%areaT(i,j) * ISS%h_shelf(i,j))*eII(i,j)**((1.-n_g)/(2.*n_g)) - ! CS%ice_visc(i,j) =1e15*(G%areaT(i,j) * ISS%h_shelf(i,j)) !constant viscosity for debugging -! enddo -! enddo end subroutine calc_shelf_visc subroutine calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf) @@ -3181,7 +2968,7 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face umask(I-1+k,J)=3. !vmask(I-1+k,J)=0. vmask(I-1+k,J)=3. - !u_face_mask(I-1+k,j-1)=3. + !u_face_mask(I-1+k,j-1)=3. ! umask(I-1+k,J-1:J)=3. ! vmask(I-1+k,J-1:J)=0. ! u_face_mask(I-1+k,j)=3. diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index f9f31a373e..d77efa358b 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -269,7 +269,7 @@ end subroutine initialize_ice_thickness_channel !> Initialize ice shelf boundary conditions for a channel configuration subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_bdry, & u_flux_bdry_val, v_flux_bdry_val, u_bdry_val, v_bdry_val, u_shelf, v_shelf, h_bdry_val, & - thickness_bdry_val, hmask, h_shelf, G,& + thickness_bdry_val, hmask, h_shelf, G,& US, PF ) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure @@ -289,9 +289,9 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b real, dimension(SZIB_(G),SZJB_(G)), & intent(inout) :: v_bdry_val !< The meridional ice shelf velocity at open real, dimension(SZIB_(G),SZJB_(G)), & - intent(inout) :: u_shelf !< The zonal ice shelf velocity [L T-1 ~> m s-1]. + intent(inout) :: u_shelf !< The zonal ice shelf velocity [L T-1 ~> m s-1]. real, dimension(SZIB_(G),SZJB_(G)), & - intent(inout) :: v_shelf !< The meridional ice shelf velocity [L T-1 ~> m s-1]. + intent(inout) :: v_shelf !< The meridional ice shelf velocity [L T-1 ~> m s-1]. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: thickness_bdry_val !< The ice shelf thickness at open boundaries [Z ~> m] !! boundary vertices [L T-1 ~> m s-1]. @@ -301,7 +301,7 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b intent(inout) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: h_shelf !< Ice-shelf thickness OVS 11/10/20 + intent(inout) :: h_shelf !< Ice-shelf thickness OVS 11/10/20 type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors type(param_file_type), intent(in) :: PF !< A structure to parse for run-time parameters @@ -367,26 +367,26 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b if (G%geoLatBu(i,j-1) == southlat) then !bot boundary if (len_stress == 0. .OR. G%geoLonCv(i,j) <= len_stress) then v_face_mask_bdry(i,j+1) = 0. - ! u_face_mask_bdry(i,j-1) = 3. - u_face_mask_bdry(i,j) = 3. + ! u_face_mask_bdry(i,j-1) = 3. + u_face_mask_bdry(i,j) = 3. u_bdry_val(i,j) = 0. - v_bdry_val(i,j) = 0. + v_bdry_val(i,j) = 0. else v_face_mask_bdry(i,j+1) = 1. - u_face_mask_bdry(i,j) = 3. + u_face_mask_bdry(i,j) = 3. u_bdry_val(i,j) = 0. - v_bdry_val(i,j) = 0. + v_bdry_val(i,j) = 0. endif elseif (G%geoLatBu(i,j-1) == southlat+lenlat) then !top boundary if (len_stress == 0. .OR. G%geoLonCv(i,j) <= len_stress) then v_face_mask_bdry(i,j-1) = 0. - u_face_mask_bdry(i,j-1) = 3. + u_face_mask_bdry(i,j-1) = 3. else !v_face_mask_bdry(i,j-1) = 1. - v_face_mask_bdry(i,j-1) = 3. - u_face_mask_bdry(i,j-1) = 3. - !u_bdry_val(i,j) = 0. - !hmask(i,j) = 0.0 + v_face_mask_bdry(i,j-1) = 3. + u_face_mask_bdry(i,j-1) = 3. + !u_bdry_val(i,j) = 0. + !hmask(i,j) = 0.0 endif endif @@ -396,9 +396,9 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b endif enddo - enddo + enddo ! if (.not. G%symmetric) then -!! do j=G%jsd,G%jed +!! do j=G%jsd,G%jed !! do i=G%isd,G%ied ! do j=jsc-1,jec+1 ! do i=isc-1,iec+1 @@ -416,7 +416,7 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b ! v_shelf(I-1,J-1) = v_bdry_val(I-1,J-1) ! v_shelf(I,J-1) = v_bdry_val(I,J-1) ! endif -! enddo +! enddo ! enddo ! endif end subroutine initialize_ice_shelf_boundary_channel @@ -583,7 +583,8 @@ end subroutine initialize_ice_shelf_boundary_channel !END MJH end subroutine initialize_ice_shelf_boundary_channel !> Initialize ice shelf flow from file -subroutine initialize_ice_flow_from_file(u_shelf, v_shelf,ice_visc,float_cond, hmask,h_shelf, G, US, PF) +subroutine initialize_ice_flow_from_file(u_shelf, v_shelf,ice_visc,float_cond,& + hmask,h_shelf, G, US, PF) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: u_shelf !< The ice shelf u velocity [Z ~> m T ~>s]. @@ -593,13 +594,13 @@ subroutine initialize_ice_flow_from_file(u_shelf, v_shelf,ice_visc,float_cond, h intent(inout) :: ice_visc !< The ice shelf viscosity [Pa ~> m T ~> s]. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: float_cond !< An array indicating where the ice - !! shelf is floating: 0 if floating, 1 if not. + !! shelf is floating: 0 if floating, 1 if not. real, dimension(SZDI_(G),SZDJ_(G)), & 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_shelf !< A mask indicating which tracer points are - !! partly or fully covered by an ice-shelf + !! partly or fully covered by an ice-shelf type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors type(param_file_type), intent(in) :: PF !< A structure to parse for run-time parameters From aed4f0ee71e4c6e179ebe196e6b4d48935c76ee1 Mon Sep 17 00:00:00 2001 From: Olga Sergienko Date: Wed, 3 Mar 2021 16:35:41 -0500 Subject: [PATCH 29/51] More style errors --- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 8640902989..4abcda0aa0 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -160,8 +160,9 @@ module MOM_ice_shelf_dynamics id_u_mask = -1, id_v_mask = -1, id_t_mask = -1 !>@} ! ids for outputting intermediate thickness in advection subroutine (debugging) + !>@{ Diagnostic handles for debugging integer :: id_h_after_uflux = -1, id_h_after_vflux = -1, id_h_after_adv = -1, id_visc_shelf = -1 - + !>@} type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to control diagnostic output. end type ice_shelf_dyn_CS @@ -809,8 +810,9 @@ subroutine ice_shelf_advect(CS, ISS, G, time_step, Time) end subroutine ice_shelf_advect +!>This subroutine computes u- and v-velocities of the ice shelf iterating on non-linear ice viscosity !subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, iters, time) - subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, iters, Time) !OVS 02/08/21 + subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, iters, Time) type(ice_shelf_dyn_CS), intent(inout) :: CS !< The ice shelf dynamics control structure type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe !! the ice-shelf state @@ -823,7 +825,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite integer, intent(out) :: iters !< The number of iterations used in the solver. type(time_type), intent(in) :: Time !< The current model time - real, dimension(SZDIB_(G),SZDJB_(G)) :: taudx, taudy ! Driving stresses at q-points [R L3 Z T-2 ~> kg m s-2] + real, dimension(SZDIB_(G),SZDJB_(G)) :: taudx, taudy !< Driving stresses at q-points [R L3 Z T-2 ~> kg m s-2] real, dimension(SZDIB_(G),SZDJB_(G)) :: u_bdry_cont ! Boundary u-stress contribution [R L3 Z T-2 ~> kg m s-2] real, dimension(SZDIB_(G),SZDJB_(G)) :: v_bdry_cont ! Boundary v-stress contribution [R L3 Z T-2 ~> kg m s-2] real, dimension(SZDIB_(G),SZDJB_(G)) :: Au, Av ! The retarding lateral stress contributions [R L3 Z T-2 ~> kg m s-2] From 43dadc16a357c891df640400c4cb7902e3064e5d Mon Sep 17 00:00:00 2001 From: Olga Sergienko Date: Wed, 3 Mar 2021 17:11:13 -0500 Subject: [PATCH 30/51] Defined variables in ice_shelf_solve_outer --- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 4abcda0aa0..299eda4f33 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -825,7 +825,10 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite integer, intent(out) :: iters !< The number of iterations used in the solver. type(time_type), intent(in) :: Time !< The current model time - real, dimension(SZDIB_(G),SZDJB_(G)) :: taudx, taudy !< Driving stresses at q-points [R L3 Z T-2 ~> kg m s-2] + real, dimension(SZDIB_(G),SZDJB_(G)), & + intent(out) :: taudx !< Driving x-stress at q-points [R L3 Z T-2 ~> kg m s-2] + real, dimension(SZDIB_(G),SZDJB_(G)), & + intent(out) :: taudy !< Driving y-stress at q-points [R L3 Z T-2 ~> kg m s-2] real, dimension(SZDIB_(G),SZDJB_(G)) :: u_bdry_cont ! Boundary u-stress contribution [R L3 Z T-2 ~> kg m s-2] real, dimension(SZDIB_(G),SZDJB_(G)) :: v_bdry_cont ! Boundary v-stress contribution [R L3 Z T-2 ~> kg m s-2] real, dimension(SZDIB_(G),SZDJB_(G)) :: Au, Av ! The retarding lateral stress contributions [R L3 Z T-2 ~> kg m s-2] @@ -2601,7 +2604,7 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) ! vy = ((v_shlf(I,J) + v_shlf(I-1,J)) - (v_shlf(I,J-1) + v_shlf(I-1,J-1))) / (2*G%dyT(i,j)) CS%ice_visc(i,j) = 0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) - CS%ice_visc(i,j) =1e14*(G%areaT(i,j) * ISS%h_shelf(i,j)) ! constant viscocity for debugging +! CS%ice_visc(i,j) =1e14*(G%areaT(i,j) * ISS%h_shelf(i,j)) ! constant viscocity for debugging ! umid = ((u_shlf(I,J) + u_shlf(I-1,J-1)) + (u_shlf(I,J-1) + u_shlf(I-1,J))) * 0.25 ! vmid = ((v_shlf(I,J) + v_shlf(I-1,J-1)) + (v_shlf(I,J-1) + v_shlf(I-1,J))) * 0.25 ! unorm = sqrt(umid**2 + vmid**2 + eps_min**2*(G%dxT(i,j)**2 + G%dyT(i,j)**2)) From 651b4673f46a83f5fc741feaafe9cc0586e4bb0b Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Sat, 6 Mar 2021 01:19:08 -0500 Subject: [PATCH 31/51] Bugfix: FGNV streamfunction vertical bounds This patch fixes an issue with the vertical array bounds of the Ferrari et al. streamfunction. The array is bounded across interfaces, from 1 to nz+1, but only the interior values need to be determined due to the arbitrary boundary value (set here to zero). In the current source, the streamfunction is rescaled before calling streamfn_solver, but need not be applied to the boundary values. This is unlikely to cause errors in production, since the values are later reset to zero, but the rescaling can raise errors in more aggressive debugging builds, such as when the arrays are initialized with NaN values. --- .../lateral/MOM_thickness_diffuse.F90 | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 8c6a90ba9c..4d602f9a67 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -993,10 +993,14 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! Solve an elliptic equation for the streamfunction following Ferrari et al., 2010. do I=is-1,ie if (G%mask2dCu(I,j)>0.) then - Sfn_unlim_u(I,:) = ( 1. + CS%FGNV_scale ) * Sfn_unlim_u(I,:) + do K=2,nz + Sfn_unlim_u(I,K) = (1. + CS%FGNV_scale) * Sfn_unlim_u(I,K) + enddo call streamfn_solver(nz, c2_h_u(I,:), hN2_u(I,:), Sfn_unlim_u(I,:)) else - Sfn_unlim_u(I,:) = 0. + do K=2,nz + Sfn_unlim_u(I,K) = 0. + enddo endif enddo endif @@ -1259,10 +1263,14 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! Solve an elliptic equation for the streamfunction following Ferrari et al., 2010. do i=is,ie if (G%mask2dCv(i,J)>0.) then - Sfn_unlim_v(i,:) = ( 1. + CS%FGNV_scale ) * Sfn_unlim_v(i,:) + do K=2,nz + Sfn_unlim_v(i,K) = (1. + CS%FGNV_scale) * Sfn_unlim_v(i,K) + enddo call streamfn_solver(nz, c2_h_v(i,:), hN2_v(i,:), Sfn_unlim_v(i,:)) else - Sfn_unlim_v(i,:) = 0. + do K=2,nz + Sfn_unlim_v(i,K) = 0. + enddo endif enddo endif From 54033aab43071a667b93cf9fe1bf4089ec1b3c52 Mon Sep 17 00:00:00 2001 From: He Wang Date: Mon, 8 Mar 2021 21:46:10 -0500 Subject: [PATCH 32/51] Bugfix: empty restart_input_dir for *_solo.res This commit fixes the issue that dirs%restart_input_dir is not initiated before "ocean_solo.res" and "ice_solo.res" are read. --- config_src/ice_solo_driver/ice_shelf_driver.F90 | 3 ++- config_src/solo_driver/MOM_driver.F90 | 4 ++++ 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/config_src/ice_solo_driver/ice_shelf_driver.F90 b/config_src/ice_solo_driver/ice_shelf_driver.F90 index bd64050a6f..959e4676d0 100644 --- a/config_src/ice_solo_driver/ice_shelf_driver.F90 +++ b/config_src/ice_solo_driver/ice_shelf_driver.F90 @@ -185,6 +185,8 @@ program Shelf_main endif endif + call Get_MOM_Input(param_file, dirs) + ! Read ocean_solo restart, which can override settings from the namelist. if (file_exists(trim(dirs%restart_input_dir)//'ice_solo.res')) then call open_ASCII_file(unit, trim(dirs%restart_input_dir)//'ice_solo.res', action=READONLY_FILE) @@ -215,7 +217,6 @@ program Shelf_main Start_time = real_to_time(0.0) endif - call Get_MOM_Input(param_file, dirs) ! Determining the internal unit scaling factors for this run. call unit_scaling_init(param_file, US) diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index 9c222bb0bb..8edad7fa05 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -250,6 +250,10 @@ program MOM_main ! This call sets the number and affinity of threads with openMP. !$ call set_MOM_thread_affinity(ocean_nthreads, use_hyper_thread) + ! This call is required to initiate dirs%restart_input_dir for ocean_solo.res + ! The contents of dirs will be reread in initialize_MOM. + call get_MOM_input(dirs=dirs) + ! Read ocean_solo restart, which can override settings from the namelist. if (file_exists(trim(dirs%restart_input_dir)//'ocean_solo.res')) then call open_ASCII_file(unit, trim(dirs%restart_input_dir)//'ocean_solo.res', action=READONLY_FILE) From b47e493d3ba28ac5544c22231a8cfb4e88feeed8 Mon Sep 17 00:00:00 2001 From: Olga Sergienko Date: Tue, 9 Mar 2021 13:15:10 -0500 Subject: [PATCH 33/51] Removed blocks of commented code. Added parentheses in calc_shelf_visc --- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 56 ++----- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 184 +-------------------- 2 files changed, 18 insertions(+), 222 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 299eda4f33..6b30b2d83d 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -579,12 +579,11 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ if (CS%id_taudx_shelf > 0) call post_data(CS%id_taudx_shelf, CS%taudx_shelf,CS%diag) if (CS%id_taudy_shelf > 0) call post_data(CS%id_taudy_shelf, CS%taudy_shelf,CS%diag) if (CS%id_visc_shelf > 0) call post_data(CS%id_visc_shelf, CS%ice_visc,CS%diag) - endif -!!! OVS vertically integrated temperature ! CS%id_t_shelf = register_diag_field('ocean_model','t_shelf',CS%diag%axesT1, Time, & ! 'T of ice', 'oC') ! CS%id_t_mask = register_diag_field('ocean_model','tmask',CS%diag%axesT1, Time, & ! 'mask for T-nodes', 'none') + endif endif end subroutine initialize_ice_shelf_dyn @@ -875,9 +874,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite enddo call calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, CS%OD_av) - call pass_vector(taudx, taudy, G%domain, TO_ALL, BGRID_NE) !OVS 02/01/21 -! call pass_var(taudx, G%Domain) !OVS 01/21/21 -! call pass_var(taudy, G%Domain) !OVS 01/21/21 + call pass_vector(taudx, taudy, G%domain, TO_ALL, BGRID_NE) ! This is to determine which cells contain the grounding line, the criterion being that the cell ! is ice-covered, with some nodes floating and some grounded flotation condition is estimated by ! assuming topography is cellwise constant and H is bilinear in a cell; floating where @@ -917,12 +914,10 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite call bilinear_shape_fn_grid(G, i, j, Phi(:,:,i,j)) enddo ; enddo - call calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) !OVS 02/24/21 + call calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) call pass_var(CS%ice_visc, G%domain) -! call pass_vector(CS%ice_visc, G%domain, TO_ALL, BGRID_NE) !OVS 02/11/21 call calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf) call pass_var(CS%basal_traction, G%domain) -! call pass_vector(CS%ice_visc,CS%basal_traction, G%domain, TO_ALL, BGRID_NE) !OVS 02/11/21 ! This makes sure basal stress is only applied when it is supposed to be do j=G%jsd,G%jed ; do i=G%isd,G%ied @@ -937,7 +932,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite call CG_action(Au, Av, u_shlf, v_shlf, Phi, Phisub, CS%umask, CS%vmask, ISS%hmask, H_node, & CS%ice_visc, float_cond, G%bathyT, CS%basal_traction, & G, US, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi_rhow) - call pass_vector(Au,Av,G%domain) !OVS pass Au and Av + call pass_vector(Au,Av,G%domain) if (CS%nonlin_solve_err_mode == 1) then err_init = 0 ; err_tempu = 0 ; err_tempv = 0 do J=G%IscB,G%JecB ; do I=G%IscB,G%IecB @@ -971,7 +966,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite write(mesg,*) "ice_shelf_solve_outer: linear solve done in ",iters," iterations" call MOM_mesg(mesg, 5) - call calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) !OVS 02/24/21 + call calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) call pass_var(CS%ice_visc, G%domain) call calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf) call pass_var(CS%basal_traction, G%domain) @@ -1823,10 +1818,8 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) S(:,:) = BASE(:,:) + ISS%h_shelf(:,:) ! check whether the ice is floating or grounded -! do j=jsc-1,jec+1 !OVS 02/02/21 -! do i=isc-1,iec+1 !OVS 02/02/21 - do j=jsc-G%domain%njhalo,jec+G%domain%njhalo !OVS 02/02/21 - do i=isc-G%domain%nihalo,iec+G%domain%nihalo !OVS 02/02/21 + do j=jsc-G%domain%njhalo,jec+G%domain%njhalo + do i=isc-G%domain%nihalo,iec+G%domain%nihalo ! if (ISS%h_shelf(i,j) < rhow/rho * G%bathyT(i,j)) then if (rhoi_rhow * ISS%h_shelf(i,j) - G%bathyT(i,j) <= 0) then @@ -2160,7 +2153,7 @@ subroutine CG_action(uret, vret, u_shlf, v_shlf, Phi, Phisub, umask, vmask, hmas v_shlf(I-1,J) * Phi(6,2*(jq-1)+iq,i,j) + & v_shlf(I,J) * Phi(8,2*(jq-1)+iq,i,j) - do iphi=1,2 ; do jphi=1,2 ; Itgt = I-2+iphi ; ;Jtgt = J-2+jphi !Jtgt = J-2-jphi !OVS fix index + do iphi=1,2 ; do jphi=1,2 ; Itgt = I-2+iphi ; ;Jtgt = J-2+jphi if (umask(Itgt,Jtgt) == 1) uret(Itgt,Jtgt) = uret(Itgt,Jtgt) + 0.25 * ice_visc(i,j) * & ((4*ux+2*vy) * Phi(2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq,i,j) + & (uy+vx) * Phi(2*(2*(jphi-1)+iphi),2*(jq-1)+iq,i,j)) @@ -2338,7 +2331,7 @@ subroutine matrix_diagonal(CS, G, US, float_cond, H_node, ice_visc, basal_trac, if (float_cond(i,j) == 1) then Hcell(:,:) = H_node(i-1:i,j-1:j) call CG_diagonal_subgrid_basal(Phisub, Hcell, G%bathyT(i,j), dens_ratio, sub_ground) - do iphi=1,2 ; do jphi=1,2 ; Itgt = I-2+iphi ; Jtgt = J-2+jphi !Jtgt = J-2-jphi !OVS fix index + do iphi=1,2 ; do jphi=1,2 ; Itgt = I-2+iphi ; Jtgt = J-2+jphi if (CS%umask(Itgt,Jtgt) == 1) then u_diagonal(Itgt,Jtgt) = u_diagonal(Itgt,Jtgt) + sub_ground(iphi,jphi) * basal_trac(i,j) v_diagonal(Itgt,Jtgt) = v_diagonal(Itgt,Jtgt) + sub_ground(iphi,jphi) * basal_trac(i,j) @@ -2479,7 +2472,7 @@ subroutine apply_boundary_values(CS, ISS, G, US, time, Phisub, H_node, ice_visc, CS%v_bdry_val(I-1,J) * Phi(6,2*(jq-1)+iq) + & CS%v_bdry_val(I,J) * Phi(8,2*(jq-1)+iq) - do iphi=1,2 ; do jphi=1,2 ; Itgt = I-2+iphi ; Jtgt = J-2+jphi !Jtgt = J-2-jphi !OVS fix index + do iphi=1,2 ; do jphi=1,2 ; Itgt = I-2+iphi ; Jtgt = J-2+jphi ilq = 1 ; if (iq == iphi) ilq = 2 jlq = 1 ; if (jq == jphi) jlq = 2 @@ -2590,14 +2583,14 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) ! enddo ! call pass_vector(ux, uy, G%domain, TO_ALL, BGRID_NE) ! call pass_vector(vx, vy, G%domain, TO_ALL, BGRID_NE) - ux = ((u_shlf(I,J) + u_shlf(I,J-1) + u_shlf(I,J+1)) - & - (u_shlf(I-1,J) + u_shlf(I-1,J-1) + u_shlf(I-1,J+1))) / (3*G%dxT(i,j)) + ux = ((u_shlf(I,J) + (u_shlf(I,J-1) + u_shlf(I,J+1))) - & + (u_shlf(I-1,J) + (u_shlf(I-1,J-1) + u_shlf(I-1,J+1)))) / (3*G%dxT(i,j)) vx = ((v_shlf(I,J) + v_shlf(I,J-1) + v_shlf(I,J+1)) - & - (v_shlf(I-1,J) + v_shlf(I-1,J-1) + v_shlf(I-1,J+1))) / (3*G%dxT(i,j)) - uy = ((u_shlf(I,J) + u_shlf(I-1,J) + u_shlf(I+1,J)) - & - (u_shlf(I,J-1) + u_shlf(I-1,J-1) + u_shlf(I+1,J-1))) / (3*G%dyT(i,j)) - vy = ((v_shlf(I,J) + v_shlf(I-1,J)+ v_shlf(I+1,J)) - & - (v_shlf(I,J-1) + v_shlf(I-1,J-1)+ v_shlf(I+1,J-1))) / (3*G%dyT(i,j)) + (v_shlf(I-1,J) + (v_shlf(I-1,J-1) + v_shlf(I-1,J+1)))) / (3*G%dxT(i,j)) + uy = ((u_shlf(I,J) + (u_shlf(I-1,J) + u_shlf(I+1,J))) - & + (u_shlf(I,J-1) + (u_shlf(I-1,J-1) + u_shlf(I+1,J-1)))) / (3*G%dyT(i,j)) + vy = ((v_shlf(I,J) + (v_shlf(I-1,J)+ v_shlf(I+1,J))) - & + (v_shlf(I,J-1) + (v_shlf(I-1,J-1)+ v_shlf(I+1,J-1)))) / (3*G%dyT(i,j)) ! ux = ((u_shlf(I,J) + u_shlf(I,J-1)) - (u_shlf(I-1,J) + u_shlf(I-1,J-1))) / (2*G%dxT(i,j)) ! vx = ((v_shlf(I,J) + v_shlf(I,J-1)) - (v_shlf(I-1,J) + v_shlf(I-1,J-1))) / (2*G%dxT(i,j)) ! uy = ((u_shlf(I,J) + u_shlf(I-1,J)) - (u_shlf(I,J-1) + u_shlf(I-1,J-1))) / (2*G%dyT(i,j)) @@ -3020,21 +3013,6 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face end select enddo - !if (CS%u_face_mask_bdry(I-1,j) >= 0) then ! Western boundary - ! u_face_mask(I-1,j) = CS%u_face_mask_bdry(I-1,j) - ! umask(I-1,J-1:J) = 3. - ! vmask(I-1,J-1:J) = 0. - !endif - - !if (j_off+j == gjsc+1) then ! SoutherN boundary - ! v_face_mask(i,J-1) = 0. - ! umask(I-1:I,J-1) = 0. - ! vmask(I-1:I,J-1) = 0. - !elseif (j_off+j == gjec) then ! Northern boundary - ! v_face_mask(i,J) = 0. - ! umask(I-1:I,J) = 0. - ! vmask(I-1:I,J) = 0. - !endif if (i < G%ied) then if ((hmask(i+1,j) == 0) .OR. (hmask(i+1,j) == 2)) then diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index d77efa358b..ff05ed7c6a 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -397,190 +397,8 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b enddo enddo -! if (.not. G%symmetric) then -!! do j=G%jsd,G%jed -!! do i=G%isd,G%ied -! do j=jsc-1,jec+1 -! do i=isc-1,iec+1 -!! if (((i+G%idg_offset) == (G%domain%nihalo+1)).and.(u_face_mask_bdry(I-1,j) == 3)) then -! if (u_face_mask_bdry(I-1,j) == 3) then -! u_shelf(I-1,J-1) = u_bdry_val(I-1,J-1) -! u_shelf(I-1,J) = u_bdry_val(I-1,J) -! v_shelf(I-1,J-1) = v_bdry_val(I-1,J-1) -! v_shelf(I-1,J) = v_bdry_val(I-1,J) -! endif -!! if (((j+G%jdg_offset) == (G%domain%njhalo+1)).and.(v_face_mask_bdry(i,J-1) == 3)) then -! if (v_face_mask_bdry(I,j-1) == 3) then -! u_shelf(I-1,J-1) = u_bdry_val(I-1,J-1) -! u_shelf(I,J-1) = u_bdry_val(I,J-1) -! v_shelf(I-1,J-1) = v_bdry_val(I-1,J-1) -! v_shelf(I,J-1) = v_bdry_val(I,J-1) -! endif -! enddo -! enddo -! endif end subroutine initialize_ice_shelf_boundary_channel -!BEGIN MJH -! subroutine initialize_ice_shelf_boundary(u_face_mask_bdry, v_face_mask_bdry, & -! u_flux_bdry_val, v_flux_bdry_val, u_bdry_val, v_bdry_val, h_bdry_val, & -! hmask, G, US, PF ) - -! type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure -! real, dimension(SZIB_(G),SZJ_(G)), & -! intent(inout) :: u_face_mask_bdry !< A boundary-type mask at C-grid u faces -! real, dimension(SZIB_(G),SZJ_(G)), & -! intent(inout) :: u_flux_bdry_val !< The boundary thickness flux through -! !! C-grid u faces [L Z T-1 ~> m2 s-1]. -! real, dimension(SZI_(G),SZJB_(G)), & -! intent(inout) :: v_face_mask_bdry !< A boundary-type mask at C-grid v faces -! real, dimension(SZI_(G),SZJB_(G)), & -! intent(inout) :: v_flux_bdry_val !< The boundary thickness flux through -! !! C-grid v faces [L Z T-1 ~> m2 s-1]. -! real, dimension(SZIB_(G),SZJB_(G)), & -! intent(inout) :: u_bdry_val !< The zonal ice shelf velocity at open -! !! boundary vertices [L T-1 ~> m s-1]. -! real, dimension(SZIB_(G),SZJB_(G)), & -! intent(inout) :: v_bdry_val !< The meridional ice shelf velocity at open -! !! boundary vertices [L T-1 ~> m s-1]. -! real, dimension(SZDI_(G),SZDJ_(G)), & -! intent(inout) :: h_bdry_val !< The ice shelf thickness at open boundaries [Z ~> m] -! real, dimension(SZDI_(G),SZDJ_(G)), & -! intent(inout) :: hmask !< A mask indicating which tracer points are -! !! partly or fully covered by an ice-shelf -! type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors -! type(param_file_type), intent(in) :: PF !< A structure to parse for run-time parameters - -! character(len=40) :: mdl = "initialize_ice_shelf_boundary" ! This subroutine's name. -! character(len=200) :: config -! logical flux_bdry - -! call get_param(PF, mdl, "ICE_BOUNDARY_CONFIG", config, & -! "This specifies how the ice domain boundary is specified. "//& -! "valid values include CHANNEL, FILE and USER.", & -! fail_if_missing=.true.) -! call get_param(PF, mdl, "ICE_BOUNDARY_FLUX_CONDITION", flux_bdry, & -! "This specifies whether mass input is a dirichlet or "//& -! "flux condition", default=.true.) - -! select case ( trim(config) ) -! case ("CHANNEL") -! call initialize_ice_shelf_boundary_channel(u_face_mask_bdry, & -! v_face_mask_bdry, u_flux_bdry_val, v_flux_bdry_val, & -! u_bdry_val, v_bdry_val, h_bdry_val, hmask, G, & -! flux_bdry, PF) -! case ("FILE"); call MOM_error(FATAL,"MOM_initialize: "// & -! "Unrecognized topography setup "//trim(config)) -! case ("USER"); call MOM_error(FATAL,"MOM_initialize: "// & -! "Unrecognized topography setup "//trim(config)) -! case default ; call MOM_error(FATAL,"MOM_initialize: "// & -! "Unrecognized topography setup "//trim(config)) -! end select - -! end subroutine initialize_ice_shelf_boundary - -! subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_bdry, & -! u_flux_bdry_val, v_flux_bdry_val, u_bdry_val, v_bdry_val, h_bdry_val, & -! hmask, G, flux_bdry, US, PF ) - -! type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure -! real, dimension(SZIB_(G),SZJ_(G)), & -! intent(inout) :: u_face_mask_bdry !< A boundary-type mask at C-grid u faces -! real, dimension(SZIB_(G),SZJ_(G)), & -! intent(inout) :: u_flux_bdry_val !< The boundary thickness flux through -! !! C-grid u faces [L Z T-1 ~> m2 s-1]. -! real, dimension(SZI_(G),SZJB_(G)), & -! intent(inout) :: v_face_mask_bdry !< A boundary-type mask at C-grid v faces -! real, dimension(SZI_(G),SZJB_(G)), & -! intent(inout) :: v_flux_bdry_val !< The boundary thickness flux through -! !! C-grid v faces [L Z T-1 ~> m2 s-1]. -! real, dimension(SZIB_(G),SZJB_(G)), & -! intent(inout) :: u_bdry_val !< The zonal ice shelf velocity at open - !! boundary vertices [L T-1 ~> m s-1]. -! real, dimension(SZIB_(G),SZJB_(G)), & -! intent(inout) :: v_bdry_val !< The meridional ice shelf velocity at open - !! boundary vertices [L T-1 ~> m s-1]. -! real, dimension(SZDI_(G),SZDJ_(G)), & -! intent(inout) :: h_bdry_val !< The ice shelf thickness at open boundaries [Z ~> m] -! real, dimension(SZDI_(G),SZDJ_(G)), & -! intent(inout) :: hmask !< A mask indicating which tracer points are -! !! partly or fully covered by an ice-shelf -! logical, intent(in) :: flux_bdry !< If true, use mass fluxes as the boundary value. -! type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors -! type(param_file_type), intent(in) :: PF !< A structure to parse for run-time parameters - -! character(len=40) :: mdl = "initialize_ice_shelf_boundary_channel" ! This subroutine's name. -! integer :: i, j, isd, jsd, is, js, iegq, jegq, giec, gjec, gisc, gjsc, isc, jsc, iec, jec, ied, jed -! real :: input_thick ! The input ice shelf thickness [Z ~> m] -! real :: input_flux ! The input ice flux per unit length [L Z T-1 ~> m2 s-1] -! real :: lenlat, len_stress - -! call get_param(PF, mdl, "LENLAT", lenlat, fail_if_missing=.true.) - -! call get_param(PF, mdl, "INPUT_FLUX_ICE_SHELF", input_flux, & -! "volume flux at upstream boundary", & -! units="m2 s-1", default=0., scale=US%m_s_to_L_T*US%m_to_Z) -! call get_param(PF, mdl, "INPUT_THICK_ICE_SHELF", input_thick, & -! "flux thickness at upstream boundary", & -! units="m", default=1000., scale=US%m_to_Z) -! call get_param(PF, mdl, "LEN_SIDE_STRESS", len_stress, & -! "maximum position of no-flow condition in along-flow direction", & -! units="km", default=0.) - -! call MOM_mesg(mdl//": setting boundary") - -! isd = G%isd ; ied = G%ied -! jsd = G%jsd ; jed = G%jed -! isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec -! gisc = G%Domain%nihalo ; gjsc = G%Domain%njhalo -! giec = G%Domain%niglobal+gisc ; gjec = G%Domain%njglobal+gjsc - -! do j=jsd,jed -! do i=isd,ied - -! ! upstream boundary - set either dirichlet or flux condition - -! if ((i+G%idg_offset) == G%domain%nihalo+1) then -! if (flux_bdry) then -! u_face_mask_bdry(i-1,j) = 4.0 -! u_flux_bdry_val(i-1,j) = input_flux -! else -! hmask(i-1,j) = 3.0 -! h_bdry_val(i-1,j) = input_thick -! u_face_mask_bdry(i-1,j) = 3.0 -! u_bdry_val(i-1,j-1) = (1 - ((G%geoLatBu(i-1,j-1) - 0.5*lenlat)*2./lenlat)**2) * & -! 1.5 * input_flux / input_thick -! u_bdry_val(i-1,j) = (1 - ((G%geoLatBu(i-1,j) - 0.5*lenlat)*2./lenlat)**2) * & -! 1.5 * input_flux / input_thick -! endif -! endif - -! ! side boundaries: no flow - -! if (G%jdg_offset+j == gjsc+1) then !bot boundary -! if (len_stress == 0. .OR. G%geoLonCv(i,j-1) <= len_stress) then -! v_face_mask_bdry(i,j-1) = 0. -! else -! v_face_mask_bdry(i,j-1) = 1. -! endif -! elseif (G%jdg_offset+j == gjec) then !top boundary -! if (len_stress == 0. .OR. G%geoLonCv(i,j-1) <= len_stress) then -! v_face_mask_bdry(i,j) = 0. -! else -! v_face_mask_bdry(i,j) = 1. -! endif -! endif - -! ! downstream boundary - CFBC - -! if (i+G%idg_offset == giec) then -! u_face_mask_bdry(i,j) = 2.0 -! endif - -! enddo -! enddo - -!END MJH end subroutine initialize_ice_shelf_boundary_channel !> Initialize ice shelf flow from file subroutine initialize_ice_flow_from_file(u_shelf, v_shelf,ice_visc,float_cond,& @@ -642,7 +460,7 @@ subroutine initialize_ice_flow_from_file(u_shelf, v_shelf,ice_visc,float_cond,& ! call MOM_read_data(filename, trim(ushelf_varname), u_shelf, G%Domain, scale=1.0) !/(365.0*86400.0)) ! call MOM_read_data(filename,trim(vshelf_varname), v_shelf, G%Domain, scale=1.0) !/(365.0*86400.0)) - call MOM_read_data(filename,trim(ice_visc_varname), ice_visc, G%Domain, scale=1.0) !*(365.0*86400.0)) + call MOM_read_data(filename,trim(ice_visc_varname), ice_visc, G%Domain, scale=1.0) call MOM_read_data(filename,trim(floatfr_varname), float_cond, G%Domain, scale=1.) ! call get_param(PF, mdl, "ICE_BOUNDARY_CONFIG", config, & ! "This specifies how the ice domain boundary is specified", & From bb5eb2527da481826721c047182dced61fe2835d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 9 Mar 2021 18:34:27 -0500 Subject: [PATCH 34/51] Explicitly set (1x1) io_domain as a default Added code to explicitly set a (1x1) io_domain when no other io_layout is specified, complying with changing requirements for 2020 and later versions of FMS, and following the default behavior of previous versions. Also corrected three module use statements in infra/FMS1 to eliminate any dependencies of code in config_src/infra/FMS1 on code in src/framework. These use statements eventually point to the same place as before, but with less indirection. This change should facilitate later steps to compile everything in and under the config_src/infra directories as libraries. All answers are bitwise identical. --- config_src/infra/FMS1/MOM_diag_manager_infra.F90 | 4 ++-- config_src/infra/FMS1/MOM_domain_infra.F90 | 4 +++- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/config_src/infra/FMS1/MOM_diag_manager_infra.F90 b/config_src/infra/FMS1/MOM_diag_manager_infra.F90 index 702c464814..18c80cf24c 100644 --- a/config_src/infra/FMS1/MOM_diag_manager_infra.F90 +++ b/config_src/infra/FMS1/MOM_diag_manager_infra.F90 @@ -20,9 +20,9 @@ module MOM_diag_manager_infra use diag_manager_mod, only : register_diag_field_fms => register_diag_field use diag_manager_mod, only : register_static_field_fms => register_static_field use diag_manager_mod, only : get_diag_field_id_fms => get_diag_field_id -use time_manager_mod, only : time_type +use MOM_time_manager, only : time_type use MOM_domain_infra, only : MOM_domain_type -use MOM_error_handler, only : MOM_error, FATAL, WARNING +use MOM_error_infra, only : MOM_error => MOM_err, FATAL, WARNING implicit none ; private diff --git a/config_src/infra/FMS1/MOM_domain_infra.F90 b/config_src/infra/FMS1/MOM_domain_infra.F90 index 86e85e60a6..fc39777a2f 100644 --- a/config_src/infra/FMS1/MOM_domain_infra.F90 +++ b/config_src/infra/FMS1/MOM_domain_infra.F90 @@ -4,7 +4,7 @@ module MOM_domain_infra ! This file is part of MOM6. See LICENSE.md for the license. use MOM_coms_infra, only : PE_here, root_PE, num_PEs -use MOM_cpu_clock, only : cpu_clock_begin, cpu_clock_end +use MOM_cpu_clock_infra, only : cpu_clock_begin, cpu_clock_end use MOM_error_infra, only : MOM_error=>MOM_err, NOTE, WARNING, FATAL use mpp_domains_mod, only : domain2D, domain1D @@ -1689,6 +1689,8 @@ subroutine clone_MD_to_d2D(MD_in, mpp_domain, min_halo, halo_size, symmetric, & if ((MD_in%io_layout(1) + MD_in%io_layout(2) > 0) .and. & (MD_in%layout(1)*MD_in%layout(2) > 1)) then call mpp_define_io_domain(mpp_domain, MD_in%io_layout) + else + call mpp_define_io_domain(mpp_domain, (/ 1, 1 /) ) endif end subroutine clone_MD_to_d2D From 5b686c838b54c8c129c48470f25ced9b92f9149a Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Wed, 10 Mar 2021 21:52:04 +0000 Subject: [PATCH 35/51] add parameter for allowing land mask changes * if true, allow the topog overrides to change the land mask --- src/initialization/MOM_shared_initialization.F90 | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 70ef0768d5..dced42574e 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -196,6 +196,7 @@ subroutine apply_topography_edits_from_file(D, G, param_file, US) character(len=40) :: mdl = "apply_topography_edits_from_file" ! This subroutine's name. integer :: i, j, n, ncid, n_edits, i_file, j_file, ndims, sizes(8) logical :: found + logical :: topog_edits_change_mask call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") @@ -206,6 +207,9 @@ subroutine apply_topography_edits_from_file(D, G, param_file, US) call get_param(param_file, mdl, "TOPO_EDITS_FILE", topo_edits_file, & "The file from which to read a list of i,j,z topography overrides.", & default="") + call get_param(param_file, mdl, "ALLOW_LANDMASK_CHANGES", topog_edits_change_mask, & + "If true, allow topography overrides to change land mask.", & + default=.false.) if (len_trim(topo_edits_file)==0) return @@ -250,8 +254,14 @@ subroutine apply_topography_edits_from_file(D, G, param_file, US) 'Ocean topography edit: ', n, ig(n), jg(n), D(i,j)/m_to_Z, '->', abs(new_depth(n)), i, j D(i,j) = abs(m_to_Z*new_depth(n)) ! Allows for height-file edits (i.e. converts negatives) else - call MOM_error(FATAL, trim(mdl)//': A zero depth edit would change the land mask and '//& - "is not allowed in"//trim(topo_edits_file)) + if (topog_edits_change_mask) then + write(stdout,'(a,3i5,f8.2,a,f8.2,2i4)') & + 'Ocean topography edit: ',n,ig(n),jg(n),D(i,j)/m_to_Z,'->',abs(new_depth(n)),i,j + D(i,j) = abs(m_to_Z*new_depth(n)) ! Allows for height-file edits (i.e. converts negatives) + else + call MOM_error(FATAL, ' apply_topography_edits_from_file: '//& + "A zero depth edit would change the land mask and is not allowed in"//trim(topo_edits_file)) + endif endif endif enddo From 8494ba8d67b7db9563050938904beb29f1be956c Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Wed, 10 Mar 2021 18:53:40 -0500 Subject: [PATCH 36/51] change logical from "topog_..." to "topo_..." --- src/initialization/MOM_shared_initialization.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index dced42574e..ee80bbdace 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -196,7 +196,7 @@ subroutine apply_topography_edits_from_file(D, G, param_file, US) character(len=40) :: mdl = "apply_topography_edits_from_file" ! This subroutine's name. integer :: i, j, n, ncid, n_edits, i_file, j_file, ndims, sizes(8) logical :: found - logical :: topog_edits_change_mask + logical :: topo_edits_change_mask call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") @@ -207,7 +207,7 @@ subroutine apply_topography_edits_from_file(D, G, param_file, US) call get_param(param_file, mdl, "TOPO_EDITS_FILE", topo_edits_file, & "The file from which to read a list of i,j,z topography overrides.", & default="") - call get_param(param_file, mdl, "ALLOW_LANDMASK_CHANGES", topog_edits_change_mask, & + call get_param(param_file, mdl, "ALLOW_LANDMASK_CHANGES", topo_edits_change_mask, & "If true, allow topography overrides to change land mask.", & default=.false.) @@ -254,7 +254,7 @@ subroutine apply_topography_edits_from_file(D, G, param_file, US) 'Ocean topography edit: ', n, ig(n), jg(n), D(i,j)/m_to_Z, '->', abs(new_depth(n)), i, j D(i,j) = abs(m_to_Z*new_depth(n)) ! Allows for height-file edits (i.e. converts negatives) else - if (topog_edits_change_mask) then + if (topo_edits_change_mask) then write(stdout,'(a,3i5,f8.2,a,f8.2,2i4)') & 'Ocean topography edit: ',n,ig(n),jg(n),D(i,j)/m_to_Z,'->',abs(new_depth(n)),i,j D(i,j) = abs(m_to_Z*new_depth(n)) ! Allows for height-file edits (i.e. converts negatives) From abc8fe46324f4f7711100da37ad4b6bec0162cb0 Mon Sep 17 00:00:00 2001 From: Olga Sergienko Date: Thu, 11 Mar 2021 12:30:24 -0500 Subject: [PATCH 37/51] Removed blocks of commented text and multiplications by 0 --- src/ice_shelf/MOM_ice_shelf.F90 | 6 +- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 69 +++++----------------- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 39 ++---------- 3 files changed, 23 insertions(+), 91 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 5d2bc88b4c..b2cb9f9c29 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -711,15 +711,15 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step, CS) endif ! Melting has been computed, now is time to update thickness and mass with dynamic ice shelf - if (CS%active_shelf_dynamics) then !OVS 12/10/20 - call change_thickness_using_melt(ISS, G, US, US%s_to_T*time_step, fluxes, CS%density_ice, CS%debug) !OVS 12/10/20 + if (CS%active_shelf_dynamics) then + call change_thickness_using_melt(ISS, G, US, US%s_to_T*time_step, fluxes, CS%density_ice, CS%debug) if (CS%debug) then call hchksum(ISS%h_shelf, "h_shelf after change thickness using melt", G%HI, haloshift=0, scale=US%Z_to_m) call hchksum(ISS%mass_shelf, "mass_shelf after change thickness using melt", G%HI, haloshift=0, & scale=US%RZ_to_kg_m2) endif - endif !OVS 12/10/20 + endif if (CS%debug) call MOM_forcing_chksum("Before add shelf flux", fluxes, G, CS%US, haloshift=0) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 6b30b2d83d..8360530f21 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -424,7 +424,6 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ ! previously allocated for registration for restarts. if (active_shelf_dynamics) then - ! DNG allocate( CS%u_bdry_val(Isdq:Iedq,Jsdq:Jedq) ) ; CS%u_bdry_val(:,:) = 0.0 allocate( CS%v_bdry_val(Isdq:Iedq,Jsdq:Jedq) ) ; CS%v_bdry_val(:,:) = 0.0 allocate( CS%t_bdry_val(isd:ied,jsd:jed) ) ; CS%t_bdry_val(:,:) = -15.0 @@ -572,7 +571,6 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ if (new_sim) then call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: initialize ice velocity.") call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf(:,:)) - !call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf, iters, Time) call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf, CS%u_shelf, CS%diag) if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf, CS%v_shelf,CS%diag) @@ -692,7 +690,6 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled if (update_ice_vel) then -! call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf, iters, Time) call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) endif @@ -1801,9 +1798,9 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) isd = G%isd ; jsd = G%jsd iegq = G%iegB ; jegq = G%jegB ! gisc = G%domain%nihalo+1 ; gjsc = G%domain%njhalo+1 - gisc = 0*G%domain%nihalo+1 ; gjsc = 0*G%domain%njhalo+1 + gisc = 1 ; gjsc = 1 ! giec = G%domain%niglobal+G%domain%nihalo ; gjec = G%domain%njglobal+G%domain%njhalo - giec = G%domain%niglobal+0*G%domain%nihalo ; gjec = G%domain%njglobal+0*G%domain%njhalo + giec = G%domain%niglobal ; gjec = G%domain%njglobal is = iscq - 1; js = jscq - 1 i_off = G%idg_offset ; j_off = G%jdg_offset @@ -2519,7 +2516,7 @@ subroutine apply_boundary_values(CS, ISS, G, US, time, Phisub, H_node, ice_visc, endif endif ; enddo ; enddo - call pass_vector(u_bdry_contr, v_bdry_contr, G%domain, TO_ALL, BGRID_NE) !OVS 02/19/21 + call pass_vector(u_bdry_contr, v_bdry_contr, G%domain, TO_ALL, BGRID_NE) end subroutine apply_boundary_values @@ -2563,26 +2560,11 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) n_g = CS%n_glen; eps_min = CS%eps_glen_min -! CS%ice_visc(:,:) = 0.0 -! ux(:,:) = 0.0; uy(:,:) = 0.0; vx(:,:) =0.0; vy(:,:) =0.0 -! eII(:,:) = (US%s_to_T**2 * (eps_min**2)) - Visc_coef = US%kg_m2s_to_RZ_T*US%m_to_L*US%Z_to_L*(CS%A_glen_isothermal)**(-1./CS%n_glen) !OVS '-' in the exponent -! call pass_vector(u_shlf, v_shlf, G%domain, TO_ALL, BGRID_NE) - do j=jsc-0*1,jec+0*1 - do i=isc-0*1,iec+0*1 -! do j=jsd+1,jed-1 !OVS 02/01/21 -! do i=isd+1,ied-1 !OVS 02/01/21 + Visc_coef = US%kg_m2s_to_RZ_T*US%m_to_L*US%Z_to_L*(CS%A_glen_isothermal)**(-1./CS%n_glen) + do j=jsc,jec + do i=isc,iec if ((ISS%hmask(i,j) == 1) .OR. (ISS%hmask(i,j) == 3)) then -! ux(i,j) = ((u_shlf(I,J) + u_shlf(I,J-1)) - (u_shlf(I-1,J) + u_shlf(I-1,J-1))) / (2*G%dxT(i,j)) -! vx(i,j) = ((v_shlf(I,J) + v_shlf(I,J-1)) - (v_shlf(I-1,J) + v_shlf(I-1,J-1))) / (2*G%dxT(i,j)) -! uy(i,j) = ((u_shlf(I,J) + u_shlf(I-1,J)) - (u_shlf(I,J-1) + u_shlf(I-1,J-1))) / (2*G%dyT(i,j)) -! vy(i,j) = ((v_shlf(I,J) + v_shlf(I-1,J)) - (v_shlf(I,J-1) + v_shlf(I-1,J-1))) / (2*G%dyT(i,j)) -! endif -! enddo -! enddo -! call pass_vector(ux, uy, G%domain, TO_ALL, BGRID_NE) -! call pass_vector(vx, vy, G%domain, TO_ALL, BGRID_NE) ux = ((u_shlf(I,J) + (u_shlf(I,J-1) + u_shlf(I,J+1))) - & (u_shlf(I-1,J) + (u_shlf(I-1,J-1) + u_shlf(I-1,J+1)))) / (3*G%dxT(i,j)) vx = ((v_shlf(I,J) + v_shlf(I,J-1) + v_shlf(I,J+1)) - & @@ -2591,17 +2573,8 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) (u_shlf(I,J-1) + (u_shlf(I-1,J-1) + u_shlf(I+1,J-1)))) / (3*G%dyT(i,j)) vy = ((v_shlf(I,J) + (v_shlf(I-1,J)+ v_shlf(I+1,J))) - & (v_shlf(I,J-1) + (v_shlf(I-1,J-1)+ v_shlf(I+1,J-1)))) / (3*G%dyT(i,j)) -! ux = ((u_shlf(I,J) + u_shlf(I,J-1)) - (u_shlf(I-1,J) + u_shlf(I-1,J-1))) / (2*G%dxT(i,j)) -! vx = ((v_shlf(I,J) + v_shlf(I,J-1)) - (v_shlf(I-1,J) + v_shlf(I-1,J-1))) / (2*G%dxT(i,j)) -! uy = ((u_shlf(I,J) + u_shlf(I-1,J)) - (u_shlf(I,J-1) + u_shlf(I-1,J-1))) / (2*G%dyT(i,j)) -! vy = ((v_shlf(I,J) + v_shlf(I-1,J)) - (v_shlf(I,J-1) + v_shlf(I-1,J-1))) / (2*G%dyT(i,j)) CS%ice_visc(i,j) = 0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) -! CS%ice_visc(i,j) =1e14*(G%areaT(i,j) * ISS%h_shelf(i,j)) ! constant viscocity for debugging -! umid = ((u_shlf(I,J) + u_shlf(I-1,J-1)) + (u_shlf(I,J-1) + u_shlf(I-1,J))) * 0.25 -! vmid = ((v_shlf(I,J) + v_shlf(I-1,J-1)) + (v_shlf(I,J-1) + v_shlf(I-1,J))) * 0.25 -! unorm = sqrt(umid**2 + vmid**2 + eps_min**2*(G%dxT(i,j)**2 + G%dyT(i,j)**2)) -! CS%basal_traction(i,j) = G%areaT(i,j) * CS%C_basal_friction * (US%L_T_to_m_s*unorm)**(CS%n_basal_fric-1) endif enddo enddo @@ -2638,8 +2611,8 @@ subroutine calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf) eps_min = CS%eps_glen_min - do j=jsd+1,jed!-1 OVS 02/01/21 - do i=isd+1,ied!-1 OVS 02/01/21 + do j=jsd+1,jed + do i=isd+1,ied if ((ISS%hmask(i,j) == 1) .OR. (ISS%hmask(i,j) == 3)) then umid = ((u_shlf(I,J) + u_shlf(I-1,J-1)) + (u_shlf(I,J-1) + u_shlf(I-1,J))) * 0.25 @@ -2949,7 +2922,6 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face endif do j=js,G%jed -! do j=js-1,G%jed !OVS change index do i=is,G%ied if (hmask(i,j) == 1) then @@ -2966,10 +2938,6 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face umask(I-1+k,J)=3. !vmask(I-1+k,J)=0. vmask(I-1+k,J)=3. - !u_face_mask(I-1+k,j-1)=3. -! umask(I-1+k,J-1:J)=3. -! vmask(I-1+k,J-1:J)=0. -! u_face_mask(I-1+k,j)=3. case (2) u_face_mask(I-1+k,j)=2. case (4) @@ -2977,9 +2945,9 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face vmask(I-1+k,J-1:J)=0. u_face_mask(I-1+k,j)=4. case (0) -! umask(I-1+k,J-1:J)=0. -! vmask(I-1+k,J-1:J)=0. -! u_face_mask(I-1+k,j)=0. + umask(I-1+k,J-1:J)=0. + vmask(I-1+k,J-1:J)=0. + u_face_mask(I-1+k,j)=0. case (1) ! stress free x-boundary umask(I-1+k,J-1:J)=0. case default @@ -2990,8 +2958,6 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face select case (int(CS%v_face_mask_bdry(i,J-1+k))) case (3) -! vmask(I-1:I,J-1+k)=3. -! umask(I-1:I,J-1+k)=0. vmask(I-1,J-1+k)=3. umask(I-1,J-1+k)=0. vmask(I,J-1+k)=3. @@ -3004,9 +2970,9 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face vmask(I-1:I,J-1+k)=0. v_face_mask(i,J-1+k)=4. case (0) -! umask(I-1:I,J-1+k)=0. -! vmask(I-1:I,J-1+k)=0. -! v_face_mask(i,J-1+k)=0. + umask(I-1:I,J-1+k)=0. + vmask(I-1:I,J-1+k)=0. + v_face_mask(i,J-1+k)=0. case (1) ! stress free y-boundary vmask(I-1:I,J-1+k)=0. case default @@ -3134,7 +3100,6 @@ subroutine ice_shelf_temp(CS, ISS, G, US, time_step, melt_rate, Time) intent(in) :: melt_rate !< basal melt rate [R Z T-1 ~> kg m-2 s-1] type(time_type), intent(in) :: Time !< The current model time -! 5/23/12 OVS ! This subroutine takes the velocity (on the Bgrid) and timesteps ! (HT)_t = - div (uHT) + (adot Tsurf -bdot Tbot) once and then calculates T=HT/H ! @@ -3170,12 +3135,6 @@ subroutine ice_shelf_temp(CS, ISS, G, US, time_step, melt_rate, Time) TH(i,j) = CS%t_shelf(i,j)*ISS%h_shelf(i,j) enddo ; enddo -! call enable_averages(time_step, Time, CS%diag) -! call pass_var(h_after_uflux, G%domain) -! call pass_var(h_after_vflux, G%domain) -! if (CS%id_h_after_uflux > 0) call post_data(CS%id_h_after_uflux, h_after_uflux, CS%diag) -! if (CS%id_h_after_vflux > 0) call post_data(CS%id_h_after_vflux, h_after_vflux, CS%diag) -! call disable_averaging(CS%diag) call ice_shelf_advect_temp_x(CS, G, time_step, ISS%hmask, TH, th_after_uflux) call ice_shelf_advect_temp_y(CS, G, time_step, ISS%hmask, th_after_uflux, th_after_vflux) diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index ff05ed7c6a..1f5ddf909b 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -16,7 +16,6 @@ module MOM_ice_shelf_initialize #include -!MJHpublic initialize_ice_shelf_boundary, initialize_ice_thickness public initialize_ice_thickness public initialize_ice_shelf_boundary_channel public initialize_ice_flow_from_file @@ -132,10 +131,6 @@ subroutine initialize_ice_thickness_from_file(h_shelf, area_shelf_h, hmask, G, U call MOM_read_data(filename, trim(thickness_varname), h_shelf, G%Domain, scale=US%m_to_Z) call MOM_read_data(filename,trim(area_varname), area_shelf_h, G%Domain, scale=US%m_to_L**2) -! call get_param(PF, mdl, "ICE_BOUNDARY_CONFIG", config, & -! "This specifies how the ice domain boundary is specified", & -! fail_if_missing=.true.) - isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec do j=jsc,jec @@ -228,7 +223,6 @@ subroutine initialize_ice_thickness_channel(h_shelf, area_shelf_h, hmask, G, US, if (G%geoLonCu(i-1,j) >= edge_pos) then ! Everything past the edge is open ocean. -! mass_shelf(i,j) = 0.0 area_shelf_h(i,j) = 0.0 hmask (i,j) = 0.0 h_shelf (i,j) = 0.0 @@ -244,11 +238,7 @@ subroutine initialize_ice_thickness_channel(h_shelf, area_shelf_h, hmask, G, US, if (G%geoLonT(i,j) > slope_pos) then h_shelf(i,j) = min_draft -! mass_shelf(i,j) = Rho_ocean * min_draft else -! mass_shelf(i,j) = Rho_ocean * (min_draft + & -! (CS%max_draft - CS%min_draft) * & -! min(1.0, (c1*(slope_pos - G%geoLonT(i,j)))**2) ) h_shelf(i,j) = (min_draft + & (max_draft - min_draft) * & min(1.0, (c1*(slope_pos - G%geoLonT(i,j)))**2) ) @@ -301,7 +291,7 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b intent(inout) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: h_shelf !< Ice-shelf thickness OVS 11/10/20 + intent(inout) :: h_shelf !< Ice-shelf thickness type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors type(param_file_type), intent(in) :: PF !< A structure to parse for run-time parameters @@ -340,26 +330,16 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b giec = G%Domain%niglobal+gisc ; gjec = G%Domain%njglobal+gjsc !---------b.c.s based on geopositions ----------------- - ! do j=jsc-1,jec+1 - do j=jsc-0*1,jec+1 + do j=jsc,jec+1 do i=isc-1,iec+1 ! upstream boundary - set either dirichlet or flux condition if (G%geoLonBu(i,j) == westlon) then - ! if (flux_bdry) then - ! u_face_mask_bdry(i-1,j) = 4.0 - ! u_flux_bdry_val(i-1,j) = input_flux - ! else hmask(i+1,j) = 3.0 - ! hmask(i,j) = 3.0 h_bdry_val(i+1,j) = h_shelf(i+1,j) - ! h_bdry_val(i,j) = h_shelf(i,j) thickness_bdry_val(i+1,j) = h_bdry_val(i+0*1,j) u_face_mask_bdry(i+1,j) = 3.0 u_bdry_val(i+1,j) = input_vel*(1-16.0*((G%geoLatBu(i-1,j)/lenlat-0.5))**4) !velocity distribution - ! u_bdry_val(i+1,j) = (1 - ((G%geoLatBu(i,j) - 0.5*lenlat)*2./lenlat)**2) * & - ! 1.5 * input_flux / input_thick - ! endif endif @@ -367,7 +347,6 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b if (G%geoLatBu(i,j-1) == southlat) then !bot boundary if (len_stress == 0. .OR. G%geoLonCv(i,j) <= len_stress) then v_face_mask_bdry(i,j+1) = 0. - ! u_face_mask_bdry(i,j-1) = 3. u_face_mask_bdry(i,j) = 3. u_bdry_val(i,j) = 0. v_bdry_val(i,j) = 0. @@ -382,11 +361,8 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b v_face_mask_bdry(i,j-1) = 0. u_face_mask_bdry(i,j-1) = 3. else - !v_face_mask_bdry(i,j-1) = 1. v_face_mask_bdry(i,j-1) = 3. u_face_mask_bdry(i,j-1) = 3. - !u_bdry_val(i,j) = 0. - !hmask(i,j) = 0.0 endif endif @@ -458,13 +434,10 @@ subroutine initialize_ice_flow_from_file(u_shelf, v_shelf,ice_visc,float_cond,& floatfr_varname = "float_frac" -! call MOM_read_data(filename, trim(ushelf_varname), u_shelf, G%Domain, scale=1.0) !/(365.0*86400.0)) -! call MOM_read_data(filename,trim(vshelf_varname), v_shelf, G%Domain, scale=1.0) !/(365.0*86400.0)) - call MOM_read_data(filename,trim(ice_visc_varname), ice_visc, G%Domain, scale=1.0) - call MOM_read_data(filename,trim(floatfr_varname), float_cond, G%Domain, scale=1.) -! call get_param(PF, mdl, "ICE_BOUNDARY_CONFIG", config, & -! "This specifies how the ice domain boundary is specified", & -! fail_if_missing=.true.) + call MOM_read_data(filename, trim(ushelf_varname), u_shelf, G%Domain, scale=1.0) + call MOM_read_data(filename,trim(vshelf_varname), v_shelf, G%Domain, scale=1.0) + call MOM_read_data(filename,trim(ice_visc_varname), ice_visc, G%Domain, scale=1.0) + call MOM_read_data(filename,trim(floatfr_varname), float_cond, G%Domain, scale=1.) isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec From 0d60fd0264ee271b1ce2a7b6c5e92d853c0c2769 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 12 Mar 2021 09:39:17 -0500 Subject: [PATCH 38/51] Change units of slope returned from calc_isoneutral_slopes() to "Z L-1" - Units of isoneutral or interface slope were recorded as "nondim". While true in SI units, not so for MOM6 units. MOM6 distinguishes between units of length in the vertical (Z) and horizontal (L) the slopes should have units of "Z L-1 ~> nondim". - This has consequences for other variables in calc_isoneutral_slopes(). - An internal constant, G_Rho0, was defined differently from elsewhere in the code. "g" has units of "L2 Z-1 T-2 ~ m s-2" because it is the vertical component of the gradient of geopotential in "L2 T-2 ~ m2 s-2". Everywhere else `G_Rho0 = g_Earth/Rho0` but in this routine it was different in order render N2 (the Brunt-Vaisala frequency) in units of "T-2" (s-2). - N2 is a quantity associated with dispersion relations and defined N2 = - g/Rho0 d/dz rho and either way acquires units of "L2 Z-2 T-2" and not just "T-2". In SI units L2 Z-2 = 1. So I have also changed the units of N2 in this, and connected, modules. - The changes also propagate to MOM_lateral_mixing_coeffs.F90 and MOM_thickness_diffuse.F90. - Changing the definition of G_Rho0 in calc_isoneutral_slopes(), and its units to "L2 Z-1 T-2", the slope and N2 calculations then require many less inline conversions. Many of the one-line changes in this commit remove factors like US%Z_to_L.There is one exception: - In the calculation of slope, we use in the denominator a mostly non-vanishing replacement for d/dz rho, the magnitude of grad rho from mag_grad2 = ( d/dx rho )^2 + ( d/dz rho )^2. In code this had `mag_grad2 = drdy**2 + (L_to_Z*drdz)**2` since this is mixing gradients in the horizontal and vertical. The result should be in "R2 Z-2" so now `mag_grad2 = (Z_to_L*drdy)**2 + drdz**2` - A few diagnostics needed new, or changed, conversion factors. - One run-time parameter needed a conversion parameter. - For the most part this commit moves inline conversions of units to the I/O stage, which is an indicator that it is the right thing to do. --- src/core/MOM_isopycnal_slopes.F90 | 26 ++++++------- .../lateral/MOM_lateral_mixing_coeffs.F90 | 10 +++-- .../lateral/MOM_thickness_diffuse.F90 | 38 +++++++++---------- 3 files changed, 38 insertions(+), 36 deletions(-) diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index e1f573f6ea..98b5b10998 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -37,14 +37,14 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & !! thermodynamic variables real, intent(in) :: dt_kappa_smooth !< A smoothing vertical diffusivity !! times a smoothing timescale [Z2 ~> m2]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: slope_x !< Isopycnal slope in i-direction [nondim] - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(inout) :: slope_y !< Isopycnal slope in j-direction [nondim] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: slope_x !< Isopycnal slope in i-dir [Z L-1 ~> nondim] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(inout) :: slope_y !< Isopycnal slope in j-dir [Z L-1 ~> nondim] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), & optional, intent(inout) :: N2_u !< Brunt-Vaisala frequency squared at - !! interfaces between u-points [T-2 ~> s-2] + !! interfaces between u-points [L2 Z-2 T-2 ~> s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), & optional, intent(inout) :: N2_v !< Brunt-Vaisala frequency squared at - !! interfaces between u-points [T-2 ~> s-2] + !! interfaces between v-points [L2 Z-2 T-2 ~> s-2] integer, optional, intent(in) :: halo !< Halo width over which to compute type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. @@ -86,7 +86,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & real :: drdz ! Vertical density gradient [R Z-1 ~> kg m-4]. real :: Slope ! The slope of density surfaces, calculated in a way ! that is always between -1 and 1. - real :: mag_grad2 ! The squared magnitude of the 3-d density gradient [R2 L-2 ~> kg2 m-8]. + real :: mag_grad2 ! The squared magnitude of the 3-d density gradient [R2 Z-2 ~> kg2 m-8]. real :: slope2_Ratio ! The ratio of the slope squared to slope_max squared. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. @@ -94,7 +94,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & real :: dz_neglect ! A change in interface heighs that is so small it is usually lost ! in roundoff and can be neglected [Z ~> m]. logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. - real :: G_Rho0 ! The gravitational acceleration divided by density [Z2 T-2 R-1 ~> m5 kg-2 s-2] + real :: G_Rho0 ! The gravitational acceleration divided by density [L2 Z-1 T-2 R-1 ~> m4 s-2 kg-1] 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 @@ -134,7 +134,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & present_N2_u = PRESENT(N2_u) present_N2_v = PRESENT(N2_v) - G_Rho0 = (US%L_to_Z*L_to_Z*GV%g_Earth) / GV%Rho0 + G_Rho0 = GV%g_Earth / GV%Rho0 if (present_N2_u) then do j=js,je ; do I=is-1,ie N2_u(I,j,1) = 0. @@ -248,17 +248,17 @@ subroutine calc_isoneutral_slopes(G, GV, US, 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 + (L_to_Z*drdz)**2 + mag_grad2 = (Z_to_L*drdx)**2 + 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. slope_x(I,j,K) = 0.0 endif - if (present_N2_u) N2_u(I,j,k) = G_Rho0 * drdz * G%mask2dCu(I,j) ! Square of buoyancy frequency [T-2 ~> s-2] + if (present_N2_u) N2_u(I,j,k) = G_Rho0 * drdz * G%mask2dCu(I,j) ! Square of buoyancy freq. [L2 Z-2 T-2 ~> s-2] else ! With .not.use_EOS, the layers are constant density. - slope_x(I,j,K) = (Z_to_L*(e(i,j,K)-e(i+1,j,K))) * G%IdxCu(I,j) + slope_x(I,j,K) = (e(i,j,K)-e(i+1,j,K)) * G%IdxCu(I,j) endif if (local_open_u_BC) then l_seg = OBC%segnum_u(I,j) @@ -351,17 +351,17 @@ subroutine calc_isoneutral_slopes(G, GV, US, 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 + (L_to_Z*drdz)**2 + mag_grad2 = (Z_to_L*drdy)**2 + 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. slope_y(i,J,K) = 0.0 endif - if (present_N2_v) N2_v(i,J,k) = G_Rho0 * drdz * G%mask2dCv(i,J) ! Square of buoyancy frequency [T-2 ~> s-2] + if (present_N2_v) N2_v(i,J,k) = G_Rho0 * drdz * G%mask2dCv(i,J) ! Square of buoyancy freq. [L2 Z-2 T-2 ~> s-2] else ! With .not.use_EOS, the layers are constant density. - slope_y(i,J,K) = (Z_to_L*(e(i,j,K)-e(i,j+1,K))) * G%IdyCv(i,J) + slope_y(i,J,K) = (e(i,j,K)-e(i,j+1,K)) * G%IdyCv(i,J) endif if (local_open_v_BC) then l_seg = OBC%segnum_v(i,J) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index e3a6f1599e..7d95c43b98 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -1125,16 +1125,18 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) if (CS%calculate_Eady_growth_rate .and. CS%use_stored_slopes) then CS%id_N2_u = register_diag_field('ocean_model', 'N2_u', diag%axesCui, Time, & 'Square of Brunt-Vaisala frequency, N^2, at u-points, as used in Visbeck et al.', & - 's-2', conversion=US%s_to_T**2) + 's-2', conversion=(US%L_to_Z*US%s_to_T)**2) CS%id_N2_v = register_diag_field('ocean_model', 'N2_v', diag%axesCvi, Time, & 'Square of Brunt-Vaisala frequency, N^2, at v-points, as used in Visbeck et al.', & - 's-2', conversion=US%s_to_T**2) + 's-2', conversion=(US%L_to_Z*US%s_to_T)**2) endif if (CS%use_stored_slopes) then CS%id_S2_u = register_diag_field('ocean_model', 'S2_u', diag%axesCu1, Time, & - 'Depth average square of slope magnitude, S^2, at u-points, as used in Visbeck et al.', 'nondim') + 'Depth average square of slope magnitude, S^2, at u-points, as used in Visbeck et al.', & + 'nondim', conversion=US%Z_to_L**2) CS%id_S2_v = register_diag_field('ocean_model', 'S2_v', diag%axesCv1, Time, & - 'Depth average square of slope magnitude, S^2, at v-points, as used in Visbeck et al.', 'nondim') + 'Depth average square of slope magnitude, S^2, at v-points, as used in Visbeck et al.', & + 'nondim', conversion=US%Z_to_L**2) endif oneOrTwo = 1.0 diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 8c6a90ba9c..99ecca9745 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -40,7 +40,7 @@ module MOM_thickness_diffuse real :: max_Khth_CFL !< Maximum value of the diffusive CFL for thickness diffusion real :: Khth_Min !< Minimum value of Khth [L2 T-1 ~> m2 s-1] real :: Khth_Max !< Maximum value of Khth [L2 T-1 ~> m2 s-1], or 0 for no max - real :: slope_max !< Slopes steeper than slope_max are limited in some way [nondim]. + real :: slope_max !< Slopes steeper than slope_max are limited in some way [Z L-1 ~> nondim]. real :: kappa_smooth !< Vertical diffusivity used to interpolate more !! sensible values of T & S into thin layers [Z2 T-1 ~> m2 s-1]. logical :: thickness_diffuse !< If true, interfaces heights are diffused. @@ -83,8 +83,8 @@ module MOM_thickness_diffuse type(diag_ctrl), pointer :: diag => NULL() !< structure used to regulate timing of diagnostics real, pointer :: GMwork(:,:) => NULL() !< Work by thickness diffusivity [R Z L2 T-3 ~> W m-2] - real, pointer :: diagSlopeX(:,:,:) => NULL() !< Diagnostic: zonal neutral slope [nondim] - real, pointer :: diagSlopeY(:,:,:) => NULL() !< Diagnostic: zonal neutral slope [nondim] + real, pointer :: diagSlopeX(:,:,:) => NULL() !< Diagnostic: zonal neutral slope [Z L-1 ~> nondim] + real, pointer :: diagSlopeY(:,:,:) => NULL() !< Diagnostic: zonal neutral slope [Z L-1 ~> nondim] real, dimension(:,:,:), pointer :: & KH_u_GME => NULL(), & !< interface height diffusivities in u-columns [L2 T-1 ~> m2 s-1] @@ -578,8 +578,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV !! the isopycnal slopes are taken directly from !! the interface slopes without consideration of !! density gradients [nondim]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), optional, intent(in) :: slope_x !< Isopycnal slope at u-points - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), optional, intent(in) :: slope_y !< Isopycnal slope at v-points + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), optional, intent(in) :: slope_x !< Isopyc. slope at u [Z L-1 ~> nondim] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), optional, intent(in) :: slope_y !< Isopyc. slope at v [Z L-1 ~> nondim] ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: & T, & ! The temperature (or density) [degC], with the values in @@ -660,7 +660,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real :: Slope ! The slope of density surfaces, calculated in a way ! that is always between -1 and 1, nondimensional. real :: mag_grad2 ! The squared magnitude of the 3-d density gradient [R2 L-2 ~> kg2 m-8]. - real :: I_slope_max2 ! The inverse of slope_max squared, nondimensional. + real :: I_slope_max2 ! The inverse of slope_max squared [L2 Z-2 ~> nondim]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: h_neglect2 ! h_neglect^2 [H2 ~> m2 or kg2 m-4]. @@ -919,7 +919,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. - mag_grad2 = drdx**2 + (US%L_to_Z*drdz)**2 + mag_grad2 = (US%Z_to_L*drdx)**2 + drdz**2 if (mag_grad2 > 0.0) then Slope = drdx / sqrt(mag_grad2) slope2_Ratio_u(I,K) = Slope**2 * I_slope_max2 @@ -933,7 +933,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! that ignore density gradients along layers. if (present_int_slope_u) then Slope = (1.0 - int_slope_u(I,j,K)) * Slope + & - int_slope_u(I,j,K) * US%Z_to_L*((e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j)) + int_slope_u(I,j,K) * ((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 @@ -942,7 +942,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (CS%id_slope_x > 0) CS%diagSlopeX(I,j,k) = Slope ! Estimate the streamfunction at each interface [Z L2 T-1 ~> m3 s-1]. - Sfn_unlim_u(I,K) = -((KH_u(I,j,K)*G%dy_Cu(I,j))*US%L_to_Z*Slope) + Sfn_unlim_u(I,K) = -((KH_u(I,j,K)*G%dy_Cu(I,j))*Slope) ! Avoid moving dense water upslope from below the level of ! the bottom on the receiving side. @@ -968,10 +968,10 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (present_slope_x) then Slope = slope_x(I,j,k) else - Slope = US%Z_to_L*((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) * G%mask2dCu(I,j) + Slope = ((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) * G%mask2dCu(I,j) endif if (CS%id_slope_x > 0) CS%diagSlopeX(I,j,k) = Slope - Sfn_unlim_u(I,K) = ((KH_u(I,j,K)*G%dy_Cu(I,j))*US%L_to_Z*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) endif ! if (use_EOS) else ! if (k > nk_linear) @@ -1185,7 +1185,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. - mag_grad2 = drdy**2 + (US%L_to_Z*drdz)**2 + mag_grad2 = (US%Z_to_L*drdy)**2 + drdz**2 if (mag_grad2 > 0.0) then Slope = drdy / sqrt(mag_grad2) slope2_Ratio_v(i,K) = Slope**2 * I_slope_max2 @@ -1199,7 +1199,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! that ignore density gradients along layers. if (present_int_slope_v) then Slope = (1.0 - int_slope_v(i,J,K)) * Slope + & - int_slope_v(i,J,K) * US%Z_to_L*((e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J)) + int_slope_v(i,J,K) * ((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 @@ -1208,7 +1208,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (CS%id_slope_y > 0) CS%diagSlopeY(I,j,k) = Slope ! Estimate the streamfunction at each interface [Z L2 T-1 ~> m3 s-1]. - Sfn_unlim_v(i,K) = -((KH_v(i,J,K)*G%dx_Cv(i,J))*US%L_to_Z*Slope) + Sfn_unlim_v(i,K) = -((KH_v(i,J,K)*G%dx_Cv(i,J))*Slope) ! Avoid moving dense water upslope from below the level of ! the bottom on the receiving side. @@ -1234,10 +1234,10 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (present_slope_y) then Slope = slope_y(i,J,k) else - Slope = US%Z_to_L*((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) * G%mask2dCv(i,J) + Slope = ((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) * G%mask2dCv(i,J) endif if (CS%id_slope_y > 0) CS%diagSlopeY(I,j,k) = Slope - Sfn_unlim_v(i,K) = ((KH_v(i,J,K)*G%dx_Cv(i,J))*US%L_to_Z*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) endif ! if (use_EOS) else ! if (k > nk_linear) @@ -1947,7 +1947,7 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) "longer than DT, or 0 to use DT.", units="s", default=0.0, scale=US%s_to_T) call get_param(param_file, mdl, "KHTH_SLOPE_MAX", CS%slope_max, & "A slope beyond which the calculated isopycnal slope is "//& - "not reliable and is scaled away.", units="nondim", default=0.01) + "not reliable and is scaled away.", units="nondim", default=0.01, scale=US%L_to_Z) call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_smooth, & "A diapycnal diffusivity that is used to interpolate "//& "more sensible values of T & S into thin layers.", & @@ -2065,10 +2065,10 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_slope_x = register_diag_field('ocean_model', 'neutral_slope_x', diag%axesCui, Time, & - 'Zonal slope of neutral surface', 'nondim') + 'Zonal slope of neutral surface', 'nondim', conversion=US%Z_to_L) if (CS%id_slope_x > 0) call safe_alloc_ptr(CS%diagSlopeX,G%IsdB,G%IedB,G%jsd,G%jed,GV%ke+1) CS%id_slope_y = register_diag_field('ocean_model', 'neutral_slope_y', diag%axesCvi, Time, & - 'Meridional slope of neutral surface', 'nondim') + 'Meridional slope of neutral surface', 'nondim', conversion=US%Z_to_L) if (CS%id_slope_y > 0) call safe_alloc_ptr(CS%diagSlopeY,G%isd,G%ied,G%JsdB,G%JedB,GV%ke+1) CS%id_sfn_x = register_diag_field('ocean_model', 'GM_sfn_x', diag%axesCui, Time, & 'Parameterized Zonal Overturning Streamfunction', & From b33b3af7fe084dd2f8828aee2187549fa52d1ed2 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 23 Mar 2021 10:38:21 -0400 Subject: [PATCH 39/51] Testing: Recurse target submodules, LDFLAGS hook Two minor changes to the .testing build: - We now apply `--recurse-submodules` to the target build in the regression test. This is required after an update to the submodules, when the target submodule is out of sync with the main branch (e.g. dev/gfdl at NOAA-GFDL). - A LDFLAGS_USER hook was added to the `.testing/Makefile` configuration, similar to the FCFLAGS_* hooks. This is required if the library dependencies do not reside in the default directores. For example, this may be needed for a custom netCDF or MPI library. --- .testing/Makefile | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/.testing/Makefile b/.testing/Makefile index 21da6cfde4..02f6557c09 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -84,6 +84,9 @@ FCFLAGS_COVERAGE ?= # - FMS cannot be built with the same aggressive initialization flags as MOM6, # so FCFLAGS_INIT is used to provide additional MOM6 configuration. +# User-defined LDFLAGS (applied to all builds and FMS) +LDFLAGS_USER ?= + # Set to `true` to require identical results from DEBUG and REPRO builds # NOTE: Many compilers (Intel, GCC on ARM64) do not yet produce identical # results across DEBUG and REPRO builds (as defined below), so we disable on @@ -217,8 +220,8 @@ REPRO_FCFLAGS := FCFLAGS="$(FCFLAGS_REPRO) $(FCFLAGS_FMS)" OPENMP_FCFLAGS := FCFLAGS="$(FCFLAGS_DEBUG) $(FCFLAGS_INIT) $(FCFLAGS_FMS)" TARGET_FCFLAGS := FCFLAGS="$(FCFLAGS_DEBUG) $(FCFLAGS_INIT) $(FCFLAGS_FMS)" -MOM_LDFLAGS := LDFLAGS="$(LDFLAGS_FMS)" -SYMMETRIC_LDFLAGS := LDFLAGS="$(COVERAGE) $(LDFLAGS_FMS)" +MOM_LDFLAGS := LDFLAGS="$(LDFLAGS_FMS) $(LDFLAGS_USER)" +SYMMETRIC_LDFLAGS := LDFLAGS="$(COVERAGE) $(LDFLAGS_FMS) $(LDFLAGS_USER)" # Environment variable configuration @@ -286,7 +289,7 @@ $(TARGET_CODEBASE)/ac/configure: $(TARGET_CODEBASE) $(TARGET_CODEBASE): git clone --recursive $(MOM_TARGET_URL) $@ - cd $@ && git checkout $(MOM_TARGET_BRANCH) + cd $@ && git checkout --recurse-submodules $(MOM_TARGET_BRANCH) #--- From 8cc501820892c6c4403bdc76ffc4f0257d8d2948 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 23 Mar 2021 15:53:38 -0400 Subject: [PATCH 40/51] Style: Line length fix in MCT_cap --- config_src/drivers/mct_cap/mom_surface_forcing_mct.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/config_src/drivers/mct_cap/mom_surface_forcing_mct.F90 b/config_src/drivers/mct_cap/mom_surface_forcing_mct.F90 index ef0527dd1c..e675170575 100644 --- a/config_src/drivers/mct_cap/mom_surface_forcing_mct.F90 +++ b/config_src/drivers/mct_cap/mom_surface_forcing_mct.F90 @@ -496,7 +496,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, if (associated(fluxes%frunoff)) then fluxes%latent(i,j) = fluxes%latent(i,j) - & IOB%rofi_flux(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion - fluxes%latent_frunoff_diag(i,j) = - G%mask2dT(i,j) * IOB%rofi_flux(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion + fluxes%latent_frunoff_diag(i,j) = -G%mask2dT(i,j) & + * IOB%rofi_flux(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion endif ! contribution from evaporation if (associated(IOB%q_flux)) then From 7ab7daaf28104f5237320d9b9555e8531a4b6a3e Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 23 Mar 2021 19:40:16 -0600 Subject: [PATCH 41/51] updates and bugfixes for area correction factors --- config_src/nuopc_driver/mom_cap.F90 | 64 +++++++++++++-------- config_src/nuopc_driver/mom_cap_methods.F90 | 43 +++++++------- 2 files changed, 63 insertions(+), 44 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index ca44833341..10c73150cf 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -38,6 +38,7 @@ module MOM_cap_mod use MOM_cap_methods, only: mom_import, mom_export, mom_set_geomtype, mod2med_areacor, med2mod_areacor #ifdef CESMCOUPLED use shr_file_mod, only: shr_file_setLogUnit, shr_file_getLogUnit +use shr_mpi_mod, only : shr_mpi_min, shr_mpi_max #endif use time_utils_mod, only: esmf2fms_time @@ -71,7 +72,7 @@ module MOM_cap_mod use ESMF, only: ESMF_FieldRegridGetArea use ESMF, only: ESMF_ArrayCreate use ESMF, only: ESMF_RC_FILE_OPEN, ESMF_RC_FILE_READ, ESMF_RC_FILE_WRITE -use ESMF, only: ESMF_VMBroadcast +use ESMF, only: ESMF_VMBroadcast, ESMF_VMReduce, ESMF_REDUCE_MAX, ESMF_REDUCE_MIN use ESMF, only: ESMF_AlarmCreate, ESMF_ClockGetAlarmList, ESMF_AlarmList_Flag use ESMF, only: ESMF_AlarmGet, ESMF_AlarmIsCreated, ESMF_ALARMLIST_ALL, ESMF_AlarmIsEnabled use ESMF, only: ESMF_STATEITEM_NOTFOUND, ESMF_FieldWrite @@ -903,6 +904,14 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) real(ESMF_KIND_R8), allocatable :: mesh_areas(:) real(ESMF_KIND_R8), allocatable :: model_areas(:) real(ESMF_KIND_R8), pointer :: dataPtr_mesh_areas(:) + real(ESMF_KIND_R8) :: max_mod2med_areacor + real(ESMF_KIND_R8) :: max_med2mod_areacor + real(ESMF_KIND_R8) :: min_mod2med_areacor + real(ESMF_KIND_R8) :: min_med2mod_areacor + real(ESMF_KIND_R8) :: max_mod2med_areacor_glob + real(ESMF_KIND_R8) :: max_med2mod_areacor_glob + real(ESMF_KIND_R8) :: min_mod2med_areacor_glob + real(ESMF_KIND_R8) :: min_med2mod_areacor_glob character(len=*), parameter :: subname='(MOM_cap:InitializeRealize)' !-------------------------------- @@ -1458,7 +1467,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !--------------------------------- ! determine flux area correction factors - module variables in mom_cap_methods !--------------------------------- - ! Area correction factors are ONLY valid for meshes that are read in - so do not need them for ! grids that are calculated internally @@ -1467,6 +1475,13 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Determine mesh areas for regridding call ESMF_MeshGet(Emesh, numOwnedElements=numOwnedElements, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + allocate (mod2med_areacor(numOwnedElements)) + allocate (med2mod_areacor(numOwnedElements)) + mod2med_areacor(:) = 1._ESMF_KIND_R8 + med2mod_areacor(:) = 1._ESMF_KIND_R8 + +#ifdef CESMCOUPLED call ESMF_StateGet(exportState, itemName=trim(fldsFrOcn(2)%stdname), field=lfield, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_FieldRegridGetArea(lfield, rc=rc) @@ -1474,37 +1489,40 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_FieldGet(lfield, farrayPtr=dataPtr_mesh_areas, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return allocate(mesh_areas(numOwnedElements)) - mesh_areas(:) = dataPtr_mesh_areas(:) - - ! Determine model areas allocate(model_areas(numOwnedElements)) + + ! Determine model areas and flux correction factors (module variables in mom_) k = 0 L2_to_rad2 = ocean_grid%US%L_to_m**2 / ocean_grid%Rad_Earth**2 do j = ocean_grid%jsc, ocean_grid%jec do i = ocean_grid%isc, ocean_grid%iec k = k + 1 ! Increment position within gindex + mesh_areas(k) = dataPtr_mesh_areas(k) model_areas(k) = ocean_grid%AreaT(i,j) * L2_to_rad2 + mod2med_areacor(k) = model_areas(k) / mesh_areas(k) + med2mod_areacor(k) = mesh_areas(k) / model_areas(k) enddo enddo - - ! Determine flux correction factors (module variables in mom_) - allocate (mod2med_areacor(numOwnedElements)) - allocate (med2mod_areacor(numOwnedElements)) - do n = 1,numOwnedElements - if (model_areas(n) == mesh_areas(n)) then - mod2med_areacor(n) = 1._ESMF_KIND_R8 - med2mod_areacor(n) = 1._ESMF_KIND_R8 - else - mod2med_areacor(n) = model_areas(n) / mesh_areas(n) - med2mod_areacor(n) = mesh_areas(n) / model_areas(n) - if (abs(mod2med_areacor(n) - 1._ESMF_KIND_R8) > 1.e-13) then - write(6,'(a,i8,2x,d21.14,2x)')' AREACOR mom6: n, abs(mod2med_areacor(n)-1)', & - n, abs(mod2med_areacor(n) - 1._ESMF_KIND_R8) - end if - end if - end do - deallocate(model_areas) deallocate(mesh_areas) + deallocate(model_areas) + + ! Write diagnostic output for correction factors + min_mod2med_areacor = minval(mod2med_areacor) + max_mod2med_areacor = maxval(mod2med_areacor) + min_med2mod_areacor = minval(med2mod_areacor) + max_med2mod_areacor = maxval(med2mod_areacor) + call shr_mpi_max(max_mod2med_areacor, max_mod2med_areacor_glob, mpicom) + call shr_mpi_min(min_mod2med_areacor, min_mod2med_areacor_glob, mpicom) + call shr_mpi_max(max_med2mod_areacor, max_med2mod_areacor_glob, mpicom) + call shr_mpi_min(min_med2mod_areacor, min_med2mod_areacor_glob, mpicom) + if (localPet == 0) then + write(logunit,'(2A,2g23.15,A )') trim(subname),' : min_mod2med_areacor, max_mod2med_areacor ',& + min_mod2med_areacor_glob, max_mod2med_areacor_glob, 'MOM6' + write(logunit,'(2A,2g23.15,A )') trim(subname),' : min_med2mod_areacor, max_med2mod_areacor ',& + min_med2mod_areacor_glob, max_med2mod_areacor_glob, 'MOM6' + end if +#endif + end if !--------------------------------- diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 625bde4cfe..2b5b54e55a 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -186,7 +186,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! sensible heat flux (W/m2) !---- call state_getimport(importState, 'mean_sensi_heat_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%t_flux, areacor=mod2med_areacor, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%t_flux, areacor=med2mod_areacor, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -196,7 +196,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! evaporation flux (W/m2) !---- call state_getimport(importState, 'mean_evap_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%q_flux, areacor=mod2med_areacor, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%q_flux, areacor=med2mod_areacor, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -206,7 +206,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! liquid precipitation (rain) !---- call state_getimport(importState, 'mean_prec_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%lprec, areacor=mod2med_areacor, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%lprec, areacor=med2mod_areacor, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -216,7 +216,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! frozen precipitation (snow) !---- call state_getimport(importState, 'mean_fprec_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%fprec, areacor=mod2med_areacor, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%fprec, areacor=med2mod_areacor, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -231,7 +231,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! liquid runoff ice_ocean_boundary%lrunoff (:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'Foxx_rofl', & - isc, iec, jsc, jec, ice_ocean_boundary%lrunoff, areacor=mod2med_areacor, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%lrunoff, areacor=med2mod_areacor, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -240,7 +240,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! ice runoff ice_ocean_boundary%frunoff (:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'Foxx_rofi', & - isc, iec, jsc, jec, ice_ocean_boundary%frunoff, areacor=mod2med_areacor, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%frunoff, areacor=med2mod_areacor, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -249,7 +249,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! heat content of lrunoff ice_ocean_boundary%lrunoff_hflx(:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'mean_runoff_heat_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%lrunoff_hflx, areacor=mod2med_areacor, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%lrunoff_hflx, areacor=med2mod_areacor, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -258,7 +258,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! heat content of frunoff ice_ocean_boundary%frunoff_hflx(:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'mean_calving_heat_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%frunoff_hflx, areacor=mod2med_areacor, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%frunoff_hflx, areacor=med2mod_areacor, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -269,7 +269,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- ice_ocean_boundary%salt_flux(:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'mean_salt_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%salt_flux, areacor=mod2med_areacor, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%salt_flux, areacor=med2mod_areacor, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -280,7 +280,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- ice_ocean_boundary%seaice_melt_heat(:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'net_heat_flx_to_ocn', & - isc, iec, jsc, jec, ice_ocean_boundary%seaice_melt_heat, areacor=mod2med_areacor, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%seaice_melt_heat, areacor=med2mod_areacor, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -291,7 +291,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- ice_ocean_boundary%seaice_melt(:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'mean_fresh_water_to_ocean_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%seaice_melt, areacor=mod2med_areacor, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%seaice_melt, areacor=med2mod_areacor, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -715,22 +715,23 @@ subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, a call state_getfldptr(state, trim(fldname), dataptr1d, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - ! option to apply area correction - if (present(areacor)) then - do n = 1,size(dataPtr1d) - dataPtr1d(n) = dataPtr1d(n) * areacor(n) - end do - end if - - ! determine output array + ! determine output array and apply area correction if present n = 0 do j = jsc,jec do i = isc,iec n = n + 1 if (present(do_sum)) then - output(i,j) = output(i,j) + dataPtr1d(n) + if (present(areacor)) then + output(i,j) = output(i,j) + dataPtr1d(n) * areacor(n) + else + output(i,j) = output(i,j) + dataPtr1d(n) + end if else - output(i,j) = dataPtr1d(n) + if (present(areacor)) then + output(i,j) = dataPtr1d(n) * areacor(n) + else + output(i,j) = dataPtr1d(n) + end if endif enddo enddo From b8aaa8824694bd33add29c8cd4b03bb77ccac62c Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 23 Mar 2021 20:46:26 -0600 Subject: [PATCH 42/51] changed computation of model_areas --- config_src/nuopc_driver/mom_cap.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 10c73150cf..862147d0d8 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1498,7 +1498,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) do i = ocean_grid%isc, ocean_grid%iec k = k + 1 ! Increment position within gindex mesh_areas(k) = dataPtr_mesh_areas(k) - model_areas(k) = ocean_grid%AreaT(i,j) * L2_to_rad2 + model_areas(k) = ocean_grid%AreaT(i,j) / ocean_grid%Rad_Earth**2 mod2med_areacor(k) = model_areas(k) / mesh_areas(k) med2mod_areacor(k) = mesh_areas(k) / model_areas(k) enddo From 973632cd6c8e7675f2e5f593975892712981abc3 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 24 Mar 2021 20:55:04 -0600 Subject: [PATCH 43/51] calculate area correction factors only over non-zero mask values --- config_src/nuopc_driver/mom_cap.F90 | 128 ++++++++++++++-------------- 1 file changed, 63 insertions(+), 65 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 862147d0d8..8e2acb5195 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1130,10 +1130,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) end if end do - deallocate(ownedElemCoords) - deallocate(lonMesh , lon ) - deallocate(latMesh , lat ) - deallocate(maskMesh, mask) ! realize the import and export fields using the mesh call MOM_RealizeFields(importState, fldsToOcn_num, fldsToOcn, "Ocn import", mesh=Emesh, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1147,6 +1143,69 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return + !--------------------------------- + ! determine flux area correction factors - module variables in mom_cap_methods + !--------------------------------- + ! Area correction factors are ONLY valid for meshes that are read in - so do not need them for + ! grids that are calculated internally + + ! Determine mesh areas for regridding + call ESMF_MeshGet(Emesh, numOwnedElements=numOwnedElements, spatialDim=spatialDim, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + allocate (mod2med_areacor(numOwnedElements)) + allocate (med2mod_areacor(numOwnedElements)) + mod2med_areacor(:) = 1._ESMF_KIND_R8 + med2mod_areacor(:) = 1._ESMF_KIND_R8 + +#ifdef CESMCOUPLED + ! Determine model areas and flux correction factors (module variables in mom_) + call ESMF_StateGet(exportState, itemName=trim(fldsFrOcn(2)%stdname), field=lfield, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_FieldRegridGetArea(lfield, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_FieldGet(lfield, farrayPtr=dataPtr_mesh_areas, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + allocate(mesh_areas(numOwnedElements)) + allocate(model_areas(numOwnedElements)) + k = 0 + do j = ocean_grid%jsc, ocean_grid%jec + do i = ocean_grid%isc, ocean_grid%iec + k = k + 1 ! Increment position within gindex + if (mask(k) /= 0) then + mesh_areas(k) = dataPtr_mesh_areas(k) + model_areas(k) = ocean_grid%AreaT(i,j) / ocean_grid%Rad_Earth**2 + mod2med_areacor(k) = model_areas(k) / mesh_areas(k) + med2mod_areacor(k) = mesh_areas(k) / model_areas(k) + end if + end do + end do + deallocate(mesh_areas) + deallocate(model_areas) + + ! Write diagnostic output for correction factors + min_mod2med_areacor = minval(mod2med_areacor) + max_mod2med_areacor = maxval(mod2med_areacor) + min_med2mod_areacor = minval(med2mod_areacor) + max_med2mod_areacor = maxval(med2mod_areacor) + call shr_mpi_max(max_mod2med_areacor, max_mod2med_areacor_glob, mpicom) + call shr_mpi_min(min_mod2med_areacor, min_mod2med_areacor_glob, mpicom) + call shr_mpi_max(max_med2mod_areacor, max_med2mod_areacor_glob, mpicom) + call shr_mpi_min(min_med2mod_areacor, min_med2mod_areacor_glob, mpicom) + if (localPet == 0) then + write(logunit,'(2A,2g23.15,A )') trim(subname),' : min_mod2med_areacor, max_mod2med_areacor ',& + min_mod2med_areacor_glob, max_mod2med_areacor_glob, 'MOM6' + write(logunit,'(2A,2g23.15,A )') trim(subname),' : min_med2mod_areacor, max_med2mod_areacor ',& + min_med2mod_areacor_glob, max_med2mod_areacor_glob, 'MOM6' + end if +#endif + + deallocate(ownedElemCoords) + deallocate(lonMesh , lon ) + deallocate(latMesh , lat ) + deallocate(maskMesh, mask) + else if (geomtype == ESMF_GEOMTYPE_GRID) then !--------------------------------- @@ -1464,67 +1523,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) endif - !--------------------------------- - ! determine flux area correction factors - module variables in mom_cap_methods - !--------------------------------- - ! Area correction factors are ONLY valid for meshes that are read in - so do not need them for - ! grids that are calculated internally - - if (geomtype == ESMF_GEOMTYPE_MESH) then - - ! Determine mesh areas for regridding - call ESMF_MeshGet(Emesh, numOwnedElements=numOwnedElements, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - allocate (mod2med_areacor(numOwnedElements)) - allocate (med2mod_areacor(numOwnedElements)) - mod2med_areacor(:) = 1._ESMF_KIND_R8 - med2mod_areacor(:) = 1._ESMF_KIND_R8 - -#ifdef CESMCOUPLED - call ESMF_StateGet(exportState, itemName=trim(fldsFrOcn(2)%stdname), field=lfield, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_FieldRegridGetArea(lfield, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_FieldGet(lfield, farrayPtr=dataPtr_mesh_areas, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - allocate(mesh_areas(numOwnedElements)) - allocate(model_areas(numOwnedElements)) - - ! Determine model areas and flux correction factors (module variables in mom_) - k = 0 - L2_to_rad2 = ocean_grid%US%L_to_m**2 / ocean_grid%Rad_Earth**2 - do j = ocean_grid%jsc, ocean_grid%jec - do i = ocean_grid%isc, ocean_grid%iec - k = k + 1 ! Increment position within gindex - mesh_areas(k) = dataPtr_mesh_areas(k) - model_areas(k) = ocean_grid%AreaT(i,j) / ocean_grid%Rad_Earth**2 - mod2med_areacor(k) = model_areas(k) / mesh_areas(k) - med2mod_areacor(k) = mesh_areas(k) / model_areas(k) - enddo - enddo - deallocate(mesh_areas) - deallocate(model_areas) - - ! Write diagnostic output for correction factors - min_mod2med_areacor = minval(mod2med_areacor) - max_mod2med_areacor = maxval(mod2med_areacor) - min_med2mod_areacor = minval(med2mod_areacor) - max_med2mod_areacor = maxval(med2mod_areacor) - call shr_mpi_max(max_mod2med_areacor, max_mod2med_areacor_glob, mpicom) - call shr_mpi_min(min_mod2med_areacor, min_mod2med_areacor_glob, mpicom) - call shr_mpi_max(max_med2mod_areacor, max_med2mod_areacor_glob, mpicom) - call shr_mpi_min(min_med2mod_areacor, min_med2mod_areacor_glob, mpicom) - if (localPet == 0) then - write(logunit,'(2A,2g23.15,A )') trim(subname),' : min_mod2med_areacor, max_mod2med_areacor ',& - min_mod2med_areacor_glob, max_mod2med_areacor_glob, 'MOM6' - write(logunit,'(2A,2g23.15,A )') trim(subname),' : min_med2mod_areacor, max_med2mod_areacor ',& - min_med2mod_areacor_glob, max_med2mod_areacor_glob, 'MOM6' - end if -#endif - - end if - !--------------------------------- ! Set module variable geomtype in MOM_cap_methods !--------------------------------- From a4bf34459c4e9490eb435827d0cf3d0bb6bca08a Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Mon, 29 Mar 2021 10:49:30 -0600 Subject: [PATCH 44/51] add if clause to a set_diffusivity OMP block including clock calls. --- src/parameterizations/vertical/MOM_set_diffusivity.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 99dee11b9a..0cb39b2f15 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -417,7 +417,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! parameterization of Kd. !$OMP parallel do default(shared) private(dRho_int,N2_lay,Kd_lay_2d,Kd_int_2d,Kv_bkgnd,N2_int,& - !$OMP N2_bot,KT_extra,KS_extra,TKE_to_Kd,maxTKE,dissip,kb) + !$OMP N2_bot,KT_extra,KS_extra,TKE_to_Kd,maxTKE,dissip,kb)& + !$OMP if(.not. CS%use_CVMix_ddiff) do j=js,je ! Set up variables related to the stratification. From b6c7fdb026ee6f8a471c981d96ec03fe76679454 Mon Sep 17 00:00:00 2001 From: jiandewang Date: Wed, 31 Mar 2021 22:06:43 -0400 Subject: [PATCH 45/51] change default value of use_mommesh as true --- config_src/drivers/nuopc_cap/mom_cap.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/config_src/drivers/nuopc_cap/mom_cap.F90 b/config_src/drivers/nuopc_cap/mom_cap.F90 index c96c98cdd4..7dc95e13fa 100644 --- a/config_src/drivers/nuopc_cap/mom_cap.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap.F90 @@ -136,7 +136,7 @@ module MOM_cap_mod logical :: profile_memory = .true. logical :: grid_attach_area = .false. logical :: use_coldstart = .true. -logical :: use_mommesh = .false. +logical :: use_mommesh = .true. character(len=128) :: scalar_field_name = '' integer :: scalar_field_count = 0 integer :: scalar_field_idx_grid_nx = 0 @@ -349,7 +349,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) write(logmsg,*) use_coldstart call ESMF_LogWrite('MOM_cap:use_coldstart = '//trim(logmsg), ESMF_LOGMSG_INFO) - use_mommesh = .false. + use_mommesh = .true. call NUOPC_CompAttributeGet(gcomp, name="use_mommesh", value=value, & isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return From 69c86cd9dc799d995471c34133e175c5da95524c Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 5 Apr 2021 08:39:30 -0600 Subject: [PATCH 46/51] add support for threading in cmeps --- config_src/drivers/nuopc_cap/mom_cap.F90 | 62 ++++++++++++++++++++++-- 1 file changed, 59 insertions(+), 3 deletions(-) diff --git a/config_src/drivers/nuopc_cap/mom_cap.F90 b/config_src/drivers/nuopc_cap/mom_cap.F90 index 15d9415471..ca0b40d509 100644 --- a/config_src/drivers/nuopc_cap/mom_cap.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap.F90 @@ -47,7 +47,7 @@ module MOM_cap_mod use, intrinsic :: iso_fortran_env, only: output_unit -use ESMF, only: ESMF_ClockAdvance, ESMF_ClockGet, ESMF_ClockPrint +use ESMF, only: ESMF_ClockAdvance, ESMF_ClockGet, ESMF_ClockPrint, ESMF_VMget use ESMF, only: ESMF_ClockGetAlarm, ESMF_ClockGetNextTime, ESMF_ClockAdvance use ESMF, only: ESMF_ClockSet, ESMF_Clock, ESMF_GeomType_Flag, ESMF_LOGMSG_INFO use ESMF, only: ESMF_Grid, ESMF_GridCreate, ESMF_GridAddCoord @@ -96,6 +96,7 @@ module MOM_cap_mod use NUOPC_Model, only: model_label_SetRunClock => label_SetRunClock use NUOPC_Model, only: model_label_Finalize => label_Finalize use NUOPC_Model, only: SetVM +!$use omp_lib , only : omp_set_num_threads implicit none; private @@ -143,7 +144,8 @@ module MOM_cap_mod integer :: scalar_field_count = 0 integer :: scalar_field_idx_grid_nx = 0 integer :: scalar_field_idx_grid_ny = 0 -character(len=*),parameter :: u_FILE_u = & +integer :: nthrds !< number of openmp threads per task +character(len=*),parameter :: u_file_u = & __FILE__ #ifdef CESMCOUPLED @@ -399,6 +401,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) logical :: existflag integer :: userRc integer :: localPet + integer :: localPeCount integer :: iostat integer :: readunit character(len=512) :: restartfile ! Path/Name of restart file @@ -435,7 +438,31 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) CALL ESMF_TimeIntervalGet(TINT, S=DT_OCEAN, RC=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !TODO: next two lines not present in NCAR + !--------------------------------- + ! openmp threads + !--------------------------------- + + call ESMF_VMGet(vm, pet=localPet, peCount=localPeCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + + if(localPeCount == 1) then + call NUOPC_CompAttributeGet(gcomp, "nthreads", value=cvalue, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + read(cvalue,*) nthrds + else + nthrds = localPeCount + endif + +!$ call omp_set_num_threads(nthrds) + print *,__FILE__,__LINE__,nthrds + call fms_init(mpi_comm_mom) call constants_init call field_manager_init @@ -790,6 +817,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) real(ESMF_KIND_R8), pointer :: dataPtr_ycor(:,:) integer :: mpicom integer :: localPet + integer :: localPeCount integer :: lsize integer :: ig,jg, ni,nj,k integer, allocatable :: gindex(:) ! global index space @@ -847,6 +875,32 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_VMGet(vm, petCount=npet, mpiCommunicator=mpicom, localPet=localPet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + !--------------------------------- + ! openmp threads + !--------------------------------- + + call ESMF_VMGet(vm, pet=localPet, peCount=localPeCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + + if(localPeCount == 1) then + call NUOPC_CompAttributeGet(gcomp, "nthreads", value=cvalue, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + read(cvalue,*) nthrds + else + nthrds = localPeCount + endif + +!$ call omp_set_num_threads(nthrds) + print *,__FILE__,__LINE__,nthrds + + !--------------------------------- ! global mom grid size !--------------------------------- @@ -1459,6 +1513,8 @@ subroutine ModelAdvance(gcomp, rc) call shr_file_setLogUnit (logunit) +!$ call omp_set_num_threads(nthrds) + ! query the Component for its clock, importState and exportState call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, & exportState=exportState, rc=rc) From 2da6ee08ec78c903a9d7e6ee52b0998a92bdbf80 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 5 Apr 2021 10:27:40 -0600 Subject: [PATCH 47/51] initialize localPet --- config_src/drivers/nuopc_cap/mom_cap.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config_src/drivers/nuopc_cap/mom_cap.F90 b/config_src/drivers/nuopc_cap/mom_cap.F90 index ca0b40d509..7379bd099a 100644 --- a/config_src/drivers/nuopc_cap/mom_cap.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap.F90 @@ -426,7 +426,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ESMF_VMGetCurrent(vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(VM, mpiCommunicator=mpi_comm_mom, rc=rc) + call ESMF_VMGet(VM, mpiCommunicator=mpi_comm_mom, localPet=localPet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockGet(CLOCK, currTIME=MyTime, TimeStep=TINT, RC=rc) From 8a8d9ea25ac065c6f462cb5e2fc27fed7f05038e Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 9 Apr 2021 07:06:45 -0600 Subject: [PATCH 48/51] response to review --- config_src/drivers/nuopc_cap/mom_cap.F90 | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/config_src/drivers/nuopc_cap/mom_cap.F90 b/config_src/drivers/nuopc_cap/mom_cap.F90 index 7379bd099a..2f6dfa86d3 100644 --- a/config_src/drivers/nuopc_cap/mom_cap.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap.F90 @@ -145,7 +145,7 @@ module MOM_cap_mod integer :: scalar_field_idx_grid_nx = 0 integer :: scalar_field_idx_grid_ny = 0 integer :: nthrds !< number of openmp threads per task -character(len=*),parameter :: u_file_u = & +character(len=*),parameter :: u_FILE_u = & __FILE__ #ifdef CESMCOUPLED @@ -461,7 +461,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) endif !$ call omp_set_num_threads(nthrds) - print *,__FILE__,__LINE__,nthrds call fms_init(mpi_comm_mom) call constants_init @@ -898,8 +897,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) endif !$ call omp_set_num_threads(nthrds) - print *,__FILE__,__LINE__,nthrds - !--------------------------------- ! global mom grid size From 3b121cf233e073248b1d555debad1a035859169a Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 21 Apr 2021 16:25:34 -0600 Subject: [PATCH 49/51] Replaces ESMF_LogFoundError to ChkErr --- config_src/drivers/nuopc_cap/mom_cap.F90 | 32 +++++++----------------- 1 file changed, 9 insertions(+), 23 deletions(-) diff --git a/config_src/drivers/nuopc_cap/mom_cap.F90 b/config_src/drivers/nuopc_cap/mom_cap.F90 index e81d220d0f..4776183c90 100644 --- a/config_src/drivers/nuopc_cap/mom_cap.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap.F90 @@ -53,7 +53,7 @@ module MOM_cap_mod use ESMF, only: ESMF_Grid, ESMF_GridCreate, ESMF_GridAddCoord use ESMF, only: ESMF_GridGetCoord, ESMF_GridAddItem, ESMF_GridGetItem use ESMF, only: ESMF_GridComp, ESMF_GridCompSetEntryPoint, ESMF_GridCompGet -use ESMF, only: ESMF_LogFoundError, ESMF_LogWrite, ESMF_LogSetError +use ESMF, only: ESMF_LogWrite, ESMF_LogSetError use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_KIND_R8, ESMF_RC_VAL_WRONG use ESMF, only: ESMF_GEOMTYPE_MESH, ESMF_GEOMTYPE_GRID, ESMF_SUCCESS use ESMF, only: ESMF_METHOD_INITIALIZE, ESMF_MethodRemove, ESMF_State @@ -464,18 +464,11 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) !--------------------------------- call ESMF_VMGet(vm, pet=localPet, peCount=localPeCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - + if (ChkErr(rc,__LINE__,u_FILE_u)) return if(localPeCount == 1) then call NUOPC_CompAttributeGet(gcomp, "nthreads", value=cvalue, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) nthrds else nthrds = localPeCount @@ -900,18 +893,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !--------------------------------- call ESMF_VMGet(vm, pet=localPet, peCount=localPeCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - + if (ChkErr(rc,__LINE__,u_FILE_u)) return if(localPeCount == 1) then call NUOPC_CompAttributeGet(gcomp, "nthreads", value=cvalue, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) nthrds else nthrds = localPeCount @@ -1075,7 +1061,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Determine mesh areas for regridding call ESMF_MeshGet(Emesh, numOwnedElements=numOwnedElements, spatialDim=spatialDim, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return allocate (mod2med_areacor(numOwnedElements)) allocate (med2mod_areacor(numOwnedElements)) @@ -1085,11 +1071,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) #ifdef CESMCOUPLED ! Determine model areas and flux correction factors (module variables in mom_) call ESMF_StateGet(exportState, itemName=trim(fldsFrOcn(2)%stdname), field=lfield, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldRegridGetArea(lfield, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(lfield, farrayPtr=dataPtr_mesh_areas, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return allocate(mesh_areas(numOwnedElements)) allocate(model_areas(numOwnedElements)) From 6196c039fb5d40759e77b8cb317f136f0aaa430e Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 22 Apr 2021 15:47:18 -0600 Subject: [PATCH 50/51] Add isPresent and isSet when retrieving nthreads --- config_src/drivers/nuopc_cap/mom_cap.F90 | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/config_src/drivers/nuopc_cap/mom_cap.F90 b/config_src/drivers/nuopc_cap/mom_cap.F90 index 4776183c90..f5f7985e15 100644 --- a/config_src/drivers/nuopc_cap/mom_cap.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap.F90 @@ -467,7 +467,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if(localPeCount == 1) then - call NUOPC_CompAttributeGet(gcomp, "nthreads", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(gcomp, "nthreads", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) nthrds else @@ -822,6 +823,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer :: lbnd3,ubnd3,lbnd4,ubnd4 integer :: nblocks_tot logical :: found + logical :: isPresent, isSet integer(ESMF_KIND_I4), pointer :: dataPtr_mask(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_area(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_xcen(:,:) @@ -896,7 +898,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if(localPeCount == 1) then - call NUOPC_CompAttributeGet(gcomp, "nthreads", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(gcomp, "nthreads", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) nthrds else From e6ce6a8865c83d67455402b8e20d5023dd5ad157 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 26 Apr 2021 11:50:36 -0600 Subject: [PATCH 51/51] use isPresent,isSet to conditionally retrieve configuration --- config_src/drivers/nuopc_cap/mom_cap.F90 | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) diff --git a/config_src/drivers/nuopc_cap/mom_cap.F90 b/config_src/drivers/nuopc_cap/mom_cap.F90 index f5f7985e15..2d79674606 100644 --- a/config_src/drivers/nuopc_cap/mom_cap.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap.F90 @@ -418,6 +418,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) character(len=512) :: diro character(len=512) :: logfile character(ESMF_MAXSTR) :: cvalue + character(len=64) :: logmsg logical :: isPresent, isPresentDiro, isPresentLogfile, isSet logical :: existflag integer :: userRc @@ -467,13 +468,19 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if(localPeCount == 1) then - call NUOPC_CompAttributeGet(gcomp, "nthreads", value=cvalue, & + call NUOPC_CompAttributeGet(gcomp, name="nthreads", value=cvalue, & isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) nthrds + if (isPresent .and. isSet) then + read(cvalue,*) nthrds + else + nthrds = localPeCount + endif else nthrds = localPeCount endif + write(logmsg,*) nthrds + call ESMF_LogWrite(trim(subname)//': nthreads = '//trim(logmsg), ESMF_LOGMSG_INFO) !$ call omp_set_num_threads(nthrds) @@ -898,10 +905,14 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if(localPeCount == 1) then - call NUOPC_CompAttributeGet(gcomp, "nthreads", value=cvalue, & + call NUOPC_CompAttributeGet(gcomp, name="nthreads", value=cvalue, & isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) nthrds + if (isPresent .and. isSet) then + read(cvalue,*) nthrds + else + nthrds = localPeCount + endif else nthrds = localPeCount endif